Directory in Pascal

Turbo-Pascal bietet neben anderen schönen Eigenschaften die Möglichkeit, BDOS-Routinen aufzurufen, also direkt auf die CP/M-Schnittstelle zuzugreifen. Das Listing im Bild zeigt, wie man mit Hilfe der BDOS-Routinen „Setdma", „Search for first" und „Search for next" auf das Directory einer Diskette vom Pascal aus zugreifen kann, und liefert einen Ausdruck, wie man ihn vom DIR-Kommando gewöhnt ist.
Durch Ändern der Ausgabeeinheit ist es möglich, diese Ausgabe auf den Drucker oder in eine Datei umzuleiten. Erweitert man die Prozedur „PrepareFCB" um eine Maske für das Directory, kann man bestimmte Dateien selektieren.
So wäre es vorstellbar, bei einem Textverarbeitungs-Programm die vorhandenen Textdateien per Menü darzubieten und sogar mehrere Laufwerke anzusteuern. Eine weitere Möglichkeit wäre es, die COM-Dateien als Menü anzubieten und das ausgewählte Programm durch die Befehle „Assign (F,Name)" und „Execute (F)" aufzurufen.

Jürgen PJate

 1: Program Listdirectory;
 2:
 3: Const
 4:    FCBlength = 35;
 5:    BuffLength = 127;
 6:    Namelength = 14;
 7:
 8: Type
 9:    FCB = Array[0..FCBlength] of Byte  (* File Control Block *);
10:    BUF = Array[0..BuffLength] of Byte (* Filebuffer *);
11:    filename = string[Namelength];
12:
13: var LW: char;
14:
15: Procedure PrepeareFCB(drive: char; var aktfcb: FCB);
16:   (* Besetzen des FCB mit Laufwerksangabe und Wildcards *)
17:   (* Hier kann spaeter eine Maske fuer das Directory auf-
18:      gebaut werden, z.B. ????????.PAS *)
19: Const Questionmark = 63;
20: Var   i: Integer;
21: Begin
22:   aktfcb[0] := ord (drive)-64;
23:   for i:=1 to 11 do aktfcb[i] := Questionmark;
24:   for i:= 12 to 14 do aktfcb[i] := 0;
25: End;
26:
27: Procedure getdir(Block: Byte; Puffer: BUF; var S:filename);
28:   (* Liefert Dateinamen oder '--nil--' *)
29: Var j: Integer;
30: Begin
31:   If Puffer[32*block+12]<2 then
32:     begin (* first entry *)
33:     S := '        .   '; (* 8 Blanks.3Blanks *)
34:     for j := 1 to 8 do S[j] := chr(Puffer[32*Block+J]);
35:     for j := 10 to 12 do S[j] := chr(Puffer[32*block+j-1]);
36:     end
37:   else
38:     S := '--nil--';
39: End;
40:
41: Procedure Directory(Drive: char);
42:   (* Listet das Directory aus *)
43: Const
44:   Setdma = 26 (* BDOS: Setze DMA-Puffer *);
45:   First  = 17 (* BDOS: Suche ersten Eintrag *);
46:   Next   = 18 (* BDOS: Suche naechsten Eintrag *);
47:   error = 255 (* Fehler bei BDOS-Aufrufen *);
48: var i: Integer;
49:     res : Byte;
50:     fn: filename;
51:     aktfcb: FCB;
52:     Puffer: BUF;
53: Begin
54:   Drive := upcase(Drive);
55:   for i := 0 to Bufflength do Puffer[i] := 0;
56:   for i := 0 to FCBlength do aktfcb[i] := 0;
57:   bdos(Setdma, Addr(Puffer[0]));
58:   Clrscr; I := 1;
59:   Writeln('Laufwerk : ',Drive);
60:   Writeln('------------');
61:   PrepeareFCB(Drive,aktfcb);
62:   res := bdos(First,Addr(aktfcb[0]));
63:   if res <> error then begin
64:     getdir(res,Puffer,fn); if fn <> '--nil--' then write(fn,' : ');
65:     repeat
66:       PrepeareFCB(Drive,aktfcb); res := bdos(Next,Addr(aktfcb[0]));
67:       if res <> error then begin
68:         getdir(res,Puffer,fn);
69:         if fn <>'--nil--' then write(fn,' : ');
70:         i := succ(i); if (i mod 5)=0 then writeln end;
71:     until res = error;
72:     writeln; writeln(i,' Dateien !'); end
73:   else
74:     writeln('No File.');
75: end;
76:
77: begin (* Main *)
78: Writeln('Laufwerk ? ');
79: Read(kbd,LW); writeln(LW);
80: Directory(LW);
81: end.
82:

Directory-Anzeige durch Aufruf von CP/M-BDOS-Routinen
Source