home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / PASCAL / TSPA2540.ZIP / SELFTEST.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-01-06  |  3.4 KB  |  102 lines
  1. (*
  2.      Programmers: Help fighting viruses and patching.
  3.  
  4. Viruses and unauthorized patching are problems which should be
  5. fought against by the PC community. This program demonstrates a
  6. simple and a reasonably general, fast selftest to detect whether the
  7. program has caught a virus, or if it has been amateurishly patched.
  8. The code is easily incorporated in any Turbo Pascal source code. The
  9. idea is to check whether the file date and size have been altered.
  10. Most .exe viruses work by appending their code to the .exe file
  11. altering the file size. Trivial patching changes the file date.
  12. Either of these is detected by selftest.
  13. ...................................................................
  14. Prof. Timo Salmi        (Moderating at anon. ftp site 128.214.12.3)
  15. School of Business Studies, University of Vaasa, SF-65101, Finland
  16. Internet: ts@chyde.uwasa.fi Funet: gado::salmi Bitnet: salmi@finfun
  17. *)
  18.  
  19. program SelftestDemo;
  20.  
  21. uses Dos
  22.      {$IFDEF VER40}  (* To provide what TP 4.0 is missing *)
  23.      ,TSUNT45        (* as compared to TP 5.0 and TP 5.5 *)
  24.      {$ENDIF}
  25.      ;
  26.  
  27. (* Define a datatype for the required information *)
  28. type SelftestRecordType = record
  29.                              size  : longint;
  30.                              year  : word;
  31.                              month : word;
  32.                              day   : word;
  33.                              ok    : boolean;
  34.                            end;
  35.  
  36. (* Define a selftest constant. Give initial values to match your
  37.    own program *)
  38. const SelftestRecord
  39.         : selftestRecordType
  40.         = (size  : 3664;
  41.            year  : 1991;
  42.            month : 1;
  43.            day   : 6;
  44.            ok    : true);
  45.  
  46. (* Tests whether file size and / or filedate have been changed.
  47.    Writes a warning message *)
  48. procedure SELFTEST (var selftestRecord : selftestRecordType);
  49. var FileInfo : SearchRec;
  50.     FileDate : DateTime;
  51.     oksize   : boolean;
  52.     okdate   : boolean;
  53.     progname : string;
  54. begin
  55.   oksize := true;
  56.   okdate := true;
  57.   {$IFDEF VER40} progname := ParamStr0;
  58.   {$ELSE}        progname := ParamStr(0);
  59.   {$ENDIF}
  60.   FindFirst (progname, AnyFile, FileInfo);
  61.   if DosError <> 0 then selftestRecord.ok := false;
  62.   if selftestRecord.ok then
  63.     if (FileInfo.Attr and VolumeId = 0) and
  64.        (FileInfo.Attr and Directory = 0) then
  65.       begin
  66.         if FileInfo.Size <> selftestRecord.size then
  67.           oksize := false;
  68.         UnpackTime (FileInfo.Time, FileDate);
  69.         if FileDate.year  <> selftestRecord.year then
  70.           okdate := false;
  71.         if FileDate.month <> selftestRecord.month then
  72.           okdate := false;
  73.         if FileDate.day   <> selftestRecord.day then
  74.           okdate := false;
  75.         selftestRecord.ok := oksize and okdate;
  76.       end;
  77.   if not selftestRecord.ok then
  78.     begin
  79.       writeln (#7, 'Warning for a patched or detached program, or a potential virus');
  80.       if not oksize then
  81.         writeln (progname, ' filesize has been altered');
  82.       if not okdate then
  83.         writeln (progname, ' filedate has been altered');
  84.     end;
  85. end;  (* selftest *)
  86.  
  87. procedure LOGO;
  88. begin
  89.   writeln;
  90.   writeln ('SELFTEST demo by Prof. Timo Salmi, 6-Jan-91');
  91.   writeln ('University of Vaasa, Finland, ts@chyde.uwasa.fi');
  92.   writeln;
  93. end;  (* logo *)
  94.  
  95. (* Main program *)
  96. begin
  97.   LOGO;
  98.   SELFTEST (selftestRecord);
  99.   if not selftestRecord.ok then halt;
  100.   writeln ('Hello world and whatever');
  101. end.  (* selftestDemo *)
  102.