uresourcefunction.pas

在delphi中实现windows核心编程.原书光盘代码核心编程.原书光盘代码

unit UResourceFunction;

interface

uses
  TypInfo, Classes, SysUtils, Windows, Graphics, UPEconst,Dialogs;

function LoadPE_GotoResources(FileName:string;var Base:pointer;var ResourceRVA:DWORD):PImageResourceDirectory;
procedure FreePE;

function HighBitSet(L: Longint): Boolean;
function StripHighBit(L: Longint): DWORD;

function ResourceIsDirectory(ResourceDirectoryEntry:PImageResourceDirectoryEntry):boolean;
function FirstChildDirEntry(ResourceDirectoryEntry:PImageResourceDirectoryEntry): PImageResourceDirectoryEntry;
procedure ResourceSaveToStream(ResType:TResourceType;ResourceDirectoryEntry:PImageResourceDirectoryEntry;Stream: TStream);
procedure ResourceSaveToFile(ResType:TResourceType;ResourceDirectoryEntry:PImageResourceDirectoryEntry;FileName:string);
function ResourceSize(ResourceDirectoryEntry:PImageResourceDirectoryEntry): Integer;
function ResourceOffset(ResourceDirectoryEntry:PImageResourceDirectoryEntry): Integer;
function ResourceRawData(ResourceDirectoryEntry:PImageResourceDirectoryEntry): Pointer;
function ResourceGetName(ResourceDirectoryEntry:PImageResourceDirectoryEntry;var ResType:TResourceType):string;

implementation

var
   FFileHandle:DWORD;
   FFileMapping: THandle; {映射文件句柄}
   FFileBase: Pointer; {映射基址}
   FResourceBase:PImageResourceDirectory;
   FResourceRVA:DWORD;
   
function LoadPE_GotoResources(FileName:string;var Base:pointer;var ResourceRVA:DWORD):PImageResourceDirectory;
var
   I:integer;
   DosHeader: PImageDosHeader;
   NTHeader: PImageNtHeaders; {NtHeader}
   SectionHeader:PImagesectionHeader;
begin
  FFileHandle := CreateFile(PChar(FileName), GENERIC_READ, FILE_SHARE_READ,
    nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);

  if FFileHandle = INVALID_HANDLE_VALUE then raise Exception.create('不能打开文件:' + FileName);
   //创建内存映射文件，返回映射句柄
  FFileMapping := CreateFileMapping(FFileHandle, nil, PAGE_READONLY, 0, 0, nil);
  if FFileMapping = 0 then raise Exception.create('CreateFileMapping failed');
    //将映象文件映射到进程中，并返回映象基地址
  FFileBase := MapViewOfFile(FFileMapping, FILE_MAP_READ, 0, 0, 0);
  if FFileBase = nil then raise Exception.create('MapViewOfFile failed');
    //定位到DosHeader
  Base:=FFileBase;
  DosHeader := PImageDosHeader(FFileBase);
  if not DosHeader.e_magic = IMAGE_DOS_SIGNATURE then
    raise Exception.create('未能识识的文件格式');
  //定位到FNtHeader
  NTHeader := PImageNtHeaders(Longint(DosHeader) + DosHeader._lfanew);
  if IsBadReadPtr(NTHeader, sizeof(TImageNtHeaders)) or
    (NTHeader.Signature <> IMAGE_NT_SIGNATURE) then
    raise Exception.create('非Win32可执行文件');
  SectionHeader := PImageSectionHeader(NTHeader); //指向NtHeader
  Inc(PImageNtHeaders(SectionHeader)); //指针向前移Sizeof(TImageNtheaders),这时指向节表第一项
  //遍历整个节表
  for I := 0 to NTHeader^.FileHeader.NumberOfSections - 1 do
  begin
    //比较是否是指定的节名，如“.rsrc”
    if Strlicomp(@SectionHeader^.Name, PChar('.rsrc'), IMAGE_SIZEOF_SHORT_NAME) = 0 then
    begin
       FResourceBase := PImageResourceDirectory(SectionHeader^.PointerToRawData + LongWord(DosHeader));
       result:=FResourceBase;
       //资源数据的重定位值，这是一个复杂的概念。
       //由于PE文件加载至内存后，并不是以原文件物理结构读入内存中，而是部分“节”被
       //重定位到新的内存中，VirtualAddress正是表示该“节”被重定位到什么位置
       FResourceRVA:= SectionHeader^.VirtualAddress;
       ResourceRVA:=FResourceRVA;
       Exit; //找到了，则退出
    end;
    Inc(SectionHeader); //取节表下一项，即当前地址加上Sizeof(TImageSectionHeader)
  end;
  raise Exception.create('没找到PE文件的资源');
end;

procedure FreePE;
begin
  if FFileHandle <> INVALID_HANDLE_VALUE then
  begin
    UnmapViewOfFile(FFileBase); //取消映象视图
    CloseHandle(FFileMapping); //关闭映象文件句柄
    CloseHandle(FFileHandle); //关闭文件句柄
  end;
end;

function ResourceIsDirectory(ResourceDirectoryEntry:PImageResourceDirectoryEntry):boolean;
begin
   result:=//(ResType=rtCursor) or
      HighBitSet(FirstChildDirEntry(ResourceDirectoryEntry)^.OffsetToData);
end;

function FirstChildDirEntry(ResourceDirectoryEntry:PImageResourceDirectoryEntry): PImageResourceDirectoryEntry;
begin
  //OffsetToData是资源的基地址
  //资源的基地址加上SizeOf(TImageResourceDirectory)，就是资源的第一项
  //FResourceBase用于把相对地址转为绝对地址
  result := PImageResourceDirectoryEntry(StripHighBit(ResourceDirectoryEntry^.OffsetToData) +
     DWORD(FResourceBase) + SizeOf(TImageResourceDirectory));
end;

function ResourceDataEntry(ResourceDirectoryEntry:PImageResourceDirectoryEntry):PImageResourceDataEntry;
begin
   result:=PImageResourceDataEntry(FirstChildDirEntry(ResourceDirectoryEntry)^.OffsetToData
       + Cardinal(FResourceBase));
end;

function ResourceGetName(ResourceDirectoryEntry:PImageResourceDirectoryEntry;var ResType:TResourceType):string;
var
  PDirStr: PImageResourceDirStringU;
begin
   if HighBitSet(ResourceDirectoryEntry^.Name) then //PTmageResourceDirStringU
   begin
      PDirStr := PImageResourceDirStringU(StripHighBit(ResourceDirectoryEntry^.Name)+DWORD(FResourceBase));
      result:=WideCharLenToString(@PDirStr^.NameString, PDirStr^.Length); //双字节转换为字符串
   end
   else if (ResourceDirectoryEntry^.Name<MAXResourceType) and (ResType=rtFirstEntry) then
   begin
      result:=ResourceTypeName[ResourceDirectoryEntry^.Name];
      ResType:=ResourceDirectoryEntry^.Name;
   end
   else begin
      result:= Format('%d', [ResourceDirectoryEntry^.Name]);
   end;
end;

function ResourceSize(ResourceDirectoryEntry:PImageResourceDirectoryEntry): Integer;
begin
  if ResourceIsDirectory(ResourceDirectoryEntry) then //如果是目录
    Result := 0
  else //如果不是目录
    //资源的第一项的数据长度，其中DataEntry是资源的第一项的数据地址
    Result := ResourceDataEntry(ResourceDirectoryEntry)^.Size;
end;

function ResourceOffset(ResourceDirectoryEntry:PImageResourceDirectoryEntry): Integer;
begin
  if ResourceIsDirectory(ResourceDirectoryEntry) then //如果是目录
    //取当前资源的基地址
    Result := StripHighBit(ResourceDirectoryEntry^.OffsetToData)
  else //如果不是目录
    //取资源第一项的数据地址的第一个入口
    //其中，DataEntry是资源第一项的数据地址
    Result := ResourceDataEntry(ResourceDirectoryEntry)^.OffsetToData;
end;

function ResourceRawData(ResourceDirectoryEntry:PImageResourceDirectoryEntry): Pointer;
begin
  //取资源第一项的数据的第一个入口，DataEntry表示资源第一项的数据
  //FResourceBase把相对地址转为绝对地址
  //FResourceRVA用于重定位的校正，因为PE文件读入内存后，部分“节”被重定位了
  Result := pointer(DWORD(FResourceBase) - FResourceRVA +
       DWORD(ResourceDataEntry(ResourceDirectoryEntry)^.OffsetToData));
end;

procedure BitmapResourceSaveToStream(ResourceDirectoryEntry:PImageResourceDirectoryEntry;Stream: TStream);
  function GetDInColors(BitCount: Word): Integer;
  begin
    case BitCount of
      1, 4, 8: Result := 1 shl BitCount; //1,4,8位色
    else
      Result := 0;
    end;
  end;
var
  BH: TBitmapFileHeader; //位图文件头信息
  BI: PBitmapInfoHeader; //
  BC: PBitmapCoreHeader; //位图核心信息
  ClrUsed: Integer;
  RawData:pointer;
begin
  FillChar(BH, sizeof(BH), #0); //填充
  BH.bfType := $4D42; //位图类型
  BH.bfSize := ResourceSize(ResourceDirectoryEntry) + sizeof(BH); //
  RawData:=ResourceRawData(ResourceDirectoryEntry);
  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^, ResourceSize(ResourceDirectoryEntry));
end;

procedure CursorIconResourceSaveToStream(IsIcon:boolean;ResourceDirectoryEntry:PImageResourceDirectoryEntry;Stream: TStream);
type
  TCursorDirentry=packed record
    bwidth:byte;
    bheight:byte;
    bcolorcount:byte;
    breserved:byte;
    wxhotspot:word;
    wyhotspot:word;
    lbytesinres:dword;
    dwimageoffset:dword;
  end;
  PCursorDirentry=^TCursorDirentry;
  TCursorDir = packed record
    cdreserved:word;
    cdtype:word;
    cdcount:word;
    cdentries:TCursorDirentry;
  end;
  PCursorDir=^TCursorDir;
  procedure CursorResource2CursorFile(ResourceData:pchar;ResourceSize:integer;Stream:TStream);
  var
     CursorDir:TCursorDir;
  begin
     with CursorDir do
     begin
        cdreserved:=0;
        cdtype:=2;
        cdcount:=1;
        cdentries.bwidth:=$20;   //
        cdentries.bheight:=$20;  //
        cdentries.bcolorcount:=0;
        cdentries.breserved:=0;
        cdentries.wxhotspot:=pword(ResourceData)^;
        cdentries.wyhotspot:=pword(ResourceData+2)^;
        cdentries.lbytesinres:=ResourceSize-4;
        cdentries.dwimageoffset:=sizeof(TCursorDir);
     end;
     Stream.Write(CursorDir,sizeof(TCursorDir));
     Stream.Write(pchar(integer(ResourceData)+4)^,ResourceSize-4);
  end;
var
   icon:TIcon;
   DataSize:integer;
   data:pchar;
begin
   DataSize:=ResourceSize(ResourceDirectoryEntry);
   data:=ResourceRawData(ResourceDirectoryEntry);
   if IsIcon then
   begin
      icon:=TIcon.Create;
      try
        icon.Handle:=CreateIconFromResource(PByte(Data),DataSize, IsIcon, $30000);
        icon.SaveToStream(stream);
      except
      end;
      icon.Free;
   end
   else CursorResource2CursorFile(Data,DataSize,Stream);
end;

procedure MenuResourceSaveToStream(ResourceDirectoryEntry:PImageResourceDirectoryEntry;Stream: TStream);
var
  IsPopup: Boolean;
  Len: Word;
  MenuData: PWord;
  MenuEnd: PChar;
  MenuText: PWChar;
  MenuID: Word;
  MenuFlags: Word;
  S: string;
  RawData:pchar;
  FNestStr: string;
  FNestLevel: Integer;
  procedure SetNestLevel(Value: Integer);
  begin
    FNestLevel := Value;
    SetLength(FNestStr, Value * 2);
    FillChar(FNestStr[1], Value * 2, ' ');
  end;
begin
        Stream.Position:=0;
        Stream.Size:=0;
        RawData:=ResourceRawData(ResourceDirectoryEntry);
        MenuData := Pointer(RawData);
        MenuEnd := RawData + ResourceSize(ResourceDirectoryEntry);
        Inc(MenuData, 2);
        FNestLevel := 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 := WideCharLenToString(MenuText, Len);
            if IsPopup then
              S := Format('POPUP "%s"', [S]) else
              S := Format('MENUITEM "%s",  %d', [S, MenuID]);
          end;
          Inc(MenuData, Len + 1);
          S := FNestStr + S + #$D#$A;
          Stream.Write(s[1],length(s));
          if (MenuFlags and MF_END) = MF_END then
          begin
            dec(FNestLevel);
            S := FNestStr + 'ENDPOPUP'+#$D#$A;
            Stream.Write(s[1],length(s));
          end;
          if IsPopup then
            inc(FNestLevel);
        end;
end;

procedure StringResourceSaveToStream(ResourceDirectoryEntry:PImageResourceDirectoryEntry;Stream: TStream);
var
  P: PWChar;
  ID: Integer;
  Cnt: Cardinal;
  Len: Word;
  S:string;
begin
        Stream.Position:=0;
        Stream.Size:=0;
        P := ResourceRawData(ResourceDirectoryEntry);
        Cnt := 0;
        while Cnt < StringsPerBlock do
        begin
          Len := Word(P^);
          if Len > 0 then
          begin
            Inc(P);
            ID := ((ResourceDirectoryEntry^.Name - 1) shl 4) + Cnt;
            S := Format('%d,  "%s"'#$D#$A, [ID, WideCharLenToString(P, Len)]);
            Stream.Write(s[1],length(s));
            Inc(P, Len);
          end;
          Inc(Cnt);
        end;
end;

procedure ResourceSaveToStream(ResType:TResourceType;ResourceDirectoryEntry:PImageResourceDirectoryEntry;Stream: TStream);
begin
   case ResType of
   rtCursorEntry:
      CursorIconResourceSaveToStream(False,ResourceDirectoryEntry,Stream);
   rtBitmap:
      BitmapResourceSaveToStream(ResourceDirectoryEntry,Stream);
   rtIconEntry:
      CursorIconResourceSaveToStream(True,ResourceDirectoryEntry,Stream);
   rtMenu:
      MenuResourceSaveToStream(ResourceDirectoryEntry,Stream);
   rtString:
      StringResourceSaveToStream(ResourceDirectoryEntry,Stream);
   end;
end;

procedure ResourceSaveToFile(ResType:TResourceType;ResourceDirectoryEntry:PImageResourceDirectoryEntry;FileName:string);
var
   F:TFileStream;
begin
   F:=TFileStream.create(FileName,fmCreate);
   ResourceSaveToStream(ResType,ResourceDirectoryEntry,F);
   F.free;
end;

//判断最高位是否是1
function HighBitSet(L: Longint): Boolean;
begin
  Result := (L and IMAGE_RESOURCE_DATA_IS_DIRECTORY) <> 0;
end;

//去掉最高位
function StripHighBit(L: Longint): DWORD;
begin
  Result := L and IMAGE_OFFSET_STRIP_HIGH;
end;

{//去掉整型的最高位，并转换为指针
function StripHighPtr(L: Longint): Pointer;
begin
  Result := Pointer(L and IMAGE_OFFSET_STRIP_HIGH);
end; }

end.