var 
  BLZ_, PRFZ_: TStringlist; 
  fehler: boolean = false; 
  Datei: string = 'blz_20060605.txt'; 
{http://www.bundesbank.de/zahlungsverkehr/zahlungsverkehr_bankleitzahlen_download.php} 
 
procedure TForm1.FormCreate(Sender: TObject); 
var 
  x: integer; 
  hlp: TStringlist; 
begin 
  if not fileexists(datei) then begin 
    fehler := true; 
    showmessage('Datei mit Bankleitzahlen nicht gefunden') 
  end else begin 
    hlp := TStringlist.create; 
    BLZ_ := TStringlist.create; 
    PRFZ_ := TStringlist.create; 
    hlp.loadfromfile(datei); 
    for x := 0 to hlp.count - 1 do begin 
      if hlp[x][9] = '1' then begin 
        BLZ_.add(copy(hlp[x], 1, 8)); 
        PRFZ_.add(copy(hlp[x], 151, 2)); 
      end; 
    end; 
    hlp.free; 
  end; 
end; 
 
procedure TForm1.FormDestroy(Sender: TObject); 
begin 
  if not fehler then begin 
    PRFZ_.free; 
    BLZ_.free; 
  end; 
end; 
 
function quer(i: integer): integer; 
var 
  s: string; 
  x: integer; 
begin 
  s := inttostr(i); 
  result := 0; 
  for x := 1 to length(s) do 
    result := result + strtoint(s[x]); 
end; 
 
function trans(KTO: string): integer; 
const 
  ta: array[0..3, 0..9] of integer = 
  ((0, 1, 5, 9, 3, 7, 4, 8, 2, 6), (0, 1, 7, 6, 9, 8, 3, 2, 5, 4), 
    (0, 1, 8, 4, 6, 2, 9, 5, 7, 3), (0, 1, 2, 3, 4, 5, 6, 7, 8, 9)); 
var 
  x, z: integer; 
begin 
  result := 0; 
  z := 0; 
  for x := 9 downto 1 do begin 
    result := result + ta[z, strtoint(KTO[x])]; 
    inc(z); 
    if z = 4 then z := 0; 
  end; 
end; 
 
function p87(KTO: string): boolean; 
const 
  TAB1: array[0..4] of integer = (0, 4, 3, 2, 6); 
  TAB2: array[0..4] of integer = (7, 1, 5, 9, 8); 
var 
  i, C2, D2, A5, P: integer; 
begin 
  result := false; 
  i := 4; 
  while KTO[i] = '0' do inc(i); 
  C2 := i mod 2; 
  D2 := 0; 
  A5 := D2; 
  while i < 10 do begin 
    case KTO[i] of 
      '0': KTO[i] := '5'; 
      '1': KTO[i] := '6'; 
      '5': KTO[i] := 'A'; 
      '6': KTO[i] := '1'; 
    end; 
    if C2 = D2 then begin 
      if strtoint('$' + KTO[i]) > 5 then begin 
        if (C2 = 0) and (D2 = 0) then begin 
          C2 := 1; 
          D2 := C2; 
          A5 := A5 + 6 - (strtoint('$' + KTO[i]) - 6); 
        end else begin 
          C2 := 0; 
          D2 := C2; 
          A5 := A5 + strtoint('$' + KTO[i]); 
        end; 
      end else begin 
        if (C2 = 0) and (D2 = 0) then begin 
          C2 := 1; 
          A5 := A5 + strtoint('$' + KTO[i]); 
        end else begin 
          C2 := 0; 
          A5 := A5 + strtoint('$' + KTO[i]); 
        end; 
      end; 
    end 
    else begin 
      if strtoint('$' + KTO[i]) > 5 then begin 
        if C2 = 0 then begin 
          C2 := 1; 
          D2 := 0; 
          A5 := A5 - 6 + (strtoint('$' + KTO[i]) - 6); 
        end else begin 
          C2 := 0; 
          D2 := 1; 
          A5 := A5 - strtoint('$' + KTO[i]); 
        end; 
      end else begin 
        if C2 = 0 then begin 
          C2 := 1; 
          A5 := A5 - strtoint('$' + KTO[i]); 
        end else begin 
          C2 := 0; 
          A5 := A5 - strtoint('$' + KTO[i]); 
        end 
      end; 
    end; 
    inc(i); 
  end; 
  while (A5 < 0) or (A5 > 4) do 
    if A5 > 4 then A5 := A5 - 5 else A5 := A5 + 5; 
  if D2 = 0 then P := TAB1[A5] else P := TAB2[A5]; 
  if P = strtoint('$' + KTO[10]) then result := true 
  else begin 
    if KTO[4] = '0' then begin 
      if P > 4 then P := P - 5 else P := P + 5; 
      if P = strtoint('$' + KTO[10]) then result := true; 
    end; 
  end; 
end; 
 
function prf(BLZ, KTO: string): byte; 
const 
  k1: array[0..2] of integer = (3, 1, 7); 
  k4: array[0..8] of integer = (2, 3, 4, 5, 6, 7, 2, 3, 4); 
  k5: array[0..2] of integer = (7, 1, 3); 
  k18: array[0..3] of integer = (9, 3, 1, 7); 
  k30: array[0..8] of integer = (2, 0, 0, 0, 0, 1, 2, 1, 2); 
  k52: array[0..11] of integer = (2, 4, 8, 5, 10, 9, 7, 3, 6, 1, 2, 4); 
  k55: array[0..8] of integer = (2, 3, 4, 5, 6, 7, 8, 7, 8); 
  k64: array[0..5] of integer = (9, 10, 5, 8, 4, 2); 
  k66: array[0..7] of integer = (2, 3, 4, 5, 6, 0, 0, 7); 
  k77: array[0..4] of integer = (5, 4, 3, 4, 5); 
  k91: array[0..5] of integer = (2, 4, 8, 5, 10, 9); 
  KB9: array[0..6] of integer = (1, 3, 2, 1, 3, 2, 1); 
var 
  kz, x, y, z, lg, m: integer; 
  hlp: int64; 
  function rechtrans: integer; 
  begin 
    result := 10 - trans(KTO) mod 10; 
    if result = 10 then result := 0; 
  end; 
  procedure w21(von, bis: integer); 
  var 
    x: integer; 
  begin 
    for x := von downto bis do 
      if odd(x) then 
        y := y + quer(strtoint(KTO[x]) * 2) else 
        y := y + strtoint(KTO[x]); 
  end; 
  procedure w75(von, bis: integer); 
  var 
    x: integer; 
  begin 
    for x := von to bis do 
      if odd(x) then 
        y := y + quer(strtoint(KTO[x]) * 2) else 
        y := y + strtoint(KTO[x]); 
  end; 
  procedure xm11(von, bis: integer); 
  var 
    x: integer; 
  begin 
    for x := von downto bis do 
      y := y + strtoint(KTO[x]) * (11 - x); 
  end; 
  function b01(prf: integer): boolean; 
  begin 
    y := y mod 11; 
    if y in [0, 1] then result := KTO[prf] = '0' 
    else result := KTO[prf] = inttostr(11 - y); 
  end; 
  function mdl10(prf: integer): boolean; 
  begin 
    y := 10 - y mod 10; 
    if y = 10 then y := 0; 
    result := inttostr(y) = KTO[prf]; 
  end; 
  function mdl11: boolean; 
  begin 
    if y = 1 then result := false 
    else begin 
      if y = 0 then result := KTO[10] = '0' else 
        result := inttostr(11 - y) = KTO[10]; 
    end; 
  end; 
  function is19: integer; 
  begin 
    y := 27; 
    xm11(9, 2); 
    result := ord(not b01(10)); 
  end; 
  function f5253(KTO: string): integer; 
  var 
    x: integer; 
  begin 
    z := strtoint(KTO[6]); 
    while copy(KTO, 7, 1) = '0' do delete(KTO, 7, 1); 
    KTO := copy(KTO, 1, 12); 
    KTO[6] := '0'; 
    lg := length(KTO); 
    for x := lg downto 1 do begin 
      if x = 6 then m := k52[lg - x]; 
      y := y + strtoint(KTO[x]) * k52[lg - x]; 
    end; 
    y := y mod 11; 
    x := -1; 
    repeat 
      inc(x); 
      lg := (y + x * m) mod 11; 
    until (lg = 10); 
    result := ord(x <> z); 
  end; 
  function a51: integer; 
  begin 
    y := 0; 
    xm11(9, 3); 
    result := ord(not b01(10)); 
    if result <> 0 then begin 
      y := 0; 
      xm11(9, 1); 
      result := ord(not b01(10)); 
    end; 
  end; 
  function ym7: integer; 
  begin 
    y := y mod 7; 
    if y = 0 then result := ord(not (KTO[10] = '0')) else 
      result := ord(not (KTO[10] = inttostr(7 - y))); 
  end; 
  procedure fk4(von, bis: integer); 
  var 
    x: integer; 
  begin 
    for x := von downto bis do 
      y := y + strtoint(KTO[x]) * k4[von - x]; 
  end; 
  function f93: integer; 
  var 
    x: integer; 
  begin 
    if copy(KTO, 1, 4) = '0000' then begin 
      xm11(9, 5); 
      result := ord(not b01(10)); 
    end else begin 
      for x := 5 downto 1 do 
        y := y + strtoint(KTO[x]) * (7 - x); 
      result := ord(not b01(6)); 
    end; 
    if result = 0 then exit; 
    y := 0; 
    if copy(KTO, 1, 4) = '0000' then begin 
      for x := 9 downto 5 do 
        y := y + strtoint(KTO[x]) * (11 - x); 
      result := ym7; 
    end else begin 
      for x := 5 downto 1 do 
        y := y + strtoint(KTO[x]) * (7 - x); 
      y := y mod 7; 
      if y = 0 then result := ord(not (KTO[6] = '0')) 
      else result := ord(not (KTO[6] = inttostr(7 - y))); 
    end; 
  end; 
  function nm3(bis: integer): integer; 
  var 
    x: integer; 
  begin 
    for x := 9 downto bis do 
      if odd(x) then 
        y := y + strtoint(KTO[x]) * 2 else 
        y := y + strtoint(KTO[x]); 
    result := ord(not mdl10(10)); 
  end; 
  function f5: integer; 
  var 
    x: integer; 
  begin 
    for x := 9 downto 1 do 
      y := y + strtoint(KTO[x]) * k5[x mod 3]; 
    result := ord(not mdl10(10)); 
  end; 
  function f2: integer; 
  begin 
    xm11(9, 2); 
    y := (y + strtoint(KTO[1]) * 2) mod 11; 
    result := ord(not mdl11); 
  end; 
  function f53: integer; 
  begin 
    result := 1; 
    if KTO[1] = '9' then begin 
      result := is19; 
      exit; 
    end; 
    if KTO[1] <> '0' then exit; 
    KTO := copy(KTO, 2, 9); 
    KTO := copy(BLZ, 5, 2) + KTO[2] + BLZ[8] + KTO[1] + 
      copy(KTO, 3, maxint); 
    if length(KTO) < 6 then exit; 
    result := f5253(KTO); 
  end; 
  function f01(bis: integer): integer; 
  var 
    x: integer; 
  begin 
    for x := 9 downto bis do 
      y := y + strtoint(KTO[x]) * k1[x mod 3]; 
    result := ord(not mdl10(10)); 
  end; 
  function fB9: integer; 
  begin 
    if y >= 10 then dec(y, 10); 
    result := ord(not (KTO[10] = inttostr(y))); 
    if result = 0 then exit; 
    inc(y, 5); 
    if y >= 10 then dec(y, 10); 
    result := ord(not (KTO[10] = inttostr(y))); 
  end; 
  function f52(KTO: string): integer; 
  begin 
    result := 1; 
    if KTO[1] = '9' then begin 
      result := is19; 
      exit; 
    end; 
    KTO := copy(KTO, 3, 8); 
    KTO := copy(BLZ, 5, 4) + KTO; 
    if length(KTO) < 6 then exit; 
    result := f5253(KTO); 
  end; 
  function f17: integer; 
  begin 
    w75(2, 7); 
    y := pred(y) mod 11; 
    if y = 0 then result := ord(not (KTO[8] = '0')) 
    else result := ord(not (KTO[8] = inttostr(10 - y))); 
  end; 
  function f22: integer; 
  var 
    x: integer; 
  begin 
    for x := 9 downto 1 do begin 
      if odd(x) then 
        z := strtoint(KTO[x]) * 3 else 
        z := strtoint(KTO[x]); 
      y := y + z mod 10; 
    end; 
    result := ord(not (KTO[10] = inttostr(10 - (y mod 10)))); 
  end; 
begin 
  result := 255; 
  if fehler then exit; 
  BLZ := stringreplace(BLZ, #32, '', [rfreplaceall]); 
  KTO := stringreplace(KTO, #32, '', [rfreplaceall]); 
  result := 2; 
  if length(BLZ) <> 8 then exit; 
  x := BLZ_.indexof(BLZ); 
  if x < 0 then exit; 
  kz := strtoint('$' + PRFZ_[x]); 
  result := 1; 
  if (length(KTO) > 10) or 
    (kz = $68) and (KTO[1] = '0') then exit; 
  while length(KTO) < 10 do KTO := '0' + KTO; 
  for x := 1 to 10 do 
    if not (KTO[x] in ['0'..'9']) then exit; 
  y := 0; 
  case kz of 
    $00, $08, $59, $60, $62: begin 
        if (kz = 8) and (strtoint64(KTO) < 60000) then exit; 
        if (kz = $59) and (copy(KTO, 1, 2) = '00') then result := 0 
        else begin 
          w21(9 - ord(kz = $62) * 2, 1 + 
            ord(kz = $60) * 2 + ord(kz = $62) * 2); 
          result := ord(not mdl10(10 - ord(kz = $62) * 2)); 
        end; 
      end; 
    $01, $92: begin 
        if kz = $01 then z := 1 else z := 4; 
        result := f01(z); 
      end; 
    $02: result := f2; 
    $03: result := nm3(1); 
    $04: begin 
        fk4(9, 1); 
        y := y mod 11; 
        result := ord(not mdl11); 
      end; 
    $05: begin 
        result := f5; 
      end; 
    $06, $70: begin 
        if (kz = $70) and ((KTO[4] = '5') or (copy(KTO, 4, 2) = '69')) 
          then z := 4 else z := 1; 
        fk4(9, z); 
        result := ord(not b01(10)); 
      end; 
    $07: begin 
        xm11(9, 1); 
        y := y mod 11; 
        result := ord(not mdl11); 
      end; 
    $09: result := 0; 
    $10: begin 
        xm11(9, 1); 
        result := ord(not b01(10)); 
      end; 
    $11: begin 
        xm11(9, 1); 
        y := y mod 11; 
        if y = 10 then result := ord(not (KTO[10] = '9')) 
        else if y = 0 then result := ord(not (KTO[10] = '0')) 
        else result := ord(not (KTO[10] = inttostr(11 - y))); 
      end; 
    $12: result := 3; 
    $13: begin 
        w21(7, 2); 
        result := ord(not mdl10(8)); 
        if result <> 0 then begin 
          if (copy(KTO, 9, 2) = '00') or (copy(KTO, 1, 2) <> '00') 
            then exit; 
          KTO := copy(KTO, 3, 8) + '00'; 
          y := 0; 
          w21(7, 2); 
          result := ord(not mdl10(8)); 
        end; 
      end; 
    $14: begin 
        xm11(9, 4); 
        y := y mod 11; 
        result := ord(not mdl11); 
      end; 
    $15: begin 
        xm11(9, 6); 
        result := ord(not b01(10)); 
      end; 
    $16: begin 
        fk4(9, 1); 
        y := y mod 11; 
        if y = 1 then 
          result := ord(not (KTO[9] = KTO[10])) 
        else begin 
          if y = 0 then result := ord(not (KTO[10] = '0')) 
          else result := ord(not (KTO[10] = inttostr(11 - y))); 
        end; 
      end; 
    $17: result := f17; 
    $18: begin 
        for x := 9 downto 1 do 
          y := y + strtoint(KTO[x]) * k18[x mod 4]; 
        result := ord(not mdl10(10)); 
      end; 
    $19, $20: begin 
        y := strtoint(KTO[1]); 
        if kz = $20 then y := y * 3; 
        xm11(9, 2); 
        result := ord(not b01(10)); 
      end; 
    $21: begin 
        w21(9, 1); 
        while y > 9 do y := quer(y); 
        result := ord(not (strtoint(KTO[10]) = 10 - y)); 
      end; 
    $22: result := f22; 
    $23: begin 
        fk4(6, 1); 
        y := y mod 11; 
        if y = 0 then result := ord(not (KTO[7] = '0')) else 
          if y = 1 then result := ord(not (KTO[6] = KTO[7])) else 
            result := ord(not (KTO[7] = inttostr(11 - y))); 
      end; 
    $24: begin 
        if KTO[1] in ['3'..'6'] then KTO[1] := '0'; 
        if KTO[1] = '9' then KTO := '000' + copy(KTO, 4, 7); 
        z := 1; 
        x := 1; 
        while KTO[x] = '0' do inc(x); 
        while x < 10 do begin 
          y := y + (strtoint(KTO[x]) * z + z) mod 11; 
          inc(x); 
          inc(z); 
          if z = 4 then z := 1; 
        end; 
        result := ord(not (KTO[10] = inttostr(y mod 10))); 
      end; 
    $25: if KTO[1] = '0' then begin 
        xm11(9, 2); 
        y := y mod 11; 
        if y = 0 then result := ord(not (KTO[10] = '0')) else 
          if y = 1 then result := ord(not ((KTO[10] = '0') 
              and ((KTO[2] = '8') or (KTO[2] = '9')))) 
          else result := ord(not (KTO[10] = inttostr(11 - y))); 
      end; 
    $26: begin 
        if copy(KTO, 1, 2) = '00' then KTO := copy(KTO, 3, 8) + '00'; 
        fk4(7, 1); 
        result := ord(not b01(8)); 
      end; 
    $27: if strtoint64(KTO) < 1000000000 then begin 
        w21(9, 1); 
        result := ord(not mdl10(10)); 
      end else 
        result := ord(not (KTO[10] = inttostr(rechtrans))); 
    $28: begin 
        for x := 7 downto 1 do 
          y := y + strtoint(KTO[x]) * (9 - x); 
        result := ord(not b01(8)); 
      end; 
    $29: result := ord(not (KTO[10] = inttostr(rechtrans))); 
    $30: begin 
        for x := 1 to 9 do 
          y := y + strtoint(KTO[x]) * k30[x - 1]; 
        result := ord(not mdl10(10)); 
      end; 
    $31: begin 
        for x := 9 downto 1 do 
          y := y + strtoint(KTO[x]) * x; 
        y := y mod 11; 
        if y = 0 then result := ord(not (KTO[10] = '0')) else 
          if y <> 10 then 
            result := ord(not (y = strtoint(KTO[10]))); 
      end; 
    $32, $81: begin 
        if (kz = $81) and (KTO[3] = '9') then 
          result := a51 else begin 
          xm11(9, 4); 
          result := ord(not b01(10)); 
        end; 
      end; 
    $33, $82: begin 
        if (kz = $82) and (copy(KTO, 3, 2) = '99') then 
          z := 1 else z := 5; 
        xm11(9, z); 
        result := ord(not b01(10)); 
      end; 
    $34: begin 
        for x := 7 downto 1 do 
          y := y + strtoint(KTO[x]) * k52[7 - x]; 
        result := ord(not b01(8)); 
      end; 
    $35: begin 
        xm11(9, 1); 
        y := y mod 11; 
        if y = 10 then result := ord(not (KTO[9] = KTO[10])) 
        else result := ord(not (KTO[10] = inttostr(y))); 
      end; 
    $36, $37, $38, $39, $40: begin 
        for x := 9 downto 
          6 - ord(kz = $37) - ord(kz = $38) * 2 - ord(kz = $39) * 3 
          - ord(kz = $40) * 5 do 
          y := y + strtoint(KTO[x]) * k52[9 - x]; 
        result := ord(not b01(10)); 
      end; 
    $41: begin 
        if KTO[4] = '9' then z := 4 
        else z := 1; 
        w21(9, z); 
        result := ord(not mdl10(10)); 
      end; 
    $42: begin 
        xm11(9, 2); 
        result := ord(not b01(10)); 
      end; 
    $43: begin 
        for x := 9 downto 1 do 
          y := y + strtoint(KTO[x]) * (10 - x); 
        result := ord(not mdl10(10)); 
      end; 
    $44: begin 
        for x := 9 downto 5 do 
          y := y + strtoint(KTO[x]) * k52[9 - x]; 
        result := ord(not b01(10)); 
      end; 
    $45: if (KTO[1] = '0') or (KTO[5] = '1') then result := 0 
      else begin 
        w21(9, 1); 
        result := ord(not mdl10(10)); 
      end; 
    $46: begin 
        for x := 7 downto 3 do 
          y := y + strtoint(KTO[x]) * (9 - x); 
        result := ord(not b01(8)); 
      end; 
    $47, $48: begin 
        for x := 8 downto 4 - ord(kz = $48) do 
          y := y + strtoint(KTO[x]) * (10 - x); 
        result := ord(not b01(9)); 
      end; 
    $49: begin 
        w21(9, 1); 
        result := ord(not mdl10(10)); 
        if result <> 0 then begin 
          y := 0; 
          result := f01(1); 
        end; 
      end; 
    $50: begin 
        for x := 6 downto 1 do 
          y := y + strtoint(KTO[x]) * (8 - x); 
        result := ord(not b01(7)); 
        if result <> 0 then begin 
          if copy(KTO, 1, 3) <> '000' then exit; 
          KTO := copy(KTO, 4, 7) + '000'; 
          y := 0; 
          for x := 6 downto 1 do 
            y := y + strtoint(KTO[x]) * (8 - x); 
          result := ord(not b01(7)); 
        end; 
      end; 
    $51: begin 
        xm11(9, 4); 
        result := ord(not b01(10)); 
        if result <> 0 then begin 
          y := 0; 
          xm11(9, 5); 
          result := ord(not b01(10)); 
        end; 
        if result <> 0 then begin 
          if KTO[10] in ['7'..'9'] then exit; 
          if KTO[3] = '9' then 
            result := a51 else begin 
            y := 0; 
            xm11(9, 5); 
            result := ym7; 
          end; 
        end; 
      end; 
    $52: if copy(KTO, 1, 2) = '00' then result := f52(KTO); 
    $53: result := f53; 
    $54: begin 
        if copy(KTO, 1, 2) <> '49' then exit; 
        fk4(9, 3); 
        y := y mod 11; 
        if y in [0, 1] then exit; 
        result := ord(not (KTO[10] = inttostr(11 - y))); 
      end; 
    $55: begin 
        for x := 9 downto 1 do 
          y := y + strtoint(KTO[x]) * k55[9 - x]; 
        result := ord(not b01(10)); 
      end; 
    $56: begin 
        fk4(9, 1); 
        y := 11 - y mod 11; 
        if y in [10, 11] then begin 
          if KTO[1] <> '9' then exit; 
          dec(y, 3); 
        end; 
        result := ord(not (KTO[10] = inttostr(y))); 
      end; 
    $57: begin 
        if (strtoint(copy(KTO, 1, 2)) in [0..50, 91, 96..99]) 
          or (copy(KTO, 1, 6) = '777777') 
          or (copy(KTO, 1, 6) = '888888') 
          then begin 
          result := 0; 
          exit; 
        end; 
        for x := 1 to 9 do 
          if odd(x) then 
            y := y + strtoint(KTO[x]) else 
            y := y + quer(strtoint(KTO[x]) * 2); 
        result := ord(not mdl10(10)); 
      end; 
    $58: begin 
        if copy(KTO, 1, 5) = '00000' then exit; 
        xm11(9, 5); 
        y := y mod 11; 
        result := ord(not mdl11); 
      end; 
    $61: begin 
        z := strtoint(KTO[8]); 
        if KTO[9] = '8' then begin 
          delete(KTO, 8, 1); 
          m := 9; 
        end else m := 7; 
        w21(m, 1); 
        y := 10 - y mod 10; 
        if y = 10 then y := 0; 
        result := ord(not z = y); 
      end; 
    $63: begin 
        if KTO[1] <> '0' then exit; 
        if copy(KTO, 1, 3) = '000' then m := 9 
        else m := 7; 
        w21(m, m - 5); 
        result := ord(not mdl10(m + 1)); 
      end; 
    $64: begin 
        for x := 1 to 6 do 
          y := y + strtoint(KTO[x]) * k64[x - 1]; 
        result := ord(not b01(7)); 
      end; 
    $65: if KTO[9] = '9' then begin 
        z := strtoint(KTO[8]); 
        delete(KTO, 8, 1); 
        w21(9, 1); 
        y := 10 - y mod 10; 
        if y = 10 then y := 0; 
        result := ord(not z = y); 
      end else begin 
        w21(7, 1); 
        result := ord(not mdl10(8)); 
      end; 
    $66: begin 
        if KTO[1] <> '0' then exit; 
        for x := 9 downto 2 do 
          y := y + strtoint(KTO[x]) * k66[9 - x]; 
        y := y mod 11; 
        if y in [0, 1] then y := 1 xor y 
        else y := 11 - y; 
        result := ord(not (inttostr(y) = KTO[10])); 
      end; 
    $67: begin 
        w21(7, 1); 
        result := ord(not mdl10(8)); 
      end; 
    $68: if (KTO[1] <> '0') then begin 
        if (KTO[4] <> '9') then exit; 
        w21(9, 4); 
        result := ord(not mdl10(10)); 
      end else begin 
        if (strtoint64(KTO) >= 400000000) 
          and (strtoint64(KTO) <= 499999999) 
          then begin 
          result := 0; 
          exit; 
        end; 
        w21(9, 2); 
        result := ord(not mdl10(10)); 
        if result <> 0 then begin 
          y := 0; 
          delete(KTO, 3, 2); 
          w21(7, 2); 
          result := ord(not mdl10(10)); 
        end; 
      end; 
    $69: begin 
        if (strtoint64(KTO) >= 9300000000) 
          and (strtoint64(KTO) <= 9399999999) 
          then begin 
          result := 0; 
          exit; 
        end; 
        if (strtoint64(KTO) >= 9700000000) 
          and (strtoint64(KTO) <= 9799999999) 
          then begin 
          result := ord(not (KTO[10] = inttostr(rechtrans))); 
          exit; 
        end; 
        for x := 7 downto 1 do 
          y := y + strtoint(KTO[x]) * (9 - x); 
        result := ord(not b01(8)); 
        if result <> 0 then begin 
          y := 0; 
          result := ord(not (KTO[10] = inttostr(rechtrans))); 
        end; 
      end; 
    $71: begin 
        for x := 2 to 7 do 
          y := y + strtoint(KTO[x]) * (8 - x); 
        y := y mod 11; 
        if y in [0, 1] then result := ord(not (KTO[10] = inttostr(y))) 
        else result := ord(not (KTO[10] = inttostr(11 - y))); 
      end; 
    $72, $73: begin 
        if (kz = $73) and (KTO[3] = '9') then begin 
          result := a51; 
          exit; 
        end; 
        w21(9, 4); 
        result := ord(not mdl10(10)); 
        if (result <> 0) and (kz = $73) then begin 
          y := 0; 
          w21(9, 5); 
          result := ord(not mdl10(10)); 
          if result <> 0 then begin 
            y := 0; 
            w21(9, 5); 
            result := ym7; 
          end; 
        end; 
      end; 
    $74: begin 
        if copy(KTO, 1, 4) = '0000' then begin 
          w21(9, 5); 
          z := y; 
          result := ord(not mdl10(10)); 
          if result <> 0 then begin 
            y := 5 - z mod 5; 
            result := ord(not (KTO[10] = inttostr(y))); 
          end; 
        end else begin 
          w21(9, 1); 
          result := ord(not mdl10(10)); 
        end; 
      end; 
    $75: begin 
        if (KTO[1] <> '0') or (copy(KTO, 1, 2) = '00') and (KTO[3] <> '0') 
          then exit; 
        if copy(KTO, 1, 3) = '000' then begin 
          w75(5, 9); 
          result := ord(not mdl10(10)); 
        end else begin 
          if KTO[2] = '9' then begin 
            w75(3, 7); 
            result := ord(not mdl10(8)); 
          end else begin 
            for x := 2 to 6 do 
              if not odd(x) then 
                y := y + quer(strtoint(KTO[x]) * 2) else 
                y := y + strtoint(KTO[x]); 
            result := ord(not mdl10(7)); 
          end; 
        end; 
      end; 
    $76: begin 
        for m := 0 to 1 do begin 
          if not (KTO[1] in ['0', '4', '6'..'9']) then exit; 
          z := 2; 
          for x := 2 to 3 do 
            if KTO[x] = '0' then inc(z); 
          for x := 7 downto z do 
            y := y + strtoint(KTO[x]) * (9 - x); 
          y := y mod 11; 
          if y = 10 then result := 0 
          else result := ord(not (KTO[8] = inttostr(y))); 
          if (result = 0) or (copy(KTO, 1, 2) <> '00') then break; 
          KTO := copy(KTO, 3, 8) + '00'; 
          y := 0; 
        end; 
      end; 
    $77: begin 
        for x := 6 to 10 do 
          y := y + strtoint(KTO[x]) * (x - 5); 
        y := y mod 11; 
        if y = 0 then result := 0 
        else begin 
          y := 0; 
          for x := 6 to 10 do 
            y := y + strtoint(KTO[x]) * k77[x - 6]; 
          y := y mod 11; 
          if y <> 0 then exit; 
          result := 0; 
        end; 
      end; 
    $78: if (copy(KTO, 1, 2) = '00') and (KTO[3] <> '0') 
      then result := 0 else begin 
        w21(9, 1); 
        result := ord(not mdl10(10)); 
      end; 
    $79: begin 
        case KTO[1] of 
          '0': exit; 
          '3'..'8': begin 
              w21(9, 1); 
              result := ord(not mdl10(10)); 
            end; 
        else begin 
            for x := 8 downto 1 do 
              if not odd(x) then 
                y := y + quer(strtoint(KTO[x]) * 2) else 
                y := y + strtoint(KTO[x]); 
            result := ord(not mdl10(9)); 
          end; 
        end; 
      end; 
    $80: begin 
        w21(9, 5); 
        result := ord(not mdl10(10)); 
        if result <> 0 then begin 
          if KTO[3] = '9' then 
            result := a51 else begin 
            y := 0; 
            w21(9, 5); 
            result := ym7; 
          end; 
        end; 
      end; 
    $83: if copy(KTO, 3, 2) = '99' then begin 
        xm11(9, 3); 
        y := y mod 11; 
        if y in [0, 1] then result := 0 
        else result := ord(not (KTO[10] = inttostr(11 - y))); 
      end else begin 
        for z := 4 to 5 do begin 
          xm11(9, z); 
          result := ord(not b01(10)); 
          if result = 0 then exit; 
          y := 0; 
        end; 
        if KTO[10] in ['7'..'9'] then result := 1 
        else begin 
          xm11(9, 5); 
          result := ym7; 
        end; 
      end; 
    $84: begin 
        xm11(9, 5); 
        result := ord(not b01(10)); 
        if result <> 0 then begin 
          if KTO[3] = '9' then 
            result := a51 else begin 
            y := 0; 
            xm11(9, 5); 
            result := ym7; 
          end; 
        end; 
      end; 
    $85: begin 
        for z := 4 to 5 do begin 
          xm11(9, z); 
          result := ord(not b01(10)); 
          if result = 0 then exit; 
          y := 0; 
        end; 
        if KTO[10] in ['7'..'9'] then exit; 
        if copy(KTO, 3, 2) = '99' then begin 
          xm11(9, 3); 
          y := y mod 11; 
          result := ord(not mdl11); 
        end else begin 
          xm11(9, 5); 
          result := ym7; 
        end; 
      end; 
    $86: begin 
        w21(9, 4); 
        result := ord(not mdl10(10)); 
        if result <> 0 then begin 
          if KTO[3] = '9' then 
            result := a51 else begin 
            y := 0; 
            xm11(9, 4); 
            result := ord(not b01(10)); 
          end; 
        end; 
      end; 
    $87: if KTO[3] = '9' then 
        result := a51 else begin 
        result := ord(not p87(KTO)); 
        if result <> 0 then begin 
          y := 0; 
          xm11(9, 5); 
          result := ord(not b01(10)); 
          if result <> 0 then begin 
            y := 0; 
            xm11(9, 5); 
            result := ym7; 
          end; 
        end; 
      end; 
    $88: begin 
        if KTO[3] = '9' then z := 3 else z := 4; 
        xm11(9, z); 
        result := ord(not b01(10)); 
      end; 
    $89: begin 
        if (KTO[1] <> '0') or (copy(KTO, 1, 4) = '0000') 
          then result := 0 else 
          if copy(KTO, 1, 3) = '000' then begin 
            for x := 9 downto 4 do 
              y := y + quer(strtoint(KTO[x]) * (11 - x)); 
            result := ord(not b01(10)); 
          end else begin 
            xm11(9, 1); 
            result := ord(not b01(10)); 
          end; 
      end; 
    $90: if KTO[3] = '9' then begin 
        xm11(9, 3); 
        result := ord(not b01(10)); 
      end else begin 
        xm11(9, 4); 
        result := ord(not b01(10)); 
        if result <> 0 then begin 
          y := 0; 
          xm11(9, 5); 
          z := y; 
          result := ord(not b01(10)); 
          if result <> 0 then begin 
            if KTO[10] in ['7'..'9'] then 
              result := 1 else begin 
              y := z; 
              result := ym7; 
            end; 
          end; 
          if result <> 0 then begin 
            if KTO[10] = '9' then 
              result := 1 else begin 
              y := z mod 9; 
              if y = 0 then result := ord(not (KTO[10] = '0')) else 
                result := ord(not (KTO[10] = inttostr(9 - y))); 
            end; 
            if result <> 0 then begin 
              y := 0; 
              result := nm3(5); 
            end; 
          end; 
        end; 
      end; 
    $91: begin 
        for x := 6 downto 1 do 
          y := y + strtoint(KTO[x]) * (8 - x); 
        result := ord(not b01(7)); 
        if result = 0 then exit; 
        y := 0; 
        for x := 6 downto 1 do 
          y := y + strtoint(KTO[x]) * (x + 1); 
        result := ord(not b01(7)); 
        if result = 0 then exit; 
        z := strtoint(KTO[7]); 
        delete(KTO, 7, 1); 
        y := 0; 
        xm11(9, 1); 
        y := y mod 11; 
        if y in [0, 1] then result := ord(not (z = 0)) 
        else result := ord(not (z = 11 - y)); 
        if result = 0 then exit; 
        y := 0; 
        for x := 6 downto 1 do 
          y := y + strtoint(KTO[x]) * k91[6 - x]; 
        y := y mod 11; 
        if y in [0, 1] then result := ord(not (z = 0)) 
        else result := ord(not (z = 11 - y)); 
      end; 
    $93: result := f93; 
    $94: begin 
        for x := 9 downto 1 do 
          if not odd(x) then 
            y := y + quer(strtoint(KTO[x]) * 2) else 
            y := y + strtoint(KTO[x]); 
        result := ord(not mdl10(10)); 
      end; 
    $95: begin 
        hlp := strtoint64(KTO); 
        if (hlp >= 1) and (hlp <= 1999999) 
          or (hlp >= 9000000) and (hlp <= 25999999) 
          or (hlp >= 396000000) and (hlp <= 499999999) 
          or (hlp >= 700000000) and (hlp <= 799999999) 
          then result := 0 else begin 
          fk4(9, 1); 
          result := ord(not b01(10)); 
        end; 
      end; 
    $96: begin 
        y := strtoint(KTO[1]); 
        xm11(9, 2); 
        result := ord(not b01(10)); 
        if result = 0 then exit; 
        y := 0; 
        w21(9, 1); 
        result := ord(not mdl10(10)); 
        if result = 0 then exit; 
        hlp := strtoint64(KTO); 
        if (hlp >= 1300000) and (hlp <= 99399999) 
          then result := 0 else result := 1; 
      end; 
    $97: begin 
        if strtoint(copy(KTO, 1, 6)) = 0 then exit; 
        z := strtoint(copy(KTO, 1, 9)); 
        y := (z div 11) * 11; 
        y := z - y; 
        if y = 10 then result := ord(not (KTO[10] = '0')) else 
          result := ord(not (KTO[10] = inttostr(y))); 
      end; 
    $98: begin 
        for x := 9 downto 3 do 
          y := y + strtoint(KTO[x]) * k1[9 - x]; 
        result := ord(not mdl10(10)); 
        if result = 0 then exit; 
        y := 0; 
        xm11(9, 4); 
        result := ord(not b01(10)); 
      end; 
    $99: if (strtoint64(KTO) >= 396000000) and (strtoint64(KTO) <= 499999999) 
      then result := 0 else begin 
        fk4(9, 1); 
        result := ord(not b01(10)); 
      end; 
    $A0: if strtoint(copy(KTO, 1, 7)) = 0 then result := 0 
      else begin 
        for x := 9 downto 5 do 
          y := y + strtoint(KTO[x]) * k91[9 - x]; 
        result := ord(not b01(10)); 
      end; 
    $A1: if (copy(KTO, 1, 2) = '00') and (KTO[3] <> '0') 
      or (KTO[1] <> '0') then begin 
        w21(9, 3); 
        result := ord(not mdl10(10)); 
      end; 
    $A2: begin 
        w21(9, 1); 
        result := ord(not mdl10(10)); 
        if result = 0 then exit; 
        y := 0; 
        fk4(9, 1); 
        y := y mod 11; 
        result := ord(not mdl11); 
      end; 
    $A3: begin 
        w21(9, 1); 
        result := ord(not mdl10(10)); 
        if result = 0 then exit; 
        y := 0; 
        xm11(9, 1); 
        result := ord(not b01(10)); 
      end; 
    $A4: if copy(KTO, 3, 2) = '99' then begin 
        fk4(9, 5); 
        result := ord(not b01(10)); 
        if result = 0 then exit; 
        y := 0; 
        result := f93; 
      end else begin 
        fk4(9, 4); 
        result := ord(not b01(10)); 
        if result = 0 then exit; 
        y := 0; 
        xm11(9, 4); 
        result := ym7; 
        if result = 0 then exit; 
        y := 0; 
        result := f93; 
      end; 
    $A5: begin 
        w21(9, 1); 
        result := ord(not mdl10(10)); 
        if result = 0 then exit; 
        if KTO[1] = '9' then exit; 
        y := 0; 
        xm11(9, 1); 
        result := ord(not b01(10)); 
      end; 
    $A6: if KTO[2] = '8' then begin 
        w21(9, 1); 
        result := ord(not mdl10(10)); 
      end else result := f01(1); 
    $A7: begin 
        w21(9, 1); 
        result := ord(not mdl10(10)); 
        if result = 0 then exit; 
        y := 0; 
        result := nm3(1); 
      end; 
    $A8: begin 
        fk4(9, 4); 
        result := ord(not b01(10)); 
        if result = 0 then exit; 
        if KTO[3] = '9' then 
          result := a51 else begin 
          y := 0; 
          w21(9, 4); 
          result := ord(not mdl10(10)); 
        end; 
      end; 
    $A9: begin 
        result := f01(1); 
        if result = 0 then exit; 
        y := 0; 
        fk4(9, 1); 
        result := ord(not b01(10)); 
      end; 
    $B0: begin 
        if (KTO[1] = '0') or (KTO[1] = '8') then exit; 
        if KTO[8] in ['1'..'3', '6'] then result := 0 
        else begin 
          fk4(9, 1); 
          result := ord(not b01(10)); 
        end; 
      end; 
    $B1: begin 
        result := f5; 
        if result = 0 then exit; 
        y := 0; 
        result := f01(1); 
      end; 
    $B2: begin 
        if KTO[1] in ['0'..'7'] then result := f2 
        else begin 
          w21(9, 1); 
          result := ord(not mdl10(10)); 
        end; 
      end; 
    $B3: begin 
        if KTO[1] in ['0'..'8'] then 
          xm11(9, 4) else fk4(9, 1); 
        result := ord(not b01(10)); 
      end; 
    $B4: begin 
        if KTO[1] = '9' then begin 
          w21(9, 1); 
          result := ord(not mdl10(10)); 
        end else result := f2; 
      end; 
    $B5: begin 
        for x := 9 downto 1 do 
          y := y + strtoint(KTO[x]) * k5[x mod 3]; 
        result := ord(not mdl10(10)); 
        if result = 0 then exit; 
        if KTO[1] in ['8', '9'] then exit; 
        y := 0; 
        w21(9, 1); 
        result := ord(not mdl10(10)); 
      end; 
    $B6: begin 
        if KTO[1] in ['1'..'9'] then begin 
          y := strtoint(KTO[1]) * 3; 
          xm11(9, 2); 
          result := ord(not b01(10)); 
        end else result := f53; 
      end; 
    $B7: begin 
        hlp := strtoint64(KTO); 
        if (hlp >= 1000000) and (hlp <= 5999999) 
          or (hlp >= 700000000) and (hlp <= 899999999) 
          then result := f01(1) else result := 0; 
      end; 
    $B8: begin 
        y := strtoint(KTO[1]) * 3; 
        xm11(9, 2); 
        result := ord(not b01(10)); 
        if result = 0 then exit; 
        result := ord(not (KTO[10] = inttostr(rechtrans))); 
      end; 
    $B9: begin 
        if (copy(KTO, 1, 4) = '0000') or 
          (copy(KTO, 1, 2) <> '00') then exit; 
        if (copy(KTO, 1, 3) = '000') then begin 
          for x := 9 downto 4 do 
            y := y + strtoint(KTO[x]) * (10 - x); 
          y := y mod 11; 
          result := fB9; 
        end else begin 
          for x := 9 downto 3 do 
            y := y + (strtoint(KTO[x]) * kb9[9 - x] + kb9[9 - x]) mod 11; 
          y := y mod 10; 
          result := fB9; 
        end; 
      end; 
    $C0: begin 
        if (copy(KTO, 1, 2) = '00') and (KTO[3] <> '0') then begin 
          result := f52(KTO); 
          if result = 0 then exit; 
        end; 
        y := strtoint(KTO[1]) * 3; 
        xm11(9, 2); 
        result := ord(not b01(10)); 
      end; 
    $C1: if KTO[1] <> '5' then result := f17 
      else begin 
        for x := 1 to 9 do 
          if not odd(x) then 
            y := y + quer(strtoint(KTO[x]) * 2) else 
            y := y + strtoint(KTO[x]); 
        y := pred(y) mod 11; 
        if y <> 0 then y := 10 - y; 
        result := ord(not (KTO[10] = inttostr(y))); 
      end; 
    $C2: begin 
        result := f22; 
        if result = 0 then exit; 
        y := 0; 
        w21(9, 1); 
        result := ord(not mdl10(10)); 
      end; 
  else result := 4; 
  end; 
end; 
 
// Beispielaufruf
procedure TForm1.Button2Click(Sender: TObject); 
begin 
  case prf('20750000', '539290858') of 
    0: showmessage('OK'); 
    1: showmessage('Konto-Nr. falsch'); 
    2: showmessage('Falsche BLZ'); 
    3: showmessage('Prüfverfahren nicht anwendbar'); 
    4: showmessage('Prüfverfahren nicht implementiert'); 
  else showmessage('Unerwarteter Fehler'); 
  end; 
end;