home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / das_buch / dos / attrib.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-05-13  |  18.6 KB  |  568 lines
  1. {$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,P-,Q-,R-,S-,T-,V-,X+,M 65520,0,0}
  2. (*===================================================================*)
  3. (*                     ATTRIB.PAS Version 2.0                        *)
  4. (*         Compiler: Turbo/Borland Pascal Real Mode Target           *)
  5. (*                Copyright (C) 1993 te-wi Verlag                    *)
  6. (*===================================================================*)
  7. (* Beschreibung:                                                     *)
  8. (*  Das Programm ersetzt das DOS-Programm ATTRIB für DOS-Versionen   *)
  9. (*  kleiner als 5.0. Es können alle Dateiattribute geändert werden,  *)
  10. (*  der Aufruf ist identisch wie beim DOS-ATTRIB-Befehl (außer den   *)
  11. (*  zusätzlichen Parametern.                                         *)
  12. (*  Verzeichnisse werden nicht angezeigt, aber im Hauptverzeichnis   *)
  13. (*  das Volume-Label (Attribut V)                                    *)
  14. (*===================================================================*)
  15.  
  16. PROGRAM FileAttribute;
  17.  
  18. USES
  19.   Crt, Dos, Cursor, ANSI, UPPER;
  20.  
  21. CONST
  22.   allfiles   : STRING[3] = '*.*';
  23.   sysfcount  = 9;
  24.   SystemFile : ARRAY[1..sysfcount] OF STRING[11] =
  25.               ('IO.SYS',     'MSDOS.SYS',             (* MS-DOS      *)
  26.                'IBMBIO.COM', 'IBMDOS.COM',            (* PC-DOS      *)
  27.                'OS2BOOT',    'OS2KRNL',   'OS2LDR',   (* OS/2 2.0    *)
  28.                'DRBIOS.SYS', 'DRBDOS.SYS');           (* DR-DOS 3.41 *)
  29.   copyrght   : STRING[52] = 'ATTRIB Version 2.00,' +
  30.                ' Copyright (c) 1993 te-wi Verlag';
  31. VAR
  32.   newattr, count, parlen     : BYTE;
  33.   drive                      : STRING[2];
  34.   CON                        : Text;
  35.   Parameter                  : ARRAY [1..20] OF STRING;
  36.   fcounter                   : WORD;
  37.   startpath, srcfile         : STRING;
  38.   deletea, deleter, deletes,
  39.   deleteh, seta, setr, sets,
  40.   seth, works, subs, sysmod,
  41.   ansiinst                   : BOOLEAN;
  42.  
  43. (*-------------------------------------------------------------------*)
  44. (*                   FUNKTIONEN und PROZEDUREN                       *)
  45. (*-------------------------------------------------------------------*)
  46.  
  47. PROCEDURE CheckForKey;
  48. VAR
  49.   ch : CHAR;
  50. BEGIN
  51.   IF KeyPressed THEN
  52.   BEGIN
  53.     ch := ReadKey;
  54.     IF ch IN [^C, ^S, ' '] THEN
  55.     BEGIN
  56.       IF ch = ^C THEN
  57.       BEGIN
  58.         WriteLn(CON, ^M^J'*** USERBREAK ***');
  59.         Close(CON);
  60.         Halt(1);
  61.       END
  62.       ELSE
  63.       IF (ch = ^S) OR (ch = ' ') THEN
  64.       BEGIN
  65.         AnsiYellow;
  66.         Write(CON, 'PAUSE --- Weiter'
  67.              + ' mit beliebiger Taste ...');
  68.         AnsiGray;
  69.         REPEAT
  70.           ch := ReadKey;
  71.           IF ch = Chr(0) THEN
  72.             IF KeyPressed THEN ch := ReadKey;
  73.         UNTIL ch <> '';
  74.         GotoXY(1, WhereY);
  75.         ClrEoL;
  76.       END;
  77.     END;
  78.   END;
  79. END;
  80.  
  81. (*-------------------------------------------------------------------*)
  82.  
  83. PROCEDURE TextOut;               (* Programmabhängiger Teil von Help *)
  84. BEGIN
  85.   TextAttr := LightGray;                  (* 2. Fenster für Schrift: *)
  86.   Window(2, 2, 79, 24);
  87.   TextAttr := Yellow;
  88.   WriteLn(' ':13, copyrght);
  89.   TextAttr := LightGray;
  90.   WriteLn(' ':8, 'Aufruf: ATTRIB [+/-AHRS] [d:]'+
  91.         '[\][DIR\]Dateien [/S] [/SYS] [/?]'+ ^M^J);
  92.   Write(' ':30);
  93.   TextAttr := 112;
  94.   WriteLn(' ':3, 'H I L F E', ' ':3);
  95.  
  96.   TextAttr := LightGray;
  97.   WriteLn(^M^J' ATTRIB ersetzt den DOS-ATTRIB-Befehl. Das '+
  98.           ' Programm  ist flexibler  als  das'^M^J +
  99.           ' Original-Programm.  Es sind beim Aufruf ver'+
  100.           'schiedene Parameter zu verwenden:'^M^J +
  101.           ' AHRS (in beliebiger Folge: Ändern des' +
  102.           ' A(rchiv),  H(idden),  R(eadOnly)  oder');
  103.   WriteLn(' S(ystemfile)-Attributes. Die Reihenfolge ist' +
  104.           ' beliebig.  Die  Attibute können'^M^J +
  105.           ' einzeln oder in Gruppen geändert werden. Wenn' +
  106.           ' vor das Attribut ein  "-"  ge-'^M^J +
  107.           ' stellt wird, wird das Attribut gelöscht, wird' +
  108.           ' ein "+" vorgestellt, wird  das');
  109.   WriteLn(' Attribut gesetzt. Es kann gleichzeitig ein' +
  110.           ' Attribut gesetzt  und ein anderes'^M^J +
  111.           ' gelöscht werden, wenn sie getrennt angegeben' +
  112.           ' werden. Der Parameter "/S" gibt'^M^J +
  113.           ' dem Programm an, daß der  Attributwechsel ' +
  114.           ' auch in allen Unterverzeichnissen');
  115.   WriteLn(' geführt werden soll. Die Parameter müssen' +
  116.           ' durch  Leerzeichen  getrennt sein.'^M^J +
  117.           ' ATTRIB ist nur auf Dateien,  nicht  auf ' +
  118.           ' Verzeichniseinträge  anwendbar, die');
  119.   WriteLn(' Platzhalter (*, ?) sind für Dateien,'+
  120.           ' nicht aber für Directories erlaubt.'^M^J +
  121.           ' ATTRIB/? oder ATTRIB ohne Parameter gibt' +
  122.           ' diesen Hilfebildschirm aus.'^M^J^J +
  123.           ' Hinweis: Die DOS-Dateien ' + SystemFile[1] +
  124.           '/' + SystemFile[2] + ' bzw. ' + SystemFile[3] +
  125.           '/' + SystemFile[4] + '  werden');
  126.   WriteLn(' aus Sicherheitsgründen von ATTRIB nur'+
  127.           ' geändert, wenn /SYS angegeben wird.');
  128. END;
  129.  
  130. PROCEDURE Help;
  131.  
  132. VAR
  133.   ScrSeg: WORD;
  134.   oldx,
  135.   oldy,
  136.   count    : BYTE;
  137.   ch       : CHAR;
  138.   scrtype  : BYTE; 
  139.   scrarray : ARRAY[0..3999] OF BYTE;                  (* BS-Speicher *)
  140.   attrib   : WORD;
  141.   Cursor   : WORD;
  142.   PROCEDURE SaveScreen;
  143.   VAR
  144.     scrofs : WORD;
  145.  (* Bildschirminhalt in dem ARRAY ScrArray speichern, Cursorposition *)
  146.  (* in OldX/OldY und altes Text-Attribut in attrib merken.           *)
  147.  (* Da das Fenster aus dem DOS gestartet wird, wurde auf das Sichern *)
  148.  (* der alten Fensterkoordinaten (WindMin/WindMax) verzichtet.       *)
  149.   BEGIN
  150.     oldx := WhereX;
  151.     oldy := WhereY;
  152.     attrib := TextAttr;
  153.     Move(Mem[scrseg:0], scrarray, 4000);
  154.    END;
  155.  
  156. (*-------------------------------------------------------------------*)
  157.  
  158.   PROCEDURE RestoreScreen;
  159.   VAR
  160.     scrofs : WORD;
  161.  (* Bildschirminhalt aus dem ARRAY ScrArray restaurieren, Cursor auf *)
  162.  (* OldX/OldY setzen und urspr. Text-Attribut aus attrib holen.      *)
  163.   BEGIN
  164.     Move(scrarray, Mem[scrseg:0], 4000);
  165.     TextAttr := attrib;
  166.     GotoXY(oldx, oldy);
  167.   END;
  168.  
  169. (*-------------------------------------------------------------------*)
  170.  
  171.   PROCEDURE DrawLine;
  172.   VAR
  173.     count: BYTE;
  174.   BEGIN
  175.     FOR count := 2 TO 79 DO Write(Chr(205));
  176.   END;
  177.  
  178. (*-------------------------------------------------------------------*)
  179.  
  180. BEGIN                                                (* Vorarbeiten: *)
  181.   scrtype := BYTE(Ptr(Seg0040, $0049)^);             (*   BS-Modus   *)
  182.   IF scrtype = 7 THEN ScrSeg := SegB000
  183.                  ELSE ScrSeg := SegB800;
  184.   SaveScreen;
  185.   IF scrtype IN [0..1, 4..6, 8..$50] THEN TextMode(CO80);
  186.   Cursor := StartCursor;
  187.   HideCursor;                                  (* Cursor ausschalten *)
  188.   Window(1, 1, 80, 25);                        (* Rahmen:            *)
  189.   TextAttr := LightGray;
  190.   GotoXY(1, 1);
  191.   TextAttr := Red;
  192.   Write(Chr(201));
  193.   DrawLine;
  194.   Write(Chr(187));
  195.   FOR count := 2 TO 24 DO Write(Chr(186), ' ':78, Chr(186));
  196.   Write(Chr(200));
  197.   DrawLine;
  198.       (* Letztes Zeichen direkt schreiben um Scrolling zu vermeiden: *)
  199.   MemW[ScrSeg:$F9E] := Red * $100 + 188;  (* HiByte := Farbe,        *)
  200.                                           (* LoByte := Ord(Zeichen)  *)
  201.                                           (* Hilfebildschirm:        *)
  202.   TextOut;                                (* Text holen und ausgeben *)
  203.   GotoXY(22, 23);
  204.   TextAttr := Yellow;
  205.   Write('Zurück zum DOS mit beliebiger Taste');
  206.   REPEAT                        (* Auf Taste warten und Eingabe ver- *)
  207.     ch := ReadKey;              (* schlucken. Bei 'KeyPressed' wird  *)
  208.   UNTIL ch <> '';               (* das Zeichen nicht verschluckt!    *)
  209.   IF ch = #0 THEN ch := ReadKey;
  210.   Window(1, 1, 80, 25);         (* Restaurierungen und Ende:         *)
  211.   IF scrtype IN [0, 1] THEN TextMode(scrtype);
  212.                    (* nur 40-Zeichen-Modi, nicht Grafik restaurieren *)
  213.   RestoreScreen;
  214.   SetCursor(StartCursor);           (* Original-Cursor restaurieren: *)
  215.   Halt(0);                          (* Programm abbrechen            *)
  216. END;
  217.  
  218. PROCEDURE ErrorHalt (s: STRING);
  219. BEGIN
  220.   AnsiWhite;
  221.   WriteLn(CON, s);
  222.   AnsiGray;
  223.   Close(CON);
  224.   Halt(1);
  225. END;
  226.  
  227. (*-------------------------------------------------------------------*)
  228.  
  229. PROCEDURE Parse(Input: STRING; VAR drive, startpath, srcfile:  STRING);
  230. VAR
  231.   len,
  232.   count,
  233.   position : BYTE;
  234.   actualdir,
  235.   dr       : STRING;
  236. BEGIN
  237.   dr := '';
  238.   drive := '';
  239.   startpath := '';
  240.   srcfile := '';
  241.  
  242.   IF Pos('\', Input) = 1 THEN
  243.   BEGIN
  244.     GetDir(0, dr);
  245.     drive := dr[1] + ':';
  246.     Input := drive + Input;
  247.     drive := '';
  248.   END;
  249.  
  250.   IF Length(Input) = 2 THEN
  251.     IF Input[2] = ':' THEN
  252.     BEGIN
  253.        drive := Input;
  254.        GetDir(Ord(Input[1]) - 64, startpath);
  255.        Delete(startpath, 1, 2);
  256.        srcfile := allfiles;
  257.        Exit;
  258.     END;
  259.  
  260.   IF Length(Input) = 3 THEN
  261.     IF Input[2] = ':' THEN
  262.       IF Input[3] = '\' THEN
  263.       BEGIN
  264.         drive := Input[1] + ':';
  265.         startpath := '\';
  266.         srcfile := allfiles;
  267.         Exit
  268.       END;
  269.  
  270.   IF (Length(Input) > 1) AND (Pos('\', Input) > 1) AND
  271.      (Pos(':', Input) = 0) THEN
  272.   BEGIN
  273.     GetDir(0, startpath);
  274.     drive := startpath[1] + ':';
  275.     Delete(startpath, 1, 2);
  276.     position := 0;
  277.     FOR count := 1 TO Length(Input) DO
  278.       IF Input[count] = '\' THEN position := count;
  279.     srcfile := Input;
  280.     Delete(srcfile, 1, position);
  281.     len := Length(startpath);
  282.     startpath := startpath + '\' + Input;
  283.     Delete(startpath, len + position  + 1,
  284.          Length(startpath) - position + 1);
  285.     Exit;
  286.   END;
  287.  
  288.   IF (Pos('\', Input) = 0) AND (Pos(':', Input) = 0) THEN
  289.   BEGIN
  290.     GetDir(0, startpath);
  291.     drive := startpath[1] + ':';
  292.     Delete(startpath, 1, 2);
  293.     srcfile := Input;
  294.     Exit;
  295.   END;
  296.  
  297.   IF (Input[2] = ':') AND
  298.      (Input[3] = '\') THEN
  299.   BEGIN
  300.     drive := Input[1] + ':';
  301.     startpath := Input;
  302.     IF startpath[Length(startpath)] = '\' THEN
  303.     BEGIN
  304.       Delete(startpath, 1, 2);
  305.       Delete(startpath, Length(startpath), 1);
  306.       srcfile := allfiles;
  307.       Exit;
  308.     END;
  309.     Delete(startpath, 1, 2);
  310.     IF Pos('\', startpath) > 0 THEN
  311.     BEGIN
  312.       position := 0;
  313.       FOR count := 1 TO Length(startpath) DO
  314.         IF startpath[count] = '\' THEN position := count;
  315.       IF position = Length(startpath) THEN
  316.       BEGIN
  317.          Delete(startpath, 2, Length(startpath) - 2);
  318.          Delete(startpath, Length(startpath) - 1, 1);
  319.          srcfile := allfiles;
  320.       END
  321.       ELSE
  322.       IF Pos('\', startpath) <> position THEN
  323.       BEGIN
  324.         srcfile := Copy(startpath, position + 1,
  325.                     Length(startpath) - position);
  326.         len := Length(startpath);
  327.         Delete(startpath, position, len - position + 1);
  328.       END
  329.       ELSE
  330.       BEGIN
  331.         srcfile := startpath;
  332.         startpath := '\';
  333.         srcfile := Copy(srcfile, 2, Length(srcfile) - 1);
  334.       END;
  335.     END;
  336.     Exit;
  337.   END;
  338.   IF (Input[2] = ':') AND (Input[3] <> '\') THEN
  339.   BEGIN
  340.     GetDir(Ord(UpCase(Input[1])) - 64, startpath);
  341.     drive := Input[1] + ':';
  342.     Delete(startpath, 1, 2);
  343.     srcfile := Copy(Input, 3, Length(Input) - 2);
  344.     Exit;
  345.   END;
  346.  
  347.   GetDir(0, startpath);
  348.   drive := startpath[1] + ':';
  349.  
  350.   Delete(startpath, 1, 2);
  351.   srcfile := Input;
  352.  
  353.   IF srcfile = startpath THEN srcfile := allfiles;
  354.   IF Pos(UpString(srcfile), startpath) > 0 THEN
  355.     Delete(srcfile, Pos(srcfile, startpath), Length(srcfile));
  356. END;
  357.  
  358. (*-------------------------------------------------------------------*)
  359.  
  360. PROCEDURE CheckParameters(VAR chg, subs: BOOLEAN);
  361. VAR
  362.   count: BYTE;
  363. BEGIN
  364.   chg     := FALSE; subs    := FALSE; deletea := FALSE;
  365.   deleter := FALSE; deletes := FALSE; deleteh := FALSE;
  366.   seta    := FALSE; setr    := FALSE; sets    := FALSE;
  367.   seth    := FALSE; srcfile := '';    sysmod  := FALSE;
  368.  
  369.   FOR count := 1 TO ParamCount DO
  370.   BEGIN
  371.     IF Pos('/?', Parameter[count]) > 0 THEN Help;
  372.     IF NOT (Parameter[count][1] IN ['-', '+', '/']) THEN
  373.     BEGIN
  374.       Parse(Parameter[count], drive, startpath, srcfile);
  375.       IF startpath[Length(startpath)] <> '\' THEN
  376.         startpath := startpath + '\';
  377.       startpath := drive + startpath;
  378.     END
  379.     ELSE
  380.     IF Parameter[count][1] IN ['-', '+'] THEN
  381.     BEGIN
  382.       IF Parameter[count][1] = '-' THEN
  383.       BEGIN
  384.         IF Pos('A', Parameter[count]) > 1 THEN deletea := TRUE;
  385.         IF Pos('H', Parameter[count]) > 1 THEN deleteh := TRUE;
  386.         IF Pos('R', Parameter[count]) > 1 THEN deleter := TRUE;
  387.         IF Pos('S', Parameter[count]) > 1 THEN deletes := TRUE;
  388.       END
  389.       ELSE
  390.       BEGIN
  391.         IF Pos('A', Parameter[count]) > 1 THEN seta := TRUE;
  392.         IF Pos('H', Parameter[count]) > 1 THEN seth := TRUE;
  393.         IF Pos('R', Parameter[count]) > 1 THEN setr := TRUE;
  394.         IF Pos('S', Parameter[count]) > 1 THEN sets := TRUE;
  395.       END;
  396.       chg := TRUE;
  397.     END
  398.     ELSE IF Parameter[count][1] = '/' THEN
  399.     BEGIN
  400.       IF Parameter[count] = '/S' THEN subs := TRUE;
  401.       IF Parameter[count] = '/SYS' THEN sysmod := TRUE;
  402.     END;
  403.   END;
  404. END;
  405.  
  406. (*-------------------------------------------------------------------*)
  407.  
  408. PROCEDURE ShowAttributes(FRecord: SearchRec; path: STRING);
  409. VAR
  410.   fname   : STRING[12];
  411.   arcdisp : STRING[9];
  412.   i       : BYTE;
  413. BEGIN
  414.   IF (NOT sysmod) AND works THEN FOR i := 1 TO sysfcount DO
  415.     IF (FRecord.Name = SystemFile[i]) THEN Exit;
  416.   IF ((NOT sysmod) AND works) THEN
  417.     IF FRecord.Attr IN [$8..$F, $28..$2F] THEN Exit;
  418.   arcdisp := '         ';
  419.   IF FRecord.Attr AND VolumeID = VolumeID THEN arcdisp[1] := 'V';
  420.   IF FRecord.Attr AND Archive  = Archive  THEN arcdisp[3] := 'A';
  421.   IF FRecord.Attr AND ReadOnly = ReadOnly THEN arcdisp[5] := 'R';
  422.   IF FRecord.Attr AND Hidden   = Hidden   THEN arcdisp[7] := 'H';
  423.   IF FRecord.Attr AND SysFile  = SysFile  THEN arcdisp[9] := 'S';
  424.   fname := FRecord.Name;
  425.   IF FRecord.Attr AND VolumeID = VolumeID THEN
  426.     IF Pos('.', fname) > 0 THEN Delete(fname, Pos('.', fname), 1);
  427.   IF works THEN
  428.   BEGIN
  429.     IF deletea THEN Write('-A') ELSE IF seta THEN Write('+A')
  430.                ELSE Write(' ':2);
  431.     IF deleter THEN Write('-R') ELSE IF setr THEN Write('+R')
  432.                ELSE Write(' ':2);
  433.     IF deleteh THEN Write('-H') ELSE IF seth THEN Write('+H')
  434.                ELSE Write(' ':2);
  435.     IF deletes THEN Write('-S') ELSE IF sets THEN Write('+S')
  436.     ELSE Write(' ':2);
  437.     WriteLn(' --> ' + path + fname);
  438.   END
  439.   ELSE
  440.   BEGIN
  441.     IF FRecord.Attr AND VolumeID = VolumeID THEN
  442.       WriteLn(CON, arcdisp, ' ':4, fname) (*für Volume Pfad weglassen*)
  443.     ELSE
  444.       WriteLn(CON, arcdisp, ' ':4, path, fname);
  445.     Inc(fcounter);
  446.   END;
  447. END;
  448.  
  449. (*-------------------------------------------------------------------*)
  450.  
  451. PROCEDURE ChangeAttributes(sr: SearchRec; path: STRING);
  452. VAR
  453.   f : FILE;
  454.   i : INTEGER;
  455. BEGIN
  456.   FOR i := 1 TO sysfcount DO
  457.   BEGIN
  458.     IF (sr.Name = SystemFile[i]) AND (sysmod = FALSE) THEN Exit;
  459.   END;
  460.   newattr := sr.Attr;
  461.   IF sr.Attr AND $20 = 0   THEN IF seta    THEN Inc(newattr, $20);
  462.   IF sr.Attr AND $20 = $20 THEN IF deletea THEN Dec(newattr, $20);
  463.   IF sr.Attr AND $01 = 0   THEN IF setr    THEN Inc(newattr, $01);
  464.   IF sr.Attr AND $01 = $01 THEN IF deleter THEN Dec(newattr, $01);
  465.   IF sr.Attr AND $02 = 0   THEN IF seth    THEN Inc(newattr, $02);
  466.   IF sr.Attr AND $02 = $02 THEN IF deleteh THEN Dec(newattr, $02);
  467.   IF sr.Attr AND $04 = 0   THEN IF sets    THEN Inc(newattr, $04);
  468.   IF sr.Attr AND $04 = $04 THEN IF deletes THEN Dec(newattr, $04);
  469.   Assign(f, path + sr.Name);
  470.   SetFAttr(f, newattr);
  471.   Inc(fcounter);
  472. END;
  473.  
  474. (*-------------------------------------------------------------------*)
  475.  
  476. PROCEDURE SearchDirectories(path, fname: STRING);
  477. VAR
  478.   sr : SearchRec;
  479. BEGIN
  480.   IF Length(path) > 0 THEN             (* Suche nach Dateieinträgen: *)
  481.     IF path[Length(path)] <> '\' THEN path := path + '\';
  482.   sr.Name := '';
  483.   FindFirst(path + fname, Anyfile MOD Directory, sr);
  484.   IF sr.Name <> '' THEN WriteLn(CON, '');
  485.   WHILE DosError = 0 DO
  486.   BEGIN
  487.     CheckForKey;
  488.     IF sr.Attr AND Directory = 0 THEN
  489.     BEGIN
  490.       IF works THEN ChangeAttributes(sr, path);
  491.       ShowAttributes(sr, path)
  492.     END;
  493.     FindNext(sr);
  494.   END;
  495.                                        (* Suche nach Verzeichnissen: *)
  496.   FindFirst(path + allfiles, Directory, sr);
  497.   WHILE DosError = 0 DO
  498.   BEGIN
  499.     CheckForKey;
  500.     IF (sr.Attr AND Directory = Directory) AND (sr.Name[1] <> '.') THEN
  501.       SearchDirectories(path + sr.Name, fname);
  502.     FindNext(sr);
  503.   END;
  504. END;
  505.  
  506. (*-------------------------------------------------------------------*)
  507.  
  508. PROCEDURE OnlyOneDirectory (path, srcfile: STRING);
  509. VAR
  510.   sr : SearchRec;
  511. BEGIN
  512.   FindFirst(path + srcfile, $3F, sr);
  513.   WHILE DosError = 0 DO
  514.   BEGIN
  515.     IF sr.Attr IN [$0..$E, $20..$2E] THEN
  516.     BEGIN
  517.       CheckForKey;
  518.       IF works THEN ChangeAttributes(sr, path);
  519.       ShowAttributes(sr, path);
  520.     END;
  521.     FindNext(sr)
  522.   END;
  523. END;
  524.  
  525. (*-------------------------------------------------------------------*)
  526. (*                            Hauptprogramm                          *)
  527. (*-------------------------------------------------------------------*)
  528.  
  529. BEGIN
  530.   CheckBreak := FALSE;
  531.   Assign(CON, '');
  532.   Append(CON);
  533.   ansiinst := ANSISYS;
  534.   IF ParamCount = 0 THEN Help;         (* Hilfe wenn kein Parameter: *)
  535.   FOR count := 1 TO 20 DO
  536.     Parameter[count] := '';                          (* Müll löschen *)
  537.   FOR count := 1 TO ParamCount DO
  538.     Parameter[count] := UpString(ParamStr(count));
  539.   IF Lo(DosVersion) < 3 THEN ErrorHalt('Falsche DOS-Version');
  540.   fcounter := 0;
  541.   CheckParameters(works, subs);
  542.   IF srcfile = '' THEN ErrorHalt('Keine Datei(en) angegeben');
  543.   IF (srcfile = SystemFile[1]) OR (srcfile = SystemFile[2]) OR
  544.      (srcfile = SystemFile[3]) OR (srcfile = SystemFile[4]) THEN
  545.     IF NOT sysmod THEN
  546.       ErrorHalt(^M^J'Systemdateien werden nicht geändert !'^M^J +
  547.                 'Wenn Sie Systemdateien ändern wollen,'^M^J +
  548.                 'müssen Sie zusätzlich die Option /SYS'^M^J +
  549.                 'angeben.');
  550.   AnsiYellow;
  551.   WriteLn(CON, 'Turbo ' + copyrght + ^J);
  552.   AnsiGray;
  553.   IF subs THEN SearchDirectories(startpath, srcfile)
  554.           ELSE OnlyOneDirectory(startpath, srcfile);
  555.   IF fcounter = 0 THEN
  556.     ErrorHalt('Datei '+ srcfile + ' nicht gefunden.')
  557.   ELSE
  558.   BEGIN
  559.     Write(CON, ^M^J, fcounter, ' Datei');
  560.     IF fcounter > 1 THEN Write (CON, 'en');
  561.     IF works THEN WriteLn(CON, ' bearbeitet.')
  562.              ELSE WriteLn(CON, ' angezeigt.');
  563.   END;
  564.   Close(CON);
  565. END.
  566.  
  567. (*===================================================================*)
  568.