home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Source Code / Peter Lewis / PNL Libraries / MyExpiry.p < prev    next >
Encoding:
Text File  |  1994-10-14  |  1.1 KB  |  55 lines  |  [TEXT/PJMM]
  1. unit MyExpiry;
  2.  
  3. interface
  4.  
  5.     function ExpiredVersion: boolean;
  6.  
  7. implementation
  8.  
  9.     uses
  10.         MyVersionResource, MyEmergencyNotifier, MyUtils;
  11.  
  12.     procedure GetCompiledDate (var date: longInt);
  13.         var
  14.             d: DateTimeRec;
  15.             s: str31;
  16.             p: integer;
  17.     begin
  18.         s := compdate;
  19.         p := Pos('/', s);
  20.         d.day := StrToNum(copy(s, 1, p - 1));
  21.         Delete(s, 1, p);
  22.         p := Pos('/', s);
  23.         d.month := StrToNum(copy(s, 1, p - 1));
  24.         Delete(s, 1, p);
  25.         d.year := 1900 + StrToNum(s);
  26.         d.hour := 0;
  27.         d.minute := 0;
  28.         d.second := 0;
  29.         Date2Secs(d, date);
  30.     end;
  31.  
  32.     function ExpiredVersion: boolean;
  33.         var
  34.             date, cdate, diff: longInt;
  35.             vers: versionRecord;
  36.     begin
  37.         ExpiredVersion := false;
  38.         GetVersion(vers);
  39.         if vers.devcode <> $80 then begin
  40.             GetDateTime(date);
  41.             GetCompiledDate(cdate);
  42.             diff := (date - cdate) div 2678400;
  43.             if diff >= 6 then begin
  44.                 EmergencyNotify('This developmental version has expired.  Set your clock back, or get a new version');
  45.                 ExpiredVersion := true;
  46.             end
  47.             else if diff >= 4 then begin
  48.                 EmergencyNotify('This developmental version has expired.  It will work for a while, and then stop working forever.  Get a new version');
  49.             end;
  50.         end;
  51.     end;
  52.  
  53.  
  54. end.
  55.