Directory unter TURBO PASCAL

TURBO-PASCAL Benutzer unter CP/M 80 müssen manche Nachteile gegenüber den MS-DOS Benutzern des Systems in Kauf nehmen. So sucht man beispielsweise vergeblich nach der Funktion DIR, die es unter MS-DOS ermöglicht, das Directory einer Diskette ins Programm einzublenden. Dies hat mit den Modulen DIRMOD1.INC und DIRMOD2.INC ein Ende.

Unter Ausnutzung der BDOS-Routinen 17 und 18 ist es möglich, diesem Mangel abzuhelfen. Von allen bisher bekannten Varianten zur Lösung dieses Problems unterscheiden sich die vorliegenden Module vor allem durch eine möglichst effektive Ausnutzung des ohnehin unter CP/M 80 knappen Speicherplatzes. Dies zeigt sich beispielsweise daran, daß der orginal FCB-Speicherplatz (Adresse 5C) benutzt und bei der Option eines sortierten Directories auf Zeigervariablen zurückgegriffen wird. Beide Module werden mittels des $I-Compilerbefehls in das Programm eingebunden.

Falls Sie auf ein sortiertes Directory verzichten wollen, so genügt die Einbindung des Moduls DIRMOD1.INC. Der Aufruf der Prozeduren ist denkbar einfach. Als Parameter sind lediglich das Laufwerk und ein dem CP/M-Standard entsprechender Dateiname zu übergeben. Auch Wildcards sind erlaubt. So bewirkt z.B. der Aufruf Dir(A,????????,PAS) die Auflistung aller Pascal-Sourcefiles auf dem Laufwerk A, und SDIR(B,????????,COM) listet alle Systemfiles auf dem Laufwerk B sortiert auf. Dateien mit SYS-Attribut werden nicht mit aufgelistet, R/O-Files erhalten wie unter BASIC gewohnt einen Stern am Ende des Namens. Das Ganze funktioniert übrigens nicht nur auf sämtlichen CPC-Rechnern und dem Joyce, sondern grundsätzlich auf allen CP/M-Maschinen.

(B.Ott)

 1  (************************************************************
 2   * DIRMOD1.INC -2421 Bytes-                 (c) 1986 by B.O. *
 3   *                                                           *
 4   * Ermoeglicht die Ausgabe eines Directories innerhalb eines *
 5   * Turbo-Pascal Programmes unter CP/M-80                     *
 6   *************************************************************)
 7
 8  type filename = array[1..8] of char;
 9       filetype = array[1..3] of char;
10
11       fcbtype  = record
12                       drive:byte;
13                       filename:filename;
14                       filetype:filetype;
15                       ex:byte;
16                       s1:array[1..2] of byte;
17                       rc:byte;
18                       s2:array[1..16] of byte;
19                  end;
20
21       dirtype = record
22                      filename:filename;
23                      filetype:filetype;
24                      roflag:boolean;
25                      sysflag:boolean;
26                 end;
27
28       dmatype = array[0..3] of fcbtype;
29
30  var  fcbentry:fcbtype absolute $5C;
31       direntry:dirtype;
32       dmaentry:dmatype;
33       dirflag:byte;
34
35  procedure initdir(drive:char;filename:filename;filetype:filetype);
36  var hvar:byte;
37  begin
38       bdos(26,addr(dmaentry));
39       fcbentry.ex:=0;
40       fcbentry.drive:=ord(drive)-64;
41       fcbentry.filename:=filename;
42       fcbentry.filetype:=filetype;
43       dirflag:=bdos(17,addr(fcbentry));
44  end;
45
46  procedure scanndir;
47  var hvar:byte;
48  begin
49       direntry.filename:=dmaentry[dirflag].filename;
50       if dmaentry[dirflag].filetype[1] > chr(127)
51          then direntry.roflag:=true
52          else direntry.roflag:=false;
53       if dmaentry[dirflag].filetype[2] > chr(127)
54          then direntry.sysflag:=true
55          else direntry.sysflag:=false;
56       for hvar:=1 to 3 do
57       begin
58            direntry.filetype[hvar]:=
59            chr(ord(dmaentry[dirflag].filetype[hvar])and 127);
60       end;
61       dirflag:=bdos(18);
62  end;
63
64  procedure dir(drive:char;filename:filename;filetype:filetype);
65  begin
66       initdir(drive,filename,filetype);
67       while dirflag<>255 do
68       begin
69            scanndir;
70            if not direntry.sysflag then
71            begin
72                write(direntry.filename,' ');
73                write(direntry.filetype);
74                if direntry.roflag then write('*   ')
75                                   else write('    ');
76            end;
77       end;
78  end;

 1  (************************************************************
 2   * DIRMOD2.INC -1905 Bytes-                 (c) 1986 by B.O. *
 3   *                                                           *
 4   * Ausgabe eines sortierten Directories. D1RMOD1.INC ist zu- *
 5   * vor in das Program einzubinden                            *
 6   *************************************************************)
 7
 8  type pointer = ^sdirtype;
 9
10       sdirtype = record
11                       data:dirtype;
12                       next:pointer;
13                  end;
14
15  var dirbase:pointer;
16
17  {$A-}procedure chaindir(var hpointer:pointer);
18  var hpointer1:pointer;
19  begin
20       if hpointer=nil then
21          begin
22               new(hpointer);
23               hpointer^.data:=direntry;
24               hpointer^.next:=nil;
25          end
26       else
27         if direntry.filename < hpointer^.data.filename then
28            begin
29                 new(hpointer1);
30                 hpointer1^:=hpointer^;
31                 hpointer^.data:=direntry;
32                 hpointer^.next:=hpointer1;
33            end
34            else
35              chaindir(hpointer^.next);
36  end;
37
38  {A-}procedure outdir(hpointer:pointer);
39  begin
40       if hpointer<>nil then
41          begin
42              direntry:=hpointer^.data;
43              if not direntry.sysflag then
44              begin
45                   write(direntry.filename,' ');
46                   write(direntry.filetype);
47                   if direntry.roflag then write('*   ')
48                                      eise write('    ');
49              end;
50              dispose (hpointer);
51              outdir(hpointer^.next);
52          end;
53  end;
54
55  procedure sdir(drive:char;filename:filename;filetype:filetype);
56  begin
57       dirbase:=nil;
58       initdir(drive,filename,filetype);
59       while dirflag<>255 do
60       begin
61           scanndir;
62           chaindir(dirbase);
63       end;
64       outdir(dirbase);
65  end;

Listing Directory

Hier das Modul DIRMOD1 und hier das Modul DIRMOD2