// 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





