home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / extra18 / grdlagen / umleitg / newdir.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-01-22  |  7.1 KB  |  261 lines
  1. (* ------------------------------------------------- *)
  2. (*                     NEWDIR.PAS                    *)
  3. (*           (c) 1992 H.Rüter & DMV-Verlag           *)
  4. (* ------------------------------------------------- *)
  5. (*  Diese Programm testet die Unit HRDOSUM.TPU       *)
  6. (*  Programmaufruf auf DOS-Ebene:                    *)
  7. (*                                                   *)
  8. (*    NewDir [?] [Dateibezeichner] [N]               *)
  9. (*               [ < Datei1 ] [ > Datei2]            *)
  10. (*                                                   *)
  11. (*      ?      : Hilfetext                           *)
  12. (*    Dateibezeichner : Dateiname oder Dateigruppe : *)
  13. (*                      Hallo.Pas , *.exe etc.       *)
  14. (*        N    : schaltet bei Ausgabeumleitung die   *)
  15. (*               Crt-Ausgabe aus                     *)
  16. (*    < Datei1 : liest einen ASCII-Text ein, der aus *)
  17. (*               Dateibezeichnern besteht            *)
  18. (*    > Datei2 : leitet die Textausgabe in Datei2 um *)
  19. (*                                                   *)
  20. (*  Die Ausgabe ist immer auf dem Schirm zu sehen,   *)
  21. (*  wenn nicht [N] angegeben wird                    *)
  22. (* ------------------------------------------------- *)
  23. PROGRAM NewDir;
  24. (*$M 4024,0,0,I-,R-,S-,N-,V-,B-,O-,A+,D+ *)
  25.  
  26. USES Dos, Crt, HrDosUm;
  27.  
  28. CONST
  29.   Space     = ' ';
  30.   A         : ARRAY [1..6] OF CHAR =
  31.               ('R', 'H', 'S', Space, Space, 'A');
  32.  
  33. VAR
  34.   Para, Dir : STRING;
  35.   F         : SearchRec;
  36.   Ready,
  37.   OU,IU     : BOOLEAN;
  38.   DelayTime : WORD;
  39.   C         : CHAR;
  40.   Summe     : Longint;
  41.   Nr        : WORD;
  42.   Lw        : BYTE;
  43.  
  44.   PROCEDURE Hilfetext;
  45.   BEGIN
  46.     ClrScr;
  47.     WriteLn(' HILFESTELLUNG FÜR ', ParamStr(0));
  48.     WriteLn;
  49.     WriteLn(' Es bestehen folgende Möglichkeiten ',
  50.             'des Programmaufrufs auf Dos-Ebene :');
  51.     WriteLn;
  52.     WriteLn(' NEWDIR [/?] [/Dateibezeichner] [/N] ',
  53.             '[ < Datei1 ] [ > Datei2]   <RETURN>');
  54.     WriteLn;
  55.     WriteLn(' PARAMETER             BEDEUTUNG',
  56.             '                  BEISPIEL');
  57.     WriteLn;
  58.     WriteLn(' [/?]                  Hilfetext',
  59.             '                  NewDir ?');
  60.     WriteLn(' [/Dateibezeichner]    Dateiname',
  61.             '                  Hallo.Pas');
  62.     WriteLn('                       oder Dateigruppe',
  63.             '           *.exe  H*.*');
  64.     WriteLn(' [/N]                  Schaltet bei ');
  65.     WriteLn('                       Ausgabeumleitung');
  66.     WriteLn('                       die Crt-Ausgabe ',
  67.             'aus        NewDir N >Out.Txt');
  68.     WriteLn(' [< Datei1]            Liest einen ',
  69.             'ASCII-Text');
  70.     WriteLn('                       ein,der aus');
  71.     WriteLn('                       Dateibezeichnern',
  72.             ' besteht   NewDir < In.Txt');
  73.     WriteLn(' [> Datei2]            Leitet die ',
  74.             'Textausgabe ');
  75.     WriteLn('                       in Datei2 um',
  76.             '               NewDir > Out.Txt');
  77.     WriteLn;
  78.     WriteLn(' Die Ausgabe ist immer auf dem Schirm ',
  79.             'zu sehen, wenn nicht [N] angegeben');
  80.     Halt;
  81.   END;
  82.  
  83.   FUNCTION FileString(M : SearchRec) : STRING;
  84.   VAR
  85.     S1, S2 : STRING;
  86.     Dt     : DateTime;
  87.     L,P    : BYTE;
  88.  
  89.     FUNCTION AttrStr(Attr : BYTE) : STRING;
  90.     VAR
  91.       L : BYTE;
  92.       S : STRING;
  93.     BEGIN
  94.       S := '';
  95.       FOR L := 1 TO 6 DO BEGIN
  96.         IF NOT (L IN [4,5]) THEN BEGIN
  97.           IF Odd(Attr) THEN S := S+A[L]+Space
  98.                        ELSE S := S+'  ';
  99.         END;
  100.         Attr := Attr SHR 1;
  101.       END;
  102.       AttrStr := S;
  103.     END;
  104.  
  105.     FUNCTION ZeroStr(W : LongInt) : STRING;
  106.     VAR
  107.       S : STRING;
  108.     BEGIN
  109.       Str(W:0, S);
  110.       IF Length(s) = 1 THEN S := '0' + S;
  111.       ZeroStr := S;
  112.     END;
  113.  
  114.   BEGIN
  115.     WITH M DO BEGIN
  116.       S2 := Name;
  117.       P  := Pos('.', S2);
  118.       IF P <> 0 THEN
  119.         Insert(Copy('        ',1,8-Pred(P)),S2,P);
  120.       FOR L := Length(S2) TO 12 DO S2 := S2 + Space;
  121.       Str(Size:10,S1);
  122.       S1 := '-   '+ S2 + S1+'   ';
  123.  
  124.       UnpackTime(Time,DT);
  125.       WITH Dt DO BEGIN
  126.         S1 := S1 + ZeroStr(hour)+'.'+
  127.                    ZeroStr(min)+','+ZeroStr(sec);
  128.         S1 := S1 + '  ' + ZeroStr(Day)+'.'+
  129.                    ZeroStr(Month)+'.'+ZeroStr(Year);
  130.       END;
  131.       FileString := S1 + '   ' + AttrStr(Attr);
  132.     END;
  133.   END;
  134.  
  135.   FUNCTION GetChar : CHAR;
  136.   VAR
  137.     C : CHAR;
  138.   BEGIN
  139.     ProtOut;
  140.     REPEAT
  141.       C := UpCase(ReadKey);
  142.     UNTIL C <> #0;
  143.     GetChar := C;
  144.     ProtOn;
  145.   END;
  146.  
  147.   PROCEDURE Pause;
  148.   VAR
  149.     Y : BYTE;
  150.   BEGIN
  151.     Y := WhereY;
  152.     TextAttr := TextAttr OR Blink;
  153.     ProtOut;
  154.     Write('Taste drücken...');
  155.     ProtOn;
  156.     C := GetChar;
  157.     TextAttr := TextAttr AND 127;
  158.     GotoXY(1,Y);
  159.     ClrEol;
  160.   END;
  161.  
  162. BEGIN
  163.   IF ParamCount = 0 THEN Para := '*.*'
  164.                     ELSE Para := ParamStr(1);
  165.   IF Para       =  '?' Then HilfeText;
  166.  
  167.   TextAttr := White;
  168.   ClrScr;
  169.   WriteLn('    DIR-UTILITY  ',
  170.           '(c) 1992 H.Rüter & DMV-Verlag');
  171.   GotoXY(1,25);
  172.   Write('     <ESC> : Exit   <Ctrl><S> : ',
  173.         'Halt/Weiter    <+> <-> : Verzögerung');
  174.   Window(1,2,80,24);
  175.   TextAttr := LightGray SHL 4;
  176.   ClrScr;
  177.  
  178.   IU := DosInputRedirected;
  179.   OU := DosOutputRedirected;
  180.  
  181.   Ready      := FALSE;
  182.   DelayTime  := 0;
  183.  
  184.   IF OU THEN BEGIN
  185.     ChangeInoutModus(OutPutRedirection);
  186.     IF ParamStr(2) = 'N' THEN
  187.       ChangeSightAbleMode(FALSE);
  188.   END;
  189.  
  190.   IF IU THEN BEGIN
  191.     ChangeInoutModus(InPutRedirection);
  192.     SetReadKeyMode(FALSE);
  193.     InSightOnOff(FALSE);
  194.     SetInputDelay(0);
  195.     IF NOT OU THEN ChangeSightAbleMode(FALSE);
  196.     ProtOut;
  197.     ReadLn(Para);
  198.     ProtOn;
  199.   END;
  200.  
  201.   WHILE NOT Ready DO BEGIN
  202.     Summe := 0;
  203.     Nr    := 0;
  204.     IF Para[2] = ':' THEN
  205.       LW := Ord(UpCase(Para[1]))-Ord('@')
  206.     ELSE
  207.       LW := 0;
  208.  
  209.     WriteLn;
  210.     WriteLn('->  PARAMETER : ', Para);
  211.  
  212.     FindFirst(Para, AnyFile, F);
  213.  
  214.     WHILE (DosError = 0) AND NOT Ready DO BEGIN
  215.       IF (F.Attr AND Directory = 0) AND
  216.          (F.Attr AND VolumeID = 0) THEN BEGIN
  217.         WriteLn(FileString(F));
  218.         Inc(Summe,F.Size);
  219.         Inc(Nr);
  220.       END;
  221.  
  222.       WHILE KeyPressed AND NOT Ready DO BEGIN
  223.         C := GetChar;
  224.         CASE C OF
  225.           #27 : Ready := TRUE;
  226.           #19 : REPEAT
  227.                   C := GetChar;
  228.                 UNTIL C = #19;
  229.           '+' : Inc(DelayTime,100);
  230.           '-' : IF DelayTime >= 100 THEN
  231.                   Dec(DelayTime, 100);
  232.         END;
  233.       END;
  234.       FindNext(F);
  235.       Delay(DelayTime);
  236.     END;
  237.  
  238.     WriteLn;
  239.     IF Nr > 0 THEN
  240.       Write('-> ',Nr:3,' Datei(en) : ',Summe:8,' Byte')
  241.     ELSE Write('->  Keine Datei gefunden');
  242.  
  243.     GetDir(LW,Dir);
  244.     WriteLn(' ',DiskFree(LW),
  245.             ' Byte frei in Laufwerk ',Dir[1]);
  246.  
  247.     IF OU AND NOT IU THEN
  248.       Ready := TRUE
  249.     ELSE If IU THEN BEGIN
  250.       Para := '';
  251.       ProtOut;
  252.       IF NOT EOFInput THEN ReadLn(Para)
  253.                       ELSE Ready := TRUE;
  254.       ProtOn;
  255.       Pause;
  256.     END ELSE Ready := TRUE;
  257.   END;
  258. END.
  259. (* ------------------------------------------------- *)
  260. (*             Ende von NEWDIR.PAS                   *)
  261.