exeimage.pas

Delphi写的PE查看器

end;

procedure TResourceItem.SaveToFile(const FileName: string);
var
  FS: TFileStream;
begin
  FS := TFileStream.Create(FileName, fmCreate);
  try
    Self.SaveToStream(FS);
  finally
    FS.Free;
  end;
end;

procedure TResourceItem.SaveToStream(Stream: TStream);
begin
  Stream.Write(RawData^, Size);
end;

function TResourceItem.Size: Integer;
begin
  if IsList then
    Result := 0
  else
    Result := DataEntry.Size;
end;

{ TBitmapResource }

procedure TBitmapResource.AssignTo(Dest: TPersistent);
var
  MemStr: TMemoryStream;
  BitMap: TBitMap;
begin
  if (Dest is TPicture) then
  begin
    BitMap := TPicture(Dest).Bitmap;
    MemStr := TMemoryStream.Create;
    try
      SaveToStream(MemStr);
      MemStr.Seek(0,0);
      BitMap.LoadFromStream(MemStr);
    finally
      MemStr.Free;
    end
  end
  else
    inherited AssignTo(Dest);
end;

procedure TBitmapResource.SaveToStream(Stream: TStream);

  function GetDInColors(BitCount: Word): Integer;
  begin
    case BitCount of
      1, 4, 8: Result := 1 shl BitCount;
    else
      Result := 0;
    end;
  end;

var
  BH: TBitmapFileHeader;
  BI: PBitmapInfoHeader;
  BC: PBitmapCoreHeader;
  ClrUsed: Integer;
begin
  FillChar(BH, sizeof(BH), #0);
  BH.bfType := $4D42;
  BH.bfSize := Self.Size + sizeof(BH);
  BI := PBitmapInfoHeader(RawData);
  if BI.biSize = sizeof(TBitmapInfoHeader) then
  begin
    ClrUsed := BI.biClrUsed;
    if ClrUsed = 0 then
      ClrUsed := GetDInColors(BI.biBitCount);
    BH.bfOffBits :=  ClrUsed * SizeOf(TRgbQuad) +
      sizeof(TBitmapInfoHeader) + sizeof(BH);
  end
  else
  begin
    BC := PBitmapCoreHeader(RawData);
    ClrUsed := GetDInColors(BC.bcBitCount);
    BH.bfOffBits :=  ClrUsed * SizeOf(TRGBTriple) +
      sizeof(TBitmapCoreHeader) + sizeof(BH);
  end;
  Stream.Write(BH, SizeOf(BH));
  Stream.Write(RawData^, Self.Size);
end;


{ TIconResource }

function TIconResource.GetResourceList: TResourceList;
begin
  if not Assigned(FList) then
    FList := TIconResourceList.CreateList(Owner, LongInt(RawData), FExeImage);
  Result := FList;
end;

function TIconResource.IsList: Boolean;
begin
  Result := True;
end;

{ TIconResEntry }

procedure TIconResEntry.AssignTo(Dest: TPersistent);
var
  hIco: HIcon;
begin
  if Dest is TPicture then
  begin
    hIco := CreateIconFromResource(RawData, Size, (ResType = rtIconEntry), $30000);
    TPicture(Dest).Icon.Handle := hIco;
  end
  else
    inherited AssignTo(Dest);
end;

function TIconResEntry.GetName: string;
begin
  if Assigned(FResInfo) then
    with FResInfo^ do
      Result := Format('%d X %d %d Colors', [bWidth, bHeight, bColorCount])
  else
    Result := inherited GetName;
end;

procedure TIconResEntry.SaveToStream(Stream: TStream);
begin
  with TIcon.Create do
  try
    Handle := CreateIconFromResource(RawData, Self.Size, (ResType <> rtIcon), $30000);
    SaveToStream(Stream);
  finally
    Free;
  end;
end;

{ TCursorResource }

function TCursorResource.GetResourceList: TResourceList;
begin
  if not Assigned(FList) then
    FList := TCursorResourceList.CreateList(Owner, LongInt(RawData), FExeImage);
  Result := FList;
end;

{ TCursorResEntry }

function TCursorResEntry.GetName: string;
begin
  if Assigned(FResInfo) then
    with FResInfo^ do
      Result := Format('%d X %d %d Bit(s)', [wWidth, wWidth, wBitCount])
  else
    Result := inherited GetName;
end;

{ TStringResource }

procedure TStringResource.AssignTo(Dest: TPersistent);
var
  P: PWChar;
  ID: Integer;
  Cnt: Cardinal;
  Len: Word;
begin
  if (Dest is TStrings) then
    with TStrings(Dest) do
    begin
      BeginUpdate;
      try
        Clear;
        P := RawData;
        Cnt := 0;
        while Cnt < StringsPerBlock do
        begin
          Len := Word(P^);
          if Len > 0 then
          begin
            Inc(P);
            ID := ((FDirEntry.Name - 1) shl 4) + Cnt;
            Add(Format('%d,  "%s"', [ID, WideCharToStr(P, Len)]));
            Inc(P, Len);
          end;
          Inc(Cnt);
        end;
      finally
        EndUpdate;
      end;
    end
  else
    inherited AssignTo(Dest);
end;

{ TMenuResource }

procedure TMenuResource.SetNestLevel(Value: Integer);
begin
  FNestLevel := Value;
  SetLength(FNestStr, Value * 2);
  FillChar(FNestStr[1], Value * 2, ' ');
end;

procedure TMenuResource.AssignTo(Dest: TPersistent);
var
  IsPopup: Boolean;
  Len: Word;
  MenuData: PWord;
  MenuEnd: PChar;
  MenuText: PWChar;
  MenuID: Word;
  MenuFlags: Word;
  S: string;
begin
  if (Dest is TStrings) then
    with TStrings(Dest) do
    begin
      BeginUpdate;
      try
        Clear;
        MenuData := RawData;
        MenuEnd := PChar(RawData) + Size;
        Inc(MenuData, 2);
        NestLevel := 0;
        while PChar(MenuData) < MenuEnd do
        begin
          MenuFlags := MenuData^;
          Inc(MenuData);
          IsPopup := (MenuFlags and MF_POPUP) = MF_POPUP;
          MenuID := 0;
          if not IsPopup then
          begin
            MenuID := MenuData^;
            Inc(MenuData);
          end;
          MenuText := PWChar(MenuData);
          Len := lstrlenw(MenuText);
          if Len = 0 then
            S := 'MENUITEM SEPARATOR'
          else
          begin
            S := WideCharToStr(MenuText, Len);
            if IsPopup then
              S := Format('POPUP "%s"', [S]) else
              S := Format('MENUITEM "%s",  %d', [S, MenuID]);
          end;
          Inc(MenuData, Len + 1);
          Add(NestStr + S);
          if (MenuFlags and MF_END) = MF_END then
          begin
            NestLevel := NestLevel - 1;
            Add(NestStr + 'ENDPOPUP');
          end;
          if IsPopup then
            NestLevel := NestLevel + 1;
        end;
      finally
        EndUpdate;
      end;
    end
  else
    inherited AssignTo(Dest);
end;

{ TResourceList }

constructor TResourceList.CreateList(AOwner: TComponent; ResDirOfs: Longint;
  AExeImage: TExeImage);
var
  DirEntry: PIMAGE_RESOURCE_DIRECTORY_ENTRY;
begin
  inherited Create(AOwner);
  FExeImage := AExeImage;
  FResDir := Pointer(ResDirOfs);
  if AOwner <> AExeImage then
    if AOwner.Owner.Owner = AExeImage then
    begin
      DirEntry := PIMAGE_RESOURCE_DIRECTORY_ENTRY(FResDir);
      inc(PIMAGE_RESOURCE_DIRECTORY(DirEntry));
      FResType := TResourceItem(Owner).FDirEntry.Name;
    end
    else
      FResType := (AOwner.Owner.Owner as TResourceList).FResType;
end;

destructor TResourceList.Destroy;
begin
  inherited Destroy;
  FList.Free;
end;

function TResourceList.List: TList;
var
  I: Integer;
  DirEntry: PIMAGE_RESOURCE_DIRECTORY_ENTRY;
  DirCnt: Integer;
  ResItem: TResourceItem;
begin
  if not Assigned(FList) then
  begin
    FList := TList.Create;
    DirEntry := PIMAGE_RESOURCE_DIRECTORY_ENTRY(FResDir);
    inc(PIMAGE_RESOURCE_DIRECTORY(DirEntry));
    DirCnt := FResDir.NumberOfNamedEntries + FResDir.NumberOfIdEntries - 1;
    for I := 0 to DirCnt do
    begin
      { Handle Cursors and Icons specially }
      ResItem := GetResourceClass(FResType).CreateItem(Self, DirEntry);
      if Owner = FExeImage then
        if (TResourceType(DirEntry.Name) in [rtCursorEntry, rtIconEntry]) then
        begin
          if TResourceType(DirEntry.Name) = rtCursorEntry then
            FExeImage.FCursorResources := ResItem else
            FExeImage.FIconResources := ResItem;
          Inc(DirEntry);
          Continue;
        end;
      FList.Add(ResItem);
      Inc(DirEntry);
    end;
  end;
  Result := FList;
end;

function TResourceList.Count: Integer;
begin
  Result := List.Count;
end;

function TResourceList.GetResourceItem(Index: Integer): TResourceItem;
begin
  Result := List[Index];
end;

{ TIconResourceList }

function TIconResourceList.List: TList;
var
  I,  J, Cnt: Integer;
  ResData: PIconResInfo;
  ResList: TResourceList;
  ResOrd: Cardinal;
  IconResource: TIconResEntry;
begin
  if not Assigned(FList) then
  begin
    FList := TList.Create;
    Cnt := PIconHeader(FResDir).wCount;
    PChar(ResData) := PChar(FResDir) + SizeOf(TIconHeader);
    ResList := FExeImage.FIconResources.List;
    for I := 0 to Cnt - 1 do
    begin
      ResOrd := ResData.wNameOrdinal;
      for J := 0 to ResList.Count - 1 do
      begin
        if ResOrd = ResList[J].FDirEntry.Name then
        begin
          IconResource := ResList[J] as TIconResEntry;
          IconResource.FResInfo := ResData;
          FList.Add(IconResource);
        end;
      end;
      Inc(ResData);
    end;
  end;
  Result := FList;
end;

{ TCursorResourceList }

function TCursorResourceList.List: TList;
var
  I, J, Cnt: Integer;
  ResData: PCursorResInfo;
  ResList: TResourceList;
  ResOrd: Cardinal;
  CursorResource: TCursorResEntry;
begin
  if not Assigned(FList) then
  begin
    FList := TList.Create;
    Cnt := PIconHeader(FResDir).wCount;
    PChar(ResData) := PChar(FResDir) + SizeOf(TIconHeader);
    ResList := FExeImage.FCursorResources.List;
    for I := 0 to Cnt - 1 do
    begin
      ResOrd := ResData.wNameOrdinal;
      for J := 0 to ResList.Count - 1 do
      begin
        if ResOrd = ResList[J].FDirEntry.Name then
        begin
          CursorResource := ResList[J] as TCursorResEntry;
          CursorResource.FResInfo := ResData;
          FList.Add(CursorResource);
        end;
      end;
      Inc(ResData);
    end;
  end;
  Result := FList;
end;

end.