home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1989 / 04 / grdlage / devices.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-01-24  |  6.0 KB  |  195 lines
  1. (* ------------------------------------------------------ *)
  2. (*                     DEVICES.PAS                        *)
  3. (*         Informationen über die Gerätetreiber           *)
  4. (*         (c) 1989  Norbert Juffa  &  TOOLBOX            *)
  5. (* ------------------------------------------------------ *)
  6. PROGRAM Devices;
  7.  
  8. USES DOS;
  9.  
  10. TYPE DevPtr  = ^DevHdr;
  11.      DevHdr  = RECORD
  12.                  Next: DevPtr;
  13.                  Attr: WORD;
  14.                  Strt: WORD;
  15.                  Srvc: WORD;
  16.                  CASE BOOLEAN OF
  17.                    FALSE: (Unts: BYTE);
  18.                    TRUE : (Name: ARRAY [0..7] OF CHAR);
  19.               END;
  20.      DevAddr = ARRAY [0..15] OF LONGINT;
  21.      List    = ^Device;
  22.      Device  = RECORD
  23.                  Address:   POINTER;
  24.                  Attribute: WORD;
  25.                  Name:      STRING [25];
  26.                  Next:      List;
  27.                END;
  28.  
  29.  
  30. CONST DevTyp : ARRAY [0..1] OF STRING [9] =
  31.                         ('CHARACTER', '  BLOCK  ');
  32.       Flag:    ARRAY [0..1] OF CHAR = (' ', '*');
  33.  
  34.  
  35. { Die Funktion PtrToLongInt gibt den übergebenen Zeiger }
  36. { Ptr als lineare Adresse zurück. }
  37.  
  38. FUNCTION PtrToLongint (Ptr: POINTER): LONGINT;
  39. BEGIN
  40.   PtrToLongint := LongInt(Seg(Ptr^)) * 16 + Ofs(Ptr^);
  41. END;
  42.  
  43. { Die Funktion Hex liefert die übergebene Wort-Variable }
  44. { als eine Kette von vier Zeichen in hexadezimaler }
  45. { Schreibweise zurück. }
  46.  
  47. FUNCTION Hex (X: WORD): STRING;
  48. VAR H: ARRAY [0..15] OF CHAR;
  49. BEGIN
  50.   H := '0123456789ABCDEF';
  51.   Hex := H [X SHR 12] + H [(X AND $0F00) SHR 8] +
  52.          H [(X AND $00F0) SHR 4] + H [(X AND $000F)];
  53. END;
  54.  
  55. { Die Prozedur GetDiskParameterBlk durchläuft die Liste }
  56. { der Diskparameterblöcke und vermerkt zu jedem Laufwerk }
  57. { in dem Array DriverAddress die Adresse des zugehörigen }
  58. { DPB. Auuserdem liefert sie in DriveNr die Gesamtzahl der }
  59. { installierten Laufwerke. }
  60.  
  61. PROCEDURE GetDiskParameterBlk(VAR DriverAddress: DevAddr;
  62.                               VAR DriveNr: WORD);
  63. TYPE DPB = RECORD
  64.              Drive:   BYTE;
  65.              Unt:     BYTE;
  66.              SecSize: WORD;
  67.              ClstSec: BYTE;
  68.              ClstSiz: BYTE;
  69.              FAT1:    WORD;
  70.              NrFAT:   BYTE;
  71.              DirEnt:  WORD;
  72.              Free1:   WORD;
  73.              DskSiz:  WORD;
  74.              FATLen:  BYTE;
  75.              DIR1:    WORD;
  76.              DevHd:   POINTER;
  77.              IDByte:  BYTE;
  78.              Flg:     BYTE;
  79.              NextDBP: Pointer;
  80.              Reserved:LONGINT;
  81.            END;
  82.  
  83. VAR Regs: Registers;
  84.     Next: ^DPB;
  85.  
  86. BEGIN
  87.   DriveNr := 1;
  88.   Regs.AH := $52;
  89.   MsDos(Regs);
  90.   Next := Pointer(Ptr(Regs.ES, Regs.BX)^);
  91.   REPEAT
  92.     DriverAddress[DriveNr] := PtrToLongInt(Next^.DevHd);
  93.     Next := Pointer(Next^.NextDBP);
  94.     Inc(DriveNr);
  95.   UNTIL(Ofs(Next^) = $FFFF);
  96. END;
  97.  
  98. { Die Prozedur InsDevLst fügt das Device CurrentDev in die }
  99. { nach Startadresse aufsteigend sortierte Liste DevList    }
  100. { ein. Zu jedem Device wird außer der Startadresse der     }
  101. { Name und das Attributwort vermerkt. Bei block devices    }
  102. { wird der Name aus den Namen der unterstützten Laufwerke  }
  103. { gebildet. Dazu wird das Array DrvAddr ausgewertet, indem }
  104. { zu allen Nr Laufwerken die Startadresse des zugehörigen  }
  105. { Treibers vermerkt ist. }
  106.  
  107. PROCEDURE InsDevLst (CurrentDev: DevPtr; VAR DevList: List;
  108.                      DrvAddr: DevAddr; Nr:WORD);
  109.  
  110. VAR NewDevice, Lauf: List;
  111.     L: WORD;
  112.  
  113. BEGIN
  114.   New(NewDevice);
  115.   IF DevList = NIL THEN BEGIN
  116.      DevList := NewDevice;
  117.      NewDevice^.Next := NIL;
  118.    END ELSE
  119.      IF PtrToLongint(CurrentDev) <=
  120.         PtrToLongint(DevList^.Address) THEN BEGIN
  121.        NewDevice^.Next := DevList;
  122.        DevList := NewDevice;
  123.      END ELSE BEGIN
  124.        Lauf := DevList;
  125.        WHILE (Lauf^.Next <> NIL) AND
  126.              (PtrToLongInt(CurrentDev) >
  127.              (PtrToLongInt(Lauf^.Next^.Address))) DO BEGIN
  128.          Lauf := Lauf^.Next;
  129.        END;
  130.        NewDevice^.Next := Lauf^.Next;
  131.        Lauf^.Next := NewDevice;
  132.      END;
  133.    NewDevice^.Address := CurrentDev;
  134.    NewDevice^.Attribute := CurrentDev^.Attr;
  135.  
  136.    IF ((CurrentDev^.Attr SHR 15) XOR 1) = 0 THEN
  137.      NewDevice^.Name := CurrentDev^.Name
  138.    ELSE BEGIN
  139.      NewDevice^.Name := '';
  140.      FOR L := 0 TO Nr-1 DO
  141.        IF DrvAddr[L] = PtrToLongInt(NewDevice^.Address) THEN
  142.          NewDevice^.Name := NewDevice^.Name + Char (L+64)
  143.                                             + ':, ';
  144.          Dec(NewDevice^.Name[0], 2);
  145.    END;
  146. END;
  147.  
  148.  
  149. VAR Lauf: DevPtr;
  150.     DriverAddresses: DevAddr;
  151.     DevList: List;
  152.     NrOfDrives: WORD;
  153.     DOSVersion: BYTE;
  154.     Regs: Registers;
  155.     Next: Pointer;
  156.  
  157. BEGIN
  158.   DevList := NIL;
  159.   GetDiskParameterBlk(DriverAddresses, NrOfDrives);
  160.   Regs.AH := $30;
  161.   MSDOS(Regs);
  162.   DOSVersion := Regs.AL;
  163.   Regs.AH := $52;
  164.   MsDos(Regs);
  165.   IF DOSVersion < 3 THEN
  166.     Lauf := Ptr(Regs.ES, Regs.BX+23)
  167.   ELSE
  168.     Lauf := Ptr(Regs.ES, Regs.BX+34);
  169.   REPEAT
  170.     InsDevLst(Lauf, DevList, DriverAddresses, NrOfDrives);
  171.     Lauf := Lauf^.Next;
  172.   UNTIL (Ofs(Lauf^) = $FFFF);
  173.   WriteLn;
  174.   WriteLn('DeviceLister 1.0      (c)  1988 N. J.');
  175.   WriteLn;
  176.   WriteLn(' Adresse      Typ     Name/Laufwerke   StdIn ',
  177.           'StdOut NulDev StdClk NonIbm Ioctl');
  178.   WriteLn('─────────  ─────────  ───────────────  ──────',
  179.           '─────────────────────────────────');
  180.   WHILE DevList <> NIL DO BEGIN
  181.     Write(Hex(Seg(DevList^.Address^)), ':' ,
  182.           Hex(Ofs(DevList^.Address^)), '  ');
  183.     Write(DevTyp[(DevList^.Attribute SHR 15) XOR 1], '  ');
  184.     Write(DevList^.Name, '':18-Length (DevList^.Name));
  185.     Write(Flag [DevList^.Attribute AND 1]:3);
  186.     Write(Flag [(DevList^.Attribute SHR 1) AND 1]:6);
  187.     Write(Flag [(DevList^.Attribute SHR 2) AND 1]:7);
  188.     Write(Flag [(DevList^.Attribute SHR 3) AND 1]:7);
  189.     Write(Flag [(DevList^.Attribute SHR 13) AND 1]:7);
  190.     WriteLn(Flag [(DevList^.Attribute SHR 14) AND 1]:6);
  191.     DevList := DevList^.Next;
  192.   END;
  193. END.
  194. (* ------------------------------------------------------ *)
  195. (*                Ende von DEVICES.PAS                    *)