// Hiermit können immer die aktuell gültigen Bankleitzahlen heruntergeladen werden.
// Dabei wird sichergestellet, dass die Datei nicht aus dem Cache, sondern
// stets frisch geladen wird.
// Siehe dazu auch:
BLZ / Kontonummer validieren


// Getestet mit D4 unter XP

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