home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1987 / 10 / dosfunc / fparscp2.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-08-25  |  3.3 KB  |  73 lines
  1. (*-------------------------------------------------------------------------*)
  2. (*                            FPARSCP2.PAS                                 *)
  3. (*              (c) 1987  Michael Ceol & PASCAL INT.                       *)
  4. (*  FCB erstellen: CP/M-Dateispez. in FCB-gerechte Struktur umsetzen.
  5.     Neuere BS wie CP/M-Plus stellen dazu ebenfalls eine BDOS-Funktion zu
  6.     Verfuegung (CP/M-Plus: Funktion 152: Parse Filename, s. FPARSCP3.PAS).
  7.     Die hier implementierte Version wurde an die Konventionen der MS-DOS-
  8.     Funktion 29 angepasst: result = 0 -> fname war ok, result = 1 -> fname
  9.     enthaelt '*' oder '?', result = 255 -> fname fehlerhaft (z.B. illegales
  10.     Laufwerk). nextch zeigt auf das erste, nicht mehr zum Dateinamen ge-
  11.     hoerende Zeichen.                                                      *)
  12.  
  13. PROCEDURE FParsName (VAR fname: Dir_Chr0; VAR nextch, result: INTEGER);
  14. VAR i, j: INTEGER;  delimiters: SET OF CHAR;  fstr: Dir_Str;
  15.  
  16.   PROCEDURE fpart;         (* einen Teil (Laufwerk, Dateiname...) abteilen *)
  17.   BEGIN
  18.     fstr := '';  nextch := Succ(nextch);
  19.     WHILE (NOT (fname[nextch] IN delimiters)) AND (fname[nextch] <> Chr(0))
  20.     DO BEGIN
  21.       fstr := Concat(fstr,UpCase(fname[nextch]));  nextch := Succ(nextch);
  22.     END;
  23.   END;
  24.  
  25.   PROCEDURE fillFCB (start, len: INTEGER);  (* Dateispez. nach FCB bringen *)
  26.   BEGIN
  27.     IF fstr <> '' THEN BEGIN
  28.       i := 1;
  29.       WHILE (i <= Length(fstr)) AND (fstr[i] <> '*') DO BEGIN
  30.         IF fstr[i] = '?' THEN result := 1;
  31.         DirFCB.name[start+i] := fstr[i];  i := Succ(i);
  32.       END;
  33.       IF fstr[i] = '*' THEN BEGIN
  34.         FOR j := i TO len DO DirFCB.name[start+j] := '?'; result := 1;
  35.       END;
  36.     END;
  37.   END;
  38.  
  39. BEGIN
  40.   delimiters := [#1..#32,';','=','<','>','.',':',',','[',']','|'];
  41.   result := 0;
  42.   WITH DirFCB DO BEGIN                               (* FCB initialisieren *)
  43.     drive := 0;                          (* angemeldetes Laufwerk annehmen *)
  44.     FOR i := 1 TO 11 DO name[i] := ' ';  (* keine Dateispezifikation       *)
  45.     extend := 0;  system[1] := 0;  system[2] := 0;
  46.   END;
  47.   nextch := 1;                        (* fuehrende Trennzeichen entfernen: *)
  48.   WHILE (fname[nextch] IN delimiters) AND (fname[nextch] <> Chr(0)) DO
  49.     nextch := Succ(nextch);
  50.   nextch := Pred(nextch);
  51.   fpart;                            (* ersten Teil des Dateinamens trennen *)
  52.   IF (fname[nextch] = ':') AND (Length(fstr) = 1) THEN (* Laufwerksangabe? *)
  53.     CASE fstr[1] OF
  54.       'A'..'P': BEGIN             (* ja. ... und naechsten Teil abtrennen: *)
  55.                   DirFCB.drive := Succ(Ord(fstr[1])-Ord('A'));  fpart;
  56.                 END;
  57.        ELSE     BEGIN  result := 255;  Exit;  END; (* ungueltiges Laufwerk!*)
  58.     END;
  59.   IF Length(fstr) <= 8 THEN                    (* ordentlicher Dateiname ? *)
  60.     BEGIN
  61.       fillFCB(0,8);                           (* ja, in FCB uebertragen... *)
  62.       IF fname[nextch] = '.' THEN              (* kommt noch Erweiterung ? *)
  63.         BEGIN
  64.           fpart;
  65.           IF Length(fstr) <= 3 THEN fillFCB(8,3) ELSE result := 255;
  66.         END;
  67.     END
  68.   ELSE result := 255;
  69.   IF fname[nextch] = Chr(0) THEN nextch := 0;
  70. END;
  71. (*-------------------------------------------------------------------------*)
  72. (*                         Ende FPARSCP2.PAS                               *)
  73.