Turbo Toolbox/Turbo_Toolbox.iso/1988/06_07/libmon.pas

Pascal/Delphi Source File | 1988-04-05 | 6.5 KB | 294 lines

(********************************************************)
(*                    LIBMON.PAS                        *)
(*      Library-Monitor zur Analyse von Library-Files   *)

PROGRAM LibMon;

TYPE ByteFile = FILE OF BYTE;
     Str255 = STRING[255];

VAR InN : Str255;
    InF : ByteFile;
    b : BYTE;
    found: BOOLEAN;
    Wahl : CHAR;
    Adr : Str255;
    Nr : INTEGER;


TYPE zweichar = STRING[2];

CONST IdentSet : SET OF CHAR = ['a'..'z','A'..'Z',
                                '0'..'9','_','@','$'];

PROCEDURE Usage;

BEGIN
  WriteLn('## LIBMON ##');
  WriteLn('Usage: LIBMON Libfile');
END;

FUNCTION Hex(i : INTEGER) : Str255;

CONST HexDigit : ARRAY[0..15] OF CHAR = '0123456789ABCDEF';

BEGIN
  Hex := Concat(HexDigit[i DIV 4096],
                HexDigit[(i MOD 4096)DIV 256],
                HexDigit[(i MOD 256) DIV 16],
                HexDigit[i MOD 16]);
END;


FUNCTION Dez(Hex : Str255) : INTEGER;

CONST HexDigit : ARRAY[0..15] OF CHAR = '0123456789ABCDEF';

VAR i,Faktor,Res : INTEGER;

BEGIN
  Faktor := 1;
  Res := 0;
  FOR i := Length(Hex) DOWNTO 1 DO BEGIN
    Res := Res + Faktor*(Pos(Hex[i],HexDigit)-1);
    Faktor := Faktor * 16;
  END;
  Dez := Res;
END;


PROCEDURE Dump(VAR f : ByteFile;
               AdrStr : Str255; Nr : INTEGER);

VAR Adr, i, ZeilenZeichen : INTEGER;
    temp : Str255;

BEGIN
  temp := '';
  FOR i := 1 TO Length(AdrStr) DO
    temp := Concat(temp,UpCase(AdrStr[i]));
  Adr := Dez(AdrStr);
  WriteLn;  WriteLn;
  Seek(f,Adr);
  ZeilenZeichen := 0;
  Write(Concat(Hex(Adr),'      '));
  FOR i := 0 TO Nr-1 DO BEGIN
    ZeilenZeichen := ZeilenZeichen+1;
    IF ZeilenZeichen > 20 THEN BEGIN
      WriteLn;
      Write(Concat(Hex(Adr+i),'      '));
      ZeilenZeichen := 0;
    END;
    IF NOT(Eof(f)) THEN BEGIN
      Read(f,b);
      Write(Copy(Hex(Ord(b)),3,2):3);
    END;
  END;
END;


FUNCTION Match(VAR f : ByteFile;
               ByteStr : Str255) : BOOLEAN;

VAR foundfirst, found : BOOLEAN;
    Last : INTEGER;

  FUNCTION SearchFirst(c : CHAR) : BOOLEAN;
  VAR z : BYTE;
  BEGIN
    IF NOT(Eof(f)) THEN Read(f,z);
    WHILE NOT(Eof(f)) AND (z <> Ord(c)) DO
      Read(f,z);
    SearchFirst := z = Ord(c);
  END;


  FUNCTION CompStr : BOOLEAN;

  VAR tempStr : Str255;
      i : INTEGER;
      b : BYTE;

  BEGIN
    tempStr := '';
    FOR i := 2 TO Length(ByteStr) DO BEGIN
      IF Eof(f) THEN BEGIN
        CompStr := FALSE;
        Exit;
      END
      ELSE BEGIN
        Read(f,b);
        tempStr := Concat(tempStr,Chr(b));
      END;
    END;
    CompStr := (Concat(ByteStr[1],tempStr) = ByteStr);
  END;

BEGIN
  REPEAT
    foundfirst := SearchFirst(ByteStr[1]);
    Last := FilePos(f);
    IF foundfirst THEN BEGIN
      found := CompStr;
      IF NOT found THEN Seek(f,Last);
    END
    ELSE BEGIN
      found := FALSE;
    END;
  UNTIL NOT(foundfirst) OR found;
  Match := found;
END;


(* Module suchen *)
PROCEDURE SearchModuls(VAR f : ByteFile;
                       VAR found : BOOLEAN);

VAR IdentStr : Str255;
    i : INTEGER;

BEGIN
  IdentStr := '';
  (* Acht führénde Nullen... *)
  FOR i := 1 TO 8 DO IdentStr := Concat(IdentStr,Chr($00));
  (* ...dann $80,$08,$00 *)
  found := Match(f,Concat(IdentStr,Chr($80),Chr($08),Chr($00)));
END;



(* Identifier suchen (erste Sorte) *)
PROCEDURE SearchIdenty1(VAR f : ByteFile;
                        VAR  found : BOOLEAN);

BEGIN
  found := Match(f,Concat(Chr($00),Chr($00),Chr($01)));
END;


(* Identifier suchen (zweite Sorte) *)
PROCEDURE SearchIdenty2(VAR f : ByteFile;
                        VAR  found : BOOLEAN);

BEGIN
  found := Match(f,Concat(Chr($0f),Chr($00),Chr($00),
                          Chr($00),Chr($00),Chr($00)));
END;


(* Ersten Identifier in Microsoft-Tabelle suchen *)
PROCEDURE SearchMSTabFirst(VAR f : ByteFile;
                           VAR  found : BOOLEAN);

BEGIN
  found := Match(f,Concat('!',Chr($01),Chr($00)));
END;


(* Identifier in Microsoft-Tabelle suchen *)
PROCEDURE SearchMSTab(VAR f : ByteFile;
                      VAR found : BOOLEAN);

BEGIN
  found := Match(f,Concat('{',Chr($00),Chr($00)));
END;


PROCEDURE WriteCountStr(Leader: Str255; VAR f : ByteFile);

LABEL 9999;
VAR count, i, c : BYTE;
    s : Str255;

BEGIN
  s := Leader;
  Read(f,count);
  FOR i := 1 TO count DO BEGIN
    Read(f,c);
    IF Chr(c) IN IdentSet THEN
      s := Concat(s,Chr(c))
    ELSE
      GOTO 9999;
  END;
  IF s <> Leader THEN WriteLn(s);
9999:
END;



BEGIN
  IF ParamCount <> 1 THEN BEGIN
    Usage;
    Exit
  END;
  InN := paramstr(1);
  Assign(InF,InN); ReSet(InF);
  ClrScr;
  Write('******************** LIBRARY-MONITOR : ');
  Write(InN); WriteLn(' **********************');
  WriteLn; WriteLn;
  WriteLn('-------- Module in der Library -------------');
  found := FALSE;
  REPEAT
    SearchModuls(InF,found);
    IF found THEN BEGIN
      WriteCountStr(Concat('Offset: ',Hex(FilePos(InF)),
                    '           '),InF);
    END;
  UNTIL NOT found;
  WriteLn; WriteLn;

  WriteLn('------- Identifier der Library I ----------');
  ReSet(InF);
  found := FALSE;
  REPEAT
    SearchIdenty1(InF,found);
    IF found THEN BEGIN
      WriteCountStr(Concat('Offset: ',Hex(FilePos(InF)),
                           '           '),InF);
    END;
  UNTIL NOT found;
  WriteLn; WriteLn;

  WriteLn('------- Identifier der Library II --------');
  ReSet(InF);
  found := FALSE;
  REPEAT
    SearchIdenty2(InF,found);
    IF found THEN BEGIN
      WriteCountStr(Concat('Offset: ',Hex(FilePos(InF)),
                           '           '),InF);
    END;
  UNTIL NOT found;
  WriteLn; WriteLn;

  WriteLn('------ Identifier in der MS-Tabelle --------');
  ReSet(InF);
  SearchMSTabFirst(InF,found);
  IF found THEN
    WriteCountStr(Concat('Offset: ',Hex(FilePos(InF)),
                         '           '),InF);
  found := FALSE;
  REPEAT
    SearchMSTab(InF,found);
    IF found THEN BEGIN
      WriteCountStr(Concat('Offset: ',Hex(FilePos(InF)),
                           '           '),InF);
    END;
  UNTIL NOT found;
  WriteLn; WriteLn;

  REPEAT
    Write('***** HEXDUMP (j/n): '); ReadLn(Wahl);
    IF Wahl IN ['j','J'] THEN BEGIN
      Write('***** Start-Adr: '); ReadLn(Adr);
      Write('*****  Nr-Bytes: '); ReadLn(Nr);
      WriteLn;
      Dump(InF,Adr,Nr);
    END;
    WriteLn; WriteLn;
  UNTIL Wahl IN ['n','N'];
  Close(InF);
END.