home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / PROGRAM / PASCAL / RKPLUS33 / RKPDEMO2 / SAMPLE1.PAS < prev    next >
Pascal/Delphi Source File  |  1993-10-19  |  5KB  |  198 lines
  1. Program Sample1;
  2.  
  3. {
  4.  This is a demonstration programme 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 programme that doesn't actually do anything, but it
  9.  should demonstrate some of what can be done with RkPlus.  It uses
  10.  a key file (SAMPLE.RKP) which can be created by GenFile or Register.
  11.  
  12.  Sample1 uses the Rkp2Enc unit to cause RkPlus to maintain version
  13.  2.x/compatible keys.
  14. }
  15.  
  16.  
  17. Uses
  18.   Crt,
  19.   RkPlus,
  20.   Rkp2Enc;
  21.  
  22.  
  23. Const
  24.   MonthNames : Array[1..12] of String[3]
  25.   = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec');
  26.  
  27.  
  28. Var
  29.   kc : Char;
  30.  
  31.  
  32. Procedure BadRegBeep;
  33.  
  34. Begin
  35.   Sound(1200);
  36.   Delay(200);
  37.   Sound(600);
  38.   Delay(200);
  39.   Sound(1200);
  40.   Delay(200);
  41.   Sound(600);
  42.   Delay(200);
  43.   NoSound;
  44. End;
  45.  
  46.  
  47. Procedure NotRegBeep;
  48.  
  49. Begin
  50.   Sound(600);
  51.   Delay(200);
  52.   Sound(1200);
  53.   Delay(200);
  54.   NoSound;
  55. End;
  56.  
  57.  
  58. Procedure DoView;
  59.  
  60. Begin
  61.   WriteLn('Sample data :');
  62.   WriteLn;
  63.   WriteLn('4.465536  7.918270  0.118373  5.367233');
  64.   WriteLn('1.396349  4.868343  7.079323  4.783021');
  65.   WriteLn('3.947924  8.864673  8.846264  2.999999');
  66.   WriteLn('8.490832  6.874378  5.338329  3.729270');
  67.   WriteLn('6.839882  8.873478  6.750373  7.018948');
  68.   WriteLn('5.034784  3.003763  3.253290  4.892387');
  69.   WriteLn('3.874378  8.314159  9.880869  3.987842');
  70.   WriteLn('2.764947  9.265358  4.013002  9.903278');
  71. End;
  72.  
  73.  
  74. Procedure DoCalc;
  75.  
  76. Begin
  77.   If Rkp.Registered then Begin
  78.     Write('The calculated result is ');
  79.     WriteLn(4.465536+7.918270+0.118373+5.367233+1.396349+4.868343+7.079323+4.783021
  80.     +3.947924+8.864673+8.846264+2.999999+8.490832+6.874378+5.338329+3.729270
  81.     +6.839882+8.873478+6.750373+7.018948+5.034784+3.003763+3.253290+4.892387
  82.     +3.874378+8.314159+9.880869+3.987842+2.764947+9.265358+4.013002+9.903278);
  83.   End Else
  84.     WriteLn('Only available in registered version!');
  85. End;
  86.  
  87.  
  88. Procedure DoTest;
  89.  
  90. Begin
  91.   If Rkp.Registered then Begin
  92.     If (Rkp.Level > 0) then Begin
  93.       Write('Performing tests...');
  94.       Delay(300);
  95.       WriteLn;
  96.       WriteLn('All tests passed.');
  97.     End Else
  98.       WriteLn('Not available in demo version!');
  99.   End Else
  100.     WriteLn('Only available in registered version!');
  101. End;
  102.  
  103.  
  104. Begin
  105.   If Not RkpOK then Begin
  106.     WriteLn('Unexpected Error ',RkpError,'!');
  107.     Halt(255);
  108.   End;
  109.   If BadSystemDate then Begin
  110.     WriteLn('You must correctly set your system clock to run Sample1!');
  111.     BadRegBeep;
  112.     Halt(1);
  113.   End;
  114.   OwnerCode := 'ArgleBarbWotsLeeb';
  115.   ProgramCode := 'Sample';
  116.   SetKeyFile('Sample');
  117.   GetRegInfo;
  118.   Write('Sample1');
  119.   If Not RkpOK then
  120.     WriteLn(' [invalid]')
  121.   Else If Rkp.Registered and (Rkp.Level > 0) then
  122.     WriteLn(' [registered]')
  123.   Else If Rkp.Registered then
  124.     WriteLn(' [demo]')
  125.   Else
  126.     WriteLn(' [unregistered]');
  127.   WriteLn('Sample of RkPlus methods 1 and 2 (using version 2.x/compatible keys)');
  128.   WriteLn('See RKPLUS.DOC for more info');
  129.   WriteLn;
  130.   If (RkpError = InvalidFile) or (RkpError = InvalidKey) then Begin
  131.     WriteLn(KeyFileName,' has been altered!');
  132.     BadRegBeep;
  133.     Halt(1);
  134.   End Else If (RkpError = ExpiredKey) then Begin
  135.     If (Rkp.Level > 0) then Begin
  136.       WriteLn('Your registration key has expired!');
  137.       WriteLn('You will be given DEMO access.');
  138.       NotRegBeep;
  139.       Rkp.Level := 0;
  140.     End Else Begin
  141.       WriteLn('Your demo key has expired!');
  142.       WriteLn('You will be given UNREGISTERED access.');
  143.       NotRegBeep;
  144.       Rkp.Registered := False;
  145.     End;
  146.   End Else If Rkp.Registered then Begin
  147.     If (Rkp.Level > 0) then Begin
  148.       WriteLn('This version of Sample1 is registered to ',Rkp.Name1);
  149.       If (Rkp.ExpYear <> 0) and (Rkp.ExpMonth <> 0) then
  150.         WriteLn('This registration will expire ','1-',MonthNames[Rkp.ExpMonth],'-',Rkp.ExpYear,'.');
  151.       WriteLn('Thank you for registering!');
  152.     End Else Begin
  153.       WriteLn('This version of Sample1 is a limited use demo for ',Rkp.Name1);
  154.       If (Rkp.ExpYear <> 0) and (Rkp.ExpMonth <> 0) then
  155.         WriteLn('This demo will expire ','1-',MonthNames[Rkp.ExpMonth],'-',Rkp.ExpYear,'.');
  156.       WriteLn('Don''t forget to register!');
  157.     End;
  158.   End Else If Not RkpOK then Begin
  159.     WriteLn('Unexpected error ',RkpError,'!');
  160.     Halt(255);
  161.   End Else Begin
  162.     WriteLn('This version of Sample1 is unregistered.');
  163.     NotRegBeep;
  164.     Delay(500);
  165.   End;
  166.   WriteLn;
  167.   WriteLn('Sample1 Menu');
  168.   WriteLn;
  169.   WriteLn('[V]iew sample data');
  170.   Write('[C]alculate');
  171.   If Not Rkp.Registered then
  172.     WriteLn('  (only available in registered version)')
  173.   Else
  174.     WriteLn;
  175.   Write('[T]est results');
  176.   If Not Rkp.Registered then
  177.     WriteLn('  (only available in registered version)')
  178.   Else If (Rkp.Level <= 0) then
  179.     WriteLn('  (not available in demo version)')
  180.   Else
  181.     WriteLn;
  182.   WriteLn;
  183.   Write('Selection : ');
  184.   kc := UpCase(ReadKey);
  185.   WriteLn;
  186.   WriteLn;
  187.   Case kc of
  188.   'V' :
  189.     DoView;
  190.   'C' :
  191.     DoCalc;
  192.   'T' :
  193.     DoTest;
  194.   Else
  195.     WriteLn('Invalid selection!');
  196.   End;
  197. End.
  198.