home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS - Coast to Coast / simteldosarchivecoasttocoast2.iso / pascal / where.pas < prev   
Pascal/Delphi Source File  |  1994-03-07  |  17KB  |  395 lines
  1.  Program WHERE - is a program to locate files on the IBM PC/XT or PC/AT     
  2.     hard disks. The search begins at the starting directory (root directory 
  3.     by default (\)) and traverses the tree for all files that match the     
  4.     search string. This search string may contain wildcards * and ?.         
  5.  
  6.     Output: For each file found:                                            
  7.                                          
  8.     nnnnn mm-dd-yy hh:mm pm pathname                                     
  9.                                          
  10.         giving the file size, creation date and time, and complete pathname. 
  11.  
  12.     The program is written in Pascal to be built with IBM Pascal 2.0.
  13.     If anyone ports it to other Pascal compilers, please let me know.
  14.  
  15.     Mike Johnson
  16.     MIT Project Athena
  17.     mjohnson@athena.mit.edu
  18.  
  19. --------------
  20. ...and here is the source file:
  21. --------------
  22.  
  23. {$include:'c:\usr\src\pascal\ibmintrp.int'}
  24.  
  25. {****************************************************************************}
  26. {                                         }
  27. { Program WHERE - is a program to locate files on the IBM PC/XT or PC/AT     }
  28. {    hard disks. The search begins at the starting directory (root directory }
  29. {    by default (\)) and traverses the tree for all files that match the     }
  30. {    search string. This search string may contain wildcards * and ?.         }
  31. {                                         }
  32. {    Output: For each file found:                                            }
  33. {                                         }
  34. {    nnnnn mm-dd-yy hh:mm pm pathname                                     }
  35. {                                         }
  36. {        giving the file size, creation date and time, and complete pathname. }
  37. {                                         }
  38. {    Syntax:  where [starting_directory]filename.ext                 }
  39. {                                         }
  40. {          starting_directory - the sub-tree of the directory heirarchy   }
  41. {                   for the program to search             }
  42. {          filename.ext     - standard DOS file description that may    }
  43. {                   include wildcards * and ?.             }
  44. {                                         }
  45. {    To build:   using IBM Pascal Compiler, release 2.0:                     }
  46. {                                         }
  47. {          PAS1 where.pas,where.obj;                                      }
  48. {          PAS2                                                           }
  49. {          LINK where,where,NUL.MAP,\lib\ibmpas.lib+\lib\pascal.lib       }
  50. {                                         }
  51. {                                         }
  52. {    Copyright:  1985  by the Massachusetts Institute of Technology         }
  53. {                                         }
  54. {         Permission to use, copy, modify, and distribute this         }
  55. {         program for any purpose and without fee is hereby granted,  }
  56. {         provided that this copyright and permission notice appear on}
  57. {         all copies and supporting documentation, the name of M.I.T. }
  58. {         not be used in advertising or publicity pertaining to         }
  59. {         distribution of the program without specific prior         }
  60. {         permission, and notice be given in supporting documentation }
  61. {         that copying and distribution is by permission of M.I.T.    }
  62. {         M.I.T. makes no representations about the suitability of    }
  63. {         this software for any purpose. It is provided "as is"       }
  64. {         without express or implied warranty.                 }
  65. {                                         }
  66. {         1984, 1985  by Mark S. Ackerman.                 }
  67. {         Permission is granted for unlimited copies if not sold      }
  68. {         or otherwise exchanged for gain.                 }
  69. {                                         }
  70. {    Status   :  Version 1.00                             }
  71. {                                         }
  72. {    Author   :  Michael G. Johnson, MIT Project Athena              }
  73. {                                         }
  74. {         This code is a port of Mark S. Ackerman's WHERE.C program   }
  75. {         written for the Mark Williams C Compiler to the IBM Pascal  }
  76. {         Compiler Version 2.00 . The C code and algorithm appear in  }
  77. {         the October 1985 issue of the PC Tech Journal vol. 3 no. 10 }
  78. {         page 85.                             }
  79. {                                         }
  80. {    Creation Date :   10/30/85                          }
  81. {                                         }
  82. {    Revisions       :   none                             }
  83. {                                         }
  84. {    Parameters passed     :                             }
  85. {                                         }
  86. {    incoming_string - the arguement line containing the starting         }
  87. {              directory and the search string             }
  88. {                                         }
  89. {    Parameters returned : none                          }
  90. {                                         }
  91. {    Entry Conditions     : none                          }
  92. {                                         }
  93. {    Exit Conditions     :                             }
  94. {                                         }
  95. {      Normal  - Normal Pascal return sequence                 }
  96. {      Special - None.                             }
  97. {                                         }
  98. {    External Calls     :                             }
  99. {                                         }
  100. {     intrp(intno, inregs, outregs) - performs a software interrupte,     }
  101. {                     found in library IBMPAS.LIB         }
  102. {          intno   : byte    ! interrupt number             }
  103. {         Vars inregs  : reglist    ! register settings before interrupt }
  104. {         Vars outregs : reglist    ! register settings after interrupt  }
  105. {                                         }
  106. {    External Data Areas ( Global Constants, Types, & Variables ) :         }
  107. {                                         }
  108. {      adsmem   - pointer structure to access data in memory          }
  109. {             ADSMEM : ADS OF ARRAY [0..32766] OF BYTE             }
  110. {                                         }
  111. {      reglist  - record structure used to set and save system registers  }
  112. {             REGLIST : RECORD                         }
  113. {                   AX, BX, CX, DX, SI, DI, DS, ES, FLAGS : WORD  }
  114. {                   END;                         }
  115. {                                         }
  116. {    Compiler  : IBM Personal Computer Pascal Compiler Version 2.00         }
  117. {                                         }
  118. {****************************************************************************}
  119.  
  120. Program WHERE (input, output, incoming_string);
  121.  
  122.    Uses ibmintrp;
  123.  
  124.    Const
  125.      size_where_string = 255;               ! maximum string size
  126.      backslash       = chr(#5C);               ! '\' character
  127.      end_of_string       = chr(#00);               ! DOS ASCIIZ end of string char
  128.  
  129.    Type
  130.      where_string  = string(size_where_string);    ! fixed length string
  131.      where_lstring = lstring(size_where_string);   ! variable length string
  132.  
  133.    Var
  134.      incoming_string  : where_string;           ! input command line
  135.      directory_string : where_lstring;           ! starting directory
  136.      check_string      : where_lstring;           ! search string
  137.      time_ampm      : array [0..1] of string(2); ! AM/PM time indicator
  138.  
  139.    Value
  140.      time_ampm[0] := 'am';
  141.      time_ampm[1] := 'pm';
  142.  
  143.    {------------------------------------------------------------------------}
  144.    {  Function INIT_STRINGS                            }
  145.    {------------------------------------------------------------------------}
  146.    Function init_strings : boolean;
  147.      { Initialze the starting directory string and the search string,        }
  148.      { DIRECTORY_STRING and CHECK_STRING respectively. This is done by        }
  149.      { by parsing the command line (INCOMING_STRING) at the last backslash. }
  150.      { If a backslask does not exist, the strating directory is by default  }
  151.      { the root (\) and the search string in the command line            }
  152.  
  153.       Const
  154.         space     = chr(#20);
  155.  
  156.       Var
  157.         inc_size, dir_size, chk_size : integer;
  158.         i : integer;
  159.  
  160.       Begin { function init_strings   }
  161.      inc_size := ord(sizeof(incoming_string)) - 1;
  162.      inc_size := inc_size +
  163.              scanne(-inc_size, space, incoming_string, inc_size);
  164.      dir_size := inc_size +
  165.              scaneq(-inc_size, backslash, incoming_string, inc_size);
  166.      chk_size := inc_size - dir_size;
  167.      directory_string.len := wrd(dir_size);
  168.      check_string.len     := wrd(chk_size);
  169.  
  170.      If dir_size = 0
  171.         Then directory_string := '\'
  172.         Else For i := 1 to dir_size
  173.            Do directory_string[i] := incoming_string[i];
  174.      If chk_size > 0
  175.         Then For i := 1 to chk_size
  176.           Do check_string[i] := incoming_string[i+dir_size];
  177.      If inc_size > 0
  178.         Then init_strings := true
  179.         Else init_strings := false;
  180.       End;  { function init_strings   }
  181.  
  182.  
  183.    {------------------------------------------------------------------------}
  184.    {  Procedure LOOKUP - is a recursive call that traverses the DOS tree    }
  185.    {     heirarchy for files matching the the search string. Lookup is        }
  186.    {     called once for each subdirectory and uses a post-order or suffix  }
  187.    {     tree search.                                }
  188.    {------------------------------------------------------------------------}
  189.    Procedure lookup (Const directory_string : string);
  190.  
  191.       Const
  192.         carry_flag_mask = #01;     ! carry flag mask for error checking
  193.         no_type        = #00;     ! file attrib.- normal file, no archive
  194.         directory_type  = #10;     ! file attrib.- directory
  195.         no_more_files   = #12;     ! error code indicating no more files
  196.  
  197.       Type
  198.         { DOS Disk Tranfer Area, see page 5-132 of DOS Tech Ref 3.0     }
  199.         dta = record
  200.            dta_data       : string(43);    ! DOS DTA, first 21 used by DOS
  201.            dta_attr       : byte;           ! file attribute
  202.            dta_time       : word;           ! file creation time
  203.            dta_date       : word;           ! file creation date
  204.            dta_size       : integer4;      ! file size
  205.            dta_filename   : lstring(13);   ! ASCIIZ filename
  206.         end;
  207.  
  208.       Var
  209.         regs    : reglist;
  210.         current_dta : dta;
  211.         current_string    : where_lstring;
  212.         newdirectory_string : where_lstring;
  213.  
  214.       {---------------------------------------------------------------------}
  215.       {  Procedure SET_DTA - define the memory area where the DOS disk        }
  216.       {     transfer area will be stored. This routine sets the         }
  217.       {     DTA to be current_dta.dta_data. It does so by using DOS        }
  218.       {     interrupt 21h, function 1Ah Set Disk Transfer Address.        }
  219.       {---------------------------------------------------------------------}
  220.       Procedure set_dta (Var current_dta : dta);
  221.  
  222.      Begin { procedure set_dta   }
  223.         regs.ax := byword(#1A, #00);
  224.         regs.ds := (ADS current_dta.dta_data[1]).s;
  225.         regs.dx := (ADS current_dta.dta_data[1]).r;
  226.         intrp(#21, regs, regs);
  227.      End;  { procedure set_dta   }
  228.  
  229.  
  230.       {---------------------------------------------------------------------}
  231.       {  Procedure SET_DTA_VALUES - takes values in the Disk Transfer Area, }
  232.       {     CURRENT_DTA.DTA_DATA and sets the remainder of the the data     }
  233.       {     structure CURRENT_DTA. When the DTA gets set by DOS, it loads   }
  234.       {     the memory in 43 consecutive bytes. Pascal 2.00 forces elements }
  235.       {     in a record structure to predetermined alignments. This is the  }
  236.       {     why the disk transfer area was not define as a RECORD with        }
  237.       {     separate elments for time, data, size, etc. but as a string of  }
  238.       {     43 bytes, then after being set transfered to record elments of  }
  239.       {     the correct size.
  240.       {---------------------------------------------------------------------}
  241.       Procedure set_dta_values (Var current_dta : dta);
  242.  
  243.      Var
  244.            i       : word;
  245.            ads_mem : adsmem;
  246.  
  247.      Begin { procedure set_dta_values   }
  248.  
  249.         current_dta.dta_attr := wrd(current_dta.dta_data[22]);
  250.         ads_mem := ads current_dta.dta_time;
  251.         For i := 0 to 1 Do
  252.           ads_mem^[i] := wrd(current_dta.dta_data[i+23]);
  253.         ads_mem := ads current_dta.dta_date;
  254.         For i := 0 to 1 Do
  255.           ads_mem^[i] := wrd(current_dta.dta_data[i+25]);
  256.         ads_mem := ads current_dta.dta_size;
  257.         For i := 0 to 3 Do
  258.           ads_mem^[i] := wrd(current_dta.dta_data[i+27]);
  259.         i := 0;
  260.         Repeat
  261.           i := i + 1;
  262.           current_dta.dta_filename[i] := current_dta.dta_data[i+31-1];
  263.         Until (i >= 13) Or (current_dta.dta_filename[i] = end_of_string);
  264.         current_dta.dta_filename[0] := chr(i-1);
  265.  
  266.      End;  { procedure set_dta_values   }
  267.  
  268.       {---------------------------------------------------------------------}
  269.       {  Procedure GET_FIRST - find the first file having the file        }
  270.       {     attribute FILETYPE, and matching the SEARCH_STRING. If a        }
  271.       {     match is found, the DTA record CURRENT_DTA is updated.        }
  272.       {     The DOS interrupt 21h, function 4Eh Find First Matching file    }
  273.       {     is used achieve this.                        }
  274.       {---------------------------------------------------------------------}
  275.       Procedure get_first (Var search_string : string;
  276.                Const filetype : integer;
  277.                Var current_dta : dta);
  278.      Begin { procedure get_first   }
  279.         regs.ax := byword(#4E, #00);
  280.         regs.cx := wrd(filetype);
  281.         regs.ds := (ADS search_string).s;
  282.         regs.dx := (ADS search_string).r;
  283.         intrp(#21, regs, regs);
  284.         set_dta_values(current_dta);
  285.      End;  { procedure get_first   }
  286.  
  287.       {---------------------------------------------------------------------}
  288.       {  Procedure GET_NEXT  - find the next file having the file attribute }
  289.       {     and matches the search string as set in the GET_FIRST procedure.}
  290.       {     The criteria for the search was saved in the DTA record element }
  291.       {     CURRENT_DTA.DTA_DATA. The DOS interrupt 21h, function 4Eh        }
  292.       {     Find Next Matching file is used to achieve this.            }
  293.       {---------------------------------------------------------------------}
  294.       Procedure get_next (Var current_dta : dta);
  295.      Begin { procedure get_next   }
  296.         regs.ax := byword(#4F, #00);
  297.         intrp(#21, regs, regs);
  298.         set_dta_values(current_dta);
  299.      End;  { procedure get_next   }
  300.  
  301.       {---------------------------------------------------------------------}
  302.       {  Procedure GET_FILES - is called once per subdirectory to look        }
  303.       {     for all files matching the search string, and having a file     }
  304.       {     attribute byte indicating a normal file with the archive bit    }
  305.       {     not set.                                }
  306.       {---------------------------------------------------------------------}
  307.       Procedure get_files (Const directory_string : string;
  308.                Var current_dta : dta);
  309.  
  310.      Const
  311.            hrs_mask = 2#1111100000000000;    ! hour mask for time
  312.            min_mask = 2#0000011111100000;    ! minute mask for time
  313.            yrs_mask = 2#1111111000000000;    ! year mask for date
  314.            mon_mask = 2#0000000111100000;    ! month mask for date
  315.            day_mask = 2#0000000000011111;    ! day mask for date
  316.  
  317.      Var
  318.            current_string : where_lstring;
  319.  
  320.      {------------------------------------------------------------------}
  321.      {  Function HOUR - convert hour miltary time to AM/PM time        }
  322.      {------------------------------------------------------------------}
  323.      Function hour(Const military_hour : word) : word;
  324.      Begin    { function hour }
  325.         If (military_hour = 12) OR (military_hour = 0)
  326.            then hour := 12
  327.            else hour := military_hour MOD 12;
  328.      End;    { function hour }
  329.  
  330.      Begin { procedure get_files   }
  331.         copylst(directory_string, current_string);
  332.         concat(current_string, check_string);
  333.         concat(current_string, end_of_string);
  334.         get_first(current_string, no_type, current_dta);
  335.         While (regs.flags And carry_flag_mask) <> carry_flag_mask
  336.            Do Begin   { write the file information out to OUTPUT }
  337.           Writeln(current_dta.dta_size:10, ' ',
  338.             ((current_dta.dta_date And mon_mask) DIV 32):2, '-',
  339.             chr(((current_dta.dta_date And day_mask)) DIV 10 + #30),
  340.             chr(((current_dta.dta_date And day_mask)) MOD 10 + #30), '-',
  341.                (((current_dta.dta_date And yrs_mask) DIV 512) + 80):2, ' ',
  342.            (hour((current_dta.dta_time And hrs_mask) DIV 2048)):2, ':',
  343.             chr(((current_dta.dta_time And min_mask) DIV 32) DIV 10 + #30),
  344.             chr(((current_dta.dta_time And min_mask) DIV 32) MOD 10 + #30), ' ',
  345.               time_ampm[ord(((current_dta.dta_time And hrs_mask) DIV 2048) DIV 12)], ' ',
  346.               directory_string,
  347.               current_dta.dta_filename);
  348.           get_next(current_dta);
  349.            End;     { write the file information out to OUTPUT }
  350.         If (regs.ax <> no_more_files)
  351.            Then Writeln('problem with looking for ', current_string);
  352.      End;  { procedure get_files   }
  353.  
  354.    Begin { procedure lookup   }
  355.       copylst(directory_string, current_string);
  356.       concat(current_string, '*.*');
  357.       concat(current_string, end_of_string);
  358.       set_dta(current_dta);
  359.       get_first(current_string, directory_type, current_dta);
  360.       While (regs.flags And carry_flag_mask) <> carry_flag_mask
  361.      Do Begin
  362.         If (current_dta.dta_attr = directory_type) And
  363.            (current_dta.dta_filename[1] <> '.')
  364.            Then Begin
  365.           copylst(directory_string, newdirectory_string);
  366.           concat(newdirectory_string, current_dta.dta_filename);
  367.           concat(newdirectory_string, backslash);
  368.           lookup(newdirectory_string);
  369.           set_dta(current_dta);
  370.            End;
  371.         get_next(current_dta);
  372.      End;
  373.       If (regs.ax = no_more_files)
  374.      Then get_files(directory_string, current_dta)
  375.      Else Writeln('problem with looking thru ', directory_string);
  376.    End;  { procedure lookup   }
  377.  
  378.  
  379. {---------------------------------------------------------------------------}
  380. {  Main Program WHERE                                }
  381. {---------------------------------------------------------------------------}
  382. Begin { main program where   }
  383.    If init_strings
  384.       Then lookup(directory_string)
  385.       Else Begin
  386.      writeln('Syntax:  where [starting_directory]filename.ext');
  387.      writeln;
  388.      writeln(' ':9,  'starting_directory - the sub-tree of the directory heirarchy');
  389.      writeln(' ':30, 'for the program to search');
  390.      writeln(' ':9,  'filename.ext       - standard DOS file description that may');
  391.      writeln(' ':30, 'include wildcards * and ?.');
  392.      writeln;
  393.       End;
  394. End.  { main program where   }
  395.