home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / nummern / nummerqp.pas < prev    next >
Pascal/Delphi Source File  |  1991-10-31  |  4KB  |  196 lines
  1. {$M+}   { Methodenprüfung EIN }
  2. program nummerungstechnik;
  3. (* Version für QUICK PASCAL *)
  4. uses CRT;
  5.  
  6. const max = 10;       (* Maximallänge der Gewichtungen *)
  7.  
  8. type zk = string;
  9.      bereich = array[1..max] of integer;
  10.      modus_typ = (berechnen,pruefen);
  11.      nummern_typ = (kontonr,artikelnr,buchnr);
  12.  
  13.      nummer =  object
  14.       no: zk;
  15.       gewicht: bereich;
  16.       modus: modus_typ;
  17.       nummern: nummern_typ;
  18.       summe,laenge,anzahl: integer;
  19.       pz: char;
  20.       procedure init(initno:zk;initmodus:modus_typ;
  21.                      initnummer:nummern_typ);
  22.       procedure zgs;
  23.       procedure ausgabe;
  24.       function pruefziffer_modulo10:char;
  25.       function pruefziffer_modulo11:char;
  26.       function gueltig:boolean;
  27.       procedure bilden;
  28.     end;
  29.  
  30.     ekons = object(nummer)
  31.       procedure initgewichtung;
  32.     end;
  33.  
  34.     ean = object(nummer)
  35.       procedure initgewichtung;
  36.     end;
  37.  
  38.     isbn = object(nummer)
  39.      procedure initgewichtung;
  40.     end;
  41.  
  42. var ekonsnr: ekons;
  43.     eannr: ean;
  44.     isbnnr: isbn;
  45.     alle: nummer;
  46.     nr: zk;
  47.     m: modus_typ;
  48.     n: nummern_typ;
  49.  
  50. procedure eingabe(var nr: zk;var modus:modus_typ;
  51.                   var nummerung:nummern_typ);
  52. const maxlaenge:array[1..6] of integer = (0,0,12,13,9,10);
  53. var c: char; h,l: integer;
  54. begin
  55.  repeat
  56.   write('EKONS (1), EAN (2), ISBN (3) oder ENDE (0): ');
  57.   c := ReadKey; writeln(c); h := ord(c)-48;
  58.  until h in [0..3];
  59.  case h of
  60.   0: halt;
  61.   1: n := kontonr;
  62.   2: n := artikelnr;
  63.   3: n := buchnr
  64.  end;
  65.  repeat
  66.   write('Modus (1 = erzeugen, 2 = prüfen): ');
  67.   c := ReadKey; writeln(c)
  68.  until c in ['1'..'2'];
  69.  if c = '1' then modus := berechnen else modus := pruefen;
  70.  repeat
  71.   write('Eingabe: '); readln(nr); l := length(nr)
  72.  until (h = 1) or (l = maxlaenge[h*2-1]+ord(modus))
  73. end;
  74.  
  75. procedure nummer.init(initno:zk;initmodus:modus_typ;
  76.                       initnummer:nummern_typ);
  77. begin
  78.  self.no := initno;
  79.  self.modus := initmodus;
  80.  self.nummern := initnummer;
  81.  self.laenge := length(self.no)
  82. end;
  83.  
  84. procedure nummer.bilden;
  85. var h: string[1];
  86. begin
  87.  self.zgs;
  88.  if n = buchnr then
  89.   h := self.pruefziffer_modulo11
  90.  else
  91.   h := self.pruefziffer_modulo10;
  92.  self.no := concat(self.no,h)
  93. end;
  94.  
  95. procedure nummer.ausgabe;
  96. begin
  97.  writeln(self.no)
  98. end;
  99.  
  100. procedure ekons.initgewichtung;
  101. begin
  102.  with self do begin
  103.   anzahl := 3;
  104.   gewicht[1] := 7; gewicht[2]:= 3;gewicht[3] := 1
  105.  end
  106. end;
  107.  
  108. procedure ean.initgewichtung;
  109. begin
  110.  self.anzahl := 2;
  111.  self.gewicht[1] := 3; self.gewicht[2] := 1
  112. end;
  113.  
  114. procedure isbn.initgewichtung;
  115. var i: integer;
  116. begin
  117.  self.anzahl := 10;
  118.  for i := 1 to 10 do self.gewicht[i] := self.anzahl - i + 1
  119. end;
  120.  
  121. procedure nummer.zgs;
  122. var i, wert, x: integer;
  123. begin
  124.  i := self.anzahl - self.laenge mod self.anzahl;
  125.  if self.modus = pruefen then i := i + 1;
  126.  if i > self.anzahl then i := 1;
  127.  self.summe := 0; x := 0;
  128.  repeat
  129.   x := x + 1;
  130.   if upcase(self.no[x]) = 'X' then wert := 10
  131.   else
  132.   wert := ord(self.no[x]) - 48;
  133.   self.summe := self.summe + wert * self.gewicht[i];
  134.    writeln(x:3,i:3,wert:5,self.gewicht[i]:3,
  135.            wert * self.gewicht[i]:5,self.summe:10);
  136.   i := i + 1;
  137.   if i > self.anzahl then i := 1
  138.  until x = self.laenge
  139. end;
  140.  
  141. function nummer.pruefziffer_modulo10:char;
  142. var h: integer;
  143. begin
  144.  h := 10 - self.summe mod 10;
  145.  if h = 10 then h := 0;
  146.  pruefziffer_modulo10 := chr(h + 48)
  147. end;
  148.  
  149. function nummer.pruefziffer_modulo11:char;
  150. var h: integer;
  151. begin
  152.  h := 11 - self.summe mod 11;
  153.  if h = 11 then h := 0;
  154.  if h = 10 then h := 40;
  155.  pruefziffer_modulo11 := chr(h + 48)
  156. end;
  157.  
  158. function nummer.gueltig:boolean;
  159. begin
  160.  self.summe := 0;
  161.  self.zgs;
  162.  if n = buchnr then
  163.   gueltig := self.summe mod 11 = 0
  164.  else
  165.   gueltig := self.summe mod 10 = 0
  166. end;
  167.  
  168. begin
  169.  eingabe(nr,m,n);
  170.  new(alle);
  171.  case n of
  172.   kontonr: begin
  173.             new(ekonsnr); ekonsnr.initgewichtung; alle := ekonsnr
  174.            end;
  175.   artikelnr: begin
  176.               new(eannr); eannr.initgewichtung; alle := eannr
  177.              end;
  178.   buchnr: begin
  179.            new(isbnnr); isbnnr.initgewichtung; alle := isbnnr
  180.           end;
  181.  else begin writeln('Undefinierter Nummerntyp'); halt end
  182.  end;
  183.  with alle do
  184.   begin
  185.    init(nr,m,n);
  186.    if m = berechnen then
  187.     begin
  188.      bilden;
  189.      ausgabe
  190.     end
  191.    else
  192.    if gueltig then writeln('GÜLTIG') else writeln('UNGÜLTIG');
  193.   end;
  194.   dispose(alle)
  195. end.
  196.