Показать сообщение отдельно

  #7  
Старый 25.05.2010, 20:49
Chrome~
Постоянный
Регистрация: 13.12.2008
Сообщений: 354
С нами: 9162683

Репутация: 175
По умолчанию

Переработал твой код, чтобы можно было скачать картинку.

Код:
function LookupName(str: string): TInAddr;
var
  _hostEnt:PHostEnt;
  _inAddr:TInAddr; 
begin
  if (str[1] in ['a'..'z']) or
      (str[2] in ['a'..'z']) then
  begin
    _hostEnt := getHostByName(pchar(str));
    FillChar(_inAddr, sizeOf(_inAddr), 0);
    if _hostEnt<>nil then 
    begin
      with _hostEnt^, _inAddr do
      begin 
        s_un_b.s_b1 := h_addr^[0];
        s_un_b.s_b2 := h_addr^[1];
        s_un_b.s_b3 := h_addr^[2];
        s_un_b.s_b4 := h_addr^[3];
      end;
    end;
  end
  else
    _inAddr.s_addr := inet_addr(pchar(str));
  Result:= _inAddr;
end;

procedure SendRequest(url, host, packet: string);
var
info      : TWSAData;
i, len    : integer;
d, b      : Cardinal;
data_flag : boolean;
h: dword;
Socket1   : TSocket;
SockAddr1 : TSockAddrIn;
buf       : array[1..1024] of char;
flag: boolean;
begin

 WSAStartup(makeword(1,0),info);
 Socket1 := Socket(AF_INET,SOCK_STREAM,0);
 SockAddr1.sin_family := AF_INET;
 SockAddr1.sin_port := htons(80);
 SockAddr1.sin_addr := LookupName(host);
 connect(Socket1, SockAddr1, sizeof(SockAddr1));

 len := 0;
 send(Socket1, packet[1], Length(packet), 0);

 h := CreateFile(pchar('C:\TestImage.jpg'), GENERIC_WRITE, 0, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);

 flag := False;
 repeat
   d := recv(Socket1, buf, 1024, 0);
   if d > 0 then
   begin
     if flag = False then
     begin
       i := pos(#13#10#13#10, buf);
       WriteFile(h, buf[i + 4], d - i - 3, b, 0);

       flag := True;
     end
     else
       WriteFile(h, buf, d, b, 0);
   end;
 until d <= 0;

 CloseHandle(h);

 Closesocket(Socket1);
 WSACleanup;
end;

function Get(const AURL: string; Host: String; AResponseContent: TStream): string;
var
  Head   : string;
  urlObj : string;
begin
 { Парсим url }
  urlObj := AURL;
  urlObj := Copy(urlObj, Length(Host) + 8, Length(urlObj));

  Head := 'GET ' + urlObj + ' HTTP/1.0' + #13#10 +
          'User-Agent: Mozilla/4.8 [en](Windows NT 5.0; U)' + #13#10 +
          'Connection: close' + #13#10 +
          'Host: ' + Host + #13#10#13#10;

  SendRequest(AURL, Host, head);
end;
Я не знаю, что это были за функции GetIPAddress и GetHost, поэтому пришлось додумывать самому.

Надеюсь, в этом коде все будет понятно. Картинка сохраняется в файле C:\TestImage.jpg.

Пример вызова функции:
Код:
Get('http://i34.tinypic.com/sdnztg.jpg', 'i34.tinypic.com', nil);
Да и небольшой совет на будущее. FillChar старайся избегать, когда это возможно.

Основная твоя проблемная часть была здесь:
Код:
 DataPos := pos(#13#10#13#10, ansistring(Data)) +4;
 if DataPos > 0 then
 begin
  FillChar(tmp_buf, SizeOf(tmp_buf), 0);
  h := CreateFile(pchar('d:\avatar111490.gif'), GENERIC_WRITE, 0, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
  WriteFile(h, Data[DataPos], len - DataPos, DataPos, 0);
  CloseHandle(h);
 end;
Если вдуматься, то можно прийти к выводу, что этот алгоритм полностью неправильный. Первый раз конструкция:
Код:
DataPos := pos(#13#10#13#10, ansistring(Data)) +4;
Примет какое либо значение (не имеет значение, какое). Все последующие разы DataPos будет принимать значение 4, либо какое нибудь другое, если в теле будет встречаться #13#10#13#10.
 
Ответить с цитированием