home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / RKPLUS30.ZIP / RKPDEMO2.ZIP / SAMPLE3.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-02-04  |  6.1 KB  |  236 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 Rkp2Enc unit to cause RkPlus to maintain version
  18.  2.x/compatible keys.
  19. }
  20.  
  21.  
  22. Uses
  23.   Crt,
  24.   RkPlus,
  25.   Rkp2Enc;
  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.  
  37.  
  38. Procedure ReadConfig;
  39.  
  40. Var
  41.   cf : Text;
  42.   cs : String[80];
  43.  
  44. Begin
  45.   Assign(cf,'SAMPLE.CNF');
  46.   {$I-}
  47.   Reset(cf);
  48.   {$I+}
  49.   If (IoResult = 0) then Begin
  50.     While (Not Eof(cf)) Do Begin
  51.       ReadLn(cf,cs);
  52.       If (Copy(cs,1,1) <> '#') then Begin
  53.         If (Copy(cs,1,5) = 'NAME=') then
  54.           Rkp.Name1 := Copy(cs,6,80)
  55.         Else If (Copy(cs,1,6) = 'LEVEL=') then
  56.           If (Copy(cs,7,1) = 'R') then
  57.             Rkp.Level := 1
  58.           Else
  59.             Rkp.Level := 0
  60.         Else If (Copy(cs,1,4) = 'KEY=') then
  61.           Rkp.Key := Copy(cs,5,80);
  62.       End;
  63.     End;
  64.     If (Rkp.Key <> '000000000000') then Begin
  65.       Rkp.Name2 := '';
  66.       Rkp.Name3 := '';
  67.       Rkp.ExpYear := 0;
  68.       Rkp.ExpMonth := 0;
  69.       VerifyKey;
  70.     End;
  71.   End;
  72. End;
  73.  
  74.  
  75. Procedure BadRegBeep;
  76.  
  77. Begin
  78.   Sound(1200);
  79.   Delay(200);
  80.   Sound(600);
  81.   Delay(200);
  82.   Sound(1200);
  83.   Delay(200);
  84.   Sound(600);
  85.   Delay(200);
  86.   NoSound;
  87. End;
  88.  
  89.  
  90. Procedure NotRegBeep;
  91.  
  92. Begin
  93.   Sound(600);
  94.   Delay(200);
  95.   Sound(1200);
  96.   Delay(200);
  97.   NoSound;
  98. End;
  99.  
  100.  
  101. Procedure DoView;
  102.  
  103. Begin
  104.   WriteLn('Sample data :');
  105.   WriteLn;
  106.   WriteLn('4.465536  7.918270  0.118373  5.367233');
  107.   WriteLn('1.396349  4.868343  7.079323  4.783021');
  108.   WriteLn('3.947924  8.864673  8.846264  2.999999');
  109.   WriteLn('8.490832  6.874378  5.338329  3.729270');
  110.   WriteLn('6.839882  8.873478  6.750373  7.018948');
  111.   WriteLn('5.034784  3.003763  3.253290  4.892387');
  112.   WriteLn('3.874378  8.314159  9.880869  3.987842');
  113.   WriteLn('2.764947  9.265358  4.013002  9.903278');
  114. End;
  115.  
  116.  
  117. Procedure DoCalc;
  118.  
  119. Begin
  120.   If Rkp.Registered then Begin
  121.     Write('The calculated result is ');
  122.     WriteLn(4.465536+7.918270+0.118373+5.367233+1.396349+4.868343+7.079323+4.783021
  123.     +3.947924+8.864673+8.846264+2.999999+8.490832+6.874378+5.338329+3.729270
  124.     +6.839882+8.873478+6.750373+7.018948+5.034784+3.003763+3.253290+4.892387
  125.     +3.874378+8.314159+9.880869+3.987842+2.764947+9.265358+4.013002+9.903278);
  126.   End Else
  127.     WriteLn('Only available in registered version!');
  128. End;
  129.  
  130.  
  131. Procedure DoTest;
  132.  
  133. Begin
  134.   If Rkp.Registered then Begin
  135.     If (Rkp.Level > 0) then Begin
  136.       Write('Performing tests...');
  137.       Delay(300);
  138.       WriteLn;
  139.       WriteLn('All tests passed.');
  140.     End Else
  141.       WriteLn('Not available in demo version!');
  142.   End Else
  143.     WriteLn('Only available in registered version!');
  144. End;
  145.  
  146.  
  147. Begin
  148.   If BadSystemDate then Begin
  149.     WriteLn('You must correctly set your system clock to run Demo!');
  150.     BadRegBeep;
  151.     Halt(1);
  152.   End;
  153.   OwnerCode := 'ArgleBarbWotsLeeb';
  154.   ProgramCode := 'Sample';
  155.   ReadConfig;
  156.   Write('Sample3');
  157.   If Not RkpOK then
  158.     WriteLn(' [invalid]')
  159.   Else If Rkp.Registered and (Rkp.Level > 0) then
  160.     WriteLn(' [registered]')
  161.   Else If Rkp.Registered then
  162.     WriteLn(' [demo]')
  163.   Else
  164.     WriteLn(' [unregistered]');
  165.   WriteLn('Sample of RkPlus method 4 (using version 2.x/compatible keys)');
  166.   WriteLn('see RKPLUS.DOC for more info');
  167.   WriteLn;
  168.   If (RkpError = InvalidFile) or (RkpError = InvalidKey) then Begin
  169.     WriteLn(KeyFileName,' has been altered!');
  170.     BadRegBeep;
  171.     Halt(1);
  172.   End Else If (RkpError = ExpiredKey) then Begin
  173.     If (Rkp.Level > 0) then Begin
  174.       WriteLn('Your registration key has expired!');
  175.       WriteLn('You will be given access at the DEMO level.');
  176.       NotRegBeep;
  177.       Rkp.Level := 0;
  178.     End Else Begin
  179.       WriteLn('Your limited use demo key has expired!');
  180.       WriteLn('You will be given access at the UNREGISTERED level.');
  181.       NotRegBeep;
  182.       Rkp.Registered := False;
  183.     End;
  184.   End Else If Rkp.Registered then Begin
  185.     If (Rkp.Level > 0) then Begin
  186.       WriteLn('This version of Sample3 is registered to ',Rkp.Name1);
  187.       If (Rkp.ExpYear <> 0) and (Rkp.ExpMonth <> 0) then
  188.         WriteLn('This registration will expire ','1-',MonthNames[Rkp.ExpMonth],'-',Rkp.ExpYear,'.');
  189.       WriteLn('Thank you for registering!');
  190.     End Else Begin
  191.       WriteLn('This version of Sample3 is a limited use demo for ',Rkp.Name1);
  192.       If (Rkp.ExpYear <> 0) and (Rkp.ExpMonth <> 0) then
  193.         WriteLn('This limited use demo will expire ','1-',MonthNames[Rkp.ExpMonth],'-',Rkp.ExpYear,'.');
  194.       WriteLn('Don''t forget to register!');
  195.     End;
  196.   End Else If Not RkpOK then Begin
  197.     WriteLn('Unexpected error ',RkpError,'!');
  198.     Halt(255);
  199.   End Else Begin
  200.     WriteLn('This version of Sample3 is unregistered.');
  201.     NotRegBeep;
  202.     Delay(500);
  203.   End;
  204.   WriteLn;
  205.   WriteLn('Sample3 Menu');
  206.   WriteLn;
  207.   WriteLn('[V]iew sample data');
  208.   Write('[C]alculate');
  209.   If Not Rkp.Registered then
  210.     WriteLn('  (only available in registered version)')
  211.   Else
  212.     WriteLn;
  213.   Write('[T]est results');
  214.   If Not Rkp.Registered then
  215.     WriteLn('  (only available in registered version)')
  216.   Else If (Rkp.Level <= 0) then
  217.     WriteLn('  (not available in demo version)')
  218.   Else
  219.     WriteLn;
  220.   WriteLn;
  221.   Write('Selection : ');
  222.   kc := UpCase(ReadKey);
  223.   WriteLn;
  224.   WriteLn;
  225.   Case kc of
  226.   'V' :
  227.     DoView;
  228.   'C' :
  229.     DoCalc;
  230.   'T' :
  231.     DoTest;
  232.   Else
  233.     WriteLn('Invalid selection!');
  234.   End;
  235. End.
  236.