home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / RKPLUS30.ZIP / RKPDEMO.ZIP / ENCODE.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-02-04  |  3.6 KB  |  206 lines
  1. Unit Encode;
  2.  
  3.  
  4. {
  5.   This sample unit contains example encoding algorythms for use by RkPlus.
  6.  
  7.   The encoding method used is an extremely simplistic one, but it should
  8.   provide an idea as to how to write and implement user-written encoding
  9.   functions.
  10.  
  11.   Warning : Do NOT use this unit in your own programmes!  Since this
  12.             source file is available to all RkPlus users, doing so
  13.             could compromise the security of your keys.
  14. }
  15.  
  16.  
  17. Interface
  18.  
  19.  
  20. Var
  21.   ProgID : String[36];
  22.  
  23.  
  24. Function RkpOK : Boolean;
  25. Function RkpError : Word;
  26. Procedure SetProgID(s : String);
  27.  
  28.  
  29. Implementation
  30.  
  31.  
  32. Uses
  33.   RkPlus;
  34.  
  35.  
  36. Const
  37.   vMajor    = '3';
  38.   vMinor    = '0';
  39.   EncConst1 : String[31] = 'Serious Cybernetics Encode Demo';
  40.   EncConst2 : String[10] = '2163454923';
  41.   eStatus   : Word = NoError;
  42.  
  43.  
  44. Function Upper(s : String) : String;
  45.  
  46. Var
  47.   q : Byte;
  48.  
  49. Begin
  50.   For q := 1 to Length(s) do
  51.     s[q] := UpCase(s[q]);
  52.   Upper := s;
  53. End;
  54.  
  55.  
  56. {$F+}
  57.  
  58. Function UserEnc1(t1,t2,t3 : String; l : Byte; i : Integer) : Word;
  59.  
  60. Var
  61.   ul : Char absolute l;
  62.   ui : Array[1..2] of Char absolute i;
  63.   s  : String;
  64.   b1 : Byte;
  65.   b2 : Byte;
  66.   q  : Byte;
  67.  
  68. Begin
  69.   UserEnc1 := 0;
  70.   b1 := 0;
  71.   b2 := 0;
  72.   If (ProgID = '') then
  73.     eStatus := InvalidParameter
  74.   Else Begin
  75.     s := Upper(EncConst1 + EncConst2 + ProgID + ul + ui + t3 + t2 + t1);
  76.     For q := 1 to Length(s) do Begin
  77.       If Odd(q) then
  78.         b1 := b1 xor Ord(s[q])
  79.       Else
  80.         b2 := b2 xor Ord(s[q]);
  81.     End;
  82.     UserEnc1 := b1*256+b2;
  83.   End;
  84. End;
  85.  
  86.  
  87. Function UserEnc2(t1,t2,t3 : String; l : Byte; i : Integer) : Word;
  88.  
  89. Var
  90.   ul : Char absolute l;
  91.   ui : Array[1..2] of Char absolute i;
  92.   s  : String;
  93.   b1 : Byte;
  94.   b2 : Byte;
  95.   q  : Byte;
  96.  
  97. Begin
  98.   UserEnc2 := 0;
  99.   b1 := 0;
  100.   b2 := 0;
  101.   If (ProgID = '') then
  102.     eStatus := InvalidParameter
  103.   Else Begin
  104.     s := Upper(ui + ul + ProgID + t1 + t3 + t2 + EncConst1 + EncConst2);
  105.     For q := 1 to Length(s) do Begin
  106.       If Odd(q) then
  107.         b1 := b1 xor Ord(s[q])
  108.       Else
  109.         b2 := b2 xor Ord(s[q]);
  110.     End;
  111.     UserEnc2 := b1*256+b2;
  112.   End;
  113. End;
  114.  
  115.  
  116. Function UserEnc3(t1,t2,t3 : String; l : Byte; i : Integer) : Word;
  117.  
  118. Var
  119.   ul : Char absolute l;
  120.   ui : Array[1..2] of Char absolute i;
  121.   s  : String;
  122.   b1 : Byte;
  123.   b2 : Byte;
  124.   q  : Byte;
  125.  
  126. Begin
  127.   UserEnc3 := 0;
  128.   b1 := 0;
  129.   b2 := 0;
  130.   If (ProgID = '') then
  131.     eStatus := InvalidParameter
  132.   Else Begin
  133.     s := Upper(t1 + t2 + t3 + ul + ProgID + EncConst1 + EncConst2 + ProgID + ui);
  134.     For q := 1 to Length(s) do Begin
  135.       If Odd(q) then
  136.         b1 := b1 xor Ord(s[q])
  137.       Else
  138.         b2 := b2 xor Ord(s[q]);
  139.     End;
  140.     UserEnc3 := b1*256+b2;
  141.   End;
  142. End;
  143.  
  144.  
  145. Function UserFileEnc(v : Byte; b : Boolean) : Byte;
  146.  
  147. Begin
  148.   If b then
  149.     v := v xor $01
  150.   Else
  151.     v := v xor $80;
  152.   UserFileEnc := v;
  153. End;
  154.  
  155. {$F-}
  156.  
  157.  
  158. Function RkpOK : Boolean;
  159.  
  160. Begin
  161.   RkpOK := False;
  162.   If RkPlus.RkpOK and (eStatus = NoError) then
  163.     RkpOK := True;
  164. End;
  165.  
  166.  
  167. Function RkpError : Word;
  168.  
  169. Begin
  170.   If (eStatus <> NoError) then
  171.     RkpError := eStatus
  172.   Else
  173.     RkpError := RkPlus.RkpError;
  174. End;
  175.  
  176.  
  177. Procedure SetProgID(s : String);
  178.  
  179. Begin
  180.   ProgID := s;
  181. End;
  182.  
  183.  
  184. Procedure Init;
  185.  
  186. Var
  187.   s : String[10];
  188.  
  189. Begin
  190.   s := RkPlusVer;
  191.   If (Length(s) < 10) or (s[8] <> vMajor) or (s[10] <> vMinor) then
  192.     eStatus := VersionMismatch
  193.   Else Begin
  194.     SetEncode(UserEnc1,UserEnc2,UserEnc3);
  195.     SetFileEnc(UserFileEnc);
  196.   End;
  197.   BaseYear := 1992;
  198.   UseExpDays := False;
  199.   ProgID := '';
  200. End;
  201.  
  202.  
  203. Begin
  204.   Init;
  205. End.
  206.