home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / utility / stripped / stripped.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1992-05-29  |  3.7 KB  |  154 lines
  1. program stripped;
  2.  
  3. { Program to detect .EXE files which have been damaged by Borland's TDSTRIP. }
  4. { Searches complete directory tree of current disk. }
  5.  
  6. uses dos,objects;
  7.  
  8. procedure Syntax_Exit(msg:string);
  9. begin
  10.   writeln(msg);
  11.   writeln;
  12.   writeln('Syntax:  STRIPPED dir ');
  13.   writeln(' will print list of files from in the dir and its subdirs which');
  14.   writeln(' have bad initial minimum memory allocations, presumably because');
  15.   writeln(' of damage by TDSTRIP.');
  16.   halt(99);
  17. end;
  18.  
  19. type
  20.   exe_header = record
  21.     sig,
  22.     remainder,
  23.     pages,
  24.     relocs,
  25.     header,
  26.     min_extra,
  27.     max_extra,
  28.     stackseg,
  29.     stackofs : word;
  30.   end;
  31.  
  32. var
  33.   currentdir : string;
  34.   filecount,badfilecount : word;
  35.  
  36. procedure testdir;
  37. { Tests all files in current directory.  Assumes currentdir has trailing backslash }
  38. var
  39.   exe : TDOSStream;
  40.   s : searchrec;
  41.   header : exe_header;
  42.   image : longint;
  43.   extra : longint;
  44.   stackneeds : longint;
  45.   headersize : longint;
  46.   foundbad : boolean;
  47. begin
  48.   foundbad := false;
  49.   findfirst(currentdir + '*.exe',anyfile,s);
  50.   while Doserror = 0 do
  51.   begin
  52.     exe.init(currentdir+s.name,stOpenRead);
  53.     exe.read(header,sizeof(header));
  54.     if exe.status <> stOK then
  55.       writeln('Warning:  Unable to open',currentdir,s.name)
  56.     else
  57.     begin
  58.       inc(filecount);
  59.       if header.sig = $5A4d then
  60.         with header do
  61.         begin
  62.           image := longmul(pages,512) - longmul(16,header);
  63.           extra := longmul(16,min_extra);               { stack and heap }
  64.           headersize := image + extra;
  65.           stackneeds := longmul(stackseg,16) + stackofs;
  66.           if headersize < (longmul(stackseg,16) + stackofs) then
  67.           begin
  68.             if not foundbad then
  69.             begin
  70.               foundbad := true;
  71.               writeln(currentdir);
  72.             end;
  73.             writeln(s.name:30,headersize+256:15,  { Add in 256 byte PSP }
  74.                     ' < RAM < ',stackneeds+256);
  75.             inc(badfilecount);
  76.           end
  77.         end;
  78.     end;
  79.     exe.done;
  80.     findnext(s);
  81.   end;
  82. end;
  83.  
  84. type
  85.   string12 = string[12];
  86.  
  87. function realdir(name:string12):boolean;
  88. begin
  89.   realdir := (name <> '.') and (name <> '..');
  90. end;
  91.  
  92. procedure addbackslash;
  93. begin
  94.   currentdir := currentdir + '\';
  95. end;
  96.  
  97. procedure testalldirs;
  98. var
  99.   s : searchrec;
  100.   oldlength : byte;
  101.  
  102.   procedure addsuffix(suffix:namestr);  { Separate proc to save stack space }
  103.   begin
  104.     currentdir := copy(currentdir,1,oldlength) + suffix;
  105.   end;
  106.  
  107.  
  108. begin
  109.   oldlength := length(currentdir);
  110.   testdir;
  111.   addsuffix('*.*');
  112.   findfirst(currentdir,directory,s);
  113.   while doserror = 0 do
  114.   begin
  115.     if s.attr = directory then
  116.     begin
  117.       if realdir(s.name) then
  118.       begin
  119.         addsuffix(s.name);
  120.         addbackslash;
  121.         testalldirs;          { do directory recursively }
  122.       end;
  123.     end;
  124.     findnext(s);
  125.   end;
  126. end;
  127.  
  128. begin
  129.   writeln('STRIPPED - Check directories for files damaged by TDSTRIP.');
  130.   if paramcount <> 1 then
  131.     syntax_exit('No directory specified.');
  132.   writeln('Dir','File  ':27,'Bad stack zone':27);
  133.   filecount := 0;
  134.   badfilecount := 0;
  135.   currentdir := paramstr(1);
  136.   if currentdir[length(currentdir)] <> '\' then
  137.     addbackslash;
  138.   testalldirs;
  139.   writeln;
  140.   if filecount > 0 then
  141.   begin
  142.     writeln('Tested ',filecount,' .EXE files.');
  143.     if badfilecount > 0 then
  144.     begin
  145.       writeln('Found ',badfilecount,' files which will load when RAM is in the');
  146.       writeln('given range but which won''t have space for a proper stack.');
  147.     end
  148.     else
  149.       writeln('No bad headers found.');
  150.   end
  151.   else
  152.     writeln('No .EXE files found in directory ',paramstr(1));
  153. end.
  154.