DBR Delphi-Ecke

// Ein paar von vielen Möglichkeiten eine Prüfziffer(-zahl)
// aus einem String bilden.

// Getestet mit D4 unter Win98

// Variante Modulus 10

function modulus10(s: string): string; 
var 
  x, y, lg: integer; 
  function quer(w: integer): integer; 
  var 
    s: string; 
    i: integer; 
  begin 
    s := inttostr(w); 
    result := 0; 
    for i := 1 to length(s) do 
      result := result + strtoint(s[i]); 
  end; 
begin 
  lg := length(s); 
  y := succ(lg) * 5; 
  for x := 1 to lg do 
    if odd(x) then 
      y := y + quer(ord(s[x]) * 2) else 
      y := y + ord(s[x]); 
  result := chr((y mod 10) + 48); 
end; 
 
function erzeugeM10(s: string): string; 
begin 
  Result := s + modulus10(s); 
end; 
 
function pruefeM10(s: string): integer; 
var 
  lg: integer; 
begin 
  lg := length(s); 
  if modulus10(copy(s, 1, lg - 1)) = copy(s, lg, 1) 
    then Result := pred(lg) else Result := -1; 
end; 
 
// --- Beispielaufrufe --- 
 
// Prüfziffer anhängen 
 
procedure TForm1.Button1Click(Sender: TObject); 
var 
  s: string; 
begin 
  s := 'Das ist ein kurzer String'; 
  Label1.Caption := erzeugeM10(s); 
end; 
 
// Ziffer prüfen 
 
procedure TForm1.Button2Click(Sender: TObject); 
var 
  i: integer; 
begin 
  i := pruefeM10(Label1.Caption); 
  if i >= 0 then 
    Label1.caption := copy(Label1.Caption, 1, i) 
  else showmessage('Prüfziffer-Fehler'); 
end;

// --------------------------------------------------------------------

// Variante Modulus 11

var 
  gewichtung: array[0..3] of byte = (3, 7, 5, 10); 
 
function modulus11(s: string): string; 
var 
  i, x, y, z, lg: integer; 
begin 
  lg := length(s); 
  z := high(gewichtung); 
  y := succ(lg) * 7; 
  i := 0; 
  for x := 1 to lg do begin 
    y := y + ord(s[x]) * gewichtung[i]; 
    inc(i); 
    if i > z then i := 0; 
  end; 
  i := y mod 11; 
  result := chr(i - ord(i = 10) + 48); 
end; 
 
function erzeugeM11(s: string): string; 
begin 
  Result := s + modulus11(s); 
end; 
 
function pruefeM11(s: string): integer; 
var 
  lg: integer; 
begin 
  lg := length(s); 
  if modulus11(copy(s, 1, lg - 1)) = copy(s, lg, 1) 
    then Result := pred(lg) else Result := -1; 
end; 
 
// --- Beispielaufrufe --- 
 
// Prüfziffer anhängen 
 
procedure TForm1.Button1Click(Sender: TObject); 
var 
  s: string; 
begin 
  s := 'Das ist ein Test'; 
  Label1.Caption := erzeugeM11(s); 
end; 
 
// Prüfziffer prüfen 
 
procedure TForm1.Button2Click(Sender: TObject); 
var 
  i: integer; 
begin 
  i := pruefeM11(Label1.Caption); 
  if i >= 0 then 
    Label1.caption := copy(Label1.Caption, 1, i) 
  else showmessage('Prüfziffer-Fehler'); 
end;

// --------------------------------------------------------------------

// 1.2 Mehrstellige Prüfzahlen
// Dient beispielsweise zur Passwort-Überprüfung.

const laenge = 32; 
 
function hash(const s: string): string; 
var 
  x, z, erg: integer; 
begin 
  erg := 1; 
  result := ''; 
  for z := 2 to succ(laenge) do begin 
    for x := 1 to length(s) do 
      erg := (erg * 2 + ord(s[x]) * (z - ord(odd(x)) * (z - 1))) mod 97; 
    result := result + inttostr(erg mod 10) 
  end; 
end; 
 
// Beispielaufruf 
 
const 
  password = '46632272800736162418772068521161'; 
 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  if hash('Delphi') <> password then 
    showmessage('Du kummst hier net rein!') 
  else showmessage('Willkommen!'); 
end;

// --------------------------------------------------------------------

// 2. Variable Länge
// (richtet sich immer nach der Länge des Strings)

function pruefzahl(const s: string): string; 
var 
  x, z, erg: integer; 
begin 
  erg := 3; 
  result := ''; 
  for x := 1 to length(s) do begin 
    for z := 2 to 9 do 
      erg := (erg * 2 + ord(s[x]) * (z - ord(odd(x)) * (z - 1))) mod 93; 
    result := result + inttostr(erg mod 10) 
  end; 
end; 
 
 
// Beispielaufruf 
const 
  teststring = '6920670'; 
 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  if pruefzahl('Versuch') <> teststring then 
    showmessage('Keine Übereinstimmung!') 
  else showmessage('OK'); 
end;