home *** CD-ROM | disk | FTP | other *** search
/ GIF-GALAXY 2 / gif-galaxy2.iso / programs / vgainfo.pas < prev    next >
Pascal/Delphi Source File  |  1992-03-31  |  5KB  |  153 lines
  1. PROGRAM VGAInfo; {$R-,S-,X+,V-,A-}
  2.  
  3. USES DOS,Crt;
  4.  
  5. CONST Monat:ARRAY [0..13] OF STRING[3]=(
  6.             '???','Jan','Feb','Mär','Apr','Mai','Jun',
  7.             'Jul','Aug','Sep','Okt','Nov','Dez','???');
  8.  
  9. VAR i:BYTE;
  10.     Regs:Registers;
  11.     Block:ARRAY [0..511] OF BYTE;
  12.     NamensString:STRING[12];
  13.  
  14. FUNCTION HexForm(x:BYTE):STRING;
  15. CONST Ziffer:ARRAY[0..15] OF CHAR='0123456789ABCDEF';
  16. BEGIN
  17.   HexForm[0]:=#2;
  18.   HexForm[1]:=Ziffer[x SHR $4];
  19.   HexForm[2]:=Ziffer[x AND $F];
  20. END;
  21.  
  22. FUNCTION LeadZero(x:BYTE):STRING;
  23. VAR Ergebnis:STRING[2];
  24. BEGIN
  25.   STR(x:2,Ergebnis);
  26.   IF Ergebnis[1]=' ' THEN Ergebnis[1]:='0';
  27.   LeadZero:=Ergebnis;
  28. END;
  29.  
  30. PROCEDURE DatumAusgeben(DatumsZahl:LONGINT);
  31. VAR Datum:DateTime;
  32. BEGIN
  33.   UnPackTime(DatumsZahl,Datum);
  34.   Write(Datum.Day:2,'.');
  35.   Write(Monat[Datum.Month]:3,'.');
  36.   Write(Datum.Year,'     ');
  37.   Write(Datum.Hour:2,':');
  38.   Write(LeadZero(Datum.Min),'.');
  39.   Write(LeadZero(Datum.Sec),'     ');
  40. END;
  41.  
  42. PROCEDURE AttributeAusgeben(Attribs:BYTE);
  43. BEGIN
  44.   IF NamensString[1]=CHR(229) THEN BEGIN
  45.     TextColor(TextAttr OR Blink);
  46.     Write('gelöscht');
  47.   END ELSE BEGIN
  48.     IF BOOLEAN(Attribs AND 128) THEN Write('G') ELSE Write('-');
  49.     IF BOOLEAN(Attribs AND  64) THEN Write('O') ELSE Write('-');
  50.     IF BOOLEAN(Attribs AND  32) THEN Write('A') ELSE Write('-');
  51.     IF BOOLEAN(Attribs AND  16) THEN Write('D') ELSE Write('-');
  52.     IF BOOLEAN(Attribs AND   8) THEN Write('V') ELSE Write('-');
  53.     IF BOOLEAN(Attribs AND   4) THEN Write('S') ELSE Write('-');
  54.     IF BOOLEAN(Attribs AND   2) THEN Write('H') ELSE Write('-');
  55.     IF BOOLEAN(Attribs AND   1) THEN Write('R') ELSE Write('-');
  56.   END;
  57.   ClrEOL;
  58. END;
  59.  
  60. FUNCTION CallInt25(Lfw,Start,Anz:WORD;Buff:POINTER):BOOLEAN; {nach: DOS-Tool 3/92, S.290}
  61. INLINE(
  62.  $8C/$DE/$8B/$FD/
  63.  $5B/$1F/$59/$5A/$58/$56/$57/
  64.  $CD/$25/$B3/$00/$72/$04/$43/$EB/$03/
  65.  $CF/
  66.  $2B/$C0/
  67.  $0E/$E8/$FFF9/
  68.  $5D/$1F/$A3/>DOSError/$8A/$C3
  69. );
  70.  
  71. PROCEDURE DiskettenInfo(Laufwerk:BYTE);
  72. LABEL Ausgang;
  73. VAR Zahl:LONGINT;
  74.     DirStart,Eintraege,Attr:BYTE;
  75. BEGIN
  76.   Regs.AH:=$00;          {Controller Reset}
  77.   Regs.DL:=Laufwerk;
  78.   Intr($13,Regs);
  79.   DirStart:=0;
  80.   IF CallInt25(Laufwerk,0,1,@Block) THEN BEGIN
  81.     TextColor(Yellow);
  82.     NamensString[0]:=CHR(8); Move(Block[3],NamensString[1],8);
  83.     Write(NamensString,'        ',HexForm(Block[$27]),HexForm(Block[$28]),
  84.                             '-',HexForm(Block[$29]),HexForm(Block[$2A]));
  85.     IF COPY(NamensString,1,6)='VGACPY' THEN BEGIN
  86.       Write('     ');
  87.       Move(Block[$27],Zahl,4);
  88.       DatumAusgeben(Zahl);
  89.     END;
  90.     WriteLn(#10#13);
  91.     DirStart:=1+Block[$10]*Block[$16];
  92.     IF DirStart>0 THEN BEGIN
  93.       Eintraege:=0;
  94.       REPEAT
  95.         CallInt25(Laufwerk,DirStart,1,@Block);
  96.         FOR i:=0 TO 15 DO BEGIN
  97.           TextColor(LightGray);
  98.           TextBackground(Black);
  99.           NamensString[0]:=CHR(12);
  100.           Move(Block[i*32],NamensString[1],12);
  101.           INSERT('.',NamensString,9);
  102.           IF NamensString[1]=CHR(0) THEN GOTO Ausgang;
  103.           INC(Eintraege);
  104.           Attr:=Block[i*32+11];
  105.           IF (COPY(NamensString,10,3)='EXE') OR
  106.              (COPY(NamensString,10,3)='COM') OR
  107.              (COPY(NamensString,10,3)='BAT') THEN TextBackground(Red);
  108.           IF BOOLEAN(Attr AND VolumeID) THEN TextBackground(Blue);
  109.           IF BOOLEAN(Attr AND Directory) THEN TextBackground(Green);
  110.           Write(NamensString,'     ');
  111.           Move(Block[i*32+28],Zahl,4);
  112.           Write(Zahl:8,'     ');
  113.           Move(Block[i*32+22],Zahl,4);
  114.           DatumAusgeben(Zahl);
  115.           AttributeAusgeben(Attr);
  116.           TextBackground(Black);
  117.           WriteLn;
  118.           IF KeyPressed THEN BEGIN
  119.             ReadKey;
  120.             Write('Beliebige Taste zum fortsetzen drücken ...');
  121.             REPEAT UNTIL ReadKey<>#0;
  122.             GotoXY(1,WhereY);
  123.             ClrEOL;
  124.           END;
  125.         END;
  126.         INC(DirStart);
  127.       UNTIL false;
  128.     END;
  129.     Ausgang:
  130.     TextColor(13);
  131.     Write(#10#13,Eintraege,' Einträge, ');
  132.     Write('Kapazität ist ',DiskSize(Laufwerk+1),' Bytes,');
  133.     WriteLn(' davon ',DiskFree(Laufwerk+1),' Bytes frei.');
  134.     TextColor(White);
  135.   END ELSE BEGIN
  136.     TextColor(LightGray);
  137.     WriteLn('Keine Diskette im Laufwerk !');
  138.     Halt(1);
  139.   END;
  140. END;
  141.  
  142. BEGIN
  143.   IF ParamCount<>1 THEN BEGIN
  144.     WriteLn(#10+'VGA-Info'+#10+#13+'========'+#10);
  145.     WriteLn('Ein kleiner Directory-Lister für alle (auch gelöschte!) Dateien auf Diskette.');
  146.     WriteLn('Public-Domain-Zugabe zu VGA-Copy. Weiterverarbeitung ausdrücklich erlaubt !'+#10);
  147.     WriteLn('Syntax: VGAINFO <Laufwerk A: oder B:>');
  148.   END ELSE BEGIN
  149.     NamensString:=COPY(FExpand(ParamStr(1)+'.'),1,1);
  150.     DiskettenInfo(ORD(NamensString[1])-65);
  151.   END;
  152. END.
  153.