Power-Programmierung/CD1.mdf/pascal/library/dos/nummern/nummern2.pas

Pascal/Delphi Source File | 1991-10-31 | 4.7 KB | 207 lines

program nummerungstechnik;
(* Version für TURBO/QUICK PASCAL                *)
(* Statische Methode, expliziter SELF-Bezeichner *)
(* QUICK-Pascal würde aufgrund des SELF-Bezeichners selbst zwischen *)
(* formalen Parametern und lokalen Variablen unterscheiden können. *)
(*
   Damit das Programm auch unter QUICK-Pascal läuft,
   muß folgendes ergänzt werden:
    Compiler-Direktive M+
   Ferner im Hauptprogramm:
    new(alle)
    new(ekonsnr); new(eannr); new(isbnnr)
    dispose(alle)
*)

uses CRT;

const max = 10;     (* Maximallänge der Gewichtungen *)

type zk = string;
     bereich = array[1..max] of integer;
     modus_typ = (berechnen,pruefen);
     nummern_typ = (kontonr,artikelnr,buchnr);

     nummer =  object
      no: zk;
      gewicht: bereich;
      modus: modus_typ;
      nummern: nummern_typ;
      summe,laenge,anzahl: integer;
      pz: char;
      procedure init(initno:zk;initmodus:modus_typ;
                     initnummer:nummern_typ);
      procedure zgs;
      procedure ausgabe;
      function pruefziffer_modulo10:char;
      function pruefziffer_modulo11:char;
      function gueltig:boolean;
      procedure bilden;
    end;

    ekons = object(nummer)
      procedure initgewichtung;
    end;

    ean = object(nummer)
      procedure initgewichtung;
    end;

    isbn = object(nummer)
     procedure initgewichtung;
    end;

var ekonsnr: ekons;
    eannr: ean;
    isbnnr: isbn;
    alle: nummer;
    nr: zk;
    m: modus_typ;
    n: nummern_typ;

procedure eingabe(var nr: zk;var modus:modus_typ;
                  var nummerung:nummern_typ);
const maxlaenge:array[1..6] of integer = (0,0,12,13,9,10);
var c: char; h,l: integer;
begin
 repeat
  write('EKONS (1), EAN (2), ISBN (3) oder ENDE (0): ');
  c := ReadKey; writeln(c); h := ord(c)-48;
 until h in [0..3];
 case h of
  0: halt;
  1: n := kontonr;
  2: n := artikelnr;
  3: n := buchnr
 end;
 repeat
  write('Modus (1 = erzeugen, 2 = prüfen): ');
  c := ReadKey; writeln(c)
 until c in ['1'..'2'];
 if c = '1' then modus := berechnen else modus := pruefen;
 repeat
  write('Eingabe: '); readln(nr); l := length(nr)
 until (h = 1) or (l = maxlaenge[h*2-1]+ord(modus))
end;

procedure nummer.init(initno:zk;initmodus:modus_typ;
                      initnummer:nummern_typ);
begin
 self.no := initno;
 self.modus := initmodus;
 self.nummern := initnummer;
 self.laenge := length(self.no)
end;

procedure nummer.bilden;
var h: string[1];
begin
 self.zgs;
 if n = buchnr then
  h := self.pruefziffer_modulo11
 else
  h := self.pruefziffer_modulo10;
 self.no := concat(self.no,h)
end;

procedure nummer.ausgabe;
begin
 writeln(self.no)
end;

procedure ekons.initgewichtung;
begin
 with self do begin
  anzahl := 3;
  gewicht[1] := 7; gewicht[2]:= 3;gewicht[3] := 1
 end
end;

procedure ean.initgewichtung;
begin
 self.anzahl := 2;
 self.gewicht[1] := 3; self.gewicht[2] := 1
end;

procedure isbn.initgewichtung;
var i: integer;
begin
 self.anzahl := 10;
 for i := 1 to 10 do self.gewicht[i] := self.anzahl - i + 1
end;

procedure nummer.zgs;
var i, wert, x: integer;
begin
 i := self.anzahl - self.laenge mod self.anzahl;
 if self.modus = pruefen then i := i + 1;
 if i > self.anzahl then i := 1;
 self.summe := 0; x := 0;
 repeat
  x := x + 1;
  if upcase(self.no[x]) = 'X' then wert := 10
  else
  wert := ord(self.no[x]) - 48;
  self.summe := self.summe + wert * self.gewicht[i];
   writeln(x:3,i:3,wert:5,self.gewicht[i]:3,
           wert * self.gewicht[i]:5,self.summe:10);
  i := i + 1;
  if i > self.anzahl then i := 1
 until x = self.laenge
end;

function nummer.pruefziffer_modulo10:char;
var h: integer;
begin
 h := 10 - self.summe mod 10;
 if h = 10 then h := 0;
 pruefziffer_modulo10 := chr(h + 48)
end;

function nummer.pruefziffer_modulo11:char;
var h: integer;
begin
 h := 11 - self.summe mod 11;
 if h = 11 then h := 0;
 if h = 10 then h := 40;
 pruefziffer_modulo11 := chr(h + 48)
end;

function nummer.gueltig:boolean;
begin
 self.summe := 0;
 self.zgs;
 if n = buchnr then
  gueltig := self.summe mod 11 = 0
 else
  gueltig := self.summe mod 10 = 0
end;

begin
 eingabe(nr,m,n);
 case n of
  kontonr: begin
            ekonsnr.initgewichtung; alle := ekonsnr
           end;
  artikelnr: begin
              eannr.initgewichtung; alle := eannr
             end;
  buchnr: begin
           isbnnr.initgewichtung; alle := isbnnr
          end;
 else begin writeln('Undefinierter Nummerntyp'); halt end
 end;
 with alle do
  begin
   init(nr,m,n);
   if m = berechnen then
    begin
     bilden;
     ausgabe
    end
   else
   if gueltig then writeln('GÜLTIG') else writeln('UNGÜLTIG');
  end;
  readln
end.