Search files using Turbo Pascal

Turbo Pascal 3.0 projects

Search files using Turbo Pascal

Turbo Pascal (CP/M-80) provides the procedures RESET(file) and REWRITE(file) for working with files After execution, Turbo Pascal calls an internal error routine. If an error occurs a message will be sent and the program is aborted. The programmer may avoid abortion, if a file to be opened is not found, by using the directive {$I-}RESET(file){$I+}. (But don't forget to handle a pending error e.g. by if IOresult<>0 then ...). This allows looking for a file, but with unambiguous file name only. Sometimes, it is necessary to search for multiple files with ambiguous file name, e.g. search for files of type .TXT, which be represented in CP/M as *.TXT.
Mallard BASIC has a built in command − FIND$(name,number) − handling multiple files. Here name means the mask for the files to be searched for and number is the number of the file to be fetched. On success, FIND$ returns an unambiguous file name. Otherwise, an empty string will be returned.

I will now describe a Turbo Pascal function which works the same way the Mallard BASIC function does. The base for searching files are two BDOS functions, namely Search for First (function 17) and Search for Next (function 18). Searching for first requires an CP/M File Control Block, subsequent calls to searching for next do not. On success, the BDOS functions return a number in the range 0..3, otherwise 255. The number is an index to one of four entries within the current DMA buffer. Because the size of the buffer is 128 bytes, this results in a 32-byte file information − exactly one directory entry. The first byte of this entry is the user area, followed by eight characters for the file name and three for the file extension.

The following CP/M structures are required for a file search:

An FCB. Here, the default FCB may be used − starting at address 0x005C.
A disk buffer. The default buffer − starting at address 0x0080 − cannot be used here because Turbo Pascal uses the memory − starting at address 0x00A0 − for internal storage.

The search function takes a string as input as well as for output. Therefore, a conversion must be performed from one structure to the other. The process of the function Finds(name,number) is as follows:

The procedure StringToFCB converts the file name into an FCB structure.
Then, searching takes place until the requested file is found or no more files are found.
The procedure FCBtoString converts the FCB structure into the resulting file name.

program Finde(input,output);

{ This small test program displays all files corresponding          }
{ to the input mask.                                                }
{ Its routines are based upon those published in the article "Turbo }
{ Directory" of the "CPC" magazine, Special Issue 4, 1987.          }

type
  fstr         = string[14];

function Finds(fn:fstr;num:integer):fstr;
const
  srcfrst      =  17;
  srcnxt       =  18;
  setdma       =  26;
  OSerr        = 255;
  NOATT        = $7F;
type
  FCBstr       = string[32];
var
  FCB          : FCBstr absolute $005C;    { File Control Block }
  DMA          : string[128];
  curcnt,
  direntry     : integer;

  function UpString(strg:fstr):fstr;
  { Convert entire string into upper case characters }
  var
  i            : integer;
  begin
    for i:=1 to length(strg) do strg[i]:=upcase(strg[i]);
    UpString:=strg;
  end;

  function wildcard(fnam:fstr):FCBstr;
  { Preparing file name to be written into an FCB }
  { regarding wildcards ('*')                     }
  const
    nam        = 8;
    ext        = 3;
  var
    leng,
    dot,
    ast        : integer;
    filename   : string[nam];
    fext       : string[ext];
  begin
    filename:='';
    fext:='   ';
    leng:=length(fnam);
    dot:=pos('.',fnam);        { Position of dot within file name }
    if (dot=0) and (leng>nam) then leng:=nam
                              else begin
                                     fext:=copy(fnam,succ(dot),ext)+'   ';
                                     if dot>succ(nam) then leng:=nam
                                                      else leng:=pred(dot);
                                     ast:=pos('*',fext);
                                     if ast<>0 then fext:=copy(fext,1,pred(ast))+'???';
                                   end;
    ast:=pos('*',fnam);
    if ast<>0 then filename:=copy(fnam,1,pred(ast))+'????????'
              else filename:=copy(fnam,1,leng)+'        ';
    wildcard:=filename+fext;
  end;

  procedure StringToFCB;
  { Write a file name into an FCB and prepare sysm bytes }
  const
    DSK        =  0;
    EX         = 12;
    CR         = 32;
    null       = #0;
  var
    drv        : char;
  begin
    FCB:=UpString(fn);
    drv:=FCB[1];
    if pos(':',FCB)=0 then drv:='@'
                      else delete(FCB,1,2);
    FCB:=wildcard(FCB);
    FCB[DSK]:=chr(ord(drv)-ord('@'));
    FCB[EX]:=null;
    FCB[CR]:=null;
  end;

  function FCBtoString:fstr;
  { Write an FCB into a file name and clear attributes }
  var
    a          : integer;
    filename   : fstr;

  procedure append(b,l:integer);
  { Append name or type to file name clearing attribute bit }
  var
    i          : integer;
  begin
    for i:=b to pred(b+l) do filename:=filename+chr(ord(DMA[a+i]) and NOATT);
  end;

  begin {FCBtoString}
    a:=succ(direntry SHL 5);
    filename:='' ;
    append(0,8);
    filename:=filename+'.';
    append(8,3);
    FCBtoString:=filename;
  end;

Begin {Finds}
  StringToFCB;
  curcnt:=1;
  bdos(setdma,addr(DMA));
  direntry:=bdos(srcfrst,addr(FCB));
  while (direntry<>OSerr) and (curcnt<>num) do
  begin
    curcnt:=succ(curcnt);
    direntry:=bdos(srcnxt);
  end;
  if direntry=OSerr then Finds:=''
                    else Finds:=FCBtoString;
End;

{ Hier beginnt der Test }

var
  fc : integer;
  fn : fstr;

function empty:boolean;
var
  emp  : boolean;
  fnam : fstr;
Begin
  fnam:=Finds(fn,fc);
  emp:=fnam='';
  if not emp then writeln(fc:3,': ',fnam);
  empty:=emp;
End;

BEGIN
  write('Maske: ');
  readln(fn);
  fc:=0;
  repeat
    fc:=succ(fc);
  until empty;
  writeln(pred(fc),' files found.');
END.

Listing of the sample program

[Find here the module FINDS.INC and here the mentioned article "Turbo Directory"]

Compiled by Werner Cirsovius
July 2009