home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / das_buch / dos / df.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-05-13  |  10.7 KB  |  357 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. (*                       DATEFIND.PAS Version 1.0                    *)
  5. (*                    Copyright (C) 1993 te-wi Verlag                *)
  6. (*           Compiler: Borland/Turbo Pascal Real Mode Target         *)
  7. (*===================================================================*)
  8.  
  9. PROGRAM DateFind; (* Gibt alle Dateien dieses Tages aus *)
  10.  
  11. USES
  12.   Crt, Dos, UPPER, Cursor, ANSI;
  13.  
  14. CONST
  15.   allfiles   : STRING[3] = '*.*';
  16.   copyrght   : STRING[49] = 'DateFind V. 1.00,' +
  17.                ' Copyright (c) 1993 te-wi Verlag';
  18.   MonName    : ARRAY[1..12] OF STRING[4] =
  19.                ('Jan.','Feb.','März','Apr.','Mai ','Juni',
  20.                 'Juli','Aug.','Sep.','Okt.','Nov.','Dez.');
  21.  
  22. VAR
  23.   count      : BYTE;
  24.   CON        : Text;
  25.   drive,
  26.   parameter  : STRING;
  27.   fcounter   : WORD;
  28.   ansiinst   : BOOLEAN;
  29.   Year,
  30.   Month,
  31.   Day,
  32.   DayofWeek  : WORD;
  33.  
  34. (*-------------------------------------------------------------------*)
  35. (*                       FUNKTIONEN und PROZEDUREN                   *)
  36. (*-------------------------------------------------------------------*)
  37.  
  38. PROCEDURE CheckForKey;
  39. VAR
  40.   ch : CHAR;
  41. BEGIN
  42.   IF KeyPressed THEN
  43.   BEGIN
  44.     ch := ReadKey;
  45.     IF ch IN [^C, ^S, ' '] THEN
  46.     BEGIN
  47.       IF ch = ^C THEN
  48.       BEGIN
  49.         WriteLn(CON, ^M^J'*** USERBREAK ***');
  50.         Close(CON);
  51.         Halt(1);
  52.       END
  53.       ELSE
  54.       IF (ch = ^S) OR (ch = ' ') THEN
  55.       BEGIN
  56.         AnsiYellow;
  57.         Write(CON, 'PAUSE --- Weiter'
  58.         + ' mit beliebiger Taste ...');
  59.         AnsiGray;
  60.         REPEAT
  61.           ch := ReadKey;
  62.           IF ch = Chr(0) THEN
  63.             IF KeyPressed THEN ch := ReadKey;
  64.         UNTIL ch <> '';
  65.         GotoXY(1, WhereY);
  66.         ClrEoL;
  67.       END;
  68.     END;
  69.   END;
  70. END;
  71.  
  72. (*-------------------------------------------------------------------*)
  73.  
  74. PROCEDURE TextOut;               (* Programmabhängiger Teil von Help *)
  75. BEGIN
  76.   TextAttr := LightGray;
  77.   Window(2, 2, 79, 24);
  78.   TextAttr := Yellow;
  79.   WriteLn(' ':13, copyrght + ^J);
  80.   TextAttr := LightGray;
  81.   WriteLn(' ':31, 'Aufruf: DF d:'^M^J^J);
  82.   Write(' ':30);
  83.   TextAttr := 112;
  84.   WriteLn(' ':3, 'H I L F E', ' ':3);
  85.   TextAttr := LightGray;
  86.   WriteLn(^J^J' DateFind zeigt alle Dateien mit heutigem ' +
  87.           'Erstellungsdatum auf einem Laufwerk  an.  Es kann ein '+
  88.           'anderes als das aktuelle  Laufwerk durchsucht werden,' +
  89.           '  wenn  auf der Kommandozeile die entsprechende ' +
  90.           'Laufwerkskennung angegeben wird.' + ^M^J);
  91.   WriteLn(' Wenn DF ohne Parameter oder DF /?  aufgerufen'  +
  92.           ' wird,  wird  dieser Hilfebild-'^M^J' schirm angezeigt.');
  93. END;
  94.  
  95. PROCEDURE Help;
  96.   
  97. VAR
  98.   oldx,
  99.   oldy,
  100.   count    : BYTE;
  101.   ch       : CHAR;
  102.   scrtype  : BYTE;
  103.   scrarray : ARRAY[0..3999] OF BYTE;                  (* BS-Speicher *)
  104.   scrseg   : WORD;
  105.   attrib   : WORD;
  106.   Cursor   : WORD;
  107.  
  108.   PROCEDURE SaveScreen;
  109.  (* Bildschirminhalt in dem ARRAY ScrArray speichern, Cursorposition *)
  110.  (* in OldX/OldY und altes Text-Attribut in attrib merken.           *)
  111.  (* Da das Fenster aus dem DOS gestartet wird, wurde auf das Sichern *)
  112.  (* der alten Fensterkoordinaten (WindMin/WindMax) verzichtet.       *)
  113.   BEGIN
  114.     oldx := WhereX;
  115.     oldy := WhereY;
  116.     attrib := TextAttr;
  117.     Move(Mem[scrseg:0], scrarray, 4000);
  118.    END;
  119.  
  120. (*-------------------------------------------------------------------*)
  121.  
  122.   PROCEDURE RestoreScreen;
  123.  (* Bildschirminhalt aus dem ARRAY ScrArray restaurieren, Cursor auf *)
  124.  (* OldX/OldY setzen und urspr. Text-Attribut aus attrib holen.      *)
  125.   BEGIN
  126.     Move(scrarray, Mem[scrseg:0], 4000);
  127.     TextAttr := attrib;
  128.     GotoXY(oldx, oldy);
  129.   END;
  130.  
  131. (*-------------------------------------------------------------------*)
  132.  
  133.   PROCEDURE DrawLine;
  134.   VAR
  135.     count: BYTE;
  136.   BEGIN
  137.     FOR count := 2 TO 79 DO Write(Chr(205));
  138.   END;
  139.  
  140. (*-------------------------------------------------------------------*)
  141.  
  142. BEGIN                                                (* Vorarbeiten: *)
  143.   scrtype := BYTE(Ptr(Seg0040, $0049)^);             (* BS-Modus     *)
  144.   IF scrtype = 7 THEN scrseg := SegB000
  145.                  ELSE scrseg := SegB800;
  146.   SaveScreen;
  147.   IF scrtype IN [0..1, 4..6, 8..$50] THEN
  148.     TextMode(CO80);
  149.   Cursor := StartCursor;
  150.   HideCursor;                                  (* Cursor ausschalten *)
  151.   Window(1, 1, 80, 25);                        (* Rahmen:            *)
  152.   TextAttr := LightGray;
  153.   GotoXY(1, 1);
  154.   TextAttr := Red;
  155.   Write(Chr(201));
  156.   DrawLine;
  157.   Write(Chr(187));
  158.   FOR count := 2 TO 24 DO
  159.     Write(Chr(186), ' ':78, Chr(186));
  160.   Write(Chr(200));
  161.   DrawLine;
  162.       (* Letztes Zeichen direkt schreiben um Scrolling zu vermeiden: *)
  163.   MemW[scrseg:$F9E] := Red * $100 + 188;  (* HiByte = Farbe,         *)
  164.                                           (* LoByte = Ord(Zeichen)   *)
  165.                                           (* Hilfebildschirm:        *)
  166.   TextOut;                                (* Text holen und ausgeben *)
  167.   GotoXY(22, 23);
  168.   TextAttr := Yellow;
  169.   Write('Zurück zum DOS mit beliebiger Taste');
  170.   REPEAT                        (* Auf Taste warten und Eingabe ver- *)
  171.     ch := ReadKey;              (* schlucken. Bei 'KeyPressed' wird  *)
  172.   UNTIL ch <> '';               (* das Zeichen nicht verschluckt!    *)
  173.   IF ch = #0 THEN ch := ReadKey;
  174.   Window(1, 1, 80, 25);         (* Restaurierungen und Ende:         *)
  175.   IF scrtype IN [0, 1] THEN TextMode(scrtype);
  176.                    (* nur 40-Zeichen-Modi, nicht Grafik restaurieren *)
  177.   RestoreScreen;
  178.  
  179.   SetCursor(StartCursor);           (* Original-Cursor restaurieren: *)
  180.   Halt(0);                          (* Programm abbrechen            *)
  181. END;
  182.  
  183. (*-------------------------------------------------------------------*)
  184.  
  185. PROCEDURE ErrorHalt (s: STRING);
  186. BEGIN
  187.   AnsiWhite;
  188.   WriteLn(CON, s);
  189.   AnsiGray;
  190.   Close(CON);
  191.   Halt(1);
  192. END;
  193.  
  194. (*-------------------------------------------------------------------*)
  195.  
  196. PROCEDURE ShowFiles (Showpath: STRING; sr: SearchRec; path: STRING);
  197. VAR
  198.   arcdisp : STRING[9];
  199.   DateRec : DateTime;
  200.   MinStr,
  201.   MonStr   : STRING[2];
  202.   YearStr  : STRING[4];
  203.   lenStr,
  204.   insertStr,
  205.   fname,
  206.   fext     : STRING;
  207.   x        : INTEGER;
  208.   len      : BYTE;
  209.   OutPutStr: STRING;
  210. BEGIN
  211.   IF sr.Attr IN [$8..$F, $28..$2F] THEN BEGIN
  212.     IF Pos('.', sr.Name) > 0 THEN
  213.       Delete(sr.Name, Pos('.', sr.Name), 1);
  214.   END;
  215.   IF (Pos('.', sr.Name) > 0) AND (Length(sr.Name) > 0) THEN
  216.   BEGIN
  217.     fname := Copy(sr.Name, 1, Pos('.', sr.Name) - 1);
  218.     fext  := sr.Name;
  219.     Delete(fext, 1, Pos('.', fext));
  220.   END
  221.   ELSE
  222.   BEGIN
  223.     fname := sr.Name;
  224.     fext := '  ';
  225.   END;
  226.   arcdisp := '    ';
  227.   IF sr.Attr AND Archive  = Archive  THEN arcdisp[1] := 'A';
  228.   IF sr.Attr AND ReadOnly = ReadOnly THEN arcdisp[2] := 'R';
  229.   IF sr.Attr AND Hidden   = Hidden   THEN arcdisp[3] := 'H';
  230.   IF sr.Attr AND SysFile  = SysFile  THEN arcdisp[4] := 'S';
  231.   IF NOT (sr.Attr IN [$8..$F, $28..$2F]) THEN
  232.   BEGIN
  233.     Str(sr.Size, lenStr);
  234.     IF Length(lenStr) > 3 THEN
  235.     BEGIN
  236.       insertStr := '.';
  237.       len := Length(lenStr) - 2;
  238.       Insert(insertStr, lenStr, len);
  239.       IF Length(lenStr) > 7 THEN
  240.       BEGIN
  241.         len := Length(lenStr) - 6;
  242.         Insert(insertStr, lenStr, len);
  243.       END;
  244.     END;
  245.   END;
  246.   IF NOT (sr.Attr IN [$8..$F, $28..$2F]) THEN BEGIN
  247.     UnPackTime(sr.Time, DateRec);
  248.     IF (DateRec.Day = Day) AND
  249.        (DateRec.Year = Year) AND
  250.        (DateRec.Month = Month) THEN BEGIN
  251.       IF Showpath[Length(Showpath)] = '\' THEN
  252.          Delete(Showpath, Length(Showpath), 1);
  253.       OutPutStr := Showpath + '\' + fname + '.' +  fext;
  254.       Write(CON, OutPutStr);
  255.       IF Length(OutPutStr) < 42 THEN
  256.         FOR x := Length(OutPutStr) TO 42 DO Write(CON, ' ');
  257.       Write(CON, ' ',arcdisp);
  258.       Write(CON, lenStr:10);
  259.       Write(CON, Day: 3, '. ');
  260.       Write(CON, MonName[DateRec.Month],' ');
  261.       Str(DateRec.Year, YearStr);
  262.       Write(CON, YearStr + '  ', DateRec.Hour:2, ':');
  263.       Str(DateRec.Min, MinStr);
  264.       IF Length(MinStr) < 2 THEN MinStr := '0' + MinStr;
  265.       Write(CON, MinStr);
  266.       WriteLn(CON, '');
  267.       Inc(fcounter);
  268.     END;
  269.   END;
  270. END;
  271.  
  272. (*-------------------------------------------------------------------*)
  273.  
  274. PROCEDURE SearchDirectories(path, fname: STRING);
  275. VAR
  276.   SRecord : SearchRec;
  277.   fle     : FILE;
  278.   Showpath: STRING;
  279. BEGIN
  280.   IF Length(path) > 0 THEN                    (* Suche nach Dateien: *)
  281.     IF path[Length(path)] <> '\' THEN
  282.       path := path + '\';
  283.   SRecord.Name := '';
  284.   FindFirst(path + fname, Anyfile MOD Directory, SRecord);
  285.   Showpath := '        .   ';
  286.   IF SRecord.Name <> '' THEN
  287.   BEGIN
  288.     IF Length(path)  > 3 THEN
  289.       Showpath := Copy(path, 1, Length(path) - 1)
  290.     ELSE Showpath := path;
  291.   END;
  292.  
  293.   WHILE DosError = 0 DO
  294.   BEGIN
  295.     CheckForKey;
  296.     IF SRecord.Attr IN [$0..$E, $20..$2E] THEN
  297.       ShowFiles(Showpath, SRecord, path);
  298.     FindNext(SRecord);
  299.   END;
  300.                                        (* Suche nach Verzeichnissen: *)
  301.   FindFirst(path + allfiles, Directory, SRecord);
  302.   WHILE DosError = 0 DO
  303.   BEGIN
  304.     CheckForKey;
  305.     IF (SRecord.Attr AND Directory <> 0) AND
  306.        (SRecord.Name[1] <> '.') THEN
  307.       SearchDirectories(path + SRecord.Name, fname);
  308.     FindNext(SRecord);
  309.   END;
  310. END;
  311.  
  312. (*-------------------------------------------------------------------*)
  313. (*                           Hauptprogramm                           *)
  314. (*-------------------------------------------------------------------*)
  315. BEGIN
  316.   CheckBreak := FALSE;
  317.  
  318.   IF (ParamCount = 0) OR (ParamStr(1) = '/?')
  319.     THEN Help;
  320.  
  321.   Assign (CON, '');
  322.   Append (CON);
  323.   ansiinst := AnsiSys;
  324.  
  325.   IF Lo(DosVersion) < 3 THEN
  326.     ErrorHalt('Falsche DOS-Version');
  327.  
  328.   fcounter := 0;
  329.   drive := '';
  330.   AnsiYellow;
  331.   WriteLn(CON,'DF - Turbo '+ copyrght + ^J);
  332.   AnsiGray;
  333.   BEGIN
  334.     parameter := ParamStr(1);
  335.     parameter := UpString(parameter);
  336.     IF NOT (parameter[1] IN ['A'..'Z']) THEN
  337.     BEGIN
  338.       GetDir(0, drive);
  339.       drive := drive[1];
  340.     END ELSE drive := parameter[1];
  341.     drive := drive + ':';
  342.     GetDate(Year, Month, Day, DayofWeek);
  343.     SearchDirectories(drive + '\', '*.*');
  344.   END;
  345.   IF fcounter = 0 THEN
  346.     ErrorHalt('Keine passenden Dateien für '
  347.             + drive + '\' + '*.*' + ' gefunden.')
  348.   ELSE
  349.   BEGIN
  350.     Write(CON, ^M^J, fcounter, ' Datei');
  351.     IF fcounter > 1 THEN Write(CON, 'en');
  352.     WriteLn(CON, ' gefunden.');
  353.   END;
  354.   Close(CON);
  355. END.
  356. (*-------------------------------------------------------------------*)
  357.