home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / MADTRB18.ZIP / FINDDUPE.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-08-04  |  27.3 KB  |  704 lines
  1.  
  2. program FindDuplicateFiles;
  3.  
  4. {      Version 1.0 by Karson Morrison
  5.        ----------------------------------------------------------------
  6.        Version 1.2 by Kenn Flee, Aug. 1985, Madison WI
  7.          Changes: (May be found by Searching for "*2*")
  8.            1. Add automatic size listing when printing.
  9.            2. Change 24-hr time in listing to 12-hr am/pm.
  10.               (Like DOS Directory listing)
  11.            3. Added filler 0 in day portion of date.
  12.        ----------------------------------------------------------------
  13.  
  14.        Anyone who modifies this program place your name and the new
  15.        version number by it.  Place a comment before and after your
  16.        changes and place the version number as part of those comments.
  17.  
  18.        This is a program to list out all of the files on a disk
  19.        sorted in file order.  It will also tell you of any duplicate
  20.        files within different directories.
  21.  
  22.        A command line is used as input if entered else the default
  23.        drive is used.
  24.  
  25.        This program requires Turbo Pascal 2.0 and the Turbo Toolbox
  26.        pascal program SORT.BOX.  The .COM version has already been
  27.        compiled with the SORT in it.
  28.  
  29.        This program was written by Karson W. Morrison
  30.                                    RD. 1, Box 531,
  31.                                    Ringoes, NJ. 08551
  32.                                    (201) 788-1846
  33.  
  34.        I used info picked up from a bulletin board for the routines
  35.        to get system date and time.  That info was created by
  36.        Jon Gray of the IBM PC USERS GROUP Milwaukee.  It did have a
  37.        bug though that would only work with months of 2 digits (now fixed by
  38.        me).
  39.  
  40.        I also used routines provided by Borland for the reading of directories.
  41.        This info was provided in their Turbo Tutor package.
  42.  
  43.        A lot of hours went into this program please do not revise it
  44.        and leave out the credit that I have done most of the work.
  45.  
  46.        Every time I turned around I was trying to delete some of the
  47.        files on my hard disk because I was always ending up with only
  48.        300 - 400 K left.  I kept thinking there must be an easier way
  49.        to know if there were duplicate files.
  50.  
  51.                           This is the result!
  52. }
  53.  
  54. const
  55.   Max_dir              = 200;   { Max number of directory entries }
  56.                                     { it can be upped }
  57. type
  58.   DirRec =                             { My Sort Record }
  59.     record
  60.         FileNme        : string[14];
  61.         FileDir        : string[36];
  62.         FileAttributes : string[5];
  63.         FileMO         : integer;
  64.         FileDA         : integer;
  65.         FileYR         : integer;
  66.         FileHR         : integer;
  67.         FileMN         : integer;
  68.         FileSize       : string[8]; { Not enough room for this on the screen }
  69.                                     { *2* But will fit on print option! *** }
  70.     end;
  71.   CommandString        = string[3];       { Command Line }
  72.   Char12arr            = string [ 50 ];
  73.   String20             = string [ 20 ];
  74.   RegRec =                                { The data to pass to DOS }
  75.     record
  76.       AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags : Integer;
  77.     end;
  78.  
  79. var
  80.   InputString          : CommandString;             { Command Line }
  81.   CL                   : CommandString absolute cseg:$80;
  82.   FilVar               : text;                      { Is it CON: or LST: }
  83.   DirectryRec          : DirRec;
  84.   Print,
  85.   FirstTime,
  86.   NotDir               : Boolean;
  87.   Regs                 : RegRec;
  88.   DTA                  : array [ 1..43 ] of Byte;
  89.   Mask                 : array [ 1..50 ] of Char;
  90.   NamR                 : String20;
  91.   timestr              : string[11];
  92.   datestr              : string[15];
  93.   Error, I             : Integer;
  94.   Buffer,
  95.   Buffer1,
  96.   Buffer2              : String [50];
  97.   DirTable             : Array [ 1..Max_dir ] of string[50];
  98.   E, E_use,
  99.   A, B, C,
  100.   PageNo               : integer;
  101.   OldName              : string [14];
  102.   OldDir               : string [36];
  103.   OldAttr              : string[5];
  104.   OldMO,
  105.   OldDA,
  106.   OldYR,
  107.   OldHR,
  108.   OldMN                : integer;
  109.   OldFileSize          : String[9];  { *2* Need it later *** }
  110.   WrkMN                : string[2];
  111.   ScreenLine           : String[29];
  112.   WorkName             : string[14];
  113.   Option               : string[1];
  114.   MatchFound           : Boolean;
  115.   ScreenLines          : integer;
  116.   Temp                 : string[1];
  117.   SortResult,
  118.   FileDateDos,
  119.   FileHourDos,
  120.   FileYear,
  121.   FileMonth,
  122.   FileDay,
  123.   FileHour,
  124.   FileMinute,
  125.   FileWork,
  126.   Hours,
  127.   NumberRecs           : integer;
  128.   Size                 : real;       { *2* Add For Print Option *** }
  129.   ap                   : Char;       { *2* am/pm in listings *** }
  130.  
  131. {$ISORT.BOX}                                { This is from Borland in their }
  132.                                             { Toolbox package }
  133. procedure date;
  134. const
  135.     montharr : array [1..12] of string[3] =
  136.                ('Jan','Feb','Mar','Apr','May',
  137.                 'Jun','Jul','Aug','Sep','Oct','Nov','Dec');
  138.  
  139. var
  140.     regs:regrec;
  141.     month, day:string[2];
  142.     year:string[4];
  143.     dx, cx, result, tmpmonth:integer;
  144.  
  145. begin
  146.     with regs do
  147.     begin
  148.       ax:= $2a shl 8;
  149.     end;
  150.     msdos (regs);
  151.     with regs do
  152.     begin
  153.       str(cx:4, year);
  154.       str(dx shr 8:2, month);
  155.       str(dx mod 256:2, day);
  156.     end;
  157.     if month[1] = ' ' then month[1] := '0';
  158.     val (month, tmpmonth, result);
  159.     datestr:= day + '-' + montharr[tmpmonth] + '-' + year
  160. end; { procedure date }
  161.  
  162. procedure time;
  163. var
  164.   regs:regrec;
  165.   ah, al, ch, cl, dh:byte;
  166.   hour, min, sec, ampm:string[2];
  167.   tmptime, result:integer;
  168.  
  169. begin
  170.   ah := $2c;
  171.   with regs do
  172.   begin
  173.     ax := ah shl 8 + al;
  174.   end;
  175.   intr($21,regs);
  176.   with regs do
  177.   begin
  178.     str(cx shr 8:2, hour);
  179.     str(cx mod 256:2, min);
  180.     str(dx shr 8:2, sec);
  181.   end;
  182.   if (hour > '12') then
  183.     begin
  184.       val (hour, tmptime, result);
  185.       tmptime:= tmptime - 12;
  186.       str (tmptime:2, hour);
  187.       ampm:= 'pm'
  188.     end
  189.   else
  190.     ampm:= 'am';
  191.   if (min[1] = ' ') then
  192.     min[1]:= '0';
  193.   if (sec[1] = ' ') then
  194.     sec[1]:= '0';
  195.   timestr := hour + ':' + min + ':' + sec + ' ' + ampm;
  196. end; { procedure time }
  197.  
  198. procedure SetUpDTA;
  199. begin
  200.   Regs.AX := $1A00;             { Function used to set the DTA }
  201.   Regs.DS := Seg(DTA);          { store the parameter segment in DS }
  202.   Regs.DX := Ofs(DTA);          {   "    "      "     offset in DX }
  203.   MSDos(Regs);                  { Set DTA location }
  204.   Error := Regs.AX and $FF;
  205. end;
  206.  
  207. procedure ReadFirst;
  208. begin
  209.   Regs.AX := $4E00;             { Get first directory entry }
  210.   Regs.DS := Seg(Mask);         { Point to the file Mask }
  211.   Regs.DX := Ofs(Mask);
  212.   Regs.CX := 23;                { Store the option }
  213.   MSDos(Regs);                  { Execute MSDos call }
  214.   Error := Regs.AX and $FF;     { Get Error return }
  215. end;
  216.  
  217. procedure ReadNext;
  218. begin
  219.     Error := 0;
  220.     Regs.AX := $4F00;           { Function used to get the next }
  221.                                 { directory entry }
  222.     Regs.CX := 23;              { Set the file option }
  223.     MSDos( Regs );              { Call MSDos }
  224.     Error := Regs.AX and $FF;   { get the Error return }
  225. end;
  226.  
  227. procedure SetUpNamR;            { Get the file name from the directory }
  228. begin
  229.     repeat
  230.       NamR[I] := Chr(Mem[Seg(DTA):Ofs(DTA)+29+I]);
  231.       I := I + 1;
  232.     until not (NamR[I-1] in [' '..'~']) or (I>20);
  233.  
  234.   NamR[0] := Chr(I-1);          { set string length because assigning }
  235.                                 { by element does not set length }
  236. end;
  237.  
  238. procedure Set_up_Dir_Chg;       { Get a new directory from the table }
  239. begin
  240.     Write('.');                 { This puts a . on the screen each }
  241.     E_use := E_Use + 1;         { time a directory changes }
  242.     Buffer := DirTable[E_use];
  243.     Buffer1 := DirTable[E_use];
  244.     Buffer[ length( Buffer ) +  1 ] := '\';   {   Move in  }
  245.     Buffer[ length( Buffer ) +  2 ] := '?';   {   Default  }
  246.     Buffer[ length( Buffer ) +  3 ] := '?';   {   For      }
  247.     Buffer[ length( Buffer ) +  4 ] := '?';   {   Files    }
  248.     Buffer[ length( Buffer ) +  5 ] := '?';
  249.     Buffer[ length( Buffer ) +  6 ] := '?';
  250.     Buffer[ length( Buffer ) +  7 ] := '?';
  251.     Buffer[ length( Buffer ) +  8 ] := '?';
  252.     Buffer[ length( Buffer ) +  9 ] := '?';
  253.     Buffer[ length( Buffer ) + 10 ] := '.';
  254.     Buffer[ length( Buffer ) + 11 ] := '?';
  255.     Buffer[ length( Buffer ) + 12 ] := '?';
  256.     Buffer[ length( Buffer ) + 13 ] := '?';
  257.     Buffer[ length( Buffer ) + 14 ] := Chr( 0 );
  258.     Buffer[0] := Chr( length(Buffer) + 14 );
  259.     if length(Buffer1) = 1 then Buffer1 := '';
  260.     for I := 1 to length(Buffer) do
  261.       Mask[I] := Buffer[I];
  262. end;
  263.  
  264. procedure FindDate;              { Translate the Date from the Disk to }
  265. begin                            { Something readable }
  266.     FileMonth := 0;              { yyyyyyymmmmddddd  in bits}
  267.     FileDay := 0;
  268.     FileDateDos := MemW[Seg(DTA):Ofs(DTA)+24];
  269.     FileYear := FileDateDos shr 9;  { drop off the last 9 positions }
  270.     FileYear := FileYear + 80;      { years are added to base year of 1980 }
  271.     FileWork := FileDateDos shl 7;  { drop off the first 7 positions }
  272.     FileMonth := FileWork shr 12;   { now move it back to the right }
  273.     FileWork := FileDateDos shl 11; { drop off the left 11 positions }
  274.     FileDay := FileWork shr 11;     { now move back to the right }
  275. end;
  276.  
  277. procedure FindTime;              { Get the time and put it in a format that }
  278. begin                            { we can use. The Dos Format in bits is    }
  279.     FileHour := 0;               { hhhhhmmmmmmsssss }
  280.     FileMinute := 0;
  281.     FileHourDos := MemW[Seg(DTA):Ofs(DTA)+22];
  282.     FileHour := FileHourDos shr 11;     { Shift it around so the minutes and }
  283.     FileWork := FileHourDos shl 5;      { seconds disappear }
  284.     FileMinute := FileWork shr 10;
  285. end;
  286.  
  287. PROCEDURE FindSize;           { *2* Added so can display on print option *** }
  288.   Begin
  289.   With DirectryRec do begin
  290.     Size := (Mem[Seg(DTA):Ofs(DTA)+28] * 65536.0) +
  291.             (Mem[Seg(DTA):Ofs(DTA)+27] * 256.0) +
  292.             (Mem[Seg(DTA):Ofs(DTA)+26] * 1.0);
  293.     Str(Size:8:0,FileSize);
  294.   End;
  295.   End;
  296.  
  297. procedure PrintDTA;
  298. var
  299.    FileAttr            : Byte;
  300. begin
  301.     FileAttr := Byte(Mem[Seg(DTA):Ofs(DTA)+21]);
  302.     if FileAttr > 31 then        { File Not Archived }
  303.     begin
  304.       FileAttr := FileAttr - 32;
  305.     end;
  306.     DirectryRec.FileAttributes := '      ';  { Make it all spaces }
  307.     if FileAttr > 15 then        { This is a directory entry }
  308.     begin                        { Let's do it to it }
  309.       FileAttr := FileAttr - 16;
  310.       E := E + 1;
  311.       Buffer2 := Buffer1;
  312.       A := Length(Buffer2) + 1;
  313.       B := Length(NamR);
  314.       C := 1;
  315.       Buffer2[A] := '\';
  316.       repeat
  317.         A := A + 1;
  318.         Buffer2[A] := NamR[C];
  319.         C := C + 1;
  320.       until C > B;
  321.       Buffer2[0] := Chr(A - 1);
  322.       DirectryRec.FileAttributes[4] := '*'; { Sub Directry }
  323.       DirTable[ E ] := Buffer2;
  324.     end;
  325.     if FileAttr > 7 then
  326.     begin
  327. (*    DirectryRec.FileAttributes[4] := 'V';  { Volume Label } Volume labels *)
  328.       FileAttr := FileAttr - 8               { don't come back on this call }
  329.     end;
  330.     if FileAttr > 3 then
  331.     begin
  332.       DirectryRec.FileAttributes[3] := 'S';  { System File }
  333.       FileAttr := FileAttr - 4;
  334.     end;
  335.     if FileAttr > 1 then
  336.     begin
  337.        DirectryRec.FileAttributes[2] := 'H'; { Hidden File }
  338.        FileAttr := FileAttr - 2;
  339.     end;
  340.     if FileAttr > 0 then
  341.     begin
  342.        DirectryRec.FileAttributes[1] := 'R'; { Read Only }
  343.     end;
  344. end;
  345.  
  346. procedure FormatAndReleaseSort;  { Yep that is what it is }
  347. begin
  348.      DirectryRec.FileNme := '             ';  { Blank it out }
  349.      DirectryRec.FileNme := NamR;
  350.      DirectryRec.FileDir := Buffer1;
  351.      DirectryRec.FileNme[0] := Chr(13);    { Now make it 13 long }
  352.      FindDate;                             { Make date readable  }
  353.      FindTime;                             { Time also }
  354.      DirectryRec.FileMO := FileMonth;      { Complete setting up }
  355.      DirectryRec.FileDA := FileDay;        { Sort Record }
  356.      DirectryRec.FileYR := FileYear;
  357.      DirectryRec.FileHR := FileHour;
  358.      DirectryRec.FileMN := FileMinute;
  359.      FindSize;                             { *2* Added for print option }
  360.      SortRelease(DirectryRec);             { Let'er go! }
  361. End;
  362.  
  363.  
  364. procedure Inp;    { ReadDirs this procedure is forward declared in SORT.BOX }
  365. begin                            { This reads the directories and releases }
  366.                                  { to the sort }
  367.   NotDir := True;
  368.   E := 1; E_Use := 0;
  369.   Buffer1 := ''; Buffer2 := Buffer; DirTable[E] := Buffer;
  370.   Buffer[ length(Buffer) + 1 ] := Chr(0);
  371.   Buffer[0] := chr(length(buffer));
  372.   FillChar(DTA,SizeOf(DTA),0);        { Initialize the DTA buffer }
  373.   FillChar(Mask,SizeOf(Mask),0);      { Initialize the mask }
  374.   FillChar(NamR,SizeOf(NamR),0);      { Initialize the file name }
  375.   SetUpDTA;
  376.   Error := 0;
  377.   While E_Use < E do
  378.   begin
  379.        Set_Up_Dir_Chg;
  380.        ReadFirst;                { This does the first read for a directory }
  381.        if (Error = 0) then
  382.        begin
  383.             I := 1;                    { initialize 'I' to the first element }
  384.             SetUpNamR;
  385.             if NamR[1] = '.' then NotDir := False;
  386.             if NotDir and  (Error = 0) then
  387.             begin
  388.                 PrintDTA;              { This gets the file attributes }
  389.                 FormatAndReleaseSort;  { Build the record }
  390.             end;
  391.        end;
  392.        while (Error = 0) do begin
  393.          NotDir := True;
  394.          ReadNext;               { This reads other entries in directory but }
  395.          if (Error = 0) then     { the first }
  396.          begin
  397.              I := 1;
  398.              SetUpNamR;
  399.              if NamR[1] = '.' then NotDir := False; { Is it a dot directory }
  400.              if NotDir and (Error = 0) then         { No it is not }
  401.              begin
  402.                  PrintDTA;
  403.                  FormatAndReleaseSort;
  404.              end;
  405.          end;
  406.        end;
  407.   end;
  408.   Writeln;                       { All done reading the directories }
  409.   Writeln('Sorting the Directory Data');
  410. end;                             { End of procedure Inp  }
  411.  
  412. function Less; { this boolean function hass two parameters, X and Y }
  413.               { and is forward declared in SORT.BOX }
  414. var
  415.   FirstDir      : DirRec absolute X;
  416.   SecondDir     : DirRec absolute Y;
  417. begin                                   { this tells the sort which of the }
  418.   Less := (FirstDir.FileNme < SecondDir.FileNme) or   { two entries are }
  419.          ((FirstDir.FileNme = SecondDir.FileNme) and  { first and which }
  420.           (FirstDir.FileDir < SecondDir.FileDir));    { is second }
  421. end;
  422.  
  423. procedure SetUpOldArea;                  { We need to keep the old }
  424. begin                                    { Stuff around to see if  }
  425.      OldName := DirectryRec.FileNme;     { Matches the new stuff   }
  426.      OldDir  := DirectryRec.FileDir;     { This is used for the duplicate }
  427.      OldAttr := DirectryRec.FileAttributes;  { compares }
  428.      OldDA := DirectryRec.FileDA;
  429.      OldMO := DirectryRec.FileMO;
  430.      OldYR := DirectryRec.FileYR;
  431.      OldHR := DirectryRec.FileHR;
  432.      OldMN := DirectryRec.FileMN;
  433.      OldFileSize := DirectryRec.FileSize;  { *2* Print FileSize if .LST *** }
  434. end;
  435.  
  436. procedure FixMinute;             { Make the time readable }
  437. begin                            { put a 0 in front of one }
  438.     if length(WrkMN) = 1 then    { character minutes }
  439.     begin
  440.        WrkMN[2] := WrkMN[1];
  441.        WrkMN[1] := '0';
  442.        WrkMN[0] := Chr(2);
  443.    end;
  444. end;
  445.  
  446. procedure HeadingDupe;           { Headings for the reports }
  447. begin
  448.      PageNo := PageNo + 1;
  449.      Writeln(FilVar,'');
  450.      Write(FilVar,'     Directory list for DUPLICATE files.   ',Datestr,' ',Timestr);
  451.      Writeln(FilVar,'  Page ',PageNo);
  452.      Writeln(FilVar,'     * = Sub Dir: R = Read only; H = Hidden: S = System');
  453.      Write(FilVar,'     Files        ');
  454.      If Print then Write(FilVar,'  Size  ');  { *2* For print option *** }
  455.      Writeln(FilVar,'   Date   Time     Directory ');
  456.      WriteLn(FilVar,'');
  457. end;
  458.  
  459. procedure HeadingAll;            { Heading for the reports }
  460. begin
  461.      PageNo := PageNo + 1;
  462.      Writeln(FilVar,'');
  463.      Write(FilVar,'     Directory list for ALL files.      ',Datestr,' ',Timestr);
  464.      Writeln(FilVar,'  Page ',PageNo);
  465.      Writeln(FilVar,'     * = Sub Dir: R = Read only: H = Hidden: S = System');
  466.      Write(FilVar,'     Files        ');
  467.      If Print then Write(FilVar,'  Size  ');  { *2* For print option *** }
  468.      Writeln(FilVar,'   Date   Time     Directory ');
  469.      WriteLn(FilVar,'');
  470. end;
  471.  
  472. procedure OutP; { this procedure is forward declared in SORT.BOX }
  473. begin                            { This takes the sorted data and creates }
  474.    ClrScr;                       { the required reports (Screen or Paper) }
  475.    OldName := '           ';     { Clear out the field }
  476.    NumberRecs := 0;
  477.    Buffer[3] := chr(0);          { Shorten the drive identifier here }
  478.    Buffer[0] := chr(2);
  479.    if print then
  480.    begin
  481.        GoToXY(30,15);            { This gives you something to look at on the }
  482.        Write('Printing the Report'); { Screen }
  483.    end;
  484.    if Option = '1' then
  485.         HeadingAll               { Do you want all the Directories }
  486.    else
  487.         HeadingDupe;             { or just the duplicate }
  488.    repeat
  489.        SortReturn(DirectryRec);         { Hay it's back, just like magic }
  490.        NumberRecs := NumberRecs + 1;
  491.        if Option = '1' then      { You want them all }
  492.        begin
  493.            if ((print) and (ScreenLines > 50))
  494.             or ((not print) and (ScreenLines > 18)) then
  495.            begin
  496.                 if print then
  497.                 begin
  498.                     Writeln(FilVar,#$0C);
  499.                 end
  500.                 else
  501.                 begin
  502.                     Write('                             More');
  503.                     Read(Kbd,Temp);
  504.                     ClrScr;
  505.                 end;
  506.                 HeadingAll;
  507.                 ScreenLines := 0;
  508.            end;
  509.            Write(FilVar,DirectryRec.FileAttributes);
  510.            Write(FilVar,DirectryRec.FileNme,' '); { Let's show'em what we found }
  511.            If Print then Write(FilVar,DirectryRec.FileSize,' ');  { *2* Print Size if .LST *** }
  512.            Str(DirectryRec.FileDA, WrkMN);        { *2* Use existing procedure to fix Day *** }
  513.            FixMinute;                             { *2* }
  514.            Write(FilVar,DirectryRec.FileMO:2,'/',WrkMN,'/',DirectryRec.FileYR);
  515.            Str(DirectryRec.FileMN, WrkMN);
  516.            FixMinute;
  517.            { *2* Following to get rid of 24 hour time *** }
  518.            If DirectryRec.FileHR >= 12 then ap := 'p' else ap := 'a';
  519.            If DirectryRec.FileHR > 12 then DirectryRec.FileHR := DirectryRec.FileHR -12;
  520.            If DirectryRec.FileHR = 0 then DirectryRec.FileHR := 12;
  521.            { *2* End time changes *** }
  522.            Write(FilVar,' ',DirectryRec.FileHR:2,':',WrkMN);
  523.            Write(FilVar,ap);  { *2* Add am/pm indicator *** }
  524.            Write(FilVar,' ');
  525.            if length(InputString) > 0 then
  526.            begin
  527.                if length(DirectryRec.FileDir) > 3 then
  528.                    Writeln(FilVar,DirectryRec.FileDir)
  529.                else
  530.                    Writeln(FilVar,buffer,'\')
  531.            end
  532.            else
  533.            if length(DirectryRec.FileDir) > 1 then
  534.                Writeln(FilVar,DirectryRec.FileDir)
  535.            else
  536.                Writeln(FilVar,'\');
  537.            ScreenLines := ScreenLines + 1;
  538.        end
  539.        else                      { You want just the Duplicate entries }
  540.        begin
  541.             WorkName := DirectryRec.FileNme;
  542.             if OldName < WorkName then     { its not duplicate }
  543.             begin
  544.                 SetUpOldArea;
  545.                 if MatchFound then
  546.                 begin
  547.                     MatchFound := False;
  548.                     Writeln(FilVar,'');
  549.                     ScreenLines := ScreenLines + 1;
  550.                 end;
  551.             end
  552.             else                          { Yes it is }
  553.             begin
  554.                 if not MatchFound then
  555.                 begin
  556.                      if ((print) and (ScreenLines > 50))  { 50 on paper is ok }
  557.                       or ((not print) and (ScreenLines > 17)) then
  558.                      begin                     { 17 is about all you want }
  559.                          if print then         { on the screen at a time }
  560.                          begin
  561.                              Writeln(FilVar,#$0C);
  562.                          end
  563.                          else
  564.                          begin
  565.                              Write('                             More');
  566.                              Read(Kbd,Temp); { I'll wait until you read these }
  567.                              ClrScr;         { Lets start anew }
  568.                          end;
  569.                          HeadingDupe;        { Put the heading back }
  570.                          ScreenLines := 0;   { I got nothing on the screen }
  571.                      end;
  572.                      Write(FilVar,OldAttr);  { Write the old data }
  573.                      Write(FilVar,OldName,' ');
  574.                      If Print then Write(FilVar,OldFileSize,' ');  { *2* Print Size if .LST *** }
  575.                      Str(OldDA,WrkMN);       { *2* Fix DAY Also *** }
  576.                      FixMinute;              { *2* }
  577.                      Write(FilVar,OldMO:2,'/',WrkMN,'/',OldYR);  { *2* Changed OldDA to WrkMn ** }
  578.                      Str(OldMN,WrkMN);       { Convert numeric to string }
  579.                      FixMinute;              { now make it more readable }
  580.                      { *2* Following to get rid of 24 hour time *** }
  581.                      If OldHR >= 12 then ap := 'p' else ap := 'a';
  582.                      If OldHR > 12 then OldHR := OldHR -12;
  583.                      If OldHR = 0 then OldHR := 12;
  584.                      { *2* End time changes *** }
  585.                      Write(FilVar,' ', OldHR:2,':',WrkMN);
  586.                      Write(FilVar,ap);  { *2* Add am/pm indicator *** }
  587.                      Write(FilVar,' ');      { Continue printing }
  588.                      if length(InputString) > 0 then     { Did I get a command line }
  589.                      begin                   { Is it the main directory }     { Yes }
  590.                          if length(OldDir) > 3 then  { Nope }
  591.                              Writeln(FilVar,OldDir)
  592.                          else                { this is the main directory }   { No }
  593.                              Writeln(FilVar,buffer,'\')
  594.                      end
  595.                      else
  596.                      if length(OldDir) > 1 then   { Is it the main directory }
  597.                          Writeln(FilVar,OldDir)   { Nope }
  598.                      else
  599.                          Writeln(FilVar,'\');     { this is the main directory }
  600.                      ScreenLines := ScreenLines + 1; { Its one more than it was }
  601.                 end;
  602.                 Write(FilVar,DirectryRec.FileAttributes); { Lets write the current }
  603.                 Write(FilVar,DirectryRec.FileNme,' ');    { Record }
  604.                 Write(FilVar,DirectryRec.FileMO:2,'/',DirectryRec.FileDA:2,'/',DirectryRec.FileYR);
  605.                 Str(DirectryRec.FileMN, WrkMN);
  606.                 FixMinute;
  607.                 Write(FilVar,' ',DirectryRec.FileHR:2,':',WrkMN);
  608.                 Write(FilVar,' ');
  609.                 if length(InputString) > 0 then  { Did I get a command line }
  610.                 begin
  611.                     if length(DirectryRec.FileDir) > 3 then  { Main Directory }
  612.                         Writeln(FilVar,DirectryRec.FileDir)  { Yes a cmd line }
  613.                     else
  614.                         Writeln(FilVar,buffer,'\') { this is the main directory }
  615.                 end
  616.                 else                          { I didn't get a command string }
  617.                 if length(DirectryRec.FileDir) > 1 then
  618.                     Writeln(FilVar,DirectryRec.FileDir)
  619.                 else
  620.                     Writeln(FilVar,'\');      { this is the main directory }
  621.                 ScreenLines := ScreenLines + 1;
  622.                 SetUpOldArea;
  623.                 MatchFound := True;
  624.              end;
  625.          end;
  626.    until SortEOS;                { Do it until its done }
  627. end;
  628.  
  629. begin                   {  Main program  }
  630.   ClrScr;                          { *2* For Turbo 3.0 (K.F.) *** }
  631.   Write(Lst,#27,'Q',#27,'L020');   { *2* Sets Nec-8023 to 17 Ch, Left Margin 20 (K.F.) *** }
  632.   InputString := CL;               { get command line }
  633.   if length(InputString) = 0 then  { I didn't get one }
  634.     Buffer := ''                   { so make the buffer blank }
  635.   else
  636.   begin                            { Yes I did get one }
  637.     Buffer[1] := UpCase(InputString[2]);  { only take the drive character }
  638.     Buffer[2] := ':';                     { put in our own : }
  639.     Buffer[3] := Chr(0);                  { End the data }
  640.     Buffer[0] := chr(2);                  { Make it length 2 }
  641.   end;
  642.   Time;                                   { Get the time }
  643.   Date;                                   { Get the date }
  644.   FirstTime := True;                      { First time here }
  645.   MatchFound := False;                    { Haven't found any matches yet }
  646.   GoToXY(10,5);                           { Fill the screen with data }
  647.   Write('Directory List Program   Version 1.0'); { This is it }
  648.   GoToXY(10,7);
  649.   Write('Written by');
  650.   GoToXY(20,8);
  651.   Write('Karson W. Morrison');            { This is who did it }
  652.   GoToXY(20,9);
  653.   Write('Feb. 13, 1985');                 { And When }
  654.   GoToXY(10,11);
  655.   Write('OPTIONS:');
  656.   GoToXY(11,12);
  657.   Write('List the entire directory of the disk: (1)');
  658.   GoToXY(11,13);
  659.   Write('List only Duplicate files on the disk: (2)');
  660.   GoToXY(22,20);
  661.   Write('For output on printer enter (P) prior to number option');
  662.   GoToXY(14,15);
  663.   Write('Option: ');
  664.   read(Kbd,Option);
  665.   GoToXY(22,15);
  666.   Writeln(Upcase(Option));
  667.   if Upcase(Option) = 'P' then
  668.   begin                          { Set up file for listing }
  669.       Print := True;
  670.       Assign(FilVar,'LST:');
  671.       GoToXY(22,15);
  672.       read(Kbd,Option);
  673.       GoToXY(22,15);
  674.       Writeln(Option);
  675.   end
  676.   else                           { Set up file for console }
  677.   begin
  678.       Print := False;
  679.       Assign(FilVar,'CON:');
  680.   end;
  681.   Rewrite(FilVar);
  682.   Writeln;
  683.   ScreenLines := 0;
  684.   PageNo := 0;
  685.   Write('Reading the Directories');
  686.   SortResult := TurboSort(SizeOf(DirectryRec)); { this does the call to the sort }
  687.   if SortResult > 1 then                    { if the sort don't work   }
  688.   begin                                     { This maybe what is wrong }
  689.       if SortResult = 3 then Writeln('Not enouth memory for sorting');
  690.       if SortResult = 9 then Writeln('More than 32767 records being sorted');
  691.       if sortresult = 10 then Writeln('Disk error during sorting (bad or full)');
  692.       if SortResult = 11 then Writeln('Read error during sort (Probably bad disk)');
  693.       if sortResult = 12 then Writeln('File creation error (directory may be full)');
  694.   end;
  695.   Writeln;
  696.   if print then
  697.   begin
  698.       Writeln(FilVar,'          Number of Directories: ',E-1,'    Number of Files: ',NumberRecs-E+1);
  699.       Writeln(FilVar,#$0C);
  700.       GoToXY(1,15);   { this is for the Writeln below this }
  701.   end;
  702.   Writeln('          Number of Directories: ',E-1,'    Number of Files: ',NumberRecs-E+1);
  703. end.
  704.