Optymalizacje w Delphi (przyklad - część II)
stg
Artykuł ten stanowi rozszerzenie do Optymalizacje w Delphi (przyklad - część I)
W ogromnych zasobach Internetu można znaleźć kolejne przykłady minimalizacji rozmiaru programów napisanych w Delphi. Jeśli nie chcemy bawić się w podmienianie linker'a firmy Borland na Microsoft lub korzystanie z fakecom (techniki najczęściej wykorzystywane), możemy zastosować inne sposoby na dalsze 'okrajanie' programu.
Jak już zapewne zauważyłeś Drogi Czytelniku, przykładowa aplikacja wciąż korzysta z zewnętrznych modułów: Windows oraz Messages. Pozbędziemy się ich całkowicie. W tym celu umieszczamy odwołania do wszystkich funkcji i procedur z których korzystamy bezpośrednio w naszym pliku. Gotowy kod programu wygląda mniej więcej tak:
program ProjectAPIm;
type
I64 = record Lo, Hi: Cardinal;
end;
type
PSHQueryRBInfo = ^TSHQueryRBInfo;
TSHQueryRBInfo = packed record
cbSize: Cardinal;
i64Size: I64;
i64NumItems: I64;
end;
var
fWnd, L1, L2: Cardinal;
Wnd : packed record
style : Cardinal;
lpfnWndProc : Pointer;
cbClsExtra : Integer;
cbWndExtra : Integer;
hInstance : Cardinal;
hIcon : Cardinal;
hCursor : Cardinal;
hbrBackground : Cardinal;
lpszMenuName : PAnsiChar;
lpszClassName : PAnsiChar;
end;
msg : packed record
hwnd : Cardinal;
message : Cardinal;
wParam : Integer;
lParam : Integer;
time : Cardinal;
X, Y : Integer;
end;
function CreateWindowEx(dwExStyle: Cardinal; lpClassName: PChar; lpWindowName: PChar; dwStyle: Cardinal; X, Y, nWidth, nHeight: Integer; hWndParent, hMenu, hInstance: Cardinal; lpParam: Pointer): Cardinal; stdcall; external 'user32.dll' name 'CreateWindowExA';
function DefWindowProc(hWnd, Msg: Cardinal; wParam, lParam: Integer): Integer; stdcall; external 'user32.dll' name 'DefWindowProcA';
function DispatchMessage(lpMsg: Pointer): Integer; stdcall; external 'user32.dll' name 'DispatchMessageA'
function GetMessage(lpMsg: Pointer; hWnd, wMsgFilterMin, wMsgFilterMax: Cardinal): Boolean; stdcall; external 'user32.dll' name 'GetMessageA';
function GetSystemMetrics(nIndex: Integer): Integer; stdcall; external 'user32.dll' name 'GetSystemMetrics';
function KillTimer(hWnd: Integer; uIDEvent: Cardinal): Boolean; stdcall; external 'user32.dll' name 'KillTimer';
function LoadCursor(hInstance: Cardinal; lpCursorName: PChar): Cardinal; stdcall; external 'user32.dll' name 'LoadCursorA';
function LoadIcon(hInstance: Cardinal; lpIconName: PChar): Cardinal; stdcall; external 'user32.dll' name 'LoadIconA';
function RegisterClass(lpWndClass: Pointer): Cardinal; stdcall; external 'user32.dll' name 'RegisterClassA';
function SetTimer(hWnd: Integer; nIDEvent, uElapse: Cardinal; lpTimerFunc: Pointer): Cardinal; stdcall; external 'user32.dll' name 'SetTimer';
function SetWindowText(hWnd: Integer; lpString: PChar): Boolean; stdcall; external 'user32.dll' name 'SetWindowTextA';
function SHQueryRecycleBin(szRootPath: PChar; SHQueryRBInfo: PSHQueryRBInfo): Integer; stdcall; external 'shell32.dll' name 'SHQueryRecycleBinA';
function StrFormatByteSize64(dw: I64; szBuf: PChar; uiBufSize: Cardinal): PChar; stdcall; external 'shlwapi.dll' name 'StrFormatByteSize64A';
function TranslateMessage(lpMsg: Pointer): Boolean; stdcall; external 'user32.dll' name 'TranslateMessage';
function wvsprintf(Output: PChar; Format: PChar; arglist: PChar): Integer; stdcall; external 'user32.dll' name 'wvsprintfA';
procedure PostQuitMessage(nExitCode: Integer); stdcall; external 'user32.dll' name 'PostQuitMessage';
procedure FillChar(Destination: Pointer; Length: Cardinal; Fill: Byte);
asm
{ ->EAX Pointer to destination }
{ EDX count }
{ CL value }
PUSH EDI
MOV EDI,EAX { Point EDI to destination }
MOV CH,CL { Fill EAX with value repeated 4 times }
MOV EAX,ECX
SHL EAX,16
MOV AX,CX
MOV ECX,EDX
SAR ECX,2
JS @@exit
REP STOSD { Fill count DIV 4 dwords }
MOV ECX,EDX
AND ECX,3
REP STOSB { Fill count MOD 4 bytes }
@@exit:
POP EDI
end;
function WndProc(hwnd, message: Cardinal; wParam, lParam: Integer): Integer; stdcall;
var
Buffer: array[0..255] of Char;
SHQueryRBInfo: TSHQueryRBInfo;
begin
Result := 0;
case message of
$0113:
begin
FillChar(@SHQueryRBInfo, SizeOf(TSHQueryRBInfo), 0);
SHQueryRBInfo.cbSize := SizeOf(TSHQueryRBInfo);
SHQueryRecycleBin(nil, @SHQueryRBInfo);
StrFormatByteSize64(SHQueryRBInfo.i64Size, Buffer, 255);
SetWindowText(L1, Buffer);
wvsprintf(Buffer, '%lu', @SHQueryRBInfo.i64NumItems);
SetWindowText(L2, Buffer);
end;
$0111: if wParam = 14 then
begin
KillTimer(hwnd,1);
PostQuitMessage(0);
end;
$0002: PostQuitMessage(0);
else Result := DefWindowProc(hwnd, message, wParam, lParam);
end;
end;
begin
with Wnd do
begin
lpfnWndProc := @WndProc;
hbrBackground := 16;
lpszClassName := 'XPU';
hIcon := LoadIcon(0, PChar(32512));
hCursor := LoadCursor(0, PChar(32512));
end;
RegisterClass(@Wnd);
fWnd := CreateWindowEx($00000001, 'XPU', 'Kosz', $10080000, (GetSystemMetrics(0) div 2)-350, (GetSystemMetrics(1) div 2)-250, 350, 250, 0, 0, Wnd.hInstance, NIL);
CreateWindowEx($10000, 'BUTTON', 'Zamknij', $40000000 or $10000000, 100, 180, 133, 33, fWnd, 14, Wnd.hInstance, nil);
CreateWindowEx($10000, 'STATIC', 'Calkowity rozmiar plikow w koszu:', $40000000 or $10000000, 20, 40, 240, 25, fWnd, 0, Wnd.hInstance, nil);
CreateWindowEx($10000, 'STATIC', 'Liczba plików w koszu:', $40000000 or $10000000, 20, 80, 240, 25, fWnd, 0, Wnd.hInstance, nil);
L1 := CreateWindowEx($10000, 'STATIC', '', $40000000 or $10000000, 250, 40, 50, 25, fWnd, 0, Wnd.hInstance, nil);
L2 := CreateWindowEx($10000, 'STATIC', '', $40000000 or $10000000, 250, 80, 50, 25, fWnd, 0, Wnd.hInstance, nil);
SetTimer(fWnd, 1, 1000, nil);
while GetMessage(@msg, 0, 0, 0) do
begin
TranslateMessage(@msg);
DispatchMessage(@msg);
end;
end.
Przy okazji zamieniliśmy CreateWindow na CreateWindowEx, ponieważ nasza pierwotna funkcja w rzeczywistości i tak korzystała z rozszerzonej wersji.
Co więcej, moduły SysInit.pas oraz System.pas są wymagane do poprawnej kompilacji projektu, ale nikt nas nie zmusza do korzystania z oryginalnych (znacznie wiekszych objętościowo) wersji - zastąpimy je własnymi.
SysInit.pas:
unit SysInit;
interface
procedure _InitExe;
procedure _halt0;
procedure _InitLib(Context: PInitContext);
var
ModuleIsLib: Boolean;
TlsIndex: Integer = -1;
TlsLast: Byte;
const
PtrToNil: Pointer = nil;
implementation
procedure _InitLib(Context: PInitContext);
asm
end;
procedure _InitExe;
asm
end;
procedure _halt0;
asm
end;
end.
System.pas:
unit System;
interface
procedure _HandleFinally;
type
TGUID = record
D1: Cardinal;
D2: Word;
D3: Word;
D4: array [0..7] of Byte;
end;
PInitContext = ^TInitContext;
TInitContext = record
OuterContext: PInitContext;
ExcFrame: Pointer;
InitTable: pointer;
InitCount: Integer;
Module: pointer;
DLLSaveEBP: Pointer;
DLLSaveEBX: Pointer;
DLLSaveESI: Pointer;
DLLSaveEDI: Pointer;
ExitProcessTLS: procedure;
DLLInitState: Byte;
end;
implementation
procedure _HandleFinally;
asm
end;
end.
Prawda, że prościej? Po kompilacji otrzymujemy program, który zajmuje całe 5 kB.
Na zakończenie kompresujemy za pomocą Mew, w wyniku czego aplikacja wyświetlająca całkowity rozmiar oraz liczbę plików znajdujących się w koszu zajmuje na dysku 1,746 bajtów.
Projekt wraz z plikami EXE: opty_przyklady2.zip