пытаюсь скачать файл, а получается какаято битая хрень! я уже 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;
Если пытаешься скачать файл, то должен считывать данные сразу не в AnsiString а массив. (etc. array[1..1024] of Char
Переработал твой код, чтобы можно было скачать картинку. 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.
Почему ни кто не сказал что Send не правильно используется? Она же возвращает сколько отправить смогла и заголовки могут отправиться не полностью если будет возвращено меньшее чем размер данных.
Я сделал поправку в тех самых важных местах кода, которые необходимы для правильного результата. Если уж на то пошло, то нужно еще проверять значения, возвращаемые GetLastError после функций WSAStartup, Socket, Connect и т д.
ну спасибо всем! Chrome~, тебе отдельное спасибо! щас пишу модуль HTTPCli.pas и переведу свой компонент на сокеты..
Не за что! Свой модуль для работы с HTTP - это гуд. Здесь Memory - наперед созданный TMemoryStream: Code: var Buf: String; begin Buf := 'Test!'; Memory.WriteBuffer(Buf[1], Length(Buf)); end;
блин. yota не работает в пригороде.. щас по городу едем и то слабо работает.. я дописал все практически... проврить не могу.. через 2 дня отпишусь..а может и раньше