home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / TURBOPAS / DPERF.ZIP / DPERF.PAS
Encoding:
Pascal/Delphi Source File  |  1987-02-15  |  22.3 KB  |  810 lines
  1. {*************************************************************************}
  2. {*         Copyright (c) Kim Kokkonen, TurboPower Software, 1986         *}
  3. {*  Released to the public domain for personal, non-commercial use only  *}
  4. {*************************************************************************}
  5.  
  6. {.F-}
  7. {
  8. This program analyzes any set of files on any MSDOS disk drive to
  9. determine a measure of performance efficiency. The performance measure
  10. is based on how many file sectors are not contiguous. When the sectors
  11. of a file are not contiguous, read and write times are longer since the
  12. drive heads are forced to seek to each non-contiguous sector.
  13.  
  14. MSDOS Wildcards can be used to select any desired group of files in
  15. any drive or directory. A "Recursive" option allows you to look at
  16. all subdirectories of the start directory, and thus the entire disk
  17. if desired.
  18.  
  19. Output includes a list of all files analyzed with various analytical
  20. information. Optionally, only those files with non-contiguous sectors
  21. can be listed. The output is written to STDOUT, so that it can be
  22. redirected or piped.
  23.  
  24. A final summary section gives statistics for all of the files analyzed.
  25. This section is not redirectable.
  26.  
  27. Examples:
  28.  
  29. EFFIC -?
  30.   gives a help screen and halts.
  31.  
  32. EFFIC
  33.   looks at all files in the current directory and writes to screen.
  34.  
  35. EFFIC -S C:\*.COM -R -Q >BREAKS.DAT
  36.   looks at all COM files on drive C: and writes those with breaks
  37.   to the file BREAKS.DAT
  38.  
  39. EFFIC -S A: | MORE
  40.   pages all files in the root directory of drive A: through the
  41.   DOS MORE filter.
  42.  
  43. EFFIC -A >NUL
  44.   generates just a summary report for all files on the default drive.
  45.  
  46. Written 1/21/86. Kim Kokkonen, TurboPower Software.
  47.   408-378-3672. Compuserve 72457,2131.
  48.  
  49. Requires Turbo Pascal version 3 to compile.
  50. No known dependencies on the PCDOS version of Turbo.
  51. Compile with max heap = $A000 to allow maximum recursion
  52. area for subdirectory searching.
  53. }
  54. {.F+}
  55.  
  56. {$P512}
  57. {$C-}
  58.  
  59. PROGRAM FilePerformance(Output);
  60.  {-measure the fraction of non-contiguous sectors in a group of files}
  61. CONST
  62.  MaxFiles=1024;     {max number of files searched in a given directory}
  63.  MaxDirs=128;       {maximum number of dirs in a given directory}
  64.  OptionChar='-';    {character which prefixes options on command line}
  65.  
  66. TYPE
  67.  DriveName=STRING[2];
  68.  FileString=STRING[12];
  69.  PathName=STRING[64];
  70.  FileName=STRING[8];
  71.  ExtName=STRING[3];
  72.  LongString=STRING[255];
  73.  FnameType=ARRAY[0..7] OF Char;
  74.  FextType=ARRAY[0..2] OF Char;
  75.  FATinRAM=ARRAY[0..32767] OF Byte;
  76.  
  77.  Darray=
  78.  RECORD
  79.   num:Integer;
  80.   arr:ARRAY[1..MaxDirs] OF FileString;
  81.  END;
  82.  
  83.  CompositeFilename=
  84.  RECORD
  85.   name:FileName;
  86.   ext:ExtName;
  87.  END;
  88.  
  89.  Farray=
  90.  RECORD
  91.   num:Integer;
  92.   arr:ARRAY[1..MaxFiles] OF CompositeFilename;
  93.  END;
  94.  
  95.  DTArec=
  96.  RECORD
  97.   DOSnext:ARRAY[1..21] OF Byte;
  98.   attr:Byte;
  99.   fTime,fDate,flSize,fhSize:Integer;
  100.   FullName:ARRAY[1..13] OF Char;
  101.  END;
  102.  
  103.  UnopenedFCBrec=
  104.  RECORD
  105.   flag:Byte;
  106.   junk:ARRAY[0..4] OF Byte;
  107.   SearchAttr:Byte;
  108.   drive:Byte;
  109.   fName:FnameType;
  110.   fExt:FextType;
  111.   attr:Byte;
  112.   DOSnext:ARRAY[12..21] OF Byte;
  113.   fTime,fDate,fCluster,flSize,fhSize:Integer;
  114.  END;
  115.  
  116.  Registers=
  117.  RECORD
  118.   CASE Integer OF
  119.    1:(ax,bx,cx,dx,bp,si,di,ds,es,flags:Integer);
  120.    2:(al,ah,bl,bh,cl,ch,dl,dh:Byte);
  121.  END;
  122.  
  123. VAR
  124.  reg:Registers;
  125.  SavePath,StartPath:PathName;
  126.  WroteFile,bigFAT,recursive,verbose:Boolean;
  127.  dta:DTArec;
  128.  tStart,tStop:Real;
  129.  err:Text[128];     {non-redirectable status output written here}
  130.  files:Farray;
  131.  FATbytes,FATsectors,secSize,AvailableClusters,fBroken,
  132.  TotalBreaks,ClustersUsed,fCount,alloUnits,secsPerAllo:Integer;
  133.  FAT:^FATinRAM;
  134.  
  135.  PROCEDURE error(errnum,erraddr:Integer);
  136.   {-get back to home in case of a crash}
  137.  BEGIN
  138.   ChDir(SavePath);
  139.   Halt(1);
  140.  END;
  141.  
  142.  PROCEDURE Time(VAR sec:Real);
  143.   {-return time of day in seconds since midnight}
  144.  BEGIN
  145.   reg.ah:=$2C;
  146.   MsDos(reg);
  147.   sec:=1.0*(reg.dh+60.0*(reg.cl+60.0*reg.ch)+reg.dl/100.0);
  148.  END;               {time}
  149.  
  150.  PROCEDURE DoHalt(exitcode:Integer);
  151.   {-halt}
  152.  BEGIN
  153.   ChDir(SavePath);
  154.   Halt(exitcode);
  155.  END;               {dohalt}
  156.  
  157.  FUNCTION BreakPressed:Boolean;
  158.   {-true if Break key has been pressed}
  159.   {-note that keypressed function executes int 23 if ^C has been pressed}
  160.  VAR
  161.   c:Char;
  162.   breakdown:Boolean;
  163.  BEGIN
  164.   {check current state}
  165.   breakdown:=False;
  166.   WHILE KeyPressed AND NOT(breakdown) DO BEGIN
  167.    Read(Kbd,c);
  168.    IF c=^C THEN breakdown:=True;
  169.   END;
  170.   BreakPressed:=breakdown;
  171.  END;               {breakpressed}
  172.  
  173.  PROCEDURE BreakHalt;
  174.   {-executed when break is detected}
  175.   {-exit with return code 1}
  176.  BEGIN
  177.   ChDir(SavePath);
  178.   Halt(1);
  179.  END;               {breakhalt}
  180.  
  181.  PROCEDURE SetBreak;
  182.   {-set the ctrl-break address to a process exit handler}
  183.  BEGIN
  184.   reg.ax:=$2523;
  185.   reg.ds:=CSeg;
  186.   reg.dx:=Ofs(BreakHalt);
  187.   MsDos(reg);
  188.  END;               {setbreak}
  189.  
  190.  PROCEDURE ParsePath(VAR start:PathName;
  191.                      VAR dName:DriveName;
  192.                      VAR pName:PathName;
  193.                      VAR fName:FileString);
  194.   {-parse a full (perhaps incomplete) pathname into component parts}
  195.  VAR
  196.   i:Integer;
  197.  
  198.   FUNCTION FileExists(s:PathName;attr:Integer):Boolean;
  199.    {-determine whether a file exists with the specified attribute}
  200.   BEGIN
  201.    reg.ah:=$4E;
  202.    s[Succ(Length(s))]:=#0;
  203.    reg.ds:=Seg(s);
  204.    reg.dx:=Ofs(s[1]);
  205.    reg.cx:=attr;
  206.    MsDos(reg);
  207.    FileExists:=((reg.flags AND 1)=0) AND ((dta.attr AND 31)=attr);
  208.   END;              {fileexists}
  209.  
  210.  BEGIN
  211.   {get drive name}
  212.   i:=Pos(':',start);
  213.   IF i=0 THEN BEGIN
  214.    dName:='';
  215.    pName:=start;
  216.   END ELSE BEGIN
  217.    dName:=Copy(start,1,i);
  218.    IF i=Length(start) THEN pName:='\'
  219.    ELSE pName:=Copy(start,Succ(i),64);
  220.   END;
  221.  
  222.   {see if wildcard specified}
  223.   i:=Pos('*',start)+Pos('?',start);
  224.  
  225.   {separate out filename and pathname}
  226.   IF (i=0) AND (FileExists(start,16) OR (pName='\')) THEN BEGIN
  227.    {start specifies a subdirectory}
  228.    fName:='*.*';
  229.    IF pName<>'\' THEN pName:=pName+'\';
  230.   END ELSE BEGIN
  231.    {parse out filename on end}
  232.    i:=Length(pName);
  233.    WHILE (i>0) AND NOT(pName[i] IN [':','\','/']) DO i:=Pred(i);
  234.    fName:=Copy(pName,Succ(i),63);
  235.    pName:=Copy(pName,1,i);
  236.    IF pName='' THEN GetDir(0,pName);
  237.    IF pName[Length(pName)]<>'\' THEN pName:=pName+'\';
  238.   END;
  239.  END;               {parsepath}
  240.  
  241.  FUNCTION Path(dName:DriveName;pName:PathName):PathName;
  242.   {-return legal pathname for chdir}
  243.  VAR
  244.   t:PathName;
  245.  BEGIN
  246.   t:=dName;
  247.   IF pName='\' THEN
  248.    t:=t+pName
  249.   ELSE
  250.    t:=t+Copy(pName,1,Pred(Length(pName)));
  251.   Path:=t;
  252.  END;               {path}
  253.  
  254.  FUNCTION ReturnDriveNum(dName:DriveName):Byte;
  255.   {-return the drive number for an FCB call, 1=A, 2=B}
  256.  CONST
  257.   DriveLets:STRING[26]='ABCDEFGHIJKLMNOPQRSTUVWXYZ';
  258.  BEGIN
  259.   IF dName='' THEN
  260.    ReturnDriveNum:=0
  261.   ELSE
  262.    ReturnDriveNum:=Pos(UpCase(dName[1]),DriveLets);
  263.  END;               {returndrivenum}
  264.  
  265.  FUNCTION StUpcase(s:LongString):LongString;
  266.   {-return the uppercase of a string}
  267.  VAR
  268.   i:Byte;
  269.  BEGIN
  270.   FOR i:=1 TO Length(s) DO s[i]:=UpCase(s[i]);
  271.   StUpcase:=s;
  272.  END;               {stupcase}
  273.  
  274.  PROCEDURE SetOptions;
  275.   {-read command line and set up options and defaults}
  276.  VAR
  277.   i:Integer;
  278.   c:Char;
  279.   HaltSoon:Boolean;
  280.   param:LongString;
  281.  
  282.   PROCEDURE WriteHelp;
  283.   BEGIN
  284.    WriteLn(err,'Usage: EFFIC [Options] [>ResultFile]');
  285.    WriteLn(err);
  286.    WriteLn(err,'  EFFIC measures the storage efficiency of any group of files on');
  287.    WriteLn(err,'  any floppy or hard disk supported by MSDOS. It returns a list of');
  288.    WriteLn(err,'  files with the number of clusters used, the number of non-contiguous');
  289.    WriteLn(err,'  clusters and a measure of the efficiency of storage as it will affect');
  290.    WriteLn(err,'  read/write performance. If all clusters are contiguous, the efficiency');
  291.    WriteLn(err,'  is rated as 100%. Otherwise, the efficiency is downgraded by the');
  292.    WriteLn(err,'  percentage of clusters that are non-contiguous.');
  293.    WriteLn(err);
  294.    WriteLn(err,'  If no options are specified, the files in the current drive and');
  295.    WriteLn(err,'  directory are analyzed, and a report listing all files found is');
  296.    WriteLn(err,'  written to the standard output.');
  297.    WriteLn(err);
  298.    WriteLn(err,'Options:');
  299.    WriteLn(err,'  -S DrivePath  Start in the specified drive and directory.');
  300.    WriteLn(err,'  -R            search Recursively, down all subdirectories found.');
  301.    WriteLn(err,'  -Q            Quiet mode. Write only non-discontiguous files.');
  302.    WriteLn(err,'  -A            Automatic mode. Analyzes entire default drive quietly.');
  303.    WriteLn(err,'  -?            write this Help message.');
  304.    DoHalt(2);
  305.   END;              {writehelp}
  306.  
  307.   PROCEDURE DoError(message:LongString);
  308.    {-display an error message}
  309.   BEGIN
  310.    WriteLn(err,message);
  311.    HaltSoon:=True;
  312.   END;              {doerror}
  313.  
  314.  BEGIN
  315.   {get options}
  316.   WriteLn(err);
  317.   HaltSoon:=False;
  318.   i:=1;
  319.   WHILE i<=ParamCount DO BEGIN
  320.    {analyze options}
  321.    param:=ParamStr(i);
  322.    IF param[1]=OptionChar THEN BEGIN
  323.     {an option}
  324.     IF Length(param)=2 THEN BEGIN
  325.      c:=UpCase(param[2]);
  326.      CASE c OF
  327.       '?':WriteHelp;
  328.       'R':recursive:=True;
  329.       'Q':verbose:=False;
  330.       'A':BEGIN
  331.            recursive:=True;
  332.            verbose:=False;
  333.            StartPath:='\';
  334.           END;
  335.       'S':BEGIN     {new start path follows}
  336.            i:=Succ(i);
  337.            IF i<=ParamCount THEN
  338.             StartPath:=StUpcase(ParamStr(i))
  339.            ELSE
  340.             DoError('New start path not found....');
  341.           END;
  342.      END;
  343.     END ELSE
  344.      DoError('Unrecognized command option....'+ParamStr(i));
  345.    END;
  346.    i:=Succ(i);
  347.   END;
  348.   IF HaltSoon THEN BEGIN
  349.    WriteLn(err,'Type EFFIC -? for help....');
  350.    DoHalt(2);
  351.   END;
  352.  END;               {setoptions}
  353.  
  354.  PROCEDURE SetDTA(VAR dta:DTArec);
  355.   {-set new DTA address}
  356.  BEGIN
  357.   reg.ah:=$1A;
  358.   reg.ds:=Seg(dta);
  359.   reg.dx:=Ofs(dta);
  360.   MsDos(reg);
  361.  END;               {setdta}
  362.  
  363.  PROCEDURE ScanFiles(StartPath:PathName);
  364.   {-get all files in pathnamed directory}
  365.   {-called recursively in recursive mode}
  366.  VAR
  367.   dirs:Darray;
  368.   dName:DriveName;
  369.   pName,UsePath:PathName;
  370.   fName:FileString;
  371.   filNum:Integer;
  372.   driveNum:Byte;
  373.  
  374.   PROCEDURE ParseDTA(VAR name,ext:FileString);
  375.    {-return a name and extension from a DTA}
  376.   VAR
  377.    i:Byte;
  378.    tempName:FileString;
  379.   BEGIN
  380.    i:=1;
  381.    WHILE dta.FullName[i]<>#0 DO i:=Succ(i);
  382.    i:=Pred(i);
  383.    Move(dta.FullName,tempName[1],i);
  384.    tempName[0]:=Chr(i);
  385.    i:=Pos('.',tempName);
  386.    IF i<=1 THEN BEGIN
  387.     name:=tempName;
  388.     ext:='';
  389.    END ELSE BEGIN
  390.     name:=Copy(tempName,1,Pred(i));
  391.     ext:=Copy(tempName,Succ(i),3);
  392.    END;
  393.   END;              {parsedta}
  394.  
  395.   FUNCTION GetFirst(attr:Integer;VAR StartPath:PathName;
  396.                     VAR name,ext:FileString;
  397.                     VAR rightdirattr:Boolean):Boolean;
  398.    {-return true and a name if first file is found}
  399.   VAR
  400.    foundone:Boolean;
  401.   BEGIN
  402.    reg.ah:=$4E;
  403.    reg.ds:=Seg(StartPath);
  404.    reg.dx:=Ofs(StartPath[1]);
  405.    reg.cx:=attr;
  406.    MsDos(reg);
  407.    foundone:=((reg.flags AND 1)=0);
  408.    rightdirattr:=(dta.attr AND 16)=(attr AND 16);
  409.    IF foundone THEN
  410.     {scan the DTA for the file name and extension}
  411.     ParseDTA(name,ext);
  412.    GetFirst:=foundone;
  413.   END;              {getfirst}
  414.  
  415.   FUNCTION GetNext(attr:Integer;VAR name,ext:FileString;
  416.                    VAR rightdirattr:Boolean):Boolean;
  417.    {-return true and a name if another file is found}
  418.   VAR
  419.    foundone:Boolean;
  420.   BEGIN
  421.    reg.ah:=$4F;
  422.    reg.ds:=Seg(dta);
  423.    reg.dx:=Ofs(dta);
  424.    MsDos(reg);
  425.    foundone:=((reg.flags AND 1)=0);
  426.    rightdirattr:=(dta.attr AND 16)=(attr AND 16);
  427.    IF foundone THEN
  428.     {scan the DTA for the file name and extension}
  429.     ParseDTA(name,ext);
  430.    GetNext:=foundone;
  431.   END;              {getnext}
  432.  
  433.   PROCEDURE GetFiles(attr:Integer;
  434.                      VAR files:Farray;
  435.                      VAR StartPath:PathName);
  436.    {-return the files in the files array}
  437.   VAR
  438.    tempName,tempExt:FileString;
  439.    rightdir:Boolean;
  440.  
  441.   BEGIN
  442.    WITH files DO BEGIN
  443.     StartPath[Succ(Length(StartPath))]:=#0;
  444.     num:=0;
  445.     IF GetFirst(attr,StartPath,tempName,tempExt,rightdir) THEN
  446.      REPEAT
  447.       IF rightdir AND (tempName[1]<>'.') THEN BEGIN
  448.        num:=Succ(num);
  449.        WITH arr[num] DO BEGIN
  450.         name:=tempName;
  451.         ext:=tempExt;
  452.        END;
  453.       END;
  454.      UNTIL (num=MaxFiles) OR NOT(GetNext(attr,tempName,tempExt,rightdir));
  455.    END;
  456.   END;              {getfiles}
  457.  
  458.   PROCEDURE GetDirs(attr:Integer;
  459.                     VAR dirs:Darray;
  460.                     VAR StartPath:PathName);
  461.    {-return the directory names in the dirs array}
  462.   VAR
  463.    tempName,tempExt:FileString;
  464.    rightdir:Boolean;
  465.   BEGIN
  466.    WITH dirs DO BEGIN
  467.     StartPath[Succ(Length(StartPath))]:=#0;
  468.     num:=0;
  469.     IF GetFirst(attr,StartPath,tempName,tempExt,rightdir) THEN
  470.      REPEAT
  471.       IF rightdir AND (tempName[1]<>'.') THEN BEGIN
  472.        num:=Succ(num);
  473.        arr[num]:=tempName;
  474.        IF tempExt<>'' THEN arr[num]:=arr[num]+'.'+tempExt;
  475.       END;
  476.      UNTIL (num=MaxDirs) OR NOT(GetNext(attr,tempName,tempExt,rightdir));
  477.    END;
  478.   END;              {getdirs}
  479.  
  480.   PROCEDURE Analyze(driveNum:Byte;VAR fName:CompositeFilename);
  481.    {-scan the file fname looking for the matchpattern}
  482.   VAR
  483.    FCB:UnopenedFCBrec;
  484.    FCBreturn:UnopenedFCBrec ABSOLUTE dta;
  485.    Breaks,LastCluster,Cluster:Integer;
  486.    EndOfFile:Boolean;
  487.    FATentry:Integer;
  488.    FileClusters:Integer;
  489.    Efficiency:Real;
  490.  
  491.    PROCEDURE InitFCB(VAR FCB:UnopenedFCBrec;
  492.                      driveNum:Byte;
  493.                      name:FileName;
  494.                      ext:ExtName);
  495.     {-set up fcb for directory call}
  496.    BEGIN
  497.     FillChar(FCB,SizeOf(FCB),32);
  498.     WITH FCB DO BEGIN
  499.      flag:=$FF;
  500.      SearchAttr:=7;
  501.      drive:=driveNum;
  502.      Move(name[1],fName,Length(name));
  503.      IF Length(ext)>0 THEN
  504.       Move(ext[1],fExt,Length(ext));
  505.     END;
  506.    END;             {initfcb}
  507.  
  508.    FUNCTION GetFATentry(Cluster:Integer):Integer;
  509.     {-return the FAT entry for the specified cluster}
  510.    VAR
  511.     t:Integer;
  512.     oddeven:Integer;
  513.    BEGIN
  514.     IF bigFAT THEN
  515.      Move(FAT^[Cluster SHL 1],t,2)
  516.     ELSE BEGIN
  517.      oddeven:=3*Cluster;
  518.      Move(FAT^[oddeven SHR 1],t,2);
  519.      IF Odd(oddeven) THEN
  520.       t:=t SHR 4
  521.      ELSE
  522.       t:=t AND $FFF;
  523.     END;
  524.     GetFATentry:=t;
  525.    END;             {getfatentry}
  526.  
  527.    FUNCTION LastFATentry(FATentry:Integer):Boolean;
  528.     {-return true if the last FAT entry for the file}
  529.    BEGIN
  530.     IF bigFAT THEN
  531.      LastFATentry:=((FATentry SHR 4)=$FFF) AND ((FATentry AND $F)>=8)
  532.     ELSE
  533.      LastFATentry:=(FATentry>=$FF8);
  534.    END;             {lastfatentry}
  535.  
  536.    FUNCTION FormattedName(name:FileName;ext:ExtName):FileString;
  537.     {-return a formatted name right padded with blanks}
  538.    VAR
  539.     t:FileString;
  540.    BEGIN
  541.     t:=name;
  542.     IF ext<>'' THEN
  543.      t:=t+'.'+ext;
  544.     WHILE Length(t)<12 DO t:=t+' ';
  545.     FormattedName:=t;
  546.    END;             {formattedname}
  547.  
  548.   BEGIN
  549.  
  550.    IF BreakPressed THEN BreakHalt;
  551.  
  552.    WITH fName DO BEGIN
  553.  
  554.     {fill in the FCB}
  555.     InitFCB(FCB,driveNum,name,ext);
  556.  
  557.     {get detailed directory info from DOS}
  558.     reg.ah:=$11;
  559.     reg.ds:=Seg(FCB);
  560.     reg.dx:=Ofs(FCB);
  561.     MsDos(reg);
  562.     IF reg.al=$FF THEN BEGIN
  563.      WriteLn(err,'ERROR: file not found... ',name,'.',ext);
  564.      DoHalt(1);
  565.     END;
  566.  
  567.     {found the file, now trace its FAT}
  568.     Cluster:=FCBreturn.fCluster;
  569.     LastCluster:=Pred(Cluster);
  570.     FileClusters:=1;
  571.     Breaks:=0;
  572.     REPEAT
  573.      IF Cluster<>Succ(LastCluster) THEN
  574.       Breaks:=Succ(Breaks);
  575.      FATentry:=GetFATentry(Cluster);
  576.      EndOfFile:=LastFATentry(FATentry);
  577.      IF NOT EndOfFile THEN BEGIN
  578.       FileClusters:=Succ(FileClusters);
  579.       LastCluster:=Cluster;
  580.       Cluster:=FATentry;
  581.      END;
  582.     UNTIL EndOfFile;
  583.  
  584.     {update counters}
  585.     fCount:=Succ(fCount);
  586.     IF Breaks>0 THEN BEGIN
  587.      fBroken:=Succ(fBroken);
  588.      TotalBreaks:=TotalBreaks+Breaks;
  589.     END;
  590.     ClustersUsed:=ClustersUsed+FileClusters;
  591.     IF FileClusters=1 THEN
  592.      Efficiency:=100.0
  593.     ELSE
  594.      Efficiency:=100.0*(1.0-Int(Breaks)/Int(FileClusters-1));
  595.  
  596.     IF verbose OR (Efficiency<>100.0) THEN BEGIN
  597.      WroteFile:=True;
  598.      {.F-}
  599.           WriteLn(FormattedName(name,ext),'  ',
  600.                   FileClusters:5,'  ',
  601.                   Breaks:5,'  ',
  602.                   1.0*secsize*FileClusters*secsPerAllo:7:0, '  ',
  603.                   efficiency:5:1,'  ',
  604.                   Path(dName,pName)
  605.                   );
  606.      {.F+}
  607.     END;
  608.    END;
  609.   END;              {analyze}
  610.  
  611.  BEGIN
  612.   {get a list of all normal, readonly, hidden matching files in startpath}
  613.   ParsePath(StartPath,dName,pName,fName);
  614.   UsePath:=dName+pName+fName;
  615.   GetFiles(7,files,UsePath);
  616.  
  617.   {move to the current directory to allow FCBs}
  618.   ChDir(Path('',pName));
  619.   driveNum:=ReturnDriveNum(dName);
  620.  
  621.   {check each file}
  622.   FOR filNum:=1 TO files.num DO Analyze(driveNum,files.arr[filNum]);
  623.  
  624.   {look at subdirectories}
  625.   IF recursive THEN BEGIN
  626.    {get all subdirectories}
  627.    UsePath:=dName+pName+'*.*';
  628.    GetDirs(19,dirs,UsePath);
  629.    {look in the subdirectories}
  630.    FOR filNum:=1 TO dirs.num DO BEGIN
  631.     {build a pathname to the subdirectory}
  632.     UsePath:=dName+pName+dirs.arr[filNum]+'\'+fName;
  633.     {call recursively}
  634.     ScanFiles(UsePath);
  635.    END;
  636.   END;
  637.  END;               {scanfiles}
  638.  
  639.  PROCEDURE InitializeGlobals;
  640.   {-set up all global data structures}
  641.  BEGIN
  642.   {get default directory and disk}
  643.   GetDir(0,StartPath);
  644.   SavePath:=StartPath;
  645.   errorptr:=Ofs(error);
  646.   Assign(err,'ERR:');
  647.   Rewrite(err);
  648.   SetBreak;
  649.   SetDTA(dta);
  650.   {set default flags and counters}
  651.   recursive:=False;
  652.   verbose:=True;
  653.   fCount:=0;
  654.   TotalBreaks:=0;
  655.   ClustersUsed:=0;
  656.   fBroken:=0;
  657.   WroteFile:=False;
  658.  END;               {initializeglobals}
  659.  
  660.  PROCEDURE GetDriveInfo;
  661.   {-determine number of clusters, fat entry size, etc. for the specified drive}
  662.  VAR
  663.   dName:DriveName;
  664.   pName:PathName;
  665.   fName:FileString;
  666.   driveNum:Byte;
  667.   driveid:Byte;
  668.   error:Integer;
  669.   fatofs,sec:Integer;
  670.  
  671.   PROCEDURE getFAT(DOSnum:Byte;VAR driveid:Byte;
  672.                    VAR secSize,alloUnits,secsPerAllo:Integer);
  673.    {-read the FAT ID info for the specified drive}
  674.   BEGIN
  675.    reg.ah:=$1C;
  676.    reg.dl:=DOSnum;
  677.    MsDos(reg);
  678.    secSize:=reg.cx;
  679.    alloUnits:=reg.dx;
  680.    secsPerAllo:=reg.al;
  681.    driveid:=Mem[reg.ds:reg.bx];
  682.   END;              {getfat}
  683.  
  684.   FUNCTION GetFreeSpace(driveNum:Byte):Integer;
  685.    {-return the number of free clusters on the drive}
  686.   BEGIN
  687.    reg.ah:=$36;
  688.    reg.dl:=Succ(driveNum);
  689.    MsDos(reg);
  690.    GetFreeSpace:=reg.bx;
  691.   END;              {GetFreeSpace}
  692.  
  693.   PROCEDURE DOSreadSectors(drive:Byte;
  694.                            LSN:Integer;
  695.                            sects:Integer;
  696.                            VAR buffer;
  697.                            VAR error:Integer);
  698.    {-execute int 25 to read disk through DOS at low level}
  699.   BEGIN
  700.    INLINE(
  701.     $1E/            {PUSH    DS}
  702.     $8A/$46/$10/    {MOV    AL,[BP+10]}
  703.     $8B/$56/$0E/    {MOV    DX,[BP+0E]}
  704.     $8B/$4E/$0C/    {MOV    CX,[BP+0C]}
  705.     $C5/$5E/$08/    {LDS    BX,[BP+08]}
  706.     $CD/$25/        {INT    25}
  707.     $72/$02/        {JB    0113}
  708.     $31/$C0/        {XOR    AX,AX}
  709.     $9D/            {POPF    }
  710.     $1F/            {POP    DS}
  711.     $5D/            {POP    BP}
  712.     $C4/$7E/$04/    {LES    DI,[BP+04]}
  713.     $26/            {ES:    }
  714.     $89/$05         {MOV    [DI],AX}
  715.     );
  716.   END;              {dosreadsectors}
  717.  
  718.   FUNCTION CurrentDrive:Byte;
  719.    {-return the current drive number, 0=A, 1=B}
  720.   BEGIN
  721.    reg.ah:=$19;
  722.    MsDos(reg);
  723.    CurrentDrive:=reg.al;
  724.   END;              {currentdrive}
  725.  
  726.  BEGIN
  727.   {break up the starting path}
  728.   ParsePath(StartPath,dName,pName,fName);
  729.  
  730.   {change to the drive we're analyzing}
  731.   IF dName<>'' THEN BEGIN
  732.    ChDir(dName);
  733.    driveNum:=ReturnDriveNum(dName)-1;{0=A,1=B}
  734.   END ELSE
  735.    driveNum:=CurrentDrive;
  736.  
  737.   {get FAT information}
  738.   getFAT(0,driveid,secSize,alloUnits,secsPerAllo);
  739.  
  740.   {test whether 8 bit or 16 bit fat}
  741.   bigFAT:=(alloUnits<0) OR (alloUnits>4086);
  742.  
  743.   {allocate memory where we will keep the FAT}
  744.   IF bigFAT THEN
  745.    FATbytes:=alloUnits SHL 1
  746.   ELSE
  747.    FATbytes:=(3*alloUnits) SHR 1;
  748.   IF FATbytes<=0 THEN BEGIN
  749.    WriteLn(err,'Error in FAT size calculation');
  750.    DoHalt(1);
  751.   END;
  752.   GetMem(FAT,FATbytes);
  753.  
  754.   FATsectors:=FATbytes DIV secSize;
  755.   IF (FATbytes AND Pred(secSize))<>0 THEN FATsectors:=Succ(FATsectors);
  756.   {read in the FAT}
  757.   fatofs:=0;
  758.   sec:=1;
  759.   WHILE sec<=FATsectors DO BEGIN
  760.    DOSreadSectors(driveNum,sec,1,FAT^[fatofs],error);
  761.    IF error<>0 THEN BEGIN
  762.     WriteLn(err,'error reading FAT');
  763.     DoHalt(1);
  764.    END;
  765.    sec:=Succ(sec);
  766.    fatofs:=fatofs+512;
  767.   END;
  768.  
  769.   {get number of available clusters}
  770.   AvailableClusters:=GetFreeSpace(driveNum);
  771.  
  772.  END;               {getdriveinfo}
  773.  
  774.  PROCEDURE WriteResults;
  775.  VAR
  776.   Efficiency:Real;
  777.  BEGIN
  778.   IF ClustersUsed=1 THEN
  779.    Efficiency:=100.0
  780.   ELSE
  781.    Efficiency:=100.0*(1.0-TotalBreaks/(ClustersUsed-1.0));
  782.   WriteLn(err);
  783.   WriteLn(err,'total files analyzed               : ',fCount);
  784.   WriteLn(err,'total clusters used in these files : ',ClustersUsed);
  785.   WriteLn(err,'total files with cluster breaks    : ',fBroken);
  786.   WriteLn(err,'total cluster breaks               : ',TotalBreaks);
  787.   WriteLn(err,'total free clusters on disk        : ',AvailableClusters);
  788.   WriteLn(err,'total clusters on disk             : ',alloUnits);
  789.   WriteLn(err,'percent of disk free               : ',(100.0*AvailableClusters/alloUnits):0:1,'%');
  790.   WriteLn(err,'total bytes on disk                : ',(1.0*secSize*secsPerAllo*alloUnits):0:0);
  791.   WriteLn(err,'percent of clusters contiguous     : ',Efficiency:0:1,'%');
  792.   IF tStop-tStart<=0 THEN Exit;
  793.   WriteLn(err,'file rate                          : ',(fCount/(tStop-tStart)):0:1,' files/sec');
  794.  END;               {writeresults}
  795.  
  796. BEGIN
  797.  InitializeGlobals;
  798.  SetOptions;
  799.  WriteLn(err,'File Performance Analyzer - by TurboPower Software');
  800.  GetDriveInfo;
  801.  WriteLn('Filename    Clusters Breaks   Bytes  Effic  Directory');
  802.  Time(tStart);
  803.  ScanFiles(StartPath);
  804.  Time(tStop);
  805.  IF NOT(WroteFile) THEN
  806.   WriteLn('--------------------- none --------------------------');
  807.  WriteResults;
  808.  ChDir(SavePath);
  809. END.
  810.