Programowanie w języku Delphi » Artykuły

Optymalizacje w Delphi (przyklad - część II)

  • 0 komentarzy
  • 931 odsłon
  • Oceń ten tekst jako pierwszy
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 (5,79 KB)