Subversion Repositories Kolibri OS

Compare Revisions

No changes between revisions

Regard whitespace Rev 666 → Rev 763

/programs/develop/fp/exe2kos/exeimage.pp
File deleted
/programs/develop/fp/exe2kos/exetypes.pp
File deleted
/programs/develop/fp/exe2kos/exe2kos.pp
File deleted
/programs/develop/fp/exe2kos/kostypes.pp
File deleted
/programs/develop/fp/exe2kos
Property changes:
Deleted: svn:ignore
-*.exe
-*.kex
-*.a
-*.o
-*.ppu
-*.log
/programs/develop/fp/rtl/buildrtl.pp
6,9 → 6,9
sysinitpas, {sysinitcyg, sysinitgprof,}
ctypes, strings,
lineinfo, lnfodwrf, heaptrc, matrix,
{windows, winsock, winsock2, initc, cmem, dynlibs, signals,}
{windows, winsock, winsock2, initc, cmem, }dynlibs, {signals,}
dos, crt, objects{, messages,
rtlconsts, sysconst}, sysutils{, math, types,
rtlconsts, sysconst}, sysutils, math{, types,
strutils, dateutils, varutils, variants, typinfo, fgl}, classes{,
convutils, stdconvs, cpu, mmx, charset, ucomplex, getopts,
winevent, sockets, printer,
/programs/develop/fp/rtl/kos.inc
146,6 → 146,28
popl %ebx
end;
 
procedure kos_setkeyboardmode(mode: DWord); assembler; register;
asm
pushl %eax
pushl %ebx
movl $66, %ecx
movl $1, %ebx
xchgl %eax, %ecx
int $0x40
xchgl %eax, %ecx
popl %ebx
popl %eax
end;
 
function kos_getkeyboardmode(): DWord; assembler; register;
asm
pushl %ebx
movl $66, %eax
movl $2, %ebx
int $0x40
popl %ebx
end;
 
procedure kos_setcaption(caption: PChar); assembler; register;
asm
pushl %ecx
/programs/develop/fp/rtl/kosh.inc
23,6 → 23,8
function kos_getmousewinpos(): TKosPoint;
function kos_getmousebuttons(): DWord;
procedure kos_maskevents(mask: DWord);
procedure kos_setkeyboardmode(mode: DWord);
function kos_getkeyboardmode(): DWord;
procedure kos_setcaption(caption: PChar);
 
{ Graphics }
/programs/develop/fp/rtl/sysfile.inc
1,18 → 1,18
{cp866}
{utf8}
 
function DecodeErrNo(ErrNo: DWord): Word;
{0 = ãᯥ譮
1 = ­¥ ®¯à¥¤¥«¥­  ¡ §  ¨/¨«¨ à §¤¥« ¦ñá⪮£® ¤¨áª  (¯®¤äã­ªæ¨ï¬¨ 7, 8 ä㭪樨 21)
2 = äã­ªæ¨ï ­¥ ¯®¤¤¥à¦¨¢ ¥âáï ¤«ï ¤ ­­®© ä ©«®¢®© á¨á⥬ë
3 = ­¥¨§¢¥áâ­ ï ä ©«®¢ ï á¨á⥬ 
4 = § à¥§¥à¢¨à®¢ ­®, ­¨ª®£¤  ­¥ ¢®§¢à é ¥âáï ¢ ⥪ã饩 ॠ«¨§ æ¨¨
5 = ä ©« ­¥ ­ ©¤¥­
6 = ä ©« § ª®­ç¨«áï
7 = 㪠§ â¥«ì ¢­¥ ¯ ¬ï⨠¯à¨«®¦¥­¨ï
8 = ¤¨áª § ¯®«­¥­
9 = â ¡«¨æ  FAT à §àã襭 
10 = ¤®áâ㯠§ ¯à¥éñ­
11 = ®è¨¡ª  ãáâனá⢠}
{0 = успешно
1 = не определена база и/или раздел жёсткого диска (подфункциями 7, 8 функции 21)
2 = функция не поддерживается для данной файловой системы
3 = неизвестная файловая система
4 = зарезервировано, никогда не возвращается в текущей реализации
5 = файл не найден
6 = файл закончился
7 = указатель вне памяти приложения
8 = диск заполнен
9 = таблица FAT разрушена
10 = доступ запрещён
11 = ошибка устройства}
begin
case ErrNo of
0: Result := 0;
24,7 → 24,7
6: Result := 0;
8: Result := 101;
else
Result := 153; { Unknown command (­¥¨§¢¥áâ­ ï ª®¬ ­¤ ) }
Result := 153; { Unknown command (неизвестная команда) }
end;
end;
 
96,6 → 96,8
InOutRes := 211;
end;
 
 
{ FIXME: Поправить RTL, факт отсутствия файла не фиксируется при его открытии. }
procedure do_open(var f; p: PChar; flags: Longint);
var
KosFile: PKosFile;
104,6 → 106,7
RecSize: Longint;
CurrDir: array[0..2048] of Char;
CurrDirLen: Longint;
Dummy: Longint;
begin
case flags and 3 of
0: FileRec(f).Mode := fmInput;
111,11 → 114,11
2: FileRec(f).Mode := fmInOut;
end;
 
{”®à¬¨à®¢ ­¨¥ ¨¬¥­¨  ¡á®«îâ­®£® ¯ãâ¨}
{Формирование имени абсолютного пути}
FilePathLen := Length(p);
if p^ <> DirectorySeparator then
begin
{XXX: à §¬¥à ¡ãä¥à  CurrDir ¬®¦¥â ®ª § âìáï ­¥¤®áâ â®ç­ë¬}
{XXX: размер буфера CurrDir может оказаться недостаточным}
CurrDirLen := kos_getdir(@CurrDir, SizeOf(CurrDir) - FilePathLen - 1) - 1;
FilePath := @CurrDir;
 
129,7 → 132,7
end else
FilePath := p;
 
{‘®§¤ ­¨¥ áâàãªâãàë TKosFile}
{Создание структуры TKosFile}
RecSize := SizeOf(TKosFile) + FilePathLen;
KosFile := GetMem(RecSize);
FillChar(KosFile^, RecSize, 0);
138,8 → 141,16
 
if flags and $1000 <> 0 then
begin
{ ᮧ¤ âì ä ©« }
{ создать файл }
InOutRes := DecodeErrNo(kos_rewritefile(KosFile, RecSize));
end else
InOutRes := 0;
begin
{ попытаться прочитать файл }
KosFile^.Size := 1;
KosFile^.Data := @Dummy;
InOutRes := DecodeErrNo(kos_readfile(KosFile, Dummy));
end;
if InOutRes <> 0 then
FreeMem(KosFile);
end;
/programs/develop/fp/rtl/windows.pp
1,7 → 1,100
unit Windows;
 
{$mode objfpc}
 
 
interface
 
 
type
WinBool = LongBool;
Bool = WinBool;
Handle = System.THandle;
THandle = Handle;
 
OVERLAPPED = record
Internal : DWORD;
InternalHigh : DWORD;
Offset : DWORD;
OffsetHigh : DWORD;
hEvent : HANDLE;
end;
LPOVERLAPPED = ^OVERLAPPED;
_OVERLAPPED = OVERLAPPED;
TOVERLAPPED = OVERLAPPED;
POVERLAPPED = ^OVERLAPPED;
 
 
 
function GetStdHandle(nStdHandle: DWord): Handle;
{function SetStdHandle(nStdHandle:DWORD; hHandle:HANDLE): WinBool;}
 
function WriteFile(hFile: THandle; const Buffer; nNumberOfBytesToWrite: DWord; var lpNumberOfBytesWritten: DWord; lpOverlapped: POverlapped): Bool;
 
function Std_Input_Handle: DWord;
function Std_Output_Handle: DWord;
function Std_Error_Handle: DWord;
 
function GetTickCount: DWord;
function QueryPerformanceCounter(var lpPerformanceCount: Int64): WinBool;
function QueryPerformanceFrequency(var lpFrequency: Int64): WinBool;
 
function AllocConsole: WinBool;
{function FreeConsole: WinBool;}
 
 
implementation
 
 
function GetStdHandle(nStdHandle: DWord): Handle;
begin
Result := 0;
end;
 
function Std_Input_Handle: DWord;
begin
Result := 0;
end;
 
function Std_Output_Handle: DWord;
begin
Result := 1;
end;
 
function Std_Error_Handle: DWord;
begin
Result := 2;
end;
 
 
function WriteFile(hFile: THandle; const Buffer; nNumberOfBytesToWrite: DWord; var lpNumberOfBytesWritten: DWord; lpOverlapped: POverlapped): Bool;
begin
Result := True;
end;
 
 
function GetTickCount: DWord;
begin
Result := kos_timecounter() * 10;
end;
 
function QueryPerformanceCounter(var lpPerformanceCount: Int64): WinBool;
begin
lpPerformanceCount := kos_timecounter();
Result := True
end;
 
function QueryPerformanceFrequency(var lpFrequency: Int64): WinBool;
begin
lpFrequency := 100;
Result := True
end;
 
 
function AllocConsole: WinBool;
begin
Result := True;
end;
 
 
end.
/programs/develop/fp/utils/exe2kos/exe2kos.pp
0,0 → 1,345
{$mode objfpc}
{$apptype console}
 
program exe2kos;
 
uses
SysUtils, Classes, ExeTypes, KosTypes;
 
const
ARGS_SIZE = 512;
PATH_SIZE = 512;
 
type
EExeError = class(Exception);
 
TExeImage = class;
TExeImageSection = class;
 
TExeImageSection = class
private
FExeImage: TExeImage;
FHeader: IMAGE_SECTION_HEADER;
FName: String;
procedure Read(var Buffer);
public
constructor Create(AExeImage: TExeImage; APosition: DWord);
property Name: String read FName;
property VirtualSize: DWord read FHeader.PhysicalAddress;
property SectionRVA: DWord read FHeader.VirtualAddress;
property PhysicalSize: DWord read FHeader.SizeOfRawData;
property PhysicalOffset: DWord read FHeader.PointerToRawData;
property ObjectFlags: DWord read FHeader.Characteristics;
end;
 
TExeImageSections = class
private
FCount: DWord;
FItems: array of TExeImageSection;
function GetItem(Index: DWord): TExeImageSection;
public
constructor Create(AExeImage: TExeImage; APosition, ACount: DWord);
destructor Destroy; override;
function ByName(AName: String): TExeImageSection;
property Count: DWord read FCount;
property Items[Index: DWord]: TExeImageSection read GetItem; default;
end;
 
TExeImage = class
private
FFileName: String;
FFileStream: TStream;
FDosHeader: IMAGE_DOS_HEADER;
FNTHeader: IMAGE_NT_HEADERS;
FSections: TExeImageSections;
procedure Read(var Buffer; Position, Size: Longint);
function GetSizeOfCode(): DWord;
function GetSizeOfInitData(): DWord;
function GetSizeOfUnInitData(): DWord;
function GetEntryPoint(): DWord;
function GetImageBase(): DWord;
function GetObjectAlign(): DWord;
function GetFileAlign(): DWord;
function GetImageSize(): DWord;
function GetHeaderSize(): DWord;
function GetStackReserveSize(): DWord;
function GetStackCommitSize(): DWord;
function GetHeapReserveSize(): DWord;
function GetHeapCommitSize(): DWord;
public
constructor Create(AFileName: String);
destructor Destroy; override;
property FileName: String read FFileName;
property Sections: TExeImageSections read FSections;
property SizeOfCode: DWord read GetSizeOfCode;
property SizeOfInitializedData: DWord read GetSizeOfInitData;
property SizeOfUninitializedData: DWord read GetSizeOfUnInitData;
property EntryPoint: DWord read FNTHeader.OptionalHeader.AddressOfEntryPoint{GetEntryPoint};
property ImageBase: DWord read FNTHeader.OptionalHeader.ImageBase{GetImageBase};
property ObjectAlign: DWord read GetObjectAlign;
property FileAlign: DWord read GetFileAlign;
property ImageSize: DWord read GetImageSize;
property HeaderSize: DWord read GetHeaderSize;
property StackReserveSize: DWord read GetStackReserveSize;
property StackCommitSize: DWord read GetStackCommitSize;
property HeapReserveSize: DWord read GetHeapReserveSize;
property HeapCommitSize: DWord read GetHeapCommitSize;
end;
 
 
constructor TExeImage.Create(AFileName: String);
begin
FFileName := AFileName;
FFileStream := TFileStream.Create(FFileName, fmOpenRead);
 
Read(FDosHeader, 0, SizeOf(FDosHeader));
if not FDosHeader.e_magic = IMAGE_DOS_SIGNATURE then
EExeError.Create('Unrecognized file format');
 
Read(FNTHeader, FDosHeader.e_lfanew, SizeOf(FNTHeader));
if FNTHeader.Signature <> IMAGE_NT_SIGNATURE then
EExeError.Create('Not a PE (WIN32 Executable) file');
 
FSections := TExeImageSections.Create(Self,
FDosHeader.e_lfanew + SizeOf(FNTHeader), FNTHeader.FileHeader.NumberOfSections);
end;
 
destructor TExeImage.Destroy;
begin
FSections.Free;
FFileStream.Free;
end;
 
procedure TExeImage.Read(var Buffer; Position, Size: Longint);
begin
FFileStream.Position := Position;
if FFileStream.Read(Buffer, Size) <> Size then
EExeError.Create('Damaged or unrecognized file');
end;
 
function TExeImage.GetSizeOfCode(): DWord;
begin
Result := FNTHeader.OptionalHeader.SizeOfCode;
end;
 
function TExeImage.GetSizeOfInitData(): DWord;
begin
Result := FNTHeader.OptionalHeader.SizeOfInitializedData;
end;
 
function TExeImage.GetSizeOfUnInitData(): DWord;
begin
Result := FNTHeader.OptionalHeader.SizeOfUninitializedData;
end;
 
function TExeImage.GetEntryPoint(): DWord;
begin
Result := FNTHeader.OptionalHeader.AddressOfEntryPoint;
end;
 
function TExeImage.GetImageBase(): DWord;
begin
Result := FNTHeader.OptionalHeader.ImageBase;
end;
 
function TExeImage.GetObjectAlign(): DWord;
begin
Result := FNTHeader.OptionalHeader.SectionAlignment;
end;
 
function TExeImage.GetFileAlign(): DWord;
begin
Result := FNTHeader.OptionalHeader.FileAlignment;
end;
 
function TExeImage.GetImageSize(): DWord;
begin
Result := FNTHeader.OptionalHeader.SizeOfImage;
end;
 
function TExeImage.GetHeaderSize(): DWord;
begin
Result := FNTHeader.OptionalHeader.SizeOfHeaders;
end;
 
function TExeImage.GetStackReserveSize(): DWord;
begin
Result := FNTHeader.OptionalHeader.SizeOfStackReserve;
end;
 
function TExeImage.GetStackCommitSize(): DWord;
begin
Result := FNTHeader.OptionalHeader.SizeOfStackCommit;
end;
 
function TExeImage.GetHeapReserveSize(): DWord;
begin
Result := FNTHeader.OptionalHeader.SizeOfHeapReserve;
end;
 
function TExeImage.GetHeapCommitSize(): DWord;
begin
Result := FNTHeader.OptionalHeader.SizeOfHeapCommit;
end;
 
 
constructor TExeImageSections.Create(AExeImage: TExeImage; APosition, ACount: DWord);
var
i: Integer;
begin
FCount := ACount;
SetLength(FItems, ACount);
for i := 0 to ACount - 1 do
begin
FItems[i] := TExeImageSection.Create(AExeImage, APosition);
Inc(APosition, SizeOf(IMAGE_SECTION_HEADER));
end;
end;
 
destructor TExeImageSections.Destroy;
var
i: Integer;
begin
for i := 0 to Length(FItems) - 1 do FItems[i].Free;
SetLength(FItems, 0);
end;
 
function TExeImageSections.GetItem(Index: DWord): TExeImageSection;
begin
Result := FItems[Index];
end;
 
function TExeImageSections.ByName(AName: String): TExeImageSection;
var
i: Integer;
begin
for i := 0 to Length(FItems) - 1 do
if FItems[i].Name = AName then
begin
Result := FItems[i];
Exit;
end;
Result := nil;
end;
 
 
 
constructor TExeImageSection.Create(AExeImage: TExeImage; APosition: DWord);
begin
FExeImage := AExeImage;
FExeImage.Read(FHeader, APosition, SizeOf(FHeader));
FName := FHeader.Name;
end;
 
procedure TExeImageSection.Read(var Buffer);
begin
FExeImage.Read(Buffer, PhysicalOffset, PhysicalSize);
end;
 
 
procedure WriteHead(s: String);
var
i: Integer;
begin
WriteLn;
WriteLn(s);
for i:=1 to Length(s) do Write('-');
WriteLn;
end;
 
procedure Convert(InputFile, OutputFile: String);
var
ExeImage: TExeImage;
KosHeader: TKosHeader;
FileStream: TStream;
ImageBase, ImageSize, Size: DWord;
Buffer: Pointer;
i: Integer;
begin
ExeImage := TExeImage.Create(InputFile);
 
{$ifdef debug}
WriteHead('NT Header');
WriteLn(Format('Size of Code: %d', [ExeImage.SizeOfCode]));
WriteLn(Format('Size of Init Data: %d', [ExeImage.SizeOfInitializedData]));
WriteLn(Format('Size of UnInit Data: %d', [ExeImage.SizeOfUninitializedData]));
WriteLn(Format('Entry Point: 0x%x', [ExeImage.EntryPoint]));
WriteLn(Format('Image Base: 0x%x', [ExeImage.ImageBase]));
WriteLn(Format('Object Align: %d; File Align: %d', [ExeImage.ObjectAlign, ExeImage.FileAlign]));
WriteLn(Format('Image Size: %d; Header Size: %d', [ExeImage.ImageSize, ExeImage.HeaderSize]));
WriteLn(Format('Stack Reserve Size: %d; Stack Commit Size: %d', [ExeImage.StackReserveSize, ExeImage.StackCommitSize]));
WriteLn(Format('Heap Reserve Size: %d; Heap Comit Size: %d', [ExeImage.HeapReserveSize, ExeImage.HeapCommitSize]));
{$endif}
 
ImageBase := ExeImage.ImageBase;
ImageSize := 0;
 
{ çàïèñü ñåêöèé }
FileStream := TFileStream.Create(OutputFile, fmCreate);
for i:=0 to ExeImage.Sections.Count-1 do
with ExeImage.Sections[i] do
begin
 
{$ifdef debug}
WriteHead(Format('Section %s (0x%x)', [Name, ObjectFlags]));
WriteLn(Format('Section RVA/Size: 0x%x / %d', [SectionRVA, VirtualSize]));
WriteLn(Format('Physical Offset/Size: 0x%x / %d', [PhysicalOffset, PhysicalSize]));
{$endif}
 
Size := ImageBase + SectionRVA;
FileStream.Position := Size;
Inc(Size, VirtualSize);
if Size > ImageSize then ImageSize := Size;
 
if PhysicalSize > 0 then
begin
GetMem(Buffer, PhysicalSize);
Read(Buffer^);
FileStream.Write(Buffer^, PhysicalSize);
FreeMem(Buffer);
end;
end;
 
FillByte(KosHeader, SizeOf(KosHeader), 0);
with KosHeader do
begin
sign := KOS_SIGN;
version := 1;
start := ImageBase + ExeImage.EntryPoint;
size := FileStream.Size;
args := ImageSize;
path := args + ARGS_SIZE;
stack := path + PATH_SIZE + ExeImage.StackReserveSize;
memory := stack;
end;
FileStream.Position := 0;
FileStream.Write(KosHeader, SizeOf(KosHeader));
FileStream.Free();
end;
 
 
var
InputFile, OutputFile: String;
begin
if ParamCount < 1 then
begin
WriteLn(Format('%s <exe input file> [kos output file]', [ExtractFileName(ParamStr(0))]));
Exit;
end;
 
InputFile := ParamStr(1);
if ParamCount <2 then
OutputFile := ChangeFileExt(InputFile, '') else
OutputFile := ParamStr(2);
 
if InputFile = OutputFile then
WriteLn(Format('Cannot convert the file "%s" onto itself.', [InputFile])) else
 
if not FileExists(InputFile) then
WriteLn(Format('Input the file "%s", not found.', [InputFile])) else
 
begin
WriteLn(Format('Converting "%s" to "%s"...', [InputFile, OutputFile]));
Convert(InputFile, OutputFile);
end;
end.
/programs/develop/fp/utils/exe2kos/exeimage.pp
0,0 → 1,827
{$mode delphi}
 
unit ExeImage;
 
interface
 
uses
TypInfo, Classes, SysUtils, Windows, RXTypes;
 
const
MF_END = $80;
 
type
 
{ Exceptions }
 
EExeError = class(Exception);
ENotImplemented = class(Exception)
public
constructor Create();
end;
 
{ Forward Declarations }
 
TResourceItem = class;
TResourceClass = class of TResourceItem;
TResourceList = class;
 
{ TExeImage }
 
TExeImage = class(TComponent)
private
FFileName: string;
FFileHandle: THandle;
FFileMapping: THandle;
FFileBase: Pointer;
FDosHeader: PIMAGE_DOS_HEADER;
FNTHeader: PIMAGE_NT_HEADERS;
FResourceList: TResourceList;
FIconResources: TResourceItem;
FCursorResources: TResourceItem;
FResourceBase: Longint;
FResourceRVA: Longint;
function GetResourceList: TResourceList;
function GetSectionHdr(const SectionName: string;
var Header: PIMAGE_SECTION_HEADER): Boolean;
public
constructor CreateImage(AOwner: TComponent; const AFileName: string);
destructor Destroy; override;
property FileName: string read FFileName;
property Resources: TResourceList read GetResourceList;
end;
 
{ TResourceItem }
 
TResourceItem = class(TComponent)
private
FList: TResourceList;
FDirEntry: PIMAGE_RESOURCE_DIRECTORY_ENTRY;
function DataEntry: PIMAGE_RESOURCE_DATA_ENTRY;
function FExeImage: TExeImage;
function FirstChildDirEntry: PIMAGE_RESOURCE_DIRECTORY_ENTRY;
function GetResourceItem(Index: Integer): TResourceItem;
function GetResourceType: TResourceType;
protected
function GetName: string; virtual;
function GetResourceList: TResourceList; virtual;
public
constructor CreateItem(AOwner: TComponent; ADirEntry: Pointer);
function IsList: Boolean; virtual;
function Offset: Integer;
function Size: Integer;
function RawData: Pointer;
function ResTypeStr: string;
procedure SaveToFile(const FileName: string);
procedure SaveToStream(Stream: TStream); virtual;
property Items[Index: Integer]: TResourceItem read GetResourceItem; default;
property List: TResourceList read GetResourceList;
property Name: string read GetName;
property ResType: TResourceType read GetResourceType;
end;
 
{ TIconResource }
 
TIconResource = class(TResourceItem)
protected
function GetResourceList: TResourceList; override;
public
function IsList: Boolean; override;
end;
 
{ TIconResEntry }
 
TIconResEntry = class(TResourceItem)
protected
FResInfo: PIconResInfo;
function GetName: string; override;
procedure AssignTo(Dest: TPersistent); override;
public
procedure SaveToStream(Stream: TStream); override;
end;
 
{ TCursorResource }
 
TCursorResource = class(TIconResource)
protected
function GetResourceList: TResourceList; override;
end;
 
{ TCursorResEntry }
 
TCursorResEntry = class(TIconResEntry)
protected
FResInfo: PCursorResInfo;
function GetName: string; override;
end;
 
{ TBitmapResource }
 
TBitmapResource = class(TResourceItem)
protected
procedure AssignTo(Dest: TPersistent); override;
public
procedure SaveToStream(Stream: TStream); override;
end;
 
{ TStringResource }
 
TStringResource = class(TResourceItem)
protected
procedure AssignTo(Dest: TPersistent); override;
end;
 
{ TMenuResource }
 
TMenuResource = class(TResourceItem)
private
FNestStr: string;
FNestLevel: Integer;
procedure SetNestLevel(Value: Integer);
protected
procedure AssignTo(Dest: TPersistent); override;
property NestLevel: Integer read FNestLevel write SetNestLevel;
property NestStr: string read FNestStr;
end;
 
{ TResourceList }
 
TResourceList = class(TComponent)
protected
FList: TList;
FResDir: PIMAGE_RESOURCE_DIRECTORY;
FExeImage: TExeImage;
FResType: Integer;
function List: TList; virtual;
function GetResourceItem(Index: Integer): TResourceItem;
public
constructor CreateList(AOwner: TComponent; ResDirOfs: Longint;
AExeImage: TExeImage);
destructor Destroy; override;
function Count: Integer;
property Items[Index: Integer]: TResourceItem read GetResourceItem; default;
end;
 
{ TIconResourceList }
 
TIconResourceList = class(TResourceList)
protected
function List: TList; override;
end;
 
{ TCursorResourceList }
 
TCursorResourceList = class(TResourceList)
protected
function List: TList; override;
end;
 
implementation
 
constructor ENotImplemented.Create();
begin
inherited Create('Not Implemented');
end;
 
 
{ This function maps a resource type to the associated resource class }
 
function GetResourceClass(ResType: Integer): TResourceClass;
const
TResourceClasses: array[TResourceType] of TResourceClass = (
TResourceItem, { rtUnknown0 }
TCursorResEntry, { rtCursorEntry }
TBitmapResource, { rtBitmap }
TIconResEntry, { rtIconEntry }
TMenuResource, { rtMenu }
TResourceItem, { rtDialog }
TStringResource, { rtString }
TResourceItem, { rtFontDir }
TResourceItem, { rtFont }
TResourceItem, { rtAccelerators }
TResourceItem, { rtRCData }
TResourceItem, { rtMessageTable }
TCursorResource, { rtGroupCursor }
TResourceItem, { rtUnknown13 }
TIconResource, { rtIcon }
TResourceItem, { rtUnknown15 }
TResourceItem); { rtVersion }
begin
if (ResType >= Integer(Low(TResourceType))) and
(ResType <= Integer(High(TResourceType))) then
Result := TResourceClasses[TResourceType(ResType)] else
Result := TResourceItem;
end;
 
{ Utility Functions }
 
function Min(A, B: Integer): Integer;
begin
if A < B then Result := A
else Result := B;
end;
 
{ This function checks if an offset is a string name, or a directory }
{Assumes: IMAGE_RESOURCE_NAME_IS_STRING = IMAGE_RESOURCE_DATA_IS_DIRECTORY}
 
function HighBitSet(L: Longint): Boolean;
begin
Result := (L and IMAGE_RESOURCE_DATA_IS_DIRECTORY) <> 0;
end;
 
function StripHighBit(L: Longint): Longint;
begin
Result := L and IMAGE_OFFSET_STRIP_HIGH;
end;
 
function StripHighPtr(L: Longint): Pointer;
begin
Result := Pointer(L and IMAGE_OFFSET_STRIP_HIGH);
end;
 
{ This function converts a pointer to a wide char string into a pascal string }
 
function WideCharToStr(WStr: PWChar; Len: Integer): string;
begin
if Len = 0 then Len := -1;
Len := WideCharToMultiByte(CP_ACP, 0, WStr, Len, nil, 0, nil, nil);
SetLength(Result, Len);
WideCharToMultiByte(CP_ACP, 0, WStr, Len, PChar(Result), Len, nil, nil);
end;
 
{ Exceptions }
 
procedure ExeError(const ErrMsg: string);
begin
raise EExeError.Create(ErrMsg);
end;
 
{ TExeImage }
 
constructor TExeImage.CreateImage(AOwner: TComponent; const AFileName: string);
begin
inherited Create(AOwner);
FFileName := AFileName;
FFileHandle := CreateFile(PChar(FFileName), GENERIC_READ, FILE_SHARE_READ,
nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
if FFileHandle = INVALID_HANDLE_VALUE then ExeError('Couldn''t open: '+FFileName);
FFileMapping := CreateFileMapping(FFileHandle, nil, PAGE_READONLY, 0, 0, nil);
if FFileMapping = 0 then ExeError('CreateFileMapping failed');
FFileBase := MapViewOfFile(FFileMapping, FILE_MAP_READ, 0, 0, 0);
if FFileBase = nil then ExeError('MapViewOfFile failed');
FDosHeader := PIMAGE_DOS_HEADER(FFileBase);
if not FDosHeader.e_magic = IMAGE_DOS_SIGNATURE then
ExeError('unrecognized file format');
FNTHeader := PIMAGE_NT_HEADERS(Longint(FDosHeader) + FDosHeader.e_lfanew);
if IsBadReadPtr(FNTHeader, sizeof(IMAGE_NT_HEADERS)) or
(FNTHeader.Signature <> IMAGE_NT_SIGNATURE) then
ExeError('Not a PE (WIN32 Executable) file');
end;
 
destructor TExeImage.Destroy;
begin
if FFileHandle <> INVALID_HANDLE_VALUE then
begin
UnmapViewOfFile(FFileBase);
CloseHandle(FFileMapping);
CloseHandle(FFileHandle);
end;
inherited Destroy;
end;
 
function TExeImage.GetSectionHdr(const SectionName: string;
var Header: PIMAGE_SECTION_HEADER): Boolean;
var
I: Integer;
begin
Header := PIMAGE_SECTION_HEADER(FNTHeader);
Inc(PIMAGE_NT_HEADERS(Header));
Result := True;
for I := 0 to FNTHeader.FileHeader.NumberOfSections - 1 do
begin
if Strlicomp(Header.Name, PChar(SectionName), IMAGE_SIZEOF_SHORT_NAME) = 0 then Exit;
Inc(Header);
end;
Result := False;
end;
 
function TExeImage.GetResourceList: TResourceList;
var
ResSectHdr: PIMAGE_SECTION_HEADER;
begin
if not Assigned(FResourceList) then
begin
if GetSectionHdr('.rsrc', ResSectHdr) then
begin
FResourceBase := ResSectHdr.PointerToRawData + LongWord(FDosHeader);
FResourceRVA := ResSectHdr.VirtualAddress;
FResourceList := TResourceList.CreateList(Self, FResourceBase, Self);
end
else
ExeError('No resources in this file.');
end;
Result := FResourceList;
end;
 
{ TResourceItem }
 
constructor TResourceItem.CreateItem(AOwner: TComponent; ADirEntry: Pointer);
begin
inherited Create(AOwner);
FDirEntry := ADirEntry;
end;
 
function TResourceItem.DataEntry: PIMAGE_RESOURCE_DATA_ENTRY;
begin
Result := PIMAGE_RESOURCE_DATA_ENTRY(FirstChildDirEntry.OffsetToData
+ Cardinal(FExeImage.FResourceBase));
end;
 
function TResourceItem.FirstChildDirEntry: PIMAGE_RESOURCE_DIRECTORY_ENTRY;
begin
Result := PIMAGE_RESOURCE_DIRECTORY_ENTRY(StripHighBit(FDirEntry.OffsetToData) +
FExeImage.FResourceBase + SizeOf(IMAGE_RESOURCE_DIRECTORY));
end;
 
function TResourceItem.FExeImage: TExeImage;
begin
Result := (Owner as TResourceList).FExeImage;
end;
 
function TResourceItem.GetResourceItem(Index: Integer): TResourceItem;
begin
Result := List[Index];
end;
 
function TResourceItem.GetResourceType: TResourceType;
begin
Result := TResourceType((Owner as TResourceList).FResType);
end;
 
function TResourceItem.IsList: Boolean;
begin
Result := HighBitSet(FirstChildDirEntry.OffsetToData);
end;
 
function TResourceItem.GetResourceList: TResourceList;
begin
if not IsList then ExeError('ResourceItem is not a list');
if not Assigned(FList) then
FList := TResourceList.CreateList(Self, StripHighBit(FDirEntry.OffsetToData) +
FExeImage.FResourceBase, FExeImage);
Result := FList;
end;
 
function TResourceItem.GetName: string;
var
PDirStr: PIMAGE_RESOURCE_DIR_STRING_U;
begin
{ Check for Level1 entries, these are resource types. }
if (Owner.Owner = FExeImage) and not HighBitSet(FDirEntry.Name) and
(FDirEntry.Name <= 16) then
begin
Result := Copy(GetEnumName(TypeInfo(TResourceType), FDirEntry.Name), 3, 20);
Exit;
end;
 
if HighBitSet(FDirEntry.Name) then
begin
PDirStr := PIMAGE_RESOURCE_DIR_STRING_U(StripHighBit(FDirEntry.Name) +
FExeImage.FResourceBase);
Result := WideCharToStr(@PDirStr.NameString, PDirStr.Length);
Exit;
end;
Result := Format('%d', [FDirEntry.Name]);
end;
 
function TResourceItem.Offset: Integer;
begin
if IsList then
Result := StripHighBit(FDirEntry.OffsetToData)
else
Result := DataEntry.OffsetToData;
end;
 
function TResourceItem.RawData: Pointer;
begin
with FExeImage do
Result := pointer(FResourceBase - FResourceRVA + LongInt(DataEntry.OffsetToData));
end;
 
function TResourceItem.ResTypeStr: string;
begin
Result := Copy(GetEnumName(TypeInfo(TResourceType), Ord(ResType)), 3, 20);
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
raise ENotImplemented.Create();
 
{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
raise ENotImplemented.Create();
 
{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
raise ENotImplemented.Create();
 
{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
raise ENotImplemented.Create();
 
{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.
/programs/develop/fp/utils/exe2kos/exetypes.pp
0,0 → 1,235
unit EXETypes;
 
interface
 
const
IMAGE_DOS_SIGNATURE = $5A4D; { MZ }
IMAGE_OS2_SIGNATURE = $454E; { NE }
IMAGE_OS2_SIGNATURE_LE = $454C; { LE }
IMAGE_VXD_SIGNATURE = $454C; { LE }
IMAGE_NT_SIGNATURE = $00004550; { PE00 }
 
IMAGE_SIZEOF_SHORT_NAME = 8;
IMAGE_SIZEOF_SECTION_HEADER = 40;
IMAGE_NUMBEROF_DIRECTORY_ENTRIES = 16;
IMAGE_RESOURCE_NAME_IS_STRING = $80000000;
IMAGE_RESOURCE_DATA_IS_DIRECTORY = $80000000;
IMAGE_OFFSET_STRIP_HIGH = $7FFFFFFF;
 
type
PIMAGE_DOS_HEADER = ^IMAGE_DOS_HEADER;
IMAGE_DOS_HEADER = packed record { DOS .EXE header }
e_magic : WORD; { Magic number }
e_cblp : WORD; { Bytes on last page of file }
e_cp : WORD; { Pages in file }
e_crlc : WORD; { Relocations }
e_cparhdr : WORD; { Size of header in paragraphs }
e_minalloc : WORD; { Minimum extra paragraphs needed }
e_maxalloc : WORD; { Maximum extra paragraphs needed }
e_ss : WORD; { Initial (relative) SS value }
e_sp : WORD; { Initial SP value }
e_csum : WORD; { Checksum }
e_ip : WORD; { Initial IP value }
e_cs : WORD; { Initial (relative) CS value }
e_lfarlc : WORD; { File address of relocation table }
e_ovno : WORD; { Overlay number }
e_res : packed array [0..3] of WORD; { Reserved words }
e_oemid : WORD; { OEM identifier (for e_oeminfo) }
e_oeminfo : WORD; { OEM information; e_oemid specific }
e_res2 : packed array [0..9] of WORD; { Reserved words }
e_lfanew : Longint; { File address of new exe header }
end;
 
PIMAGE_FILE_HEADER = ^IMAGE_FILE_HEADER;
IMAGE_FILE_HEADER = packed record
Machine : WORD;
NumberOfSections : WORD;
TimeDateStamp : DWORD;
PointerToSymbolTable : DWORD;
NumberOfSymbols : DWORD;
SizeOfOptionalHeader : WORD;
Characteristics : WORD;
end;
 
PIMAGE_DATA_DIRECTORY = ^IMAGE_DATA_DIRECTORY;
IMAGE_DATA_DIRECTORY = packed record
VirtualAddress : DWORD;
Size : DWORD;
end;
 
PIMAGE_OPTIONAL_HEADER = ^IMAGE_OPTIONAL_HEADER;
IMAGE_OPTIONAL_HEADER = packed record
{ Standard fields. }
Magic : WORD;
MajorLinkerVersion : Byte;
MinorLinkerVersion : Byte;
SizeOfCode : DWORD;
SizeOfInitializedData : DWORD;
SizeOfUninitializedData : DWORD;
AddressOfEntryPoint : DWORD;
BaseOfCode : DWORD;
BaseOfData : DWORD;
{ NT additional fields. }
ImageBase : DWORD;
SectionAlignment : DWORD;
FileAlignment : DWORD;
MajorOperatingSystemVersion : WORD;
MinorOperatingSystemVersion : WORD;
MajorImageVersion : WORD;
MinorImageVersion : WORD;
MajorSubsystemVersion : WORD;
MinorSubsystemVersion : WORD;
Reserved1 : DWORD;
SizeOfImage : DWORD;
SizeOfHeaders : DWORD;
CheckSum : DWORD;
Subsystem : WORD;
DllCharacteristics : WORD;
SizeOfStackReserve : DWORD;
SizeOfStackCommit : DWORD;
SizeOfHeapReserve : DWORD;
SizeOfHeapCommit : DWORD;
LoaderFlags : DWORD;
NumberOfRvaAndSizes : DWORD;
DataDirectory : packed array [0..IMAGE_NUMBEROF_DIRECTORY_ENTRIES-1] of IMAGE_DATA_DIRECTORY;
end;
 
PIMAGE_SECTION_HEADER = ^IMAGE_SECTION_HEADER;
IMAGE_SECTION_HEADER = packed record
Name : packed array [0..IMAGE_SIZEOF_SHORT_NAME-1] of Char;
PhysicalAddress : DWORD; // or VirtualSize (union);
VirtualAddress : DWORD;
SizeOfRawData : DWORD;
PointerToRawData : DWORD;
PointerToRelocations : DWORD;
PointerToLinenumbers : DWORD;
NumberOfRelocations : WORD;
NumberOfLinenumbers : WORD;
Characteristics : DWORD;
end;
 
PIMAGE_NT_HEADERS = ^IMAGE_NT_HEADERS;
IMAGE_NT_HEADERS = packed record
Signature : DWORD;
FileHeader : IMAGE_FILE_HEADER;
OptionalHeader : IMAGE_OPTIONAL_HEADER;
end;
 
{ Resources }
 
PIMAGE_RESOURCE_DIRECTORY = ^IMAGE_RESOURCE_DIRECTORY;
IMAGE_RESOURCE_DIRECTORY = packed record
Characteristics : DWORD;
TimeDateStamp : DWORD;
MajorVersion : WORD;
MinorVersion : WORD;
NumberOfNamedEntries : WORD;
NumberOfIdEntries : WORD;
end;
 
PIMAGE_RESOURCE_DIRECTORY_ENTRY = ^IMAGE_RESOURCE_DIRECTORY_ENTRY;
IMAGE_RESOURCE_DIRECTORY_ENTRY = packed record
Name: DWORD; // Or ID: Word (Union)
OffsetToData: DWORD;
end;
 
PIMAGE_RESOURCE_DATA_ENTRY = ^IMAGE_RESOURCE_DATA_ENTRY;
IMAGE_RESOURCE_DATA_ENTRY = packed record
OffsetToData : DWORD;
Size : DWORD;
CodePage : DWORD;
Reserved : DWORD;
end;
 
PIMAGE_RESOURCE_DIR_STRING_U = ^IMAGE_RESOURCE_DIR_STRING_U;
IMAGE_RESOURCE_DIR_STRING_U = packed record
Length : WORD;
NameString : array [0..0] of WCHAR;
end;
 
{
/* Predefined resource types */
#define RT_NEWRESOURCE 0x2000
#define RT_ERROR 0x7fff
#define RT_CURSOR 1
#define RT_BITMAP 2
#define RT_ICON 3
#define RT_MENU 4
#define RT_DIALOG 5
#define RT_STRING 6
#define RT_FONTDIR 7
#define RT_FONT 8
#define RT_ACCELERATORS 9
#define RT_RCDATA 10
#define RT_MESSAGETABLE 11
#define RT_GROUP_CURSOR 12
#define RT_GROUP_ICON 14
#define RT_VERSION 16
#define RT_NEWBITMAP (RT_BITMAP|RT_NEWRESOURCE)
#define RT_NEWMENU (RT_MENU|RT_NEWRESOURCE)
#define RT_NEWDIALOG (RT_DIALOG|RT_NEWRESOURCE)
 
}
 
type
TResourceType = (
rtUnknown0,
rtCursorEntry,
rtBitmap,
rtIconEntry,
rtMenu,
rtDialog,
rtString,
rtFontDir,
rtFont,
rtAccelerators,
rtRCData,
rtMessageTable,
rtCursor,
rtUnknown13,
rtIcon,
rtUnknown15,
rtVersion);
 
{ Resource Type Constants }
 
const
StringsPerBlock = 16;
 
{ Resource Related Structures from RESFMT.TXT in WIN32 SDK }
 
type
 
PIconHeader = ^TIconHeader;
TIconHeader = packed record
wReserved: Word; { Currently zero }
wType: Word; { 1 for icons }
wCount: Word; { Number of components }
end;
 
PIconResInfo = ^TIconResInfo;
TIconResInfo = packed record
bWidth: Byte;
bHeight: Byte;
bColorCount: Byte;
bReserved: Byte;
wPlanes: Word;
wBitCount: Word;
lBytesInRes: DWORD;
wNameOrdinal: Word; { Points to component }
end;
 
PCursorResInfo = ^TCursorResInfo;
TCursorResInfo = packed record
wWidth: Word;
wHeight: Word;
wPlanes: Word;
wBitCount: Word;
lBytesInRes: DWORD;
wNameOrdinal: Word; { Points to component }
end;
 
 
implementation
 
end.
/programs/develop/fp/utils/exe2kos/kostypes.pp
0,0 → 1,23
unit KOSTypes;
 
interface
 
type
TKosSign = array[0..7] of Byte;
TKosHeader = packed record
sign : TKOSSign;
version: DWord;
start : DWord;
size : DWord;
memory : DWord;
stack : DWord;
args : DWord;
path : DWord;
end;
 
const
KOS_SIGN: TKOSSign = ($4D, $45, $4E, $55, $45, $54, $30, $31);
 
implementation
 
end.
/programs/develop/fp/utils/exe2kos
Property changes:
Added: svn:ignore
+*.exe
+*.kex
+*.a
+*.o
+*.ppu
+*.log