home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1989 / 05 / tricks / memmap.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-02-08  |  13.5 KB  |  401 lines
  1. (* ------------------------------------------------------ *)
  2. (*                    MEMMAP.PAS                          *)
  3. (* Das Programm liefert eine ausführliche Speicher-       *)
  4. (* belegungstabelle für alle DOS-Versionen 2.xx und 3.xx. *)
  5. (*                                                        *)
  6. (*       (c) 1989  Norbert Juffa  &  TOOLBOX              *)
  7. (* ------------------------------------------------------ *)
  8. PROGRAM MemMap;
  9.  
  10. USES DOS;
  11.  
  12. TYPE
  13.   DeviceHdrPtr = ^DeviceHdr;
  14.   DeviceHdr    = RECORD
  15.                    NextDevice : DeviceHdrPtr;
  16.                    Attribute  : WORD;
  17.                    StratEntry : WORD;
  18.                    InterEntry : WORD;
  19.                    CASE BOOLEAN OF
  20.                      FALSE   : (NrOfUnits: BYTE);
  21.                      TRUE    : (Name: ARRAY[1..8] OF CHAR);
  22.                  END;
  23.   DevicePtr    = ^Device;
  24.   Device       = RECORD
  25.                    Address : POINTER;
  26.                    Typ     : BYTE;
  27.                    Name    : STRING [15];
  28.                    Next    : DevicePtr;
  29.                  END;
  30.   MCBPtr       = ^MCB;
  31.   MCB          =  RECORD
  32.                     Signature   : CHAR;
  33.                     OwnerProc   : WORD;
  34.                     BlockLength : WORD;
  35.                     Reserved    : ARRAY [$5..$F] OF BYTE;
  36.                   END;
  37.   DPBPtr       = ^DPB;
  38.   DPB          = RECORD
  39.                    Drive             : BYTE;
  40.                    DriverUnit        : BYTE;
  41.                    SectorSize        : WORD;
  42.                    SectorsPerCluster : BYTE;
  43.                    LogSecPerCluster  : BYTE;
  44.                    FirstFATSector    : WORD;
  45.                    NrOfFATs          : BYTE;
  46.                    NrOfDirEntries    : WORD;
  47.                    FirstDataSector   : WORD;
  48.                    ClustersPerDrive  : WORD;
  49.                    SectorsPerFAT     : BYTE;
  50.                    FirstDirSector    : WORD;
  51.                    DeviceHeader      : DeviceHdrPtr;
  52.                    IDByte            : BYTE;
  53.                    CheckMediaChanged : BYTE;
  54.                    NextDPB           : DPBPtr;
  55.                    Reserved          : LONGINT;
  56.                  END;
  57.   ProcessPtr   = ^Process;
  58.   Process      = RECORD
  59.                    PSPAddress : WORD;
  60.                    Name       : STRING [8];
  61.                    Next       : ProcessPtr;
  62.                  END;
  63.   DriverAddr   = ARRAY [0..10] OF LONGINT;
  64.  
  65. VAR
  66.   LogicalDrives,
  67.   DOSVersion     : BYTE;
  68.   MSEG, DSEG,
  69.   FSEG, BSEG,
  70.   LSEG, SSEG,
  71.   FCBSEG,
  72.   FCBSize,
  73.   STACKSize,
  74.   IOSYSSize,
  75.   MSDOSSize,
  76.   FILESSize,
  77.   BUFFERSSize,
  78.   LASTDRIVESize  : WORD;
  79.   FirstMCB       : MCBPtr;
  80.   FirstDPB       : DPBPtr;
  81.   Regs           : Registers;
  82.   UserDeviceList : DevicePtr;
  83.   ProcessList    : ProcessPtr;
  84.  
  85. FUNCTION Hex(x : WORD) : STRING;
  86. VAR h : ARRAY [0..15] OF CHAR;
  87. BEGIN
  88.   h   := '0123456789ABCDEF';
  89.   Hex := h[x SHR 12] + h[(x AND $0F00) SHR 8] +
  90.          h[(x AND $00F0) SHR 4] + h[(x AND $000F)];
  91. END;
  92.  
  93. FUNCTION PtrToLongint(Ptr : POINTER) : LONGINT;
  94. BEGIN
  95.   PtrToLongint := LongInt(Seg(Ptr^))*16 + Ofs(Ptr^);
  96. END;
  97.  
  98. PROCEDURE AddToDeviceList(ThisDevice     : DeviceHdrPtr;
  99.                           VAR DeviceList : DevicePtr;
  100.                           DriverAddress  : DriverAddr;
  101.                           NrOfDrives     : WORD);
  102. VAR NewDevice, CurrentDevice : DevicePtr; L : WORD;
  103. BEGIN
  104.   New(NewDevice);
  105.   IF DeviceList = NIL THEN BEGIN
  106.     DeviceList      := NewDevice;
  107.     NewDevice^.Next := NIL;
  108.   END ELSE
  109.     IF  PtrToLongint(ThisDevice) <=
  110.         PtrToLongint(DeviceList^.Address) THEN BEGIN
  111.       NewDevice^.Next := DeviceList;
  112.       DeviceList      := NewDevice;
  113.     END ELSE BEGIN
  114.       CurrentDevice   := DeviceList;
  115.       WHILE (CurrentDevice^.Next <> NIL) AND
  116.             (PtrToLongInt(CurrentDevice) >
  117.             (PtrToLongInt(CurrentDevice^.Next^.Address))) DO
  118.         CurrentDevice := CurrentDevice^.Next;
  119.       NewDevice^.Next     := CurrentDevice^.Next;
  120.       CurrentDevice^.Next := NewDevice;
  121.     END;
  122.     NewDevice^.Address := ThisDevice;
  123.     NewDevice^.Typ := (ThisDevice^.Attribute SHR 15) XOR 1;
  124.     IF NewDevice^.Typ = 0 THEN
  125.       NewDevice^.Name := ThisDevice^.Name
  126.     ELSE BEGIN
  127.       NewDevice^.Name := '';
  128.       FOR L := 1 TO NrOfDrives DO
  129.         IF DriverAddress [L] =
  130.           PtrToLongInt(NewDevice^.Address) THEN
  131.             NewDevice^.Name :=
  132.             NewDevice^.Name + Char (L+64) + ':, ';
  133.         Dec(NewDevice^.Name[0], 2);
  134.     END;
  135. END;
  136.  
  137. PROCEDURE MakeDeviceList(CurrentDPB : DPBPtr; DSEG: WORD;
  138.                          Regs: Registers; DOSVersion: BYTE;
  139.                          VAR DeviceList: DevicePtr);
  140. VAR DriveNr:       BYTE; DriverAddress: DriverAddr;
  141.     CurrentDevice: DeviceHdrPtr;
  142. BEGIN
  143.   DeviceList := NIL;
  144.   DriveNr    := 1;
  145.   REPEAT
  146.     DriverAddress[DriveNr] :=
  147.                      PtrToLongInt(CurrentDPB^.DeviceHeader);
  148.     CurrentDPB := CurrentDPB^.NextDPB;
  149.     Inc(DriveNr);
  150.   UNTIL(Ofs(CurrentDPB^) = $FFFF);
  151.   IF DOSVersion >= 3 THEN
  152.     CurrentDevice := Ptr(Regs.ES, Regs.BX+34)
  153.   ELSE
  154.     CurrentDevice := Ptr(Regs.ES, Regs.BX+23);
  155.   REPEAT
  156.     IF Seg(CurrentDevice^) > DSEG THEN
  157.       AddToDeviceList(CurrentDevice, DeviceList,
  158.                       DriverAddress, DriveNr);
  159.     CurrentDevice := CurrentDevice^.NextDevice;
  160.   UNTIL(Ofs(CurrentDevice^) = $FFFF);
  161. END;
  162.  
  163. FUNCTION GetProcessName(PSPSeg : WORD) : STRING;
  164. TYPE Environment    = ARRAY [0..32767] OF CHAR;
  165. VAR  EnvironmentPtr : ^Environment;
  166.      HelpStr        : STRING;        L : WORD;
  167. BEGIN
  168.   HelpStr := '';
  169.   EnvironmentPtr := Ptr(MemW[PSPSeg:$2C], 0);
  170.   L := 1;
  171.   WHILE (EnvironmentPtr^[L-1]+EnvironmentPtr^[L]) <> #0#0 DO
  172.     Inc(L);
  173.   Inc(L, 3);
  174.   WHILE EnvironmentPtr^[L] <> #0 DO BEGIN
  175.     HelpStr := HelpStr + EnvironmentPtr^[L];
  176.     Inc(L);
  177.   END;
  178.   REPEAT
  179.     L := Pos('\', HelpStr);
  180.     Delete(HelpStr, 1, L);
  181.   UNTIL L = 0;
  182.   HelpStr := Copy(HelpStr, 1, Pos('.', HelpStr) - 1);
  183.   IF HelpStr = '' THEN HelpStr := '???';
  184.   GetProcessName := HelpStr;
  185. END;
  186.  
  187. PROCEDURE AddToProcessList (ProcessID: WORD; Name: STRING;
  188.                             VAR ProcessList: ProcessPtr);
  189. VAR CurrentProcess, NewProcess: ProcessPtr;
  190. BEGIN
  191.   IF ProcessList = NIL THEN BEGIN
  192.     New(NewProcess);
  193.     NewProcess^.Next := NIL;
  194.     NewProcess^.Name := Name;
  195.     NewProcess^.PSPAddress := ProcessID;
  196.     ProcessList := NewProcess;
  197.   END ELSE BEGIN
  198.     CurrentProcess := ProcessList;
  199.     WHILE (CurrentProcess^.Name <> Name) AND
  200.           (CurrentProcess^.Next <> NIL) DO BEGIN
  201.       CurrentProcess := CurrentProcess^.Next;
  202.     END;
  203.     IF CurrentProcess^.Name <> Name THEN BEGIN
  204.       New (NewProcess);
  205.       NewProcess^.Next := NIL;
  206.       NewProcess^.Name := Name;
  207.       NewProcess^.PSPAddress := ProcessID;
  208.       CurrentProcess^.Next := NewProcess;
  209.     END;
  210.   END;
  211. END;
  212.  
  213. PROCEDURE MakeProcessList(CurrentMCB : MCBPtr;
  214.                           VAR ProcessList: ProcessPtr);
  215. VAR ProcessName: STRING [8];
  216. BEGIN
  217.   REPEAT
  218.     CurrentMCB := Ptr(Seg(CurrentMCB^) +
  219.                   CurrentMCB^.BlockLength + 1, 0);
  220.     IF CurrentMCB^.OwnerProc <>
  221.        (Seg(CurrentMCB^) + 1) THEN BEGIN
  222.       ProcessName := GetProcessName(CurrentMCB^.OwnerProc);
  223.       AddToProcessList(CurrentMCB^.OwnerProc,
  224.                        ProcessName, ProcessList);
  225.     END;
  226.   UNTIL CurrentMCB^.Signature = 'Z';
  227. END;
  228.  
  229. FUNCTION SearchProcessName(ProcessID : WORD;
  230.                            ProcessList: ProcessPtr): STRING;
  231. BEGIN
  232.   WHILE (ProcessList <> NIL) AND
  233.         (ProcessList^.PSPAddress <> ProcessID) DO
  234.     ProcessList:= ProcessList^.Next;
  235.   IF (ProcessList = NIL) OR (DOSVersion < 3) THEN
  236.     SearchProcessName := '???'
  237.   ELSE
  238.     SearchProcessName := ProcessList^.Name;
  239. END;
  240.  
  241. PROCEDURE PrintProcessList(CurrentMCB : MCBPtr;
  242.                            ProcessList: ProcessPtr);
  243. VAR ProcName: STRING [8];
  244.     CommandID:WORD;
  245.     Size: LONGINT;
  246.     OldMCB: MCBPtr;
  247. BEGIN
  248.   CurrentMCB := Ptr(Seg(CurrentMCB^) +
  249.                     CurrentMCB^.BlockLength + 1, 0);
  250.   CommandID  := Seg (CurrentMCB^)+1;
  251.   WHILE Seg(CurrentMCB^) < PrefixSeg DO BEGIN
  252.     OldMCB := CurrentMCB;
  253.     WHILE (CurrentMCB^.OwnerProc=0) OR
  254.           (CurrentMCB^.OwnerProc = PrefixSeg) DO BEGIN
  255.       CurrentMCB := Ptr(Seg(CurrentMCB^) +
  256.                         CurrentMCB^.BlockLength + 1, 0);
  257.     END;
  258.     Size := LongInt(Seg(CurrentMCB^) - Seg(OldMCB^)) * 16;
  259.     IF Size <> 0 THEN
  260.       WriteLn (Hex(Seg(OldMCB^)+1),
  261.               ':0000   Freier Speicherblock ─           ',
  262.               (Size-16):6);
  263.     IF Seg(CurrentMCB^) < PrefixSeg THEN BEGIN
  264.       Write(Hex(Seg(CurrentMCB^)+1), ':0000   ');
  265.       IF (CurrentMCB^.OwnerProc <> (Seg(CurrentMCB^)+1)) AND
  266.          ((Word(Ptr(CurrentMCB^.OwnerProc, $2C)^) =
  267.                                         Seg(CurrentMCB^)+1)
  268.          OR (Word(Ptr(CurrentMCB^.OwnerProc, $2C)^)=0)) THEN
  269.         Write('Environment          ')
  270.       ELSE
  271.         Write('Programm             ');
  272.       IF CurrentMCB^.OwnerProc = CommandID THEN
  273.         ProcName  := 'COMMAND'
  274.       ELSE
  275.         ProcName := SearchProcessName(CurrentMCB^.OwnerProc,
  276.                                       ProcessList);
  277.       Write(ProcName, '':12-Length(ProcName));
  278.       WriteLn(LongInt(CurrentMCB^.BlockLength)*16:6);
  279.       CurrentMCB := Ptr(Seg(CurrentMCB^) +
  280.                         CurrentMCB^.BlockLength + 1, 0);
  281.     END;
  282.   END;
  283. END;
  284.  
  285. PROCEDURE PrintDeviceList (DeviceList: DevicePtr;
  286.                            FSEG: WORD);
  287. CONST DeviceType: ARRAY [0..1] OF STRING [16] =
  288.                        ('Character-Device', 'Block-Device');
  289. BEGIN
  290.   WHILE DeviceList <> NIL DO BEGIN
  291.     Write(Hex(Seg(DeviceList^.Address^)), ':0000   ');
  292.     Write(DeviceType[DeviceList^.Typ]);
  293.     Write('':21-Length(DeviceType[DeviceList^.Typ]));
  294.     Write(DeviceList^.Name, '':12-Length(DeviceList^.Name));
  295.     IF DeviceList^.Next <> NIL THEN
  296.       WriteLn((Seg(DeviceList^.Next^.Address^) -
  297.                Seg(DeviceList^.Address^))*16:6)
  298.     ELSE
  299.       WriteLn((FSEG - Seg(DeviceList^.Address^))*16:6);
  300.     DeviceList := DeviceList^.Next;
  301.   END;
  302. END;
  303.  
  304. FUNCTION GetBuffersStart(Regs: Registers; DSEG: WORD): WORD;
  305. VAR CurrentBuffer: Pointer;
  306.     Start: WORD;
  307. BEGIN
  308.   IF DOSVersion < 3 THEN
  309.     CurrentBuffer := Pointer(Ptr(Regs.ES, Regs.BX+19)^)
  310.   ELSE
  311.     CurrentBuffer := Pointer(Ptr(Regs.ES, Regs.BX+18)^);
  312.   WHILE Ofs(CurrentBuffer^) <> 0 DO
  313.     CurrentBuffer := Pointer(CurrentBuffer^);
  314.   Start := Seg(CurrentBuffer^);
  315.   REPEAT
  316.     IF (Seg(CurrentBuffer^) < Start) AND
  317.        (Seg(CurrentBuffer^) > DSEG) THEN
  318.       Start := Seg(CurrentBuffer^);
  319.     CurrentBuffer := Pointer(CurrentBuffer^);
  320.   UNTIL Ofs(CurrentBuffer^) = $FFFF;
  321.   GetBuffersStart := Start;
  322. END;
  323.  
  324. BEGIN
  325.   Regs.AH := $30;            { DOS-Version }
  326.   MSDOS(Regs);
  327.   DOSVersion := Regs.AL;
  328.   Regs.AH := $52;            { undokumentierte Funktion : }
  329.   MSDOS(Regs);               { wichtige Variablen }
  330.   MSEG := Regs.ES;
  331.   DSEG := Seg(Pointer(Ptr(Regs.ES, Regs.BX-4)^)^);
  332.   FSEG := Seg(Pointer(Pointer(Ptr(Regs.ES, Regs.BX+4)^)^)^);
  333.   BSEG := GetBuffersStart(Regs, DSEG);
  334.   IF DOSVersion >= 3 THEN BEGIN
  335.     LogicalDrives := Byte(Ptr(Regs.ES, Regs.BX+33)^);
  336.     FCBSEG := Seg(Pointer(Ptr(Regs.ES, Regs.BX+26)^)^);
  337.     LSEG := Seg(Pointer(Ptr(Regs.ES, Regs.BX+22)^)^);
  338.   END;
  339.   FirstMCB := Ptr(DSEG, 0);
  340.   FirstDPB := Pointer(Ptr(Regs.ES, Regs.BX)^);
  341.   UserDeviceList := NIL;
  342.   ProcessList := NIL;
  343.   MakeDeviceList(FirstDPB, DSEG, Regs, DOSVersion,
  344.                  UserDeviceList);
  345.   IOSYSSize   := (MSEG - $70)  * 16;
  346.   MSDOSSize   := (DSEG - MSEG) * 16;
  347.   IF DOSVersion >= 3 THEN BEGIN
  348.     FILESSize    := (FCBSEG - FSEG) * 16;
  349.     FCBSize      := (BSEG - FCBSEG) * 16;
  350.     BUFFERSSize  := (LSEG - BSEG) * 16;
  351.     LASTDRIVESize:= ((LogicalDrives*81 - 1) DIV 16 + 1)*16;
  352.     SSEG         := LSEG + LASTDRIVESize DIV 16;
  353.     STACKSize    := (FirstMCB^.BlockLength+1+DSEG-SSEG)*16;
  354.   END ELSE BEGIN
  355.     FILESSize    := (BSEG - FSEG) * 16;
  356.     BUFFERSSize  := (FirstMCB^.BlockLength+1+DSEG-BSEG)*16;
  357.   END;
  358.   IF FSEG = $FFFF THEN
  359.     FSEG := BSEG;
  360.   MakeProcessList(FirstMCB, ProcessList);
  361.   WriteLn;
  362.   Write('MemMap1.1   Speicherbelegungstabelle');
  363.   WriteLn('   (c) 1988 N.J');
  364.   WriteLn;
  365.   WriteLn(' Adresse       Beschreibung         ',
  366.           'Name      Größe');
  367.   WriteLn('---------   ------------------   ---',
  368.           '-------  ------');
  369.   WriteLn('0000:0000   Interrupt-Vektoren   ─ ',
  370.           '            1024');
  371.   WriteLn('0040:0000   BIOS-Datenbereich    ─ ',
  372.           '             256');
  373.   WriteLn('0050:0000   DOS-Datenbereich     ─ ',
  374.           '             512');
  375.   WriteLn('0070:0000   DOS                  IO.SYS    ',
  376.            IOSYSSize:8);
  377.   WriteLn(Hex(MSEG),':0000   DOS              ',
  378.           '    MSDOS.SYS ', MSDOSSize:8);
  379.  
  380.   PrintDeviceList(UserDeviceList, FSEG);
  381.   IF FSEG <> BSEG THEN
  382.     WriteLn(Hex(FSEG),':0000   DOS           ',
  383.             '       FILES     ', FILESSize:8);
  384.   IF DosVersion >= 3 THEN
  385.     WriteLn(Hex(FCBSEG),':0000   DOS         ',
  386.             ' FCBS      ', FCBSize:8);
  387.   WriteLn (Hex(BSEG),':0000   DOS            ',
  388.             '      BUFFERS   ', BUFFERSSize:8);
  389.   IF DOSVersion >= 3 THEN BEGIN
  390.     WriteLn(Hex(LSEG),':0000   DOS           ',
  391.             '       LASTDRIVE ', LASTDRIVESize:8);
  392.     IF STACKSize > 0 THEN
  393.       WriteLn(Hex(SSEG),':0000   DOS         ',
  394.             '         STACK     ', STACKSize:8);
  395.   END;
  396.  
  397.   PrintProcessList (FirstMCB, ProcessList);
  398.  
  399. END.
  400. (* ------------------------------------------------------ *)
  401. (*                 Ende von MEMMAP.PAS                    *)