home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / PROGRAM / PASCAL / RKPLUS33 / RKPDEMO3 / SAMPLE3.PAS < prev    next >
Pascal/Delphi Source File  |  1993-10-19  |  6KB  |  243 lines
  1. Program Sample3;
  2.  
  3. {
  4.  This is a demonstration program using RkPlus.
  5.  It uses 2 registration levels (0 and 1).
  6.  If a Level 1 key has expired, it will be treated as Level 0.
  7.  If a Level 0 key has expired, it will be treated as Unregistered.
  8.  This is a very simple program that doesn't actually do anything, but it
  9.  should demonstrate some of what can be done with RkPlus.
  10.  
  11.  It is identical to Sample1, except that it reads the registration
  12.  information from its own configuration file, instead of using the
  13.  RkPlus procedures GetRegInfo and SaveRegInfo (which use a .RKP file).
  14.  It uses the same keys as Sample1, which can be created with the GenKey
  15.  programme.
  16.  
  17.  Sample3 uses the Rkp3Enc unit to cause RkPlus to use the new version 3.x
  18.  keys.
  19. }
  20.  
  21.  
  22. Uses
  23.   Crt,
  24.   RkPlus,
  25.   Rkp3Enc;
  26.  
  27.  
  28. Const
  29.   MonthNames : Array[1..12] of String[3]
  30.   = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec');
  31.  
  32.  
  33. Var
  34.   kc  : Char;
  35.   lcv : Byte;
  36.   Owner : Array[0..16] of Char;
  37.   Prog  : Array[0..5] of Char;
  38.   Ver   : Real;
  39.  
  40.  
  41. Procedure ReadConfig;
  42.  
  43. Var
  44.   cf : Text;
  45.   cs : String[80];
  46.  
  47. Begin
  48.   Assign(cf,'SAMPLE.CNF');
  49.   {$I-}
  50.   Reset(cf);
  51.   {$I+}
  52.   If (IoResult = 0) then Begin
  53.     While (Not Eof(cf)) Do Begin
  54.       ReadLn(cf,cs);
  55.       If (Copy(cs,1,1) <> '#') then Begin
  56.         If (Copy(cs,1,5) = 'NAME=') then
  57.           Rkp.Name1 := Copy(cs,6,80)
  58.         Else If (Copy(cs,1,6) = 'LEVEL=') then
  59.           If (Copy(cs,7,1) = 'R') then
  60.             Rkp.Level := 1
  61.           Else
  62.             Rkp.Level := 0
  63.         Else If (Copy(cs,1,4) = 'KEY=') then
  64.           Rkp.Key := Copy(cs,5,80);
  65.       End;
  66.     End;
  67.     If (Rkp.Key <> '000000000000') then Begin
  68.       Rkp.Name2 := '';
  69.       Rkp.Name3 := '';
  70.       Rkp.ExpYear := 0;
  71.       Rkp.ExpMonth := 0;
  72.       VerifyKey;
  73.     End;
  74.   End;
  75. End;
  76.  
  77.  
  78. Procedure BadRegBeep;
  79.  
  80. Begin
  81.   Sound(1200);
  82.   Delay(200);
  83.   Sound(600);
  84.   Delay(200);
  85.   Sound(1200);
  86.   Delay(200);
  87.   Sound(600);
  88.   Delay(200);
  89.   NoSound;
  90. End;
  91.  
  92.  
  93. Procedure NotRegBeep;
  94.  
  95. Begin
  96.   Sound(600);
  97.   Delay(200);
  98.   Sound(1200);
  99.   Delay(200);
  100.   NoSound;
  101. End;
  102.  
  103.  
  104. Procedure DoView;
  105.  
  106. Begin
  107.   WriteLn('Sample data :');
  108.   WriteLn;
  109.   WriteLn('4.465536  7.918270  0.118373  5.367233');
  110.   WriteLn('1.396349  4.868343  7.079323  4.783021');
  111.   WriteLn('3.947924  8.864673  8.846264  2.999999');
  112.   WriteLn('8.490832  6.874378  5.338329  3.729270');
  113.   WriteLn('6.839882  8.873478  6.750373  7.018948');
  114.   WriteLn('5.034784  3.003763  3.253290  4.892387');
  115.   WriteLn('3.874378  8.314159  9.880869  3.987842');
  116.   WriteLn('2.764947  9.265358  4.013002  9.903278');
  117. End;
  118.  
  119.  
  120. Procedure DoCalc;
  121.  
  122. Begin
  123.   If Rkp.Registered then Begin
  124.     Write('The calculated result is ');
  125.     WriteLn(4.465536+7.918270+0.118373+5.367233+1.396349+4.868343+7.079323+4.783021
  126.     +3.947924+8.864673+8.846264+2.999999+8.490832+6.874378+5.338329+3.729270
  127.     +6.839882+8.873478+6.750373+7.018948+5.034784+3.003763+3.253290+4.892387
  128.     +3.874378+8.314159+9.880869+3.987842+2.764947+9.265358+4.013002+9.903278);
  129.   End Else
  130.     WriteLn('Only available in registered version!');
  131. End;
  132.  
  133.  
  134. Procedure DoTest;
  135.  
  136. Begin
  137.   If Rkp.Registered then Begin
  138.     If (Rkp.Level > 0) then Begin
  139.       Write('Performing tests...');
  140.       Delay(300);
  141.       WriteLn;
  142.       WriteLn('All tests passed.');
  143.     End Else
  144.       WriteLn('Not available in demo version!');
  145.   End Else
  146.     WriteLn('Only available in registered version!');
  147. End;
  148.  
  149.  
  150. Begin
  151.   If BadSystemDate then Begin
  152.     WriteLn('You must correctly set your system clock to run Demo!');
  153.     BadRegBeep;
  154.     Halt(1);
  155.   End;
  156.   Owner := 'ArgleBarbWotsLeeb';
  157.   Prog := 'Sample';
  158.   Ver := 1.0;
  159.   SetOwnerCode(Owner,SizeOf(Owner));
  160.   SetProgCode(Prog,SizeOf(Prog));
  161.   SetVerCode(Ver,SizeOf(Ver));
  162.   ReadConfig;
  163.   Write('Sample3');
  164.   If Not RkpOK then
  165.     WriteLn(' [invalid]')
  166.   Else If Rkp.Registered and (Rkp.Level > 0) then
  167.     WriteLn(' [registered]')
  168.   Else If Rkp.Registered then
  169.     WriteLn(' [demo]')
  170.   Else
  171.     WriteLn(' [unregistered]');
  172.   WriteLn('Sample of RkPlus method 4 (using version 3.x/compatible keys)');
  173.   WriteLn('see RKPLUS.DOC for more info');
  174.   WriteLn;
  175.   If (RkpError = InvalidFile) or (RkpError = InvalidKey) then Begin
  176.     WriteLn(KeyFileName,' has been altered!');
  177.     BadRegBeep;
  178.     Halt(1);
  179.   End Else If (RkpError = ExpiredKey) then Begin
  180.     If (Rkp.Level > 0) then Begin
  181.       WriteLn('Your registration key has expired!');
  182.       WriteLn('You will be given access at the DEMO level.');
  183.       NotRegBeep;
  184.       Rkp.Level := 0;
  185.     End Else Begin
  186.       WriteLn('Your limited use demo key has expired!');
  187.       WriteLn('You will be given access at the UNREGISTERED level.');
  188.       NotRegBeep;
  189.       Rkp.Registered := False;
  190.     End;
  191.   End Else If Rkp.Registered then Begin
  192.     If (Rkp.Level > 0) then Begin
  193.       WriteLn('This version of Sample3 is registered to ',Rkp.Name1);
  194.       If (Rkp.ExpYear <> 0) and (Rkp.ExpMonth <> 0) then
  195.         WriteLn('This registration will expire ','1-',MonthNames[Rkp.ExpMonth],'-',Rkp.ExpYear,'.');
  196.       WriteLn('Thank you for registering!');
  197.     End Else Begin
  198.       WriteLn('This version of Sample3 is a limited use demo for ',Rkp.Name1);
  199.       If (Rkp.ExpYear <> 0) and (Rkp.ExpMonth <> 0) then
  200.         WriteLn('This limited use demo will expire ','1-',MonthNames[Rkp.ExpMonth],'-',Rkp.ExpYear,'.');
  201.       WriteLn('Don''t forget to register!');
  202.     End;
  203.   End Else If Not RkpOK then Begin
  204.     WriteLn('Unexpected error ',RkpError,'!');
  205.     Halt(255);
  206.   End Else Begin
  207.     WriteLn('This version of Sample3 is unregistered.');
  208.     NotRegBeep;
  209.     Delay(500);
  210.   End;
  211.   WriteLn;
  212.   WriteLn('Sample3 Menu');
  213.   WriteLn;
  214.   WriteLn('[V]iew sample data');
  215.   Write('[C]alculate');
  216.   If Not Rkp.Registered then
  217.     WriteLn('  (only available in registered version)')
  218.   Else
  219.     WriteLn;
  220.   Write('[T]est results');
  221.   If Not Rkp.Registered then
  222.     WriteLn('  (only available in registered version)')
  223.   Else If (Rkp.Level <= 0) then
  224.     WriteLn('  (not available in demo version)')
  225.   Else
  226.     WriteLn;
  227.   WriteLn;
  228.   Write('Selection : ');
  229.   kc := UpCase(ReadKey);
  230.   WriteLn;
  231.   WriteLn;
  232.   Case kc of
  233.   'V' :
  234.     DoView;
  235.   'C' :
  236.     DoCalc;
  237.   'T' :
  238.     DoTest;
  239.   Else
  240.     WriteLn('Invalid selection!');
  241.   End;
  242. End.
  243.