Arkadaşlar kendi işyerim için yazdığım gib portalından indirdiğim e arşiv xlm faturaları okuyup stoklarımı düzenleyip görselini gösteren bir program yazdım sizinle paylaşmak istedim
Konuyu Oyla:
E fatura okuma xlm
|
05-04-2025, Saat: 19:02
Teşekkürler. Kodlarınızı "Delphi Kod Ekle" aracını kullanarak eklerseniz, aşağıdakine benzer şekilde daha okunaklı ve anlaşılır olacaktır.
Procedure Deneme; begin // açıklama label1.caption := 'merhaba'; end;
05-04-2025, Saat: 19:06
(05-04-2025, Saat: 19:02)frmman Adlı Kullanıcıdan Alıntı: Teşekkürler. Kodlarınızı "Delphi Kod Ekle" aracını kullanarak eklerseniz, aşağıdakine benzer şekilde daha okunaklı ve anlaşılır olacaktır.kod aracını görmemiştim teşekkürler unit xlm_gosterUnit; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, xmldom, XMLIntf, msxmldom, XMLDoc, OleCtrls, SHDocVw, StdCtrls, my_compenent, Buttons, DB, ADODB ; type TXlm_Fatura_gosterForm = class(TForm) WebBrowser1: TWebBrowser; doc: TXMLDocument; OpenDialog1: TOpenDialog; GroupBox1: TGroupBox; Button11: TButton1; SpeedButton11: TSpeedButton1; Buttonnext: TButton1; ListBox1: TListBox; procedure fatura_goster(filename:string); procedure Button11Click(Sender: TObject); procedure FormShow(Sender: TObject); procedure SpeedButton11Click(Sender: TObject); procedure WebBrowser1Enter(Sender: TObject); private { Private declarations } public Txlm_filename:WideString; { Public declarations } end; {$ifndef unicode} type Tbytes=array of byte; {$endif} var Xlm_Fatura_gosterForm: TXlm_Fatura_gosterForm; // xslt_klasor:string; procedure xlm_fatura_gorsel(filename:string;liste:TListBox); implementation {$R *.dfm} uses IdCoderMIME,msxml,encddecd,tmodul_unit,Stok_Ekle_Unit,ClipBrd; procedure xlm_fatura_gorsel(filename:string;liste:TListBox);// listebox olmasada olur ben buton dan sıradaki fatura görüntülemek icin yaptım begin filename:=TXlm_Files+filename; if not FileExists(filename) then begin ShowMessage(filename+' Görsel Dosya Bulunamadı');Abort end; if not Assigned(Xlm_Fatura_gosterForm) then Application.CreateForm(TXlm_Fatura_gosterForm, Xlm_Fatura_gosterForm); Xlm_Fatura_gosterForm.Txlm_filename:=filename; if liste<> nil then Xlm_Fatura_gosterForm.ListBox1.Items:=liste.Items; Xlm_Fatura_gosterForm.ShowModal; FreeAndNil(Xlm_Fatura_gosterForm); end; // wep browsere yuklemek procedure LoadHTMLCode(AWebBrowser : TWebBrowser; const AHTMLCode: string); var Doc: Variant; begin if not Assigned(AWebBrowser.Document) then AWebBrowser.Navigate('about:blank'); Doc := AWebBrowser.Document; Doc.Clear; Doc.Write(AHTMLCode); Doc.Close; end; function Transform(const AXMLContent : string; const AXSLContent : string) : string; var XML : IXMLDOMDocument; XSL : IXMLDOMDocument; begin XML := CoDOMDocument.Create; XML.load(AXMLContent); XSL := CoDOMDocument.Create; XSL.load(AXSLContent); Result := XML.TransformNode(XSL); end; procedure Save_BinaryTo_File(const BinaryStream: TMemoryStream; const FileName: string); var FileStream: TFileStream; begin FileStream := TFileStream.Create(FileName, fmCreate); try BinaryStream.Position := 0; FileStream.CopyFrom(BinaryStream, BinaryStream.Size); finally FileStream.Free; end; end; function Base64ToBinary(const Base64String: string; out BinaryStream: TMemoryStream): Boolean; var DecodedStream: TStringStream; DecodedString: string; begin Result := False; DecodedStream := TStringStream.Create(''); try try DecodedString := DecodeString(Base64String); DecodedStream.WriteString(DecodedString); DecodedStream.Position := 0; BinaryStream.CopyFrom(DecodedStream, 0); Result := True; except // Hata durumunda False döndürülür. end; finally DecodedStream.Free; end; end; procedure ConvertBase64To_xlts(const Base_txt: string; const FileName: string);// base64 formatındaki bilgiyi dosyaya cevirir var BinaryStream: TMemoryStream; begin BinaryStream := TMemoryStream.Create; try if Base64ToBinary(Base_txt, BinaryStream) then Save_BinaryTo_File(BinaryStream,FileName) else ShowMessage('Base64 dönüşümü başarısız.'); finally BinaryStream.Free; end; end; procedure kaydet_txt(filename:string;str:String);// xlm den okudugu base64 fornatını txt dosyasına kaydediyor var LogFile: TextFile; begin AssignFile(LogFile,FileName); {$IOChecks off} ReWrite(LogFile); WriteLn(LogFile, str); CloseFile(LogFile); {$IOChecks on} end; function txt_oku(filename:string):AnsiString; // yazdıgınız base64 txt dosyasını okuyoruz var LoadString: AnsiString; FS: TFileStream; begin FS := TFileStream.Create(FileName, fmOpenRead ); try SetLength(LoadString, FS.Size); FS.ReadBuffer(Pointer(LoadString)^, FS.Size); finally FS.Free; end; Result:=(String(LoadString)); end; procedure TXlm_Fatura_gosterForm.fatura_goster(filename:string); // xlm dosyasını adını girecegiz burada xlm de gömülü xlts dosyasını base64 formatında onu alıp txt dosyasına yazacak var myFile : TextFile; LBytes: tBytes; LBase64Text: string; XMLContent : string; xslt_klasor, XLSContent : string; HTMLCode ,txt_adi: string; node_doc,alt_node,b_node,h: IXMLNode; begin xslt_klasor:=filename;; doc.FileName:=filename; doc.Active:=true; node_doc:=Doc.DocumentElement.ChildNodes.First; repeat if node_doc.NodeName = 'cbc:ID' then txt_adi:= node_doc.NodeValue; if node_doc.NodeName ='cac:AdditionalDocumentReference' then begin alt_node:=node_doc.ChildNodes.First; begin repeat if alt_node.NodeName ='cac:Attachment'then begin b_node:=alt_node.ChildNodes.First; repeat if b_node.NodeName='cbc:EmbeddedDocumentBinaryObject' then begin if b_node.Attributes['mimeCode']='application/xml' then begin kaydet_txt(xslt_klasor+txt_adi+ '.txt',b_node.Text);// xlm nin içinde base64 formatındaki xlts dosayası yani görsel fatura end; end; b_node:=b_node.NextSibling; until b_node=nil; end; alt_node:=alt_node.NextSibling; until alt_node=nil; end; end; node_doc:=node_doc.NextSibling; until node_doc=nil; doc.DOMDocument.appendChild( doc.DOMDocument.createProcessingInstruction('xml-stylesheet', 'type="text/xsl" href="'+ txt_adi+'.xslt"')); if not FileExists(xslt_klasor+txt_adi+'.xml') then doc.SaveToFile(xslt_klasor+txt_adi+'.xml'); // görüntülenecek xml if not FileExists(xslt_klasor+txt_adi+'.xslt') then begin LBase64Text:=txt_oku(xslt_klasor+txt_adi+ '.txt'); // txt dosyasındaki base64 formatındaki bilgileri alıyoruz ConvertBase64To_xlts(LBase64Text, xslt_klasor+txt_adi+ '.xslt'); //txt dosyasını xlts formatına ceviriyoruz end; //// fatuara göster XMLContent:= xslt_klasor+txt_adi+'.xml'; XLSContent := xslt_klasor+txt_adi+'.xslt'; //transforming HTMLCode := Transform(XMLContent, XLSContent); //wep browserde göterecek WebBrowser1.Silent := True; LoadHTMLCode(WebBrowser1, HTMLCode); // web yükle end; end; end.xlm gömülü xlts yi base64 den xlts formatına çıkarıp webbrowserde görseli görebilirsiniz unit Fonksiyonlar_Unit; interface uses System.SysUtils, System.Classes ,Winapi.Windows ; type TDataModule2 = class(TDataModule) private { Private declarations } public { Public declarations } end; var DataModule2: TDataModule2; function Kurus_ayırac: string; function para_ayirac: string; function Tarih_ayirac: string; function Ayirac_düzelt(deger:string):string; function matrah_Ayirac_düzelt(deger:string):string; implementation {%CLASSGROUP 'Vcl.Controls.TControl'} {$R *.dfm} function Kurus_ayırac: string; var L: Integer; Buffer: array[0..255] of Char; DefaultLCID: LCID; begin DefaultLCID := GetThreadLocale; L := GetLocaleInfo(DefaultLCID, LOCALE_STHOUSAND, Buffer, SizeOf(Buffer)); if L > 0 then SetString(Result, Buffer, L - 1) else Result := ','; end; function PARA_ayirac: string; var L: Integer; Buffer: array[0..255] of Char; DefaultLCID: LCID; begin DefaultLCID := GetThreadLocale; L := GetLocaleInfo(DefaultLCID, LOCALE_SDECIMAL, Buffer, SizeOf(Buffer)); if L > 0 then SetString(Result, Buffer, L - 1) else Result := '.'; end; function Tarih_ayirac: string; var L: Integer; Buffer: array[0..255] of Char; DefaultLCID: LCID; begin DefaultLCID := GetThreadLocale; L := GetLocaleInfo(DefaultLCID, LOCALE_SDATE, Buffer, SizeOf(Buffer)); if L > 0 then SetString(Result, Buffer, L - 1) else Result := '/'; end; function matrah_Ayirac_düzelt(deger:string):string; var I: Integer; begin i := pos('(',deger); if i<>0 then delete(deger,i,length(deger)-1); end; function Ayirac_düzelt(deger:string):string; var I: Integer; begin for I := 1 to Length(deger)-1 do if not (deger[i] in ['0'..'9']) then deger[i]:=PARA_ayirac[1]; Result:= deger; end; end. LOCALE_SCURRENCY, //para birimi işareti LOCALE_ICURRENCY, //para sıfır ekleme LOCALE_INEGCURR, LOCALE_SDECIMAL, LOCALE_ICURRDIGITS, LOCALE_STHOUSAND, LOCALE_SDATE, LOCALE_STIME end. unit E_fatura_Unit; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, Buttons, StdCtrls, ZipForge, //FileCtrl, xmldom, XMLIntf, msxmldom, XMLDoc, Grids, DBGrids, DB, ADODB, Mask, DBCtrls, Menus, ComCtrls, my_compenent, FileCtrl; type TEfatura_Form = class(TForm) GroupBox1: TGroupBox; SpeedButton11: TSpeedButton1; OpenDialog1: TOpenDialog; XMLDocument1: TXMLDocument; GroupBox2: TGroupBox; FileListBox1: TFileListBox; GroupBox3: TGroupBox; DBGrid_faturalar: TDBGrid; DBGrid_satirlar: TDBGrid; GroupBox4: TGroupBox; GroupBox5: TGroupBox; DBEdit11: TDBEdit1; GroupBox6: TGroupBox; DBEdit12: TDBEdit1; GroupBox7: TGroupBox; DBEdit13: TDBEdit1; GroupBox8: TGroupBox; GroupBox9: TGroupBox; GroupBox10: TGroupBox; Label1: TLabel; Label2: TLabel; Label3: TLabel; Label4: TLabel; DBEdit14: TDBEdit1; DBEdit15: TDBEdit1; DBEdit16: TDBEdit1; DBEdit17: TDBEdit1; PopupMenu1: TPopupMenu; xlmac1: TMenuItem; GroupBox11: TGroupBox; DBGrid1: TDBGrid; GroupBox12: TGroupBox; SpeedButton12: TSpeedButton1; SpeedButton13: TSpeedButton1; GroupBox13: TGroupBox; GroupBox14: TGroupBox; GroupBox15: TGroupBox; ilk_tarih: TDateTimePicker1; son_tarih: TDateTimePicker1; GroupBox16: TGroupBox; Label_say: TLabel; GroupBox17: TGroupBox; GroupBox18: TGroupBox; Bul_edit: TEdit1; GroupBox19: TGroupBox; Edit11: TEdit1; PopupMenu_kalemler: TPopupMenu; StokAra1: TMenuItem; BarkodAra1: TMenuItem; GroupBox20: TGroupBox; SpeedButton15: TSpeedButton1; SpeedButton14: TSpeedButton1; Button11: TButton1; Combobox_gonderen: TCombobox1; SeciliCariyeAaitFaturalarGster1: TMenuItem; Seci1: TMenuItem; mKaytlar1: TMenuItem; ListBox1: TListBox; function zip_dosya_ac:boolean; procedure SpeedButton11Click(Sender: TObject); procedure FormCreate(Sender: TObject); procedure fatura_kalemler( ANode : IXMLNode; ATitle : string = '' ); function xml_fatura_yukle(klasor,filename:string) :boolean; procedure DBGrid_faturalarDblClick(Sender: TObject); procedure xlmac1Click(Sender: TObject); procedure gonderen_al(gon_node: IXMLNode); procedure alici_al(alc_node:IXMLNode); procedure kdv_ayrinti_al(tnode:IXMLNode); procedure SpeedButton12Click(Sender: TObject); procedure SpeedButton13Click(Sender: TObject); procedure SpeedButton14Click(Sender: TObject); procedure DBEdit12DblClick(Sender: TObject); procedure GroupBox16DblClick(Sender: TObject); procedure test_dosyasini_sil; procedure Bul_editChange(Sender: TObject); procedure Edit11Change(Sender: TObject); procedure StokAra1Click(Sender: TObject); procedure BarkodAra1Click(Sender: TObject); procedure SpeedButton15Click(Sender: TObject); procedure Button11Click(Sender: TObject); procedure SeciliCariyeAaitFaturalarGster1Click(Sender: TObject); procedure Seci1Click(Sender: TObject); procedure mKaytlar1Click(Sender: TObject); procedure FormShow(Sender: TObject); private { Private declarations } public { Public declarations } end; var Efatura_Form: TEfatura_Form; implementation {$R *.dfm} uses Comobj, Stok_Ekle_Unit, Tlhelp32,tmodul_unit,Fonksion_Unit, Math,ShellAPI, xlm_gosterUnit, DateUtils, depar_iletiUnit; const SHCONTCH_NOPROGRESSBOX = 4; SHCONTCH_AUTORENAME = 8; SHCONTCH_RESPONDYESTOALL = 16; SHCONTF_INCLUDEHIDDEN = 128; SHCONTF_FOLDERS = 32; SHCONTF_NONFOLDERS = 64; function tarih_duzelt(ttarih:string):string; begin Result:=Copy(ttarih, 9, 2)+'.'+ Copy(ttarih, 6, 2)+'.'+ Copy(ttarih, 1, 4); end; { function zip_ac(zipfile, targetfolder: string; filter: string = ''): boolean; var shellobj: variant; srcfldr, destfldr: variant; shellfldritems: variant; begin shellobj := CreateOleObject('Shell.Application'); srcfldr := shellobj.NameSpace(zipfile); destfldr := shellobj.NameSpace(targetfolder); shellfldritems := srcfldr.Items; if (filter <> '') then shellfldritems.Filter(SHCONTF_INCLUDEHIDDEN or SHCONTF_NONFOLDERS or SHCONTF_FOLDERS,filter); destfldr.CopyHere(shellfldritems, SHCONTCH_NOPROGRESSBOX or SHCONTCH_RESPONDYESTOALL); end; } function TEfatura_Form.zip_dosya_ac:boolean; var zip_dosya:string; archiver : TZipForge; begin if OpenDialog1.Execute then begin zip_dosya:=OpenDialog1.FileName; archiver := TZipForge.Create(nil); try with archiver do begin FileName := zip_dosya; OpenArchive(fmOpenRead); BaseDir := ExtractFilePath(Application.ExeName)+'\'+Txstl_xlm_klasor; ExtractFiles('*.*'); CloseArchive(); FileName := zip_dosya; OpenArchive(fmOpenRead); BaseDir := ExtractFilePath(Application.ExeName)+'\test'; ExtractFiles('*.*'); CloseArchive(); end; except on E: Exception do begin Writeln('Exception: ', E.Message); end; end; result:=True; end else Result:=False; end; //// fatura kalemleri al procedure TEfatura_Form.fatura_kalemler( ANode : IXMLNode; ATitle : string = '' ); var altnode, anaNode, tmpSubNode:IXMLNode; begin anaNode := ANode.ChildNodes.First; with DataModule1 do begin F_Kalemler_ADOTable.Append; repeat if ( anaNode.NodeName = 'cbc:ID' ) then // F_Kalemler_ADOTableSra_No.AsString:=anaNode.Text; // sırano If anaNode.LocalName ='InvoicedQuantity' then // birim kodu ve adeti begin F_Kalemler_ADOTableMiktar.Value:= StrToCurr(Ayirac_duzelt(anaNode.NodeValue)); //miktar if anaNode.HasAttribute('unitCode') then //birimide al if urun_Birimler_ADOTable.Locate('birim_kodu',anaNode.AttributeNodes.FindNode('unitCode').Text,[loCaseInsensitive]) then begin F_Kalemler_ADOTablebirim_kodu.Value:= anaNode.AttributeNodes.FindNode('unitCode').Text; F_Kalemler_ADOTableBirim.Value:= urun_Birimler_ADOTablebirim_acklama.Value; F_Kalemler_ADOTablebirim_adet.Value:=urun_Birimler_ADOTableBirim_adet.Value; end else begin F_Kalemler_ADOTableBirim.Value:= anaNode.AttributeNodes.FindNode('unitCode').Text; F_Kalemler_ADOTablebirim_kodu.Value:= anaNode.AttributeNodes.FindNode('unitCode').Text; F_Kalemler_ADOTablebirim_adet.Value:=False; end; end; // satır tutarı kdv haric iskondo düsülmüş zorunlu if anaNode.LocalName='LineExtensionAmount' then F_Kalemler_ADOTableSatir_Tutar.Value:=StrToCurr(Ayirac_duzelt(anaNode.NodeValue)); if anaNode.LocalName='AllowanceCharge' then ///iskonto begin altnode:=anaNode.ChildNodes.First; repeat if altnode.LocalName='ChargeIndicator' then //kdv dahil true veya falsr F_Kalemler_ADOTablekdv_dahil.Value:= altnode.Text; if altnode.LocalName='BaseAmount' then // kdv dahil satırtutar F_Kalemler_ADOTableSatir_Toplam.Value:=StrToCurr(Ayirac_duzelt(altnode.NodeValue)); if altnode.LocalName='MultiplierFactorNumeric' then //iskonto oranı F_Kalemler_ADOTableIskonto_Orani.Value:=StrToCurr(Ayirac_duzelt(altnode.NodeValue)); if altnode.LocalName='Amount' then F_Kalemler_ADOTableskonto_Tutari.Value:=StrToCurr(Ayirac_duzelt(altnode.NodeValue)); altnode:=altnode.NextSibling; until altnode=nil; end; if anaNode.LocalName = 'TaxTotal' then //kalem vergi bilgileri begin tmpSubNode := anaNode.ChildNodes.First; repeat if tmpSubNode.LocalName='TaxSubtotal' then begin altnode:=tmpSubNode.ChildNodes.First; repeat if altnode.LocalName='TaxAmount' then //kdv tutarı F_Kalemler_ADOTableKdv_Tutar.Value:=StrToCurr(Ayirac_duzelt(altnode.NodeValue)); if altnode.LocalName='Percent'then //kdv oranı F_Kalemler_ADOTableKdv_Orani.Value:=StrToCurr(Ayirac_duzelt(altnode.NodeValue)); altnode:=altnode.NextSibling; until altnode= nil; end; tmpSubNode := tmpSubNode.NextSibling;//bir sonraki node ye atla... until tmpSubNode = Nil; end; if anaNode.LocalName='Item' then begin altnode:=anaNode.ChildNodes.First; repeat if altnode.LocalName='Name' then F_Kalemler_ADOTableMal_Hizmet.Value:=altnode.Text; if altnode.LocalName='Description' then F_Kalemler_ADOTableMal_Hizmet_1.Value:=altnode.Text; if altnode.LocalName= 'SellersItemIdentification'then //ürün kodu veya barkod F_Kalemler_ADOTableBarkod.Value:=altnode.ChildNodes.first.Text; altnode:=altnode.NextSibling; until altnode=nil; end; if anaNode.LocalName='Price' then // b,r,m fiyatı begin altnode:=anaNode.ChildNodes.First; repeat if altnode.LocalName='PriceAmount' then F_Kalemler_ADOTableBirim_Fiyat.Value:=StrToCurr(Ayirac_duzelt(altnode.NodeValue)); altnode:=altnode.NextSibling; until altnode=nil; end; anaNode := anaNode.NextSibling;// next satır bilgileri until anaNode = Nil; F_Kalemler_ADOTable.Post; end; end; procedure TEfatura_Form.alici_al(alc_node:IXMLNode); var alt_node, av_node:IXMLNode; begin with DataModule1 do repeat if alc_node.NodeName = 'cacsuan butun faturaları ve stokları ve kalemleri kendi veri tabanıma alıp muhasebeleştiriyorum fakat sıkıntı su fatura kesen entegresyon firmaları bazı alanları fatura görselinde olmadığı için yanlış dolduruyorlar urun barkodunun yazılması gereken yere isim vs yazıyorlar bende bunu hizmet adındaki alan mecburi olduğu için urun ismine göre aratıp stok girdi çıktısını yapıyorum normalde görsel ile xlm aynı olmalı fakat olmuyor gramlı ve adetli barkodlar olusturuyorom turkiyede 29 28 27 barkodun ilk iki hanesi toplam 13 hane 2 hane urunun gramajlı veya adetli satıldığı anlamında sonraki 5 hane urunun barkodu sonraki 6 hane gram cinsinden fakat ben ek adında bir barkod üretiyorum sonraki alanlar urun miktarı yani ek1 1 adet ek demek ek20 20 adet ek bunud da tabloda belirtiyorun function gramli_barkod(tbarkod:string; var tmiktar:Currency ): string; var ex:Extended; gramli_barkod:string; gramli_miktar:string; begin with DataModule1 do begin If barkod.Active= false Then barkod.Open; if barkod.Locate('barkod',Copy(tbarkod, 1,2),[loPartialKey]) then begin gramli_barkod:= Copy(tbarkod ,1, barkodbarkod_uzunluk.Value); // barkod uzunluk gramli_miktar:= Copy(tbarkod,barkodbarkod_uzunluk.Value+1, Length(tbarkod)); // miktar uzunluk Result:=gramli_barkod; if TryStrToFloat(gramli_miktar,ex) then tmiktar:= StrToFloat( gramli_miktar)/DataModule1.barkodcarpan.Value else begin //ShowMessage('EDET TANIMLI BARKOD HATASI düzeltiniz'); Result:=tbarkod; end; end else Result:=tbarkod; If barkod.Active= true Then barkod.close; end; end;
my_compenent
delphi 7 de bazı nesleler de aling olmadığı için kendim o neslelere olay yordam ekledim SpeedButton11: TSpeedButton1; vs gibi siz SpeedButton1: TSpeedButton; tanımlarsanız sorun olmaz Zip dosya açmak içim 10,3 de içinde geliyor ben delphi 7 de yazdım 7-zip yuklemeniz gerekli üçretsiz sadece delphi de mesaj verir derlediğizde mesaj almazsınız xlm formatı günceldir sunan gelen tüm fatura bilgileri okuyabilirsiniz if alc_node.NodeName = 'cac<img src="https://www.delphican.com/images/smilies/tongue.png" alt="Tongue" title="Tongue" class="smilie smilie_5">arty' thenbu satırlar böyle oldu anlamadım gib sitesinde xlm node alanları yazılıyor sablonlar da var
zip olarak gelen dosyanın içindeki 10 adet e arsiv dosyayı excel direk aktarır satır ve sütunları kendiniz belirlersiniz alt toplamları
procedure TForm1.Button_excel_aktarClick(Sender: TObject); dbgrideki bilgileri aynı hücre yapısına göre aktarır unit ecxell_aktar_Unit; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, my_compenent, DB, ADODB, IdBaseComponent, IdComponent, IdTCPServer, Buttons, ExtCtrls, DBCtrls, Grids, DBGrids, ComCtrls, FileCtrl, xmldom, XMLIntf, msxmldom, XMLDoc,StrUtils; // for TDocVariant type support; type TForm1 = class(TForm) GroupBox1: TGroupBox; Stok_aktar_Button: TButton1; ADOConnection1: TADOConnection; hesapADOQuery: TADOQuery; Cari_ADOTable: TADOTable; Button11: TButton1; hesapADOQueryhesapi: TBCDField; OpenDialog1: TOpenDialog; IdTCPServer1: TIdTCPServer; PageControl1: TPageControl; TabSheet1: TTabSheet; TabSheet2: TTabSheet; DBGrid1: TDBGrid; DataSource_Stok: TDataSource; GroupBox2: TGroupBox; DBNavigator1: TDBNavigator; Stok_ADOTable: TADOQuery; Button_Veri_al: TButton1; Button_excel_aktar: TButton1; ListBox1: TListBox; FileListBox1: TFileListBox; XMLDocument1: TXMLDocument; function _dosya_ac:boolean; procedure Button_excel_aktarClick(Sender: TObject); procedure Button_Veri_alClick(Sender: TObject); procedure ListBox1DblClick(Sender: TObject); procedure FormShow(Sender: TObject); function farura_baslik(D : IXMLDocument; var g_satir:integer;g_sutun:integer) :boolean; procedure alici_al(D : IXMLDocument; var g_satir:integer;g_sutun:integer); procedure gonderen_al(D : IXMLDocument; var g_satir:integer;g_sutun:integer); procedure FileListBox1DblClick(Sender: TObject); procedure kalemleri_al(D:IXMLDocument; var gsatir:integer;gsutun:integer); procedure fatura_kalemler(ANode : IXMLNode; g_satir,g_sutun:integer); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} uses comobj, DateUtils,ZipForge; var sayfa,uygulama: Variant; function birim(g_birim_kodu:string): string; const birim_kodlari : array [0..3] of String = ('TN','NIU','PK','EA'); begin case AnsiIndexStr(g_birim_kodu,birim_kodlari ) of 1 : Result:='Teneke'; 2 : Result:='ADET'; 3 : Result:='PAKET'; 4 : Result:='paket'; 5 :Result:='KARTON'; else Result:='Adet'; end ; end; // birim kodlaı cözümlenecek gib portalta kodlara gelen karşilıkları mevcut function TForm1._dosya_ac:boolean; var zip_dosya:string; archiver : TZipForge; begin OpenDialog1.DefaultExt:='*.zip'; OpenDialog1.Filter:=' E arşiv Zip dosyalar|*.zip'; OpenDialog1.FilterIndex:=1; if OpenDialog1.Execute then begin zip_dosya:=OpenDialog1.FileName; archiver := TZipForge.Create(nil); try with archiver do begin FileName := zip_dosya; OpenArchive(fmOpenRead); BaseDir := ExtractFilePath(Application.ExeName)+'\'+'xlm'; // ana dizine xlm klasorune acılacak ExtractFiles('*.*'); CloseArchive(); end; except on E: Exception do begin Writeln('Exception: ', E.Message); Readln; end; end; result:=True; end else Result:=False; end; procedure TForm1.Button_Veri_alClick(Sender: TObject); begin if ADOConnection1.Connected then ADOConnection1.Close; OpenDialog1.Title:='Program Kayıt dosyaını Şeciniz'; OpenDialog1.InitialDir:=ExtractFilePath(Application.ExeName); if OpenDialog1.Execute then Caption:=OpenDialog1.FileName; if FileExists(Caption) then begin ADOConnection1.ConnectionString:= 'Provider=Microsoft.Jet.OLEDB.4.0;User ID=Admin;Data Source='+ Caption+';Mode=Share Deny None;Jet OLEDB:'+ 'System database="";Jet OLEDB:Registry Path="";Jet OLEDB if fatura_node.NodeName = ProfileID then " burası farklı çıkıyor anlamış degilim yukarıdaki base64 fonciyonu ile faturalarınıza loğorı base64 formatına çevirip görsele gömebilirsiniz yukarıdaki programla bu program arasındaki fark yukarıda xlm dosyasını 2 defa yükleyip acar çünkü fatura kalemleri en alt satırdadır node ler iç içe gectiğinde veri tabanı kayıt eklerken sıkıntı çıkıyor geçici yükler iseniz excell vs gibi zaman kaybı oluyor en sağlılı olanı veri tabanına alıp ondan sonra işlem yapmak açılacak dosya sayısı fazla olursa zaman kaybı misal ben hızlı satış programında satış yapıyorum ana veri tabanıma yazmadan önce faklı veri tabanında işlem yapıyorum ne zaman kaydet dedim ana veri tabanıma işliyor yani elektirik kesilse veya program bir şekilde kapatılsa dahi veriler orda duruyor ve daha hızlı çünkü ana veri tabanında tablo sayısı farklı diger veri tabanı olusturaşağım kasa sayısı kadar 2 veya 3 adet ve diğer bir avantajı diğer veri tabanı bağlantısı yerel pc de ana bağlantı diğer pc veya wepte olsun ne zaman kaydet dersem o zaman işlem yapıyor ve programı farklı pc lerde kullanabiliyorum sadece ana baglantı yolunu gostermem yeterli oluyor doğrumu yapıyorum orasını bilmiyorum fakat şu ana kadar sıkıntı çıkmadı 1999 da pascal da akaryakıt istasyonu programı yazmıştım degişken fiyat üstünden malum o zaman fiyatlar çok değişken olunca cari hesabı da değisiyordu ben sadece hobi amaçlı uğraşıyorum |
« Önceki Konu | Sonraki Konu »
|
Konu ile Alakalı Benzer Konular | |||||
Konular | Yazar | Yorumlar | Okunma | Son Yorum | |
Mikrotik routher Port okuma | Mert_37 | 1 | 253 |
23-08-2024, Saat: 16:46 Son Yorum: Syntax |
|
ENTEGRATOR ile E-FATURA (elektronik dönüşüm) UYGULAMASI | guverdik | 50 | 23.721 |
13-06-2024, Saat: 15:39 Son Yorum: ahmet6513 |
|
[ÇÖZÜLDÜ] En Kolay E-Fatura entegratörü hangisi? | rmzgenius | 22 | 4.130 |
25-05-2024, Saat: 09:20 Son Yorum: hbulus |
|
OPC Server veri okuma | enigma | 1 | 740 |
13-09-2023, Saat: 11:50 Son Yorum: shooterman |
|
ReadProcessMemory ile veri okuma nasıl yapılır | eraendless | 2 | 717 |
07-09-2023, Saat: 00:35 Son Yorum: veteran |
Konuyu Okuyanlar: 1 Ziyaretçi