pedump.pas

East make Tray Icon in delphi

        UpdateRelocationView(Node);
        PageControl1.ActivePage := RelocTab;
      end;
    vcResource:
      if Node.Level = 0 then
      begin
        UpdateResourceDir;
        PageControl1.ActivePage := ResourceDirTab;
      end else
      begin
        UpdateResourceView(TJclPeResourceItem(Node.Data));
        PageControl1.ActivePage := ResourceTab;
      end;
    vcDebug:
      begin
        DebugListView.Items.Count := FPeImage.DebugList.Count;
        PageControl1.ActivePage := DebugTab;
      end;
  end;
end;

procedure TPeDumpChild.DirectoryListViewData(Sender: TObject; Item: TListItem);
const
  DirectoryIcons: array[0..15] of Integer =
    (icoExports, icoImports, icoResources, -1, -1, icoRelocation, icoDebug,
     -1, -1, -1, icoLoadConfig, icoBoundImport, -1, icoDelayImport, -1, -1);
var
  Percent: Single;
begin
  with Item, FPeImage.OptionalHeader do
  begin
    Percent := DataDirectory[Index].Size * 100 / SizeOfImage;
    Caption := FPeImage.DirectoryNames(Index);
    Data := Pointer(DataDirectory[Index].Size);
    if Integer(Data) <> 0 then ImageIndex := DirectoryIcons[Index];
    SubItems.Add(Format('%.8x', [DataDirectory[Index].VirtualAddress]));
    SubItems.Add(Format('%.8x', [DataDirectory[Index].Size]));
    SubItems.Add(Format('%3.1f%%', [Percent]));
    SubItems.Add(FPeImage.ImageSectionNameFromRva[DataDirectory[Index].VirtualAddress]);
  end;
end;

class procedure TPeDumpChild.UpdateSortData(Column: TListColumn);
var
  ListView: TListView;
  I: Integer;
begin
  ListView := TListView(TListColumns(Column.Collection).Owner);
  ListView.Columns.BeginUpdate;
  with ListView.Columns do
    for I := 0 to Count - 1 do
      Items[I].ImageIndex := -1;
  if ListView.Tag and $FF = Column.Index then
    ListView.Tag := ListView.Tag xor $100
  else
    ListView.Tag := Column.Index;
  if ListView.Tag and $100 = 0 then
    Column.ImageIndex := icoSortDesc
  else
    Column.ImageIndex := icoSortAsc;
  ListView.Columns.EndUpdate;
end;

procedure TPeDumpChild.ImportListViewColumnClick(Sender: TObject; Column: TListColumn);
begin
  UpdateSortData(Column);
  ImportListViewSort;
end;

procedure TPeDumpChild.UpdateImportView(Node: TTreeNode);
const
  LinkerProducers: array[TJclPeLinkerProducer] of string =
    ('Borland', 'Microsoft');
begin
  FCurrentImportIndex := -1;
  if Node = nil then
  begin
    FPeImage.ImportList.FilterModuleName := '';
    ImportListView.Items.Count := FPeImage.ImportList.AllItemCount;
  end else
  if Integer(Node.Data) = -1 then
  begin
    FPeImage.ImportList.FilterModuleName := Node.Text;
    ImportListView.Items.Count := FPeImage.ImportList.AllItemCount;
  end else
  begin
    FCurrentImportIndex := Integer(Node.Data);
    ImportListView.Items.Count := FPeImage.ImportList[FCurrentImportIndex].Count;
  end;
  ImportListViewSort;
  ImportListView.Invalidate;
  with ImportStatusBar, FPeImage.ImportList do
  begin
    Panels[0].Text := Format(RsNumberOfFunctions, [ImportListView.Items.Count]);
    Panels[1].Text := Format(RsLinkerProducer, [LinkerProducers[LinkerProducer]]);
  end;
end;

procedure TPeDumpChild.ImportListViewData(Sender: TObject; Item: TListItem);
var
  ViewItem: TJclPeImportFuncItem;
begin
  if FCurrentImportIndex = -1 then
    ViewItem := FPeImage.ImportList.AllItems[Item.Index]
  else
    ViewItem := FPeImage.ImportList[FCurrentImportIndex][Item.Index];
  with Item, ViewItem do
  begin
    if IndirectImportName then
      Caption := Format('[%s]', [Name])
    else
      Caption := FunctionName(Name);
    if IsByOrdinal then
    begin
      SubItems.Add(Format('%d', [Ordinal]));
      SubItems.Add('');
    end else
    begin
      SubItems.Add('');
      SubItems.Add(Format('%d', [Hint]));
    end;
    SubItems.Add(ImportLib.Name);
    ImageIndex := ImageIndexFromImportKind(ImportLib.ImportKind);
  end;
end;

procedure TPeDumpChild.FormDestroy(Sender: TObject);
begin
  FPeImage.Free;
end;

procedure TPeDumpChild.ExportListViewData(Sender: TObject; Item: TListItem);
begin
  with Item, FPeImage.ExportList[Item.Index] do
  begin
    Caption := FunctionName(Name);
    SubItems.Add(Format('%d', [Ordinal]));
    SubItems.Add(Format('%d', [Hint]));
    SubItems.Add(Format('%.8x', [Address]));
    SubItems.Add(ForwardedName);
    SubItems.Add(SectionName);
    ImageIndex := 3;
  end;
end;

procedure TPeDumpChild.ExportListViewColumnClick(Sender: TObject;
  Column: TListColumn);
begin
  UpdateSortData(Column);
  ExportListViewSort;
end;

function TPeDumpChild.IsListViewActiveAndFocused(ListView: TListView): Boolean;
begin
  Result := (ActiveControl = ListView) and (ListView.ItemFocused <> nil);
end;

procedure TPeDumpChild.SectionTreeViewDblClick(Sender: TObject);
begin
  MainForm.OpenLibrary1.Execute;
end;

procedure TPeDumpChild.SectionListViewData(Sender: TObject; Item: TListItem);
var
  Percent: Single;
begin
  with FPeImage, Item do
  begin
    Caption := ImageSectionNames[Item.Index];
    with ImageSectionHeaders[Item.Index] do
    begin
      Percent := SizeOfRawData * 100 / OptionalHeader.SizeOfImage;
      SubItems.Add(Format('%.8x', [Misc.VirtualSize]));
      SubItems.Add(Format('%.8x', [VirtualAddress]));
      SubItems.Add(Format('%.8x', [SizeOfRawData]));
      SubItems.Add(Format('%.8x', [PointerToRawData]));
      SubItems.Add(Format('%.8x', [Characteristics]));
      SubItems.Add(ShortSectionInfo(Characteristics));
      SubItems.Add(Format('%3.1f%%', [Percent]));
    end;
  end;
end;

procedure TPeDumpChild.UpdateResourceView(Directory: TJclPeResourceItem);
begin
  ResourceListView.Items.Count := 0;
  FCurrentResourceDirectory := Directory;
  ResourceListView.Items.Count := Directory.List.Count;
  ResourceListView.Invalidate;
end;

procedure TPeDumpChild.ResourceListViewData(Sender: TObject; Item: TListItem);
var
  DirSize, I: Integer;
begin
  with Item, FCurrentResourceDirectory.List[Item.Index] do
  begin
    if IsDirectory then
    begin
      Caption := Name;
      if (List.Count = 1) and (StrToIntDef(List[0].Name, 0) = LANG_NEUTRAL) then
      begin // only neutral language
        DirSize := List[0].DataEntry^.Size;
        SubItems.Add(Format('(%x)', [List[0].DataEntry^.OffsetToData]));
      end else
      begin
        DirSize := 0;
        for I := 0 to List.Count - 1 do
          Inc(DirSize, List[I].DataEntry^.Size);
        SubItems.Add('');
      end;  
      SubItems.Add(Format('%x', [DirSize]));
      SubItems.Add(Format('%d', [List.Count]));
    end else
    begin 
      Caption := Format('%s (%s)', [ParentItem.Name, Name]);
      SubItems.Add(Format('%x', [DataEntry^.OffsetToData]));
      SubItems.Add(Format('%x', [DataEntry^.Size]));
      SubItems.Add(LangNameFromName(Name));
    end;
  end;
end;

procedure TPeDumpChild.UpdateResourceDir;
begin
  ResourceDirListView.Items.Count := FPeImage.ResourceList.Count;
  ResourceDirListView.Invalidate;
end;

procedure TPeDumpChild.ResourceDirListViewData(Sender: TObject; Item: TListItem);
begin
  with Item, FPeImage.ResourceList[Item.Index] do
  begin
    Caption := ResourceTypeStr;
    SubItems.Add(Format('%d', [List.Count]));
  end;
end;

procedure TPeDumpChild.UpdateRelocationView(Node: TTreeNode);
begin
  if Node.Level = 0 then
  begin
    FCurrentRelocationIndex := -1;
    RelocListView.Items.Count := FPeImage.RelocationList.AllItemCount;
  end else
  begin
    FCurrentRelocationIndex := Integer(Node.Data);
    RelocListView.Items.Count := FPeImage.RelocationList[FCurrentRelocationIndex].Count;
  end;
  RelocStatusBar.Panels[0].Text := Format(RsAddresses, [RelocListView.Items.Count]);
  RelocListView.Invalidate;
end;

procedure TPeDumpChild.RelocListViewData(Sender: TObject; Item: TListItem);
var
  ViewItem: TJclPeRelocation;

  function RelocationTypeStr(RelocType: Byte): string;
begin
  case RelocType of
    IMAGE_REL_BASED_ABSOLUTE: Result := 'ABSOLUTE';
    IMAGE_REL_BASED_HIGHLOW: Result := 'HIGHLOW';
  else
    Result := IntToStr(RelocType);
  end;
end;

begin
  if FCurrentRelocationIndex = -1 then
    ViewItem := FPeImage.RelocationList.AllItems[Item.Index]
  else
    ViewItem := FPeImage.RelocationList[FCurrentRelocationIndex][Item.Index];
  with Item, ViewItem do
  begin
    Caption := Format('%.8x', [VirtualAddress]);
    SubItems.Add(RelocationTypeStr(RelocType));
  end;
end;

procedure TPeDumpChild.DebugListViewData(Sender: TObject; Item: TListItem);
begin
  with Item, FPeImage.DebugList[Item.Index] do
  begin
    Caption := FPeImage.DebugTypeNames(_Type);
    SubItems.Add(Format('%.8x', [SizeOfData]));
    SubItems.Add(Format('%.8x', [AddressOfRawData]));
    SubItems.Add(Format('%.8x', [PointerToRawData]));
    SubItems.Add(Format('%d.%.2d', [MajorVersion, MinorVersion]));
  end;  
end;

procedure TPeDumpChild.ImportListViewDblClick(Sender: TObject);
begin
  MainForm.InvokeHelp1.Execute;
end;

procedure TPeDumpChild.DirectoryListViewCustomDrawItem(Sender: TCustomListView;
  Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
begin
  if Integer(Item.Data) = 0 then Sender.Canvas.Font.Color := clGrayText;
end;

procedure TPeDumpChild.SetGroupImports(const Value: Boolean);
var
  NodeIndex: Integer;
  TempNode: TTreeNode;
  WasExpanded: Boolean;
begin
  if FGroupImports <> Value then
  begin
    FGroupImports := Value;
    with SectionTreeView do
    begin
      Items.BeginUpdate;
      FUpdatingView := True;
      try
        if Assigned(Selected) then
        begin
          if Selected.Level > 0 then
          begin
            NodeIndex := Selected.Parent.Index;
            WasExpanded := True;
          end else
          begin
            NodeIndex := Selected.Index;
            WasExpanded := Selected.Expanded;
          end;
        end else
        begin
          NodeIndex := 0;
          WasExpanded := False;
        end;
        Self.UpdateView;
        TempNode := Items.GetFirstNode;
        while NodeIndex > 0 do
        begin
          TempNode := TempNode.GetNextSibling;
          Dec(NodeIndex);
        end;
        FUpdatingView := False;
        Selected := TempNode;
        if WasExpanded then Selected.Expand(False);
      finally
        Items.EndUpdate;
      end;
    end;
  end;
end;

procedure TPeDumpChild.ImportListViewSort;
const
  MapIndexToSortType: array[0..3] of TJclPeImportSort = (isName, isOrdinal, isHint, isLibImport);
begin
  with ImportListView do
  begin
    if FCurrentImportIndex = -1 then
      FPeImage.ImportList.SortAllItemsList(MapIndexToSortType[Tag and $FF], Tag and $100 <> 0)
    else
      FPeImage.ImportList[FCurrentImportIndex].SortList(MapIndexToSortType[Tag and $FF], Tag and $100 <> 0);
    Invalidate;
  end;
end;

procedure TPeDumpChild.ExportListViewSort;
const
  MapIndexToSortType: array[0..5] of TJclPeExportSort =
    (esName, esOrdinal, esHint, esAddress, esForwarded, esSection);
begin
  with ExportListView do
  begin
    FPeImage.ExportList.SortList(MapIndexToSortType[Tag and $FF], Tag and $100 <> 0);
    Invalidate;
  end;
end;

function TPeDumpChild.GetNodeCategory(Node: TTreeNode): TPeDumpViewCategory;
begin
  while Node.Parent <> nil do Node := Node.Parent;
  Result := TPeDumpViewCategory(Node.Data);
end;

procedure TPeDumpChild.SetUnmangleNames(const Value: Boolean);
begin
  if FUnmangleNames <> Value then
  begin
    FUnmangleNames := Value;
    ImportListView.Invalidate;
    ExportListView.Invalidate;
  end;
end;

function TPeDumpChild.FunctionName(const Name: string): string;
begin
  if FUnmangleNames then
    PeUnmangleName(Name, Result)
  else
    Result := Name;
end;

function TPeDumpChild.HeadersRemark(HeaderItem: TJclPeHeader): string;
const
  ImageCharacteristicValues: array [1..14] of packed record
      Value: Word;
      Name: PChar;
    end = (
    (Value: IMAGE_FILE_RELOCS_STRIPPED; Name: 'RELOCS_STRIPPED'),
    (Value: IMAGE_FILE_EXECUTABLE_IMAGE; Name: 'EXECUTABLE_IMAGE'),
    (Value: IMAGE_FILE_LINE_NUMS_STRIPPED; Name: 'LINE_NUMS_STRIPPED'),
    (Value: IMAGE_FILE_LOCAL_SYMS_STRIPPED; Name: 'LOCAL_SYMS_STRIPPED'),
    (Value: IMAGE_FILE_AGGRESIVE_WS_TRIM; Name: 'AGGRESIVE_WS_TRIM'),
    (Value: IMAGE_FILE_BYTES_REVERSED_LO; Name: 'BYTES_REVERSED_LO'),
    (Value: IMAGE_FILE_32BIT_MACHINE; Name: '32BIT_MACHINE'),
    (Value: IMAGE_FILE_DEBUG_STRIPPED; Name: 'DEBUG_STRIPPED'),
    (Value: IMAGE_FILE_REMOVABLE_RUN_FROM_SWAP; Name: 'REMOVABLE_RUN_FROM_SWAP'),
    (Value: IMAGE_FILE_NET_RUN_FROM_SWAP; Name: 'NET_RUN_FROM_SWAP'),
    (Value: IMAGE_FILE_SYSTEM; Name: 'SYSTEM'),
    (Value: IMAGE_FILE_DLL; Name: 'DLL'),
    (Value: IMAGE_FILE_UP_SYSTEM_ONLY; Name: 'UP_SYSTEM_ONLY'),
    (Value: IMAGE_FILE_BYTES_REVERSED_HI; Name: 'BYTES_REVERSED_HI')
  );
var
  C: Word;
  I: Integer;
begin
  case HeaderItem of
    JclPeHeader_Characteristics:
      begin
        Result := '';
        C := FPeImage.LoadedImage.FileHeader.FileHeader.Characteristics;
        for I := Low(ImageCharacteristicValues) to High(ImageCharacteristicValues) do
          if C and ImageCharacteristicValues[I].Value <> 0 then
            Result := Result + #13#10 + ImageCharacteristicValues[I].Name;
        Delete(Result, 1, 2);
      end;
  else
    Result := '';
  end;
end;

procedure TPeDumpChild.ItemsListViewInfoTip(Sender: TObject;
  Item: TListItem; var InfoTip: String);
begin
  case TListView(Sender).Tag of
    0: InfoTip := HeadersRemark(TJclPeHeader(Item.Index));
  end;
end;

end.