Dateisuche mit TURBO Pascal

TURBO Pascal 3.0 Projekte

Dateisuche mit TURBO Pascal

Für die Verarbeitung von Dateien stellt TURBO Pascal (CP/M-80) die Prozeduren RESET(file) und REWRITE(file) zur Verfügung. Nach dem Abarbeiten dieser Prozeduren erfolgt ein interner Aufruf zur Fehlerroutine von TURBO Pascal. Im Fehlerfall gibt das Programm eine Meldung aus und bricht ab. Mit der Direktive {$I-}RESET(file){$I+} lässt sich der Abbruch beim Öffnen einer nicht vorhandenen Datei vermeiden. (Der Programmierer sollte aber anschließend das Ergebnis verarbeiten, z.B. mit if IOresult<>0 then ...). Mit dieser Methode lässt sich gezielt nach einer Datei suchen, die allerdings einen eindeutigen Namen haben muss. Es kommt aber vor, dass nach mehreren Dateien gesucht werden soll, die dann auch noch einen nicht eindeutigen Namen haben, z.B. nach allen Dateien mit der Endung .TXT, was in CP/M als *.TXT angegeben wird.
In Mallard BASIC existiert dafür der Befehl FIND$(name,nummer). Hierbei ist name die Maske für die zu suchende Datei und nummer gibt an, die wievielte Datei gesucht werden soll. Ist die Suche erfolgreich, dann gibt FIND$ einen eindeutigen Dateinamen zurück. Im anderen Fall ist der zurückgegebene Dateiname leer.

Es soll nun eine Funktion für TURBO Pascal vorgestellt werden, die genau wie der BASIC-Befehl funktioniert. Die Basis für das Suchen einer Datei sind zwei BDOS-Funktionen, nämlich Search for First (Funktion 17) und Search for Next (Funktion 18). Für das erste Suchen wird die Adresse eines CP/M File Control Blocks verwendet, der bei den folgenden Suchaufrufen nicht mehr benötigt wird. Ist der Suchvorgang erfolgreich, dann gibt die BDOS-Suchfunktion eine Zahl im Bereich 0..3 zurück, andernfalls 255. Die Zahl zeigt auf einen von vier möglichen Einträgen im aktuellen DMA-Puffer. Da dieser Puffer 128 Bytes groß ist, ergibt sich als Ergebnis eine 32 Byte große Dateiinformation, die einem Verzeichniseintrag entspricht. Dabei ist das erste Byte die Benutzernummer, an die sich acht Zeichen für den Dateinamen und drei für den Dateitypen anschließen.

Für die Such-Funktion werden also folgende CP/M Strukturen benötigt:

Ein FCB. Hierfür kann der Standard-FCB − ab Adresse 0x005C − verwendet werden.
Ein Disk-Puffer. Hier kann der Standard-Puffer − ab Adresse 0x0080 − nicht verwendet werden, da TURBO Pascal ab Adresse 0x00A0 den Speicher für Systemwerte nutzt.

Da die Such-Funktion einen String übernimmt und auch übergibt, muss eine Konvertierung der unterschiedlichen Strukturen erfolgen. Der Ablauf der Funktion Finds(name,nummer) ist wie folgt:

Die Prozedur StringToFCB konvertiert den Aufrufnamen in die FCB-Struktur.
Dann wird solange gesucht, bis die Suche entweder erfolglos ist oder die gewählte Datei gefunden wurde.
Die Prozedur FCBtoString konvertiert die FCB-Struktur in einen Dateinamen.

program Finde(input,output);

{ Dieses kleine Testprogramm gibt gemaess einer Eingabemaske }
{ alle gefundenen Dateien und die Anzahl aus                 }
{ Es basiert auf Routinen aus dem Artikel "Turbo Directory"  }
{ der Zeitschrift "CPC" aus dem Sonderheft 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;
  { Umwandlung aller Buchstaben einer Zeile in Grossbuchstaben }
  var
  i            : integer;
  begin
    for i:=1 to length(strg) do strg[i]:=upcase(strg[i]);
    UpString:=strg;
  end;

  function wildcard(fnam:fstr):FCBstr;
  { Der Dateiname wird so aufbereitet, dass er in den FCB geschrieben }
  { werden kann. Wildcards ('*') werden beruecksichtigt.              }
  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 des Punktes im Dateinamen }
    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;
  { Schreibt einen Dateinamen in einen FCB und bereitet Systembytes vor }
  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;
  { Schreibt einen FCB in einen Dateinamen und loescht Attribute }
  var
    a          : integer;
    filename   : fstr;

  procedure append(b,l:integer);
  { Namen oder Typen an Dateinamen haengen ohne Attributbit }
  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 des Beispielprogramms

[Hier das Modul FINDS.INC und hier der erwähnte Artikel "Turbo Directory"]

Zusammengestellt von Werner Cirsovius
Juli 2009