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

Pascal/Delphi Source File | 1991-10-30 | 5.2 KB | 228 lines

program nummerungstechnik;
(* Version TURBO-Pascal 6.0 mit virtuellen Methoden *)
(* i.e späte Bindung                                *)
uses CRT;

const max = 10;

type zk = string;
     bereich = array[1..max] of integer;
     nummer_ptr = ^nummer;
     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;
      constructor init(initno:zk;initmodus:modus_typ;
                     initnummer:nummern_typ);
      procedure zgs; virtual;
      procedure ausgabe; virtual;
      function pruefziffer_modulo10:char; virtual;
      function pruefziffer_modulo11:char; virtual;
      function gueltig:boolean; virtual;
      procedure bilden; virtual;
      destructor done; virtual;
    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;
    speicher, belegt: real;

(* ------------------------------------------------------------*)
(*   Prozeduren, die keine Methoden sind                       *)
(* ------------------------------------------------------------*)

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 report(heapfrei_vor,belegt:real);
var heapfrei_nach: real;
begin
  heapfrei_nach := MemAvail;
  if heapfrei_vor = heapfrei_nach then
   begin
    writeln('Objekt belegt ',belegt:10:0,' Byte.');
    writeln('Verbrauchter Heap ist wieder verfügbar.');
   end;
end;

constructor nummer.init(initno:zk;initmodus:modus_typ;
                      initnummer:nummern_typ);
var i: integer;
begin
 no := initno;
 modus := initmodus;
 nummern := initnummer;
 laenge := length(no)
end;

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

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

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

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

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

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

function nummer.pruefziffer_modulo10:char;
var h: integer;
begin
 h := 10 -  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 -  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
 summe := 0;
 zgs;
 if n = buchnr then
  gueltig := summe mod 11 = 0
 else
  gueltig := summe mod 10 = 0
end;

destructor nummer.done;
begin
end;

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