home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / ECO30603.ZIP / ECO30603.LZH / ECOLIBII / eco_reg.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-04-12  |  15.1 KB  |  465 lines
  1. (*
  2.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  3.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  4.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  5.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  6.     ▓▓▓▓▓▓▓▓·──                                              ──·▓▓▓▓▓▓▓▓▓▓▓
  7.     ▓▓▓▓▓▓▓▓│                                                  │░░▓▓▓▓▓▓▓▓▓
  8.     ▓▓▓▓▓▓▓▓   ECO_REG was Conceived, Designed and Written      ░░▓▓▓▓▓▓▓▓▓
  9.     ▓▓▓▓▓▓▓▓   by Floor A.C. Naaijkens for                      ░░▓▓▓▓▓▓▓▓▓
  10.     ▓▓▓▓▓▓▓▓   UltiHouse Software / The ECO Group.              ░░▓▓▓▓▓▓▓▓▓
  11.     ▓▓▓▓▓▓▓▓                                                    ░░▓▓▓▓▓▓▓▓▓
  12.     ▓▓▓▓▓▓▓▓   (C) MCMXCII by EUROCON PANATIONAL CORPORATION.   ░░▓▓▓▓▓▓▓▓▓
  13.     ▓▓▓▓▓▓▓▓   All Rights Reserved for The ECO Group.           ░░▓▓▓▓▓▓▓▓▓
  14.     ▓▓▓▓▓▓▓▓                                                    ░░▓▓▓▓▓▓▓▓▓
  15.     ▓▓▓▓▓▓▓▓   ECO_REG is the ultimate registration-kit for     ░░▓▓▓▓▓▓▓▓▓
  16.     ▓▓▓▓▓▓▓▓   TurboPascal programmers.                         ░░▓▓▓▓▓▓▓▓▓
  17.     ▓▓▓▓▓▓▓▓│                                                  │░░▓▓▓▓▓▓▓▓▓
  18.     ▓▓▓▓▓▓▓▓·──                                              ──·░░▓▓▓▓▓▓▓▓▓
  19.     ▓▓▓▓▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓▓▓▓
  20.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  21.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  22.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  23. *)
  24.  
  25.  
  26.  
  27. {$A-,B-,D-,E-,F-,I-,L-,N-,O-,R-,S-,V-}
  28. {$M 65520, 0, 655360}
  29. unit eco_reg;
  30.  
  31. interface
  32. uses
  33.   eco_lib, dos
  34.  
  35.   ;
  36.  
  37.  
  38.  
  39. type
  40.   keyerrortype = (
  41.     errornokey, errorkeycopyright, errorkeyposession,
  42.     errorkeydate, errorkeyunknown, errorinternal,
  43.     errorprogrammer, errorversion, errorbadcrc
  44.   );
  45.   keyoptions = (
  46.     keypermanent, key30day, key30runs, keynday, keynruns, keyexpiration,
  47.     keyreserved1, keyreserved2
  48.   );
  49.  
  50.  
  51.  
  52. const
  53.   keytypes : array[keyoptions] of string[19] = (
  54.     'Key is permanent.',
  55.     'Key runs 30 days.',
  56.     'Key allows 30 runs.',
  57.     'Key runs N days.' ,
  58.     'Key allows N runs.',
  59.     'Key expires on ',
  60.     'Key overusurped.',
  61.     'Key is reserved2'
  62.   );
  63.   keyerrors : array[keyerrortype] of string[49] = (
  64.     'KEY does not exist!',
  65.     'KEY Copyright Information Violation Error.',
  66.     'KEY Posession Violation Error.',
  67.     'KEY Date/Time Violation Error.',
  68.     'KEY Error UNKNOWN, sorry can''t allow, to be sure.',
  69.     'Internal Copyright Information Violation Error.',
  70.     'KEY used for other program.',
  71.     'KEY used for different version',
  72.     'KEY not generated: bad CRC given.'
  73.   );
  74.  
  75.  
  76.  
  77. type
  78.   regkey = record
  79.     keyfilename : string[12];    {           key filename to be set by user }
  80.     programkey  : string[20];    {            keyname as to show in keyfile }
  81.     programmer  : string[20];    {          the programmers/companies' code }
  82.     upgradecode : string[10];    {       code, same in all upgradable progs }
  83.     registered  : string[40];    {                naam of registered person }
  84.     expiredate  :    longint;    {             key expiration date and time }
  85.     creation    :    longint;    {               key creation date and time }
  86.     expireamount:       word;    {           if type of key correct, amount }
  87.     keylevel    :       word;    {               level of key  (default: 0) }
  88.     invokes     :    longint;    {                   number of key accesses }
  89.     typeofkey   : keyoptions;    {                              bit pattern }
  90.     keycreator  :  string[8];    { HEX-CRC/32 to be entered to generate key }
  91.   end;
  92.  
  93.  
  94. var
  95.   validuser :              regkey;
  96.   keyerror  : set of keyerrortype;
  97.  
  98.  
  99.  
  100.   procedure createkey(prog: regkey);
  101.   function  checkkey(var prog: regkey): boolean;
  102.   function  checkcreator(prog: regkey): boolean;
  103.   procedure getcreator(var prog: regkey);
  104.   procedure clearerrors;
  105.   function  __diff(create, dead: longint): longint;
  106.             { difference in days dead-create }
  107.  
  108.  
  109.  
  110.  
  111. implementation
  112.  
  113.  
  114.  
  115.  
  116.  
  117.  
  118. const
  119.   copylen =  73;
  120.   ljunk0  = 213;
  121.   ljunk1  = 182;
  122.   ljunk2  = 045;
  123.   ljunk3  = 125;
  124.   ljunk4  = 214;
  125.   ljunk5  = 039;
  126.   ljunk6  = 155;
  127.   ljunk7  = 236;
  128.   ljunk8  = 114;
  129.   ljunk9  = 231;
  130.   ljunk10 = 142;
  131.  
  132.  
  133. type
  134.   cryptor = record    { junk-aligned data record for extra encryption safety }
  135.     keycopyright : array[1..3,1..copylen] of char;  { UltiHouse Software Copyright }
  136.     keyintro     :      array[1..12] of char;  {    'Keyfile for ' - sentence }
  137.     keyname      :      array[1..20] of char;  {        name the key yourself }
  138.     keyend       :                      char;  {         always <esc> char 26 }
  139.     junk0        :  array[1..ljunk0] of byte;
  140.     reallength   :                      byte;  {        actual length of name }
  141.     junk1        :  array[1..ljunk1] of byte;
  142.     name         :                string[40];  {               encrypted name }
  143.     company      :                string[20];  {  programmers/companies' code }
  144.     upgrade      :                string[10];  {  code,same 4 all upgradables }
  145.     junk2        :  array[1..ljunk2] of byte;
  146.     level        :                      word;  {                 level of key }
  147.     junk3        :  array[1..ljunk3] of byte;
  148.     crc          :                   longint;  {                  crc of name }
  149.     junk4        :  array[1..ljunk4] of byte;
  150.     crc2         :                   longint;  { crc of string of crc of name }
  151.     junk5        :  array[1..ljunk5] of byte;
  152.     createdate   :                   longint;  {   key creation date and time }
  153.     junk6        :  array[1..ljunk6] of byte;
  154.     expiration   :                   longint;  { key expiration date and time }
  155.     junk7        :  array[1..ljunk7] of byte;
  156.     usages       :                   longint;  {       number of key accesses }
  157.     junk8        :  array[1..ljunk8] of byte;
  158.     amount       :                      word;  {          e.g. 51 days / runs }
  159.     junk9        :  array[1..ljunk9] of byte;
  160.     seed         :                      byte;  {   random seed for encryption }
  161.     junk10       : array[1..ljunk10] of byte;
  162.     keytype      :                keyoptions;  {                  bit pattern }
  163.   end;
  164.  
  165.  
  166.  
  167. const
  168.   keycopyrights : array[1..3] of string[copylen] = (
  169.     'The ECO Library II Registration Unit was Conceived, Designed and       '#10#13,
  170.     'Written by Floor A.C. Naaijkens for UltiHouse Software / The ECO Group.'#10#13,
  171.     '(C) MCMXCIII by EUROCON PANATIONAL CORPORATION, All Rights Reserved.   '#10#13
  172.   );
  173.   keycopycrc = -742070740;
  174.   keyfileformsg : string[12] = 'Keyfile for ';
  175.  
  176.  
  177. var
  178.   i, j          :            byte;
  179.   st            :          string;
  180.   testcrc32,
  181.   crc32         :         longint;
  182.   key           :         cryptor;
  183.   keyfile       : file of cryptor;
  184.  
  185.  
  186.  
  187.   function encrypch(b: char; p: byte): char;
  188.   var bb: byte; { encryption dependent of position }
  189.   begin
  190.     bb := byte(b);
  191.     if bb mod 2 = 0 then dec(bb) else inc(bb, 3);
  192.     if p mod 2 = 0 then dec(p) else inc(p, 3);
  193.     encrypch := char(bb + (p * (p+5) * (p+7) * (p + 13)))
  194.   end;
  195.  
  196.  
  197.  
  198.   function decrypch(b: char; p: byte): char;
  199.   var bb: byte; { encryption dependent of position }
  200.   begin
  201.     bb := byte(b);
  202.     if bb mod 2 = 0 then dec(bb, 3) else inc(bb);
  203.     if p mod 2 = 0 then dec(p) else inc(p, 3);
  204.     decrypch := char(bb - (p * (p+5) * (p+7) * (p + 13)))
  205.   end;
  206.  
  207.  
  208.  
  209.   procedure checkinternals;
  210.   begin
  211.     crc32 := $ffffffff;
  212.     for j := 1 to 3 do for i := 1 to copylen do
  213.       crc32 := __crc32(byte(keycopyrights[j, i]), crc32);
  214.     if crc32 <> keycopycrc then begin
  215.       writeln(crc32, ':', keyerrors[errorinternal]); halt;
  216.     end;
  217.   end;
  218.  
  219.  
  220.  
  221.   procedure filljunkwithjunk;
  222.   var i : word;
  223.   begin
  224.     randomize;
  225.     with key do begin
  226.       for i := 1 to ljunk0 do junk0[i] := random(255);
  227.       for i := 1 to ljunk1 do junk1[i] := random(255);
  228.       for i := 1 to ljunk2 do junk2[i] := random(255);
  229.       for i := 1 to ljunk3 do junk3[i] := random(255);
  230.       for i := 1 to ljunk4 do junk4[i] := random(255);
  231.       for i := 1 to ljunk5 do junk5[i] := random(255);
  232.       for i := 1 to ljunk6 do junk6[i] := random(255);
  233.       for i := 1 to ljunk7 do junk7[i] := random(255);
  234.       for i := 1 to ljunk8 do junk8[i] := random(255);
  235.       for i := 1 to ljunk9 do junk9[i] := random(255);
  236.       for i := 1 to ljunk10 do junk10[i] := random(255);
  237.     end;
  238.   end;
  239.  
  240.  
  241.  
  242.   procedure createkey(prog: regkey);
  243.   var
  244.     i    :   word;
  245.     j    :   byte;
  246.     tmp  : string;
  247.  
  248.   begin
  249.     with key, prog do begin
  250.       filljunkwithjunk;
  251.  
  252.       for j := 1 to 3 do for i := 1 to copylen do
  253.         keycopyright[j, i] := keycopyrights[j, i];
  254.       for i := 1 to 12 do keyintro[i] := keyfileformsg[i];
  255.       tmp := programkey;
  256.       for i := 1 to length(tmp) do keyname[i] := tmp[i];
  257.       for i := length(tmp)+1 to 20 do keyname[i] := ' ';
  258.       for i := 1 to 19 do junk0[i] := 13;
  259.       keyend := #26;
  260.  
  261.       name := 'ß≥|÷ûñ°M≥ ╨ûτêB2·÷╩░M≥ ╨⌐B╥╜O╗╩░z.:╥╛r';
  262.       name := registered;
  263.       for i := 1 to length(name) do name[i] := encrypch(name[i], i);
  264.       crc32 := $ffffffff;                    { calculate 32-bit crc values. }
  265.       for i := 1 to length(name) do crc32 := __crc32(byte(name[i]), crc32);
  266.       crc := crc32;
  267.  
  268.       keytype := typeofkey; seed := random(3); createdate := creation;
  269.       expiration := expiredate; level := keylevel;
  270.       usages := 0; level := 0; invokes := 0; amount := expireamount;
  271.  
  272.       tmp := '';
  273.       for i := 1 to length(programmer) do
  274.         tmp := tmp + encrypch(programmer[i], i);
  275.       company := tmp;
  276.  
  277.       tmp := '';
  278.       for i := 1 to length(upgradecode) do
  279.         tmp := tmp + encrypch(upgradecode[i], i);
  280.       upgrade := tmp;
  281.  
  282.       assign(keyfile, keyfilename); rewrite(keyfile);
  283.       write(keyfile, key); close(keyfile);
  284.     end;
  285.   end;
  286.  
  287.  
  288.  
  289.   function checkkey(var prog: regkey) : boolean;
  290.   var
  291.     st1, st2 : string;
  292. (*
  293.     function __existfil(pathname: string): boolean;
  294.     var fileinfo : searchrec;
  295.     begin
  296.       findfirst(pathname, anyfile, fileinfo);
  297.       __existfil := (doserror = 0)
  298.     end;
  299. *)
  300.   begin
  301.     if (
  302.       not __existfil(prog.keyfilename)
  303.     ) then keyerror := keyerror + [errornokey] else begin
  304.       with key, prog do begin
  305.         assign(keyfile, keyfilename); reset(keyfile);
  306.         read(keyfile, key); close(keyfile);
  307.         inc(usages); rewrite(keyfile); write(keyfile, key); close(keyfile);
  308.  
  309.         testcrc32 := $ffffffff;
  310.         for i := 1 to length(name) do
  311.           testcrc32 := __crc32(byte(name[i]), testcrc32);
  312.         if crc <> testcrc32 then keyerror := keyerror + [errorkeyposession];
  313.         for i := 1 to length(name) do name[i] := decrypch(name[i], i);
  314.  
  315.         crc32 := $ffffffff;
  316.         for j := 1 to 3 do for i := 1 to copylen do
  317.           crc32 := __crc32(byte(keycopyright[j, i]), crc32);
  318.         if crc32 <> keycopycrc then keyerror := keyerror + [errorkeycopyright];
  319.  
  320.         st1 := ''; st2 := '';
  321.         for i := 1 to length(programmer) do st1 := st1 + programmer[i];
  322.         for i := 1 to length(company) do
  323.           st2 := st2 + decrypch(company[i], i);
  324.         if (st1 <> st2) then keyerror := keyerror + [errorprogrammer];
  325.  
  326.         st1 := ''; st2 := '';
  327.         for i := 1 to length(upgradecode) do st1 := st1 + upgradecode[i];
  328.         for i := 1 to length(upgrade) do st2 := st2 + decrypch(upgrade[i], i);
  329.         if st1 <> st2 then keyerror := keyerror + [errorversion];
  330.  
  331.         registered := name;
  332.         expiredate := expiration;
  333.         expireamount := amount;
  334.         creation := createdate;
  335.         keylevel := level;
  336.         typeofkey := keytype;
  337.         invokes := usages;
  338.       end;
  339.     end;
  340.     checkkey := (prog.typeofkey = keypermanent);
  341.   end;
  342.  
  343.  
  344.  
  345.   procedure clearerrors;
  346.   begin
  347.     keyerror := [];
  348.   end;
  349.  
  350.  
  351.  
  352.   function __diff(create, dead: longint): longint;
  353.   var _creation, _dead : datetime;
  354.  
  355.  
  356.     function  __dt2jlutl(year, month, day : word) : longint;
  357.     const days : array[1..12] of word = (31,29,31,30,31,30,31,31,30,31,30,31);
  358.     begin
  359.       __dt2jlutl := -1;
  360.       if ((year < 1900) and (year > 99)) then exit;
  361.       if (year < 100) then inc(year,1900);
  362.       if ((month < 1) or (month > 12)) then exit;
  363.       if (((month = 2) and (day = 29)) and ((year mod 4) <> 0)) then exit;
  364.       if ((day = 0) or (day > days[month])) then exit;
  365.       if ((year = 1900) and (month < 3)) then exit;
  366.       dec(year,1900);
  367.       if (month > 2) then dec(month,3) else begin inc(month,9); dec(year) end;
  368.       __dt2jlutl := ((longint(1461) * longint(year)) div 4) +
  369.         ((153 * month + 2) div 5) + day - 1;
  370.     end;
  371.  
  372.     function  __daysutl(
  373.       year1, month1, day1: word; year2, month2, day2 : word
  374.     ): longint;
  375.     var temp1, temp2 : longint;
  376.     begin
  377.       temp1 :=  __dt2jlutl(year1,month1,day1);
  378.       temp2 :=  __dt2jlutl(year2,month2,day2);
  379.       if (temp1 < 0) or (temp2 < 0) then __daysutl := -1 else
  380.         __daysutl := temp2 - temp1;
  381.     end;
  382.  
  383.   begin
  384.     unpacktime(create, _creation); unpacktime(dead, _dead);
  385.     __diff := __daysutl(
  386.       _creation.year, _creation.month, _creation.day,
  387.       _dead.year, _dead.month, _dead.day
  388.     )
  389.   end;
  390.  
  391.  
  392.  
  393.  
  394.     function __dechexstr(intvalue: longint; size: word): string;
  395.     const hexcheck : array[0..15] of char = '0123456789ABCDEF';
  396.     var
  397.       i       : integer;
  398.       tempstr : string[8];
  399.  
  400.     begin
  401.       if ((size <> 1) and (size <> 2) and (size <> 4)) then begin
  402.         __dechexstr := ''; exit
  403.       end;
  404.  
  405.       tempstr[0] := chr(8);
  406.       for i := 0 to 7 do begin
  407.         tempstr[8 - i] := hexcheck[intvalue and $000f];
  408.         intvalue := intvalue shr 4
  409.       end;
  410.       i := 2 * size;
  411.       __dechexstr := copy(tempstr,8 - i + 1,i)
  412.     end;
  413.  
  414.  
  415.  
  416.   procedure getcreator(var prog: regkey);
  417.   var
  418.     crc  :    longint;
  419.     i    :       byte;
  420.     tmp  :  string[8];
  421.     name :     string;
  422.  
  423.   begin
  424.     with prog do begin
  425.       crc := $ffffffff;
  426.       name := registered + programkey + upgradecode + chr(keylevel);
  427.       for i := 1 to length(name) do name[i] := encrypch(name[i], i);
  428.       for i := 1 to length(name) do crc := __crc32(byte(name[i]), crc);
  429.       keycreator := __dechexstr(crc, 4);
  430.     end;
  431.   end;
  432.  
  433.  
  434.  
  435.   function checkcreator(prog: regkey): boolean;
  436.   var
  437.     crc  :    longint;
  438.     i    :       byte;
  439.     name :     string;
  440.     tmp  :  string[8];
  441.  
  442.   begin        { checks encrypname against CRC }
  443.     {
  444.       1. encrypt name
  445.       2. calculate CRC/32 of encrypted name
  446.       3. create HEX of CRC
  447.       4. compare keycreator against HEX-CRC/32
  448.     }
  449.     with prog do begin
  450.       name := registered + programkey + upgradecode + chr(keylevel);
  451.       for i := 1 to length(name) do name[i] := encrypch(name[i], i);
  452.       crc := $ffffffff;
  453.       for i := 1 to length(name) do crc := __crc32(byte(name[i]), crc);
  454.       tmp := __dechexstr(crc, 4);
  455.       checkcreator := (tmp = keycreator);
  456.     end;
  457.   end;
  458.  
  459.  
  460.  
  461. begin
  462.   checkinternals; clearerrors; randomize;
  463.   fillchar(validuser, sizeof(validuser), #0);
  464. end. { unit }
  465.