home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / PASCAL / TSPA2540.ZIP / TSUNTI.TST < prev    next >
Encoding:
Text File  |  1990-08-08  |  4.3 KB  |  142 lines
  1. (* This is a test program for the TSUNTI.TPU unit 6-Aug-90,
  2.  
  3. IMPORTANT ADVICE: Study these tests and the information in TSUNTI.INT
  4. carefully before writing your own applications. The routines in the
  5. TSUNTI.TPU unit are much more complicated than any of the others.
  6.  
  7. *)
  8.  
  9. uses Dos,
  10.      TSUNTI
  11.      {$IFDEF VER40}
  12.      ,TSUNT45
  13.      {$ENDIF}
  14.      ;
  15.  
  16. procedure LOGO;
  17. begin
  18.   writeln;
  19.   writeln ('TSUNTI unit test by Prof. Timo Salmi, 6-Aug-90');
  20.   writeln ('University of Vaasa, Finland, ts@chyde.uwasa.fi');
  21.   writeln;
  22. end;  (* logo *)
  23.  
  24. (* Get the number of times this program has been run since last
  25.    compiled. Run this test a few times, and see the count increase *)
  26. procedure TEST1;
  27. var status : string;
  28.     count  : longint;
  29. begin
  30.   USECOUNT (count, status);
  31.   if status = '' then
  32.     writeln ('This program has been run ', count, ' times since compilation')
  33.   else
  34.     writeln ('Status of usecount ', status);
  35. end;  (* test1 *)
  36.  
  37. (* Get the number of times this program has been run since last compiled.
  38.    Run this test a few times, and see the counter increase. Then recompile,
  39.    and see the counter being initialized. Nifty, isn't it. *)
  40. procedure TEST2;
  41. const counter : longint = 0;
  42. var status : word;
  43. begin
  44.   counter := counter + 1;
  45.   BRANDEXE (counter, SizeOf(counter), status);
  46.   if status <> 0 then
  47.     begin writeln ('Error status = ', status); exit; end;
  48.   writeln ('Counter = ', counter);
  49. end;  (* test2 *)
  50.  
  51. (* Here is a more complicted test of BRANDEXE usage. Study it carefully,
  52.    and try out your own variations *)
  53. procedure TEST3;
  54. type MyInfoType = record
  55.                     counter   : longint;
  56.                     hour      : word;
  57.                     minute    : word;
  58.                     second    : word;
  59.                     sec100    : word;
  60.                   end;
  61. const MyInfo
  62.       : MyInfoType
  63.       = (counter : 0;  { These initial values are changed by BRANDEXE. }
  64.          hour    : 0;  { The next time you run this program, the branded }
  65.          minute  : 0;  { values will have replaced these zeros in the .exe }
  66.          second  : 0;
  67.          sec100  : 0);
  68. var status : word;
  69.     hh, mm, ss, s100 : word;
  70. begin
  71.   {... This shows how the counter is used now, but let's comment it away
  72.        this time and concentrate on the run-last-time test ...}
  73.   {
  74.   myinfo.counter := myinfo.counter + 1;
  75.   BRANDEXE (MyInfo, SizeOf(MyInfo), status);
  76.   if status <> 0 then
  77.     begin writeln ('Error status = ', status); exit; end;
  78.   writeln ('Counter = ', myinfo.counter);
  79.   }
  80.   {}
  81.   {... This information is taken from within the .exe ...}
  82.   write ('Last run at ', myinfo.hour, ':');
  83.   if myinfo.minute < 10 then write ('0');
  84.   write (myinfo.minute, ':');
  85.   if myinfo.second < 10 then write ('0');
  86.   writeln (myinfo.second);
  87.   {}
  88.   {... Get the current time ...}
  89.   GetTime (hh, mm, ss, s100);
  90.   write ('The time now ', hh, ':');
  91.   if mm < 10 then write ('0');
  92.   write (mm, ':');
  93.   if ss < 10 then write ('0');
  94.   writeln (ss);
  95.   {}
  96.   {... And now store the current time within the .exe as the MyInfo
  97.        initial values ...}
  98.   myinfo.hour := hh;
  99.   myinfo.minute := mm;
  100.   myinfo.second := ss;
  101.   myinfo.sec100 := s100;
  102.   BRANDEXE (MyInfo, SizeOf(MyInfo), status);
  103.   if status <> 0 then
  104.     writeln ('Branding failed, status : ', status);
  105. end;  (* test3 *)
  106.  
  107. (* How to use the direct checksum *)
  108. procedure TEST4;
  109. type checksumRecordType
  110.         = record
  111.             chksum : longint;
  112.             show   : boolean;
  113.           end;
  114. const checksumRecord
  115.         : checksumRecordType
  116.         = (chksum : 576792;      (* Alter chksum to match your program's *)
  117.            show   : true);       (* Turn false for no display, see below *)
  118. var chksum
  119.       : longint;
  120. begin
  121.   chksum := CHKSUMFN (checksumRecord, SizeOf(checksumRecord));
  122.   if checksumRecord.show then writeln ('CHECKSUM = ', chksum);
  123.   if (chksum <> checksumRecord.chksum) and (chksum <> 0) then
  124.     begin
  125.       {$IFNDEF VER40}
  126.       writeln ('Checksum error in ', paramstr(0));
  127.       {$ELSE}
  128.       writeln ('Checksum error in ', paramstr0);
  129.       {$ENDIF}
  130.     end;
  131. end;  (* test4 *)
  132.  
  133. (* Main program *)
  134. begin
  135.   LOGO;
  136.   TEST4;
  137.   {}
  138.   {... if you want the rest of the tests, just include them ...}
  139.   {}
  140.   write ('Press <═╝'); readln;
  141. end.  (* tsunti.tst *)
  142.