home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1989 / 10 / praxis / project.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-02-21  |  7.0 KB  |  205 lines
  1. (* ------------------------------------------------------ *)
  2. (*                    PROJECT.PAS                         *)
  3. (*     Auflistung aller zu einem Turbo Pascal-Programm    *)
  4. (*                gehörenden Dateien                      *)
  5. (*         (c) 1989   TOOLBOX  &  Karsten Gieselmann      *)
  6. (* ------------------------------------------------------ *)
  7. {$R-,S-,I-,V-,B-,N-}
  8. {$M 4096, 8192, 8192}
  9.          (* möglichst viel Speicher für TPC übrig lassen! *)
  10. PROGRAM Project;
  11.  
  12. USES
  13.   Crt, Dos;                            (* benötigte Units *)
  14.  
  15. CONST
  16.   Version  = 'PROJECT 1.0';
  17.   MaxFiles = 100;       (* Maximalzahl von Projektdateien *)
  18.   Compiler = 'C:\TURBO5\TPC.EXE';
  19.                       (* Pfad für Kommandozeilen-Compiler *)
  20.   Options  = '/TC:\TURBO/M ';
  21.                           (* fixer Teil der Kommandozeile *)
  22.   Units    = '';    (* zu TPC.CFG alternative Pfadangaben *)
  23.   Includes = '';
  24.   Objects  = '';
  25.  
  26. VAR
  27.   SaveInt21    : POINTER;          (* alter INT-21-Vektor *)
  28.   k,LastFile   : WORD;
  29.   CurrentFile  : STRING;       (* aktueller Listeneintrag *)
  30.   Overflow     : BOOLEAN;               (* Liste zu groß? *)
  31.   RequiredFile : ARRAY[1..MaxFiles] OF ^STRING;
  32.                                      (* Liste der Dateien *)
  33.  
  34. (* ------ allgemeiner Pattern-Matching-Algorithmus ------ *)
  35.  
  36. FUNCTION Match(Source, Pattern : STRING) : BOOLEAN;
  37.   (* prüft, ob die durch "Pattern" gegebene Zeichenkette,
  38.      die beliebig mit Wildcards "?" (ein Zeichen) und "*"
  39.      (beliebig viele Zeichen) durchsetzt sein kann, mit
  40.      "Source" (darf keine Wildcards enthalten!)
  41.      übereinstimmt. Groß- und Kleinschreibung werden dabei
  42.      nicht unterschieden.
  43.      Beispiel:  "T*B?x*SP??Z*" stimmt mit
  44.                 "Toolbox ist Spitze!" überein.            *)
  45.  
  46. TYPE
  47.   Result = (Failed, Passed, Scanning);
  48.  
  49. VAR
  50.   PatternLen : BYTE ABSOLUTE Pattern;
  51.   SourceLen  : BYTE ABSOLUTE Source;
  52.  
  53.   FUNCTION MatchSubStr(s : BYTE; p : BYTE) : Result;
  54.     (* Test auf Übereinstimmung der Teilstrings
  55.                                  ab Pattern[p], Source[s] *)
  56.   VAR
  57.     State : Result;
  58.   BEGIN
  59.     IF PatternLen = 0 THEN
  60.       State := Passed
  61.                (* triviale Übereinstimmung: leeres Muster *)
  62.     ELSE BEGIN
  63.       State := Scanning;
  64.       REPEAT
  65.         IF (s > SourceLen) AND (p > PatternLen) THEN
  66.                            (* Muster und Zeichenvorrat... *)
  67.           State := Passed  (* ...vollständig abgearbeitet *)
  68.         ELSE
  69.           IF p > PatternLen THEN
  70.             State := Failed
  71.                            (* Muster vorzeitig erschöpft! *)
  72.           ELSE
  73.             IF Pattern[p] = '*' THEN
  74.               IF p = PatternLen THEN
  75.                            (* Jokerzeichen entspricht.... *)
  76.                 State := Passed
  77.                            (* ...restlichem Zeichenvorrat *)
  78.               ELSE
  79.                 REPEAT        (* rekursiver Restvergleich *)
  80.                   State := MatchSubStr(s, p+1);
  81.                   Inc(s);
  82.                 UNTIL (State = Passed) OR (s > SourceLen)
  83.             ELSE
  84.               IF (Upcase(Pattern[p]) <> Upcase(Source[s]))
  85.               AND (Pattern[p] <> '?') THEN
  86.                 State := Failed  (* keine Übereinstimmung *)
  87.               ELSE BEGIN
  88.                 Inc(s); Inc(p);
  89.                      (* Übereinstimmung, nächstes Zeichen *)
  90.               END;
  91.       UNTIL State <> Scanning;
  92.     END;
  93.     MatchSubStr := State;
  94.   END;
  95.  
  96. BEGIN
  97.   Match := (MatchSubStr(1, 1) = Passed);
  98. END;
  99.  
  100. FUNCTION MatchesMask(FileName : STRING) : BOOLEAN;
  101.   (* stimmt "FileName" mit einer
  102.                           der angegebenen Masken überein? *)
  103. VAR
  104.   Matched : BOOLEAN;
  105.   k : WORD;
  106. BEGIN
  107.   IF ParamCount >= 2 THEN BEGIN
  108.                  (* Übereinstimmung mit Masken überprüfen *)
  109.     k := 2;
  110.     Matched := FALSE;
  111.     WHILE (k <= ParamCount) AND NOT Matched DO BEGIN
  112.       Matched := Matched OR Match(FileName, ParamStr(k));
  113.       Inc(k);
  114.     END;
  115.     MatchesMask := Matched;
  116.   END ELSE
  117.     MatchesMask := TRUE;
  118.                 (* keine Maskenangabe: dann *.* annehmen! *)
  119. END;
  120.  
  121. (*  neue Service-Routine für DOS-Funktionsinterrupt 21H   *)
  122.  
  123. {$F+}
  124. PROCEDURE Int21(Flags,CS,IP,AX,BX,CX,DX,
  125.                           SI,DI,DS,ES,BP : WORD); INTERRUPT;
  126. {$F-}
  127.  
  128. TYPE
  129.   IntRegisters = RECORD CASE BYTE OF
  130.                    1 : (BP,ES,DS,DI,SI,
  131.                         DX,CX,BX,AX,IP,CS,Flags : WORD);
  132.                    2 : (Dummy : ARRAY[1..5] OF WORD;
  133.                         DL,DH,CL,CH,BL,BH,AL,AH : BYTE);
  134.                  END;
  135.  
  136. CONST                       (* Aufrufzähler: die ersten
  137.                                          beiden Dateien.. *)
  138.   NumberOfCalls : WORD = 0; (* ..TPC.CFG, TURBO.TPL sollen
  139.                                         ignoriert werden! *)
  140. VAR
  141.   Regs : IntRegisters ABSOLUTE BP;
  142.   Len  : BYTE ABSOLUTE CurrentFile;
  143.  
  144.   PROCEDURE ChainInt(Regs: IntRegisters; Address : POINTER);
  145.     INLINE($5B/$58/$5E/$1F/$87/$5C/$0E/$87/$44/$10/$8B/$54/
  146.            $16/$52/$9D/$8C/$DA/$FA/$8E/$D2/$89/$F4/$FB/$5D/
  147.            $07/$1F/$5F/$5E/$5A/$59/$CB);
  148. BEGIN
  149.   WITH Regs DO BEGIN
  150.     IF AH = $02 THEN BEGIN
  151.          (* Ausgaben von TPC direkt auf den Bildschirm... *)
  152.       Write(Chr(DL)); Exit;
  153.          (* ...um die Liste vollständig zu isolieren! *)
  154.     END;
  155.     IF AH = $3D THEN BEGIN
  156.       Inc(NumberOfCalls);
  157.       IF (NumberOfCalls > 2) AND NOT Overflow THEN BEGIN
  158.                                          (* Projektdatei! *)
  159.         Len := 0;
  160.         WHILE Chr(Mem[DS:DX+Len]) <> #0 DO BEGIN
  161.                                    (* Dateinamen auslesen *)
  162.           Inc(Len);
  163.           CurrentFile[Len] := Chr(Mem[DS:DX+Len-1]);
  164.         END;
  165.         k := 1;
  166.         WHILE (k <= LastFile) AND
  167.               (CurrentFile <> RequiredFile[k]^) DO
  168.           Inc(k);
  169.         IF MatchesMask(CurrentFile) AND
  170.                       (k > LastFile) THEN BEGIN
  171.           GetMem(RequiredFile[k], Len+1);
  172.           Move(CurrentFile, RequiredFile[k]^, Len+1);
  173.                                     (* in Liste eintragen *)
  174.           Inc(LastFile);
  175.           Overflow := LastFile > MaxFiles;
  176.         END;
  177.       END;
  178.     END;
  179.   END;
  180.   ChainInt(Regs, SaveInt21);
  181. END;
  182.  
  183. BEGIN
  184.   WriteLn(^M^J, Version);
  185.   IF (ParamCount = 0) OR (ParamStr(1) = '?') THEN BEGIN
  186.     WriteLn('Syntax:  PROJECT  Name [Dateigruppen] ',
  187.             '[>Output]'); Halt;
  188.   END;
  189.   WriteLn;
  190.   LastFile := 0;
  191.   Overflow := FALSE;
  192.   GetIntVec($21, SaveInt21);
  193.                            (* Funktionsinterrupt umleiten *)
  194.   SetIntVec($21, @Int21);
  195.   Exec(Compiler,Options+Units+Objects+Includes+ParamStr(1));
  196.   SetIntVec($21, SaveInt21);
  197.   IF Overflow THEN
  198.    WriteLn('Too many files, project file list not written');
  199.   Assign(Output, ''); Rewrite(Output);
  200.   IF NOT Overflow THEN         (* Projektdateien ausgeben *)
  201.     FOR k := 1 TO LastFile DO
  202.       WriteLn(RequiredFile[k]^);
  203. END.
  204. (* ------------------------------------------------------ *)
  205. (*                Ende von PROJECT.PAS                    *)