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

[RedFern.89]

пытаюсь скачать файл, а получается какаято битая хрень! я уже 2 часа негодую от злобы. Что может быть не так?


// ---- Шлем запрос ----
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;

[sn0w]

я в дельфи не кодю, но вса стартап у тя 1.0 а не заявленный в топике

[RedFern.89]

сделал на 2.0 и сделал $202 значение )) тоже самое

[Chrome~]

Если пытаешься скачать файл, то должен считывать данные сразу не в AnsiString а массив. (etc. array[1..1024] of Char;)

[RedFern.89]

Chrome~, пример в студию!!)

[wolmer]

RedFern.89, смотри личку

[Chrome~]

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

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.

[Jingo Bo]

Почему ни кто не сказал что Send не правильно используется? Она же возвращает сколько отправить смогла и заголовки могут отправиться не полностью если будет возвращено меньшее чем размер данных.

[Chrome~]

Почему ни кто не сказал что Send не правильно используется? Она же возвращает сколько отправить смогла и заголовки могут отправиться не полностью если будет возвращено меньшее чем размер данных.
Я сделал поправку в тех самых важных местах кода, которые необходимы для правильного результата.

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

[RedFern.89]

ну спасибо всем! Chrome~, тебе отдельное спасибо! щас пишу модуль HTTPCli.pas и переведу свой компонент на сокеты..

[RedFern.89]

Chrome~, а как вместо WriteFile в TMemoryStream записать? что то не выходит у меня никак

[Chrome~]

ну спасибо всем! Chrome~, тебе отдельное спасибо! щас пишу модуль HTTPCli.pas и переведу свой компонент на сокеты..
Не за что! Свой модуль для работы с HTTP - это гуд.
Chrome~, а как вместо WriteFile в TMemoryStream записать? что то не выходит у меня никак
Здесь Memory - наперед созданный TMemoryStream:
var
Buf: String;
begin
Buf := 'Test!';
Memory.WriteBuffer(Buf[1], Length(Buf));
end;

[RedFern.89]

блин. yota не работает в пригороде.. щас по городу едем и то слабо работает.. я дописал все практически... проврить не могу.. через 2 дня отпишусь..а может и раньше