home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / das_buch / dos / ff.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-05-13  |  12.5 KB  |  394 lines
  1. {$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,P-,Q-,R-,S-,T-,V-,X-,M 65520,0,0}
  2.                  (* rekursive Prozedur SearchDirectories -> MaxStack *)
  3. (*===================================================================*)
  4. (*                           FF.PAS Version 1.0                      *)
  5. (*                    Copyright (C) 1993 te-wi Verlag                *)
  6. (*           Compiler: Borland/Turbo Pascal Real Mode Target         *)
  7. (*===================================================================*)
  8. (* Funktion:                                                         *)
  9. (* vollständige Dateisuche auf einem Laufwerk über die Verzeichnis-  *)
  10. (* grenzen hinaus. Es kann nicht nach Directories gesucht werden.    *)
  11. (*===================================================================*)
  12.  
  13. PROGRAM FileFinder;
  14.  
  15. USES
  16.   Crt, Dos, DosUtil, Hex, ANSI, Cursor, UPPER;
  17.  
  18. CONST
  19.   CtrlC      = Chr(3);
  20.   LF         = Chr(10);
  21.   CRLF       = Chr(13) + LF;
  22.   CtrlS      = Chr(19);
  23.   ESC        = Chr(27);
  24.   invers     = 112;
  25.  
  26.   allfiles   : STRING[3] = '*.*';
  27.   copyrght   : STRING[51] = 'FileFinder V. 1.00,' +
  28.                             ' Copyright (c) 1993 te-wi Verlag';
  29.   MonName    : ARRAY[1..12] OF STRING[4] =
  30.                     ('Jan.','Feb.','März','Apr.','Mai ','Juni',
  31.                      'Juli','Aug.','Sep.','Okt.','Nov.','Dez.');
  32.  
  33. VAR
  34.   count      : BYTE;
  35.   CON        : Text;
  36.   drive,
  37.   parameter  : STRING;
  38.   fcounter   : WORD;
  39.   ansiinst   : BOOLEAN;
  40.  
  41. (*-------------------------------------------------------------------*)
  42. (*                     FUNKTIONEN und PROZEDUREN                     *)
  43. (*-------------------------------------------------------------------*)
  44.  
  45. PROCEDURE CheckForKey;
  46. VAR
  47.   ch : CHAR;
  48. BEGIN
  49.   IF KeyPressed THEN
  50.   BEGIN
  51.     ch := ReadKey;
  52.     IF ch IN [CtrlC, CtrlS, ' '] THEN
  53.     BEGIN
  54.       IF ch = CtrlC THEN
  55.       BEGIN
  56.         WriteLn(CON, CRLF + '*** USERBREAK ***');
  57.         Close(CON);
  58.         Halt(1);
  59.       END
  60.       ELSE
  61.       IF (ch = CtrlS) OR (ch = ' ') THEN
  62.       BEGIN
  63.         AnsiYellow;
  64.         Write(CON, 'PAUSE --- Weiter mit beliebiger Taste ...');
  65.         AnsiGray;
  66.         REPEAT
  67.           ch := ReadKey;
  68.           IF ch = Chr(0) THEN
  69.             IF KeyPressed THEN ch := ReadKey;
  70.         UNTIL ch <> '';
  71.         GotoXY(1, WhereY);
  72.         ClrEoL;
  73.       END;
  74.     END;
  75.   END;
  76. END;
  77.  
  78. (*-------------------------------------------------------------------*)
  79.  
  80. PROCEDURE TextOut;               (* Programmabhängiger Teil von Help *)
  81. BEGIN
  82.   TextAttr := LightGray;
  83.   Window(2, 2, 79, 24);
  84.   TextAttr := Yellow;
  85.   WriteLn(' ':13, copyrght);
  86.   TextAttr := LightGray;
  87.   WriteLn(' ':12, 'Aufruf: FF [d:]datei[.ext]' +
  88.                   ' [[d:]datei[.ext] ... ] [/?]'+ CRLF);
  89.   Write(' ':30);
  90.   TextAttr := 112;
  91.   WriteLn(' ':3, 'H I L F E', ' ':3);
  92.   TextAttr := LightGray;
  93.   WriteLn(LF +
  94.           ' FileFind sucht alle passenden Dateien' +
  95.           ' auf einem Laufwerk und  zeigt  sie an.' + CRLF +
  96.           ' Es kann ein anderes als das  aktuelle' +
  97.           ' Laufwerk  durchsucht  werden, wenn zum' + CRLF +
  98.           ' Dateinamen die Laufwerkskennung angegeben wird.');
  99.   WriteLn(' Im Gegensatz zu FileFile der Norton' +
  100.           ' Utilities können bei einem Aufruf unter-' + CRLF +
  101.           ' schiedliche Dateien auch auf verschiedenen' +
  102.           ' Laufwerken gesucht werden,  z. B.' + CRLF +
  103.           ' FF A:*.sys C:*.sys A:*. Wird kein Laufwerk' +
  104.           ' angegeben wird, wird auf  dem ak-');
  105.   WriteLn(' tuellen bzw. dem vorigen Laufwerk gesucht.' +
  106.           ' "FF A:*.exe *.com" sucht auch die' + CRLF +
  107.           ' .COM-Dateien auf Laufwerk A:. Wenn Dateien auf' +
  108.           ' verschiedenen Laufwerken  ge-');
  109.   WriteLn(' sucht werden sollen, muß, wenn zuerst auf einem' +
  110.           ' anderen und dann auf dem ak-' + CRLF +
  111.           ' tuellen Laufwerk gesucht werden soll, auch' +
  112.           ' für  das  aktuelle  Laufwerk  die' + CRLF +
  113.           ' Laufwerkskennung angegeben werden.');
  114.   WriteLn(' Wie beim DOS-DIR-Befehl wird, wenn  keine ' +
  115.           ' Dateiendung  angegeben wird, ".*"' + CRLF +
  116.           ' angehängt. Sollen Dateien ohne Endung gesucht '+
  117.           ' werden, muß an den Dateinamen');
  118.   WriteLn(' ein Punkt angehängt werden, damit das Programm'+
  119.           ' weiß,  daß das Anhängen einer' + CRLF +
  120.           ' Endung nicht gewünscht wird.');
  121.   WriteLn(' Wenn FF ohne Parameter oder FF /?  aufgerufen' +
  122.           ' wird,  wird  dieser Hilfebild-'+ CRLF +
  123.           ' schirm angezeigt.');
  124. END;
  125.  
  126. (*-------------------------------------------------------------------*)
  127.  
  128. PROCEDURE Help;
  129.  
  130. VAR
  131.   oldx,
  132.   oldy,
  133.   count    : BYTE;
  134.   ch       : CHAR;
  135.   scrtype  : BYTE;
  136.   scrarray : ARRAY[0..3999] OF BYTE;                  (* BS-Speicher *)
  137.   scrseg,
  138.   attrib   : WORD;
  139.   Cursor   : WORD;
  140.  
  141.   PROCEDURE SaveScreen;
  142.  (* Bildschirminhalt in dem ARRAY ScrArray speichern, Cursorposition *)
  143.  (* in OldX/OldY und altes Text-Attribut in attrib merken.           *)
  144.  (* Da das Fenster aus dem DOS gestartet wird, wurde auf das Sichern *)
  145.  (* der alten Fensterkoordinaten (WindMin/WindMax) verzichtet.       *)
  146.   BEGIN
  147.     oldx := WhereX;
  148.     oldy := WhereY;
  149.     attrib := TextAttr;
  150.     Move(Mem[scrseg:0], scrarray, 4000);
  151.    END;
  152.  
  153. (*-------------------------------------------------------------------*)
  154.  
  155.   PROCEDURE RestoreScreen;
  156.  (* Bildschirminhalt aus dem ARRAY ScrArray restaurieren, Cursor auf *)
  157.  (* OldX/OldY setzen und urspr. Text-Attribut aus attrib holen.      *)
  158.   BEGIN
  159.     Move(scrarray, Mem[scrseg:0], 4000);
  160.     TextAttr := attrib;
  161.     GotoXY(oldx, oldy);
  162.   END;
  163.  
  164. (*-------------------------------------------------------------------*)
  165.  
  166.   PROCEDURE DrawLine;
  167.   VAR
  168.     count: BYTE;
  169.   BEGIN
  170.     FOR count := 2 TO 79 DO Write(Chr(205));
  171.   END;
  172.  
  173. (*-------------------------------------------------------------------*)
  174.  
  175. BEGIN                                                (* Vorarbeiten: *)
  176.   ScrType := BYTE(Ptr(Seg0040, $0049)^);             (* BS-Modus     *)
  177.   IF ScrType = 7 THEN ScrSeg := SegB000
  178.                  ELSE ScrSeg := SegB800;
  179.  
  180.   SaveScreen;
  181.   IF ScrType IN [0..1, 4..6, 8..$FF] THEN TextMode(CO80);
  182.   Cursor := StartCursor;
  183.   HideCursor;                                  (* Cursor ausschalten *)
  184.   Window(1, 1, 80, 25);                        (* Rahmen:            *)
  185.   TextAttr := LightGray;
  186.   GotoXY(1, 1);
  187.   TextAttr := Red;
  188.   Write(Chr(201));
  189.   DrawLine;
  190.   Write(Chr(187));
  191.   FOR count := 2 TO 24 DO
  192.     Write(Chr(186), ' ':78, Chr(186));
  193.   Write(Chr(200));
  194.   DrawLine;
  195.       (* Letztes Zeichen direkt schreiben um Scrolling zu vermeiden: *)
  196.   MemW[ScrSeg:$F9E] := Red * $100 + 188;  (* HiByte = Farbe,         *)
  197.                                           (* LoByte = Ord(Zeichen)   *)
  198.                                           (* Hilfebildschirm:        *)
  199.   TextOut;                                (* Text holen und ausgeben *)
  200.   GotoXY(22, 23);
  201.   TextAttr := Yellow;
  202.   Write('Zurück zum DOS mit beliebiger Taste');
  203.   REPEAT                        (* Auf Taste warten und Eingabe ver- *)
  204.     ch := ReadKey;              (* schlucken. Bei 'KeyPressed' wird  *)
  205.   UNTIL ch <> '';               (* das Zeichen nicht verschluckt!    *)
  206.   IF ch = #0 THEN ch := ReadKey;
  207.   Window(1, 1, 80, 25);                 (* Restaurierungen und Ende: *)
  208.   IF ScrType IN [0, 1] THEN TextMode(ScrType);
  209.                    (* nur 40-Zeichen-Modi, nicht Grafik restaurieren *)
  210.   RestoreScreen;
  211.  
  212.   SetCursor(StartCursor);           (* Original-Cursor restaurieren: *)
  213.   Halt(0);                          (* Programm abbrechen            *)
  214. END;
  215.  
  216. (*-------------------------------------------------------------------*)
  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 ShowFiles(sr: SearchRec; path: STRING);
  230. VAR
  231.   arcdisp : STRING[9];
  232.   DateRec : DateTime;
  233.   MinStr,
  234.   MonStr   : STRING[2];
  235.   YearStr  : STRING[4];
  236.   lenStr,
  237.   insertStr,
  238.   fname,
  239.   fext     : STRING;
  240.   len      : BYTE;
  241.  
  242. BEGIN
  243.   IF sr.Attr IN [$8..$F, $28..$2F] THEN
  244.     IF Pos('.', sr.Name) > 0 THEN
  245.       Delete(sr.Name, Pos('.', sr.Name), 1);
  246.   IF Pos('.',sr.Name) > 0 THEN
  247.   BEGIN
  248.     fname := Copy(sr.Name, 1, Pos('.', sr.Name) - 1);
  249.     fext  := sr.Name;
  250.     Delete(fext, 1, Pos('.', fext));
  251.   END
  252.   ELSE
  253.   BEGIN
  254.     fname := sr.Name;
  255.     fext := '';
  256.   END;
  257.   Write(CON,' ':5, fname, ' ':11 - Length(fname),
  258.                     fext, ' ': 5 - Length(fext));
  259.  
  260.   arcdisp := '    ';
  261.   IF sr.Attr AND Archive  = Archive  THEN arcdisp[1] := 'A';
  262.   IF sr.Attr AND ReadOnly = ReadOnly THEN arcdisp[2] := 'R';
  263.   IF sr.Attr AND Hidden   = Hidden   THEN arcdisp[3] := 'H';
  264.   IF sr.Attr AND SysFile  = SysFile  THEN arcdisp[4] := 'S';
  265.   Write(CON, ' ', arcdisp);
  266.   IF sr.Attr AND VolumeID = VolumeID THEN
  267.     Write(CON,' ':4,'Volume Label')
  268.   ELSE
  269.   BEGIN
  270.     Str(sr.Size, lenStr);
  271.     IF Length(lenStr) > 3 THEN
  272.     BEGIN
  273.       insertStr := '.';
  274.       len := Length(lenStr) - 2;
  275.       Insert(insertStr, lenStr, len);
  276.       IF Length(lenStr) > 7 THEN
  277.       BEGIN
  278.         len := Length(lenStr) - 6;
  279.         Insert(insertStr, lenStr, len);
  280.       END;
  281.     END;
  282.     Write (CON, lenStr:10, ' Bytes');
  283.   END;
  284.   WriteLn(CON, '');
  285.   Inc(fcounter);
  286. END;
  287.  
  288. (*-------------------------------------------------------------------*)
  289.  
  290. PROCEDURE SearchDirectories(path, fname: STRING);
  291. VAR
  292.   SRecord : SearchRec;
  293.   fle     : FILE;
  294.   ShowPath: STRING;
  295. BEGIN
  296.   IF Length(path) > 0 THEN                    (* Suche nach Dateien: *)
  297.     IF path[Length(path)] <> '\' THEN
  298.       path := path + '\';
  299.   SRecord.Name := '';
  300.   FindFirst(path + fname, Anyfile MOD Directory, SRecord);
  301.  
  302.   IF SRecord.Name <> '' THEN
  303.   BEGIN
  304.     IF Length(path)  > 3 THEN
  305.       ShowPath := Copy(path, 1, Length(path) - 1)
  306.     ELSE ShowPath := path;
  307.     Write(CON, ShowPath);
  308.     IF Length(ShowPath) = 3 THEN
  309.       WriteLn(CON, '  ', ReadDiskIDNumber(ShowPath[1]), ' ':17,
  310.                    'Datenträger-Nummer')
  311.     ELSE
  312.       WriteLn(CON, '');
  313.   END;
  314.  
  315.   WHILE DosError = 0 DO
  316.   BEGIN
  317.     CheckForKey;
  318.     IF SRecord.Attr IN [$0..$E, $20..$2E] THEN
  319.       ShowFiles(SRecord, path);
  320.     FindNext(SRecord);
  321.   END;
  322.                                        (* Suche nach Verzeichnissen: *)
  323.   FindFirst(path + allfiles, Directory, SRecord);
  324.   WHILE DosError = 0 DO
  325.   BEGIN
  326.     CheckForKey;
  327.     IF (SRecord.Attr AND Directory <> 0) AND
  328.        (SRecord.Name[1] <> '.') THEN
  329.       SearchDirectories(path + SRecord.Name, fname);
  330.     FindNext(SRecord);
  331.   END;
  332. END;
  333.  
  334. (*-------------------------------------------------------------------*)
  335. (*                          Hauptprogramm                            *)
  336. (*-------------------------------------------------------------------*)
  337. BEGIN
  338.   CheckBreak := FALSE;
  339.  
  340.   IF (ParamCount = 0) OR (ParamStr(1) = '/?')
  341.     THEN Help;
  342.  
  343.   Assign (CON, '');
  344.   Append (CON);
  345.   ansiinst := AnsiSys;
  346.  
  347.   IF Lo(DosVersion) < 3 THEN
  348.     ErrorHalt('Falsche DOS-Version');
  349.  
  350.   fcounter := 0;
  351.   drive := '';
  352.   AnsiYellow;
  353.   WriteLn(CON,'FF - Turbo '+ copyrght + LF);
  354.   AnsiGray;
  355.   FOR count := 1 TO ParamCount DO
  356.   (*  Abarbeiten aller in der Kommandozeile angegebenen Dateinamen:  *)
  357.   BEGIN
  358.     parameter := ParamStr(count);
  359.     parameter := UpString(parameter);
  360.     IF Pos('.', parameter) = Length(parameter) THEN
  361.        Delete(parameter,Length(parameter),1)                 (* »*.« *)
  362.     ELSE
  363.     IF Pos('.', parameter) = 0 THEN                          (* »*«  *)
  364.       parameter := parameter + '.*';
  365.  
  366.     IF Pos(':', parameter) > 0 THEN                          (* D:.. *)
  367.     BEGIN
  368.       drive := parameter[1] + ':';
  369.       Delete(parameter, 1, 2);
  370.     END;
  371.     IF drive = '' THEN                     (* nur beim ersten Namen, *)
  372.     BEGIN                                  (* sonst ist drive <> ''* *)
  373.       GetDir(0, drive);
  374.       Delete(drive, 3, Length(drive) - 2);
  375.     END;
  376.     WHILE Pos('\', parameter) > 0 DO                  (* User-Fehler *)
  377.        Delete(parameter, 1, Pos('\', parameter));
  378.     IF parameter = '' THEN parameter := '*.*';
  379.     SearchDirectories(drive + '\', parameter);
  380.   END;
  381.  
  382.   IF fcounter = 0 THEN
  383.     ErrorHalt('Keine passenden Dateien für ' + drive + '\' + parameter
  384.             + ' gefunden.')
  385.   ELSE
  386.   BEGIN
  387.     Write(CON, CRLF, fcounter, ' Datei');
  388.     IF fcounter > 1 THEN Write(CON, 'en');
  389.     WriteLn(CON, ' gefunden.');
  390.   END;
  391.   Close(CON);
  392. END.
  393. (*-------------------------------------------------------------------*)
  394.