![]() // Hiermit können
immer die aktuell gültigen Bankleitzahlen heruntergeladen werden. uses activex, urlmon, wininet; type cDownloadStatusCallback = class(TObject, IUnknown, IBindStatusCallback) private CacheDatei: string; function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall; function _AddRef: Integer; stdcall; function _Release: Integer; stdcall; function OnStartBinding(dwReserved: Longint; pib: IBinding): HResult; stdcall; function GetPriority(out pnPriority: Longint): HResult; stdcall; function OnLowResource(reserved: Longint): HResult; stdcall; function OnProgress(ulProgress: Longint; ulProgressMax: Longint; ulStatusCode: Longint; szStatusText: PWideChar): HResult; stdcall; function OnStopBinding(hRes: HResult; szError: PWideChar): HResult; stdcall; function GetBindInfo(out grfBINDF: Longint; var pbindinfo: TBindInfo): HResult; stdcall; function OnDataAvailable(grfBSCF: Longint; dwSize: Longint; var pformatetc: TFormatEtc; var pstgmed: TSTGMEDIUM): HResult; stdcall; function OnObjectAvailable(const iid: TGUID; const punk: IUnknown): HResult; stdcall; end; var BLZDatei, tmp: string; sl: TStringlist; MyCancel: boolean; function cDownloadStatusCallback._AddRef: Integer; begin Result := 0; end; function cDownloadStatusCallback._Release: Integer; begin Result := 0; end; function cDownloadStatusCallback.QueryInterface(const IID: TGUID; out Obj): HResult; begin if (GetInterface(IID, Obj)) then begin Result := 0 end else begin Result := E_NOINTERFACE; end; end; function cDownloadStatusCallback.OnStartBinding(dwReserved: Longint; pib: IBinding): HResult; begin Result := S_OK; end; function cDownloadStatusCallback.GetPriority(out pnPriority: Longint): HResult; begin Result := S_OK; end; function cDownloadStatusCallback.OnLowResource(reserved: Longint): HResult; begin Result := S_OK; end; function cDownloadStatusCallback.OnStopBinding(hRes: HResult; szError: PWideChar): HResult; begin Result := S_OK; end; function cDownloadStatusCallback.GetBindInfo(out grfBINDF: Longint; var pbindinfo: TBindInfo): HResult; begin Result := S_OK; end; function cDownloadStatusCallback.OnDataAvailable(grfBSCF: Longint; dwSize: Longint; var pformatetc: TFormatEtc; var pstgmed: TSTGMEDIUM): HResult; begin Result := S_OK; end; function cDownloadStatusCallback.OnObjectAvailable(const iid: TGUID; const punk: IUnknown): HResult; begin Result := S_OK; end; function cDownloadStatusCallback.OnProgress(ulProgress: Longint; ulProgressMax: Longint; ulStatusCode: Longint; szStatusText: PWideChar): HResult; begin case ulStatusCode of BINDSTATUS_CACHEFILENAMEAVAILABLE: CacheDatei := string(szStatusText); end; if application.terminated then MyCancel := true; Application.ProcessMessages; if MyCancel then begin Result := E_ABORT; exit; end; Result := S_OK; end; function BLZ_download(pfad: string): boolean; var cDown: CDownloadstatuscallback; qll, o, Bundesbank, ZielDatei: string; vd, bd: TDate; x, status: integer; procedure weg; begin while pos('Aktuelle Bankleitzahlendatei', sl[0]) <> 1 do sl.delete(0); end; procedure fnd; var i, lg: integer; s: string; begin weg; o := ''; s := 'gültig ab'; i := pos(s, sl[0]); if i = 0 then begin s := 'gültig ab'; i := pos(s, sl[0]); end; if i = 0 then exit; lg := length(s) + 1; sl[0] := copy(sl[0], i + lg, maxint); vd := strtodate(copy(sl[0], 1, 10)); i := pos('bis', sl[0]); sl[0] := copy(sl[0], i + 4, maxint); bd := strtodate(copy(sl[0], 1, 10)); BLZDatei := 'blz_' + formatdatetime('YYYYMMDD', vd) + '.txt'; o := 'http://www.Bundesbank.de/download/zahlungsverkehr/bankleitzahlen/' + formatdatetime('YYYYMMDD', bd) + '/' + BLZDatei; end; begin result := false; MyCancel := false; cDown := cDownloadStatusCallback.Create; Bundesbank := tmp + 'Seite.txt'; if ansilastchar(Pfad) <> '\' then pfad := pfad + '\'; ZielDatei := pfad + BLZDatei; try sl.clear; qll := 'http://www.Bundesbank.de/zahlungsverkehr/' + 'zahlungsverkehr_bankleitzahlen_download.php'; status := URLDownloadToFileA(nil, pchar(qll), pchar(Bundesbank), 0, cdown); DeleteUrlCacheEntry(PansiChar(cDown.CacheDatei)); deletefile(cDown.CacheDatei); DeleteUrlCacheEntry(PansiChar(qll)); sleep(200); if (status <> 0) or not fileexists(Bundesbank) then exit else begin sl.loadfromfile(Bundesbank); sl.text := stringreplace(sl.text, #13, #13#10, [rfreplaceall]); for x := 0 to sl.count - 1 do sl[x] := trimleft(sl[x]); fnd; sl.delete(0); if date < vd then fnd; if o <> '' then begin status := URLDownloadToFileA(nil, pchar(o), pchar(ZielDatei), 0, cdown); DeleteUrlCacheEntry(PansiChar(cDown.CacheDatei)); deletefile(cDown.CacheDatei); DeleteUrlCacheEntry(PansiChar(ZielDatei)); if status <> 0 then exit; sl.loadfromfile(ZielDatei); // Formatierung sl.savetofile(ZielDatei); result := true; end; end; except end; cdown.free; deletefile(Bundesbank); end; procedure TForm1.FormCreate(Sender: TObject); var d: Cardinal; p: PChar; begin sl := TStringlist.create; d := max_path; getmem(p, d); gettemppath(d, p); tmp := p; freemem(p); end; procedure TForm1.FormDestroy(Sender: TObject); begin sl.free; end; procedure abfrage(Datei: TFilename; s: string; gefunden: TStrings; nurEine: boolean); var x: integer; begin gefunden.clear; if not fileexists(Datei) or (s = '') then exit; s := ansiuppercase(s); sl.loadfromfile(Datei); for x := 0 to sl.count - 1 do if pos(s, ansiuppercase(sl[x])) in [1..66] then begin gefunden.add(copy(sl[x], 1, 8) + #32 + copy(sl[x], 10, 58)); if nurEine then break; end; end; // Beispielaufruf procedure TForm1.Button1Click(Sender: TObject); begin Button1.enabled := false; if BLZ_download('c:\') then showmessage('OK') else showmessage('Fehlgeschlagen'); Button1.enabled := true; end; // Abbruch procedure TForm1.Button2Click(Sender: TObject); begin MyCancel := true; end; // Suche procedure TForm1.Button3Click(Sender: TObject); begin abfrage('c:\' + BLZDatei, '83050303', Listbox1.items, false); end; // oder auch procedure TForm1.Button4Click(Sender: TObject); begin abfrage('c:\' + BLZDatei, 'Raiffeisenbank Tölzer Land', Listbox1.items, true); end; |
Zugriffe seit 6.9.2001 auf Delphi-Ecke