[Delphi] Winsock 1.1; скачать файл

Discussion in 'С/С++, C#, Rust, Swift, Go, Java, Perl, Ruby' started by RedFern.89, 25 May 2010.

  1. RedFern.89

    RedFern.89 Member

    Joined:
    20 Jan 2010
    Messages:
    577
    Likes Received:
    48
    Reputations:
    0
    пытаюсь скачать файл, а получается какаято битая хрень! я уже 2 часа негодую от злобы. Что может быть не так?

    Code:
    // ---- Шлем запрос ----
    procedure SendRequest(url, packet: string);
    var
    info      : TWSAData;
    Data      : AnsiString;
    i,d,
    len       :integer;
    data_flag : boolean;
    h, DataPos: dword;
    Socket1   : TSocket;
    SockAddr1 : TSockAddrIn;
    tmp_buf   : array[0..1024] of char;
    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.s_addr := inet_addr(Pansichar(GetIPAddress(gethost(url))));
     connect(Socket1, SockAddr1, sizeof(SockAddr1));
    
     len := 0;
     send(Socket1, packet[1], Length(packet), 0);
    
     repeat
        FillChar(tmp_buf,SizeOf(tmp_buf),0);
        d := recv(Socket1, tmp_buf, 1024, 0);
        len := len + d;
        for i := 1 to d do Data := Data + tmp_buf[i];
     until d <= 0;
    
     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;
    
     Closesocket(Socket1);
     WSACleanup;
    end;
    
    function Get(const AURL: string; AResponseContent: TStream): string;
    var
      Head   : string;
      Host   : string;
      urlObj : string;
    begin
     { Парсим url }
      urlObj := AURL;
      urlObj := Copy(urlObj, Length(GetHost(urlObj)) +8, Length(urlObj));
      Host   := GetHost(AURL);
    
      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, head);
    end;
    
     
  2. sn0w

    sn0w Статус пользователя:

    Joined:
    26 Jul 2005
    Messages:
    1,009
    Likes Received:
    1,115
    Reputations:
    327
    я в дельфи не кодю, но вса стартап у тя 1.0 а не заявленный в топике
     
  3. RedFern.89

    RedFern.89 Member

    Joined:
    20 Jan 2010
    Messages:
    577
    Likes Received:
    48
    Reputations:
    0
    сделал на 2.0 и сделал $202 значение )) тоже самое
     
  4. Chrome~

    Chrome~ Elder - Старейшина

    Joined:
    13 Dec 2008
    Messages:
    939
    Likes Received:
    162
    Reputations:
    27
    Если пытаешься скачать файл, то должен считывать данные сразу не в AnsiString а массив. (etc. array[1..1024] of Char;)
     
    #4 Chrome~, 25 May 2010
    Last edited: 25 May 2010
  5. RedFern.89

    RedFern.89 Member

    Joined:
    20 Jan 2010
    Messages:
    577
    Likes Received:
    48
    Reputations:
    0
    Chrome~, пример в студию!!)
     
    #5 RedFern.89, 25 May 2010
    Last edited: 26 May 2010
  6. wolmer

    wolmer Member

    Joined:
    12 May 2009
    Messages:
    445
    Likes Received:
    97
    Reputations:
    9
    RedFern.89, смотри личку
     
  7. Chrome~

    Chrome~ Elder - Старейшина

    Joined:
    13 Dec 2008
    Messages:
    939
    Likes Received:
    162
    Reputations:
    27
    Переработал твой код, чтобы можно было скачать картинку.

    Code:
    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.

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

    Основная твоя проблемная часть была здесь:
    Code:
     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;
    
    Если вдуматься, то можно прийти к выводу, что этот алгоритм полностью неправильный. Первый раз конструкция:
    Code:
    DataPos := pos(#13#10#13#10, ansistring(Data)) +4;
    Примет какое либо значение (не имеет значение, какое). Все последующие разы DataPos будет принимать значение 4, либо какое нибудь другое, если в теле будет встречаться #13#10#13#10.
     
  8. Jingo Bo

    Jingo Bo Member

    Joined:
    25 Oct 2009
    Messages:
    368
    Likes Received:
    51
    Reputations:
    7
    Почему ни кто не сказал что Send не правильно используется? Она же возвращает сколько отправить смогла и заголовки могут отправиться не полностью если будет возвращено меньшее чем размер данных.
     
  9. Chrome~

    Chrome~ Elder - Старейшина

    Joined:
    13 Dec 2008
    Messages:
    939
    Likes Received:
    162
    Reputations:
    27
    Я сделал поправку в тех самых важных местах кода, которые необходимы для правильного результата.

    Если уж на то пошло, то нужно еще проверять значения, возвращаемые GetLastError после функций WSAStartup, Socket, Connect и т д.
     
  10. RedFern.89

    RedFern.89 Member

    Joined:
    20 Jan 2010
    Messages:
    577
    Likes Received:
    48
    Reputations:
    0
    ну спасибо всем! Chrome~, тебе отдельное спасибо! щас пишу модуль HTTPCli.pas и переведу свой компонент на сокеты..
     
  11. RedFern.89

    RedFern.89 Member

    Joined:
    20 Jan 2010
    Messages:
    577
    Likes Received:
    48
    Reputations:
    0
    Chrome~, а как вместо WriteFile в TMemoryStream записать? что то не выходит у меня никак
     
  12. Chrome~

    Chrome~ Elder - Старейшина

    Joined:
    13 Dec 2008
    Messages:
    939
    Likes Received:
    162
    Reputations:
    27
    Не за что! Свой модуль для работы с HTTP - это гуд.
    Здесь Memory - наперед созданный TMemoryStream:
    Code:
    var
      Buf: String;
    begin
      Buf := 'Test!';
      Memory.WriteBuffer(Buf[1], Length(Buf));
    end;
     
  13. RedFern.89

    RedFern.89 Member

    Joined:
    20 Jan 2010
    Messages:
    577
    Likes Received:
    48
    Reputations:
    0
    блин. yota не работает в пригороде.. щас по городу едем и то слабо работает.. я дописал все практически... проврить не могу.. через 2 дня отпишусь..а может и раньше
     
Loading...