home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / VCARD.ZIP / VERICARD.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-07-17  |  1.1 KB  |  75 lines
  1. Unit Vericard;
  2.  
  3.  
  4. {$F+,D+,L+}
  5.  
  6.  
  7.  
  8. Interface
  9.  
  10.  
  11. Function Vc(c : string) : char;
  12.  
  13.  
  14. Implementation
  15.  
  16.  
  17.  
  18.   Function Vc(C : String) : Char;
  19.   var
  20.     card : string[21];
  21.    Vcard : array[0..21] of byte absolute card;
  22.    Xcard : Integer;
  23.     Cstr : String[21];
  24.      y,x : integer;
  25.  
  26.  
  27.   Begin
  28.  
  29.    x:=0;
  30.  
  31.   Cstr:='                ';
  32.  
  33.   Cstr:='';
  34.  
  35.   Fillchar(Vcard,22,#0);
  36.  
  37.   Card:=C;
  38.  
  39.   for x:=1 to 20 do if Vcard[x] IN ([48..57]) then Cstr:=Cstr+chr(Vcard[x]);
  40.  
  41.   Card:='';
  42.  
  43.   Card:=Cstr;
  44.  
  45.     Xcard:=0;
  46.  
  47.      if NOT odd(length(card)) then
  48.  
  49.    for x:=length(card)-1 downto 1 do
  50.   begin
  51.   if odd(x) then y:=((Vcard[x]-48)*2) else y:=(Vcard[x]-48);
  52.   if y>=10 then y:=((y-10)+1);
  53.   Xcard:=(Xcard+y);
  54.                end else for x:=length(card)-1 downto 1 do
  55.            begin
  56.   if odd(x) then y:=(Vcard[x]-48) else y:=((Vcard[x]-48)*2);
  57.   if y>=10 then y:=((y-10)+1);
  58.   Xcard:=(Xcard+y);
  59.                end;
  60.  
  61.     x:=(10-(Xcard MOD 10));
  62.  
  63.     if (x=10) then x:=0;
  64.  
  65.   if x=(Vcard[length(card)]-48) then Vc:=Cstr[1] else Vc:=#0;
  66.  
  67.    end;
  68.  
  69.      end.
  70.  
  71.  
  72.  
  73.  
  74.  
  75.