DBR Delphi-Ecke

// Die Internationale Standard-Buchnummer
// (International Standard Book Number),
// abgekürzt ISBN, ist eine Nummer zur eindeutigen Kennzeichnung
// von Büchern. Das ISBN-System wurde an das System internationaler
// Artikelnummern EAN (European Article Number) gekoppelt. ISBN-13
// sind identisch mit der zum Buch gehörenden EAN-13. Auch ISBN-10
// können in eine EAN-13 bzw. ins ISBN-13-System überführt werden.
// Dazu wird der ISBN-10 einfach die EAN-Ziffernfolge 978
// vorangestellt und die alte Prüfziffer (letzte Stelle) durch eine
// neue EAN-Prüfziffer ersetzt.
// Der folgende Code überprüft sowie die alten ISBN-10
// (welche seit 1.1.2007 nicht mehr vergeben werden), als auch die
// neuen ISBN-13.

// Getestet mit D4 unter XP

function CheckISBN(ISBN: string): Boolean; 
var g, u, x, lg: integer; 
  function Numbertest: boolean; 
  var i: integer; 
  begin 
    result := true; 
    for i := 1 to lg do 
      if not (ISBN[i] in ['0'..'9', 'X']) 
        then begin 
        result := false; 
        break; 
      end; 
  end; 
begin 
  result := false; 
  ISBN := Uppercase(ISBN); 
  ISBN := stringreplace(ISBN, 'ISBN', '', [rfReplaceAll]); 
  ISBN := stringreplace(ISBN, #32, '', [rfReplaceAll]); 
  ISBN := stringreplace(ISBN, '-', '', [rfReplaceAll]); 
  lg := length(ISBN); 
  if not Numbertest then exit; 
  g := 0; 
  if lg = 13 then begin 
    if (copy(ISBN, 1, 3) <> '978') 
      and (copy(ISBN, 1, 3) <> '979') then exit; 
    u := g; 
    for x := 1 to lg do 
      if odd(x) then u := u + ord(ISBN[x]) - 48 
      else g := g + ord(ISBN[x]) - 48; 
    g := g * 3 + u; 
    result := g mod 10 = 0; 
  end else 
    if lg = 10 then begin 
      for x := 1 to lg do begin 
        if ISBN[x] = 'X' then u := 10 
        else u := ord(ISBN[x]) - 48; 
        g := g + u * x; 
      end; 
      result := g mod 11 = 0; 
    end; 
end; 
 
 
// Beispielaufruf 
 
procedure TForm1.Button5Click(Sender: TObject); 
begin 
  if CheckISBN('979-3-86680-192-8') then ShowMessage('ISBN OK') 
  else ShowMessage('ISBN ist nicht korrekt'); 
end;