Antichat снова доступен.
Форум Antichat (Античат) возвращается и снова открыт для пользователей.
Здесь обсуждаются безопасность, программирование, технологии и многое другое.
Сообщество снова собирается вместе.
Новый адрес: forum.antichat.xyz
 |
|
[Delphi] Winsock 1.1; скачать файл |

25.05.2010, 17:56
|
|
Постоянный
Регистрация: 20.01.2010
Сообщений: 338
Провел на форуме: 500264
Репутация:
69
|
|
[Delphi] Winsock 1.1; скачать файл
пытаюсь скачать файл, а получается какаято битая хрень! я уже 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;
|
|
|

25.05.2010, 18:00
|
|
Статус пользователя:
Регистрация: 26.07.2005
Сообщений: 568
Провел на форуме: 1290766
Репутация:
1236
|
|
я в дельфи не кодю, но вса стартап у тя 1.0 а не заявленный в топике
__________________
 
snow white world wide
|
|
|

25.05.2010, 18:03
|
|
Постоянный
Регистрация: 20.01.2010
Сообщений: 338
Провел на форуме: 500264
Репутация:
69
|
|
сделал на 2.0 и сделал $202 значение )) тоже самое
|
|
|

25.05.2010, 19:31
|
|
Постоянный
Регистрация: 13.12.2008
Сообщений: 354
Провел на форуме: 1747641
Репутация:
175
|
|
Если пытаешься скачать файл, то должен считывать данные сразу не в AnsiString а массив. (etc. array[1..1024] of Char;)
Последний раз редактировалось Chrome~; 25.05.2010 в 19:40..
|
|
|

25.05.2010, 19:35
|
|
Постоянный
Регистрация: 20.01.2010
Сообщений: 338
Провел на форуме: 500264
Репутация:
69
|
|
Chrome~, пример в студию!!)
Последний раз редактировалось RedFern.89; 26.05.2010 в 11:25..
|
|
|

25.05.2010, 19:47
|
|
Постоянный
Регистрация: 12.05.2009
Сообщений: 395
Провел на форуме: 4761503
Репутация:
229
|
|
RedFern.89, смотри личку
|
|
|

25.05.2010, 20:49
|
|
Постоянный
Регистрация: 13.12.2008
Сообщений: 354
Провел на форуме: 1747641
Репутация:
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.
|
|
|

26.05.2010, 01:56
|
|
Познающий
Регистрация: 25.10.2009
Сообщений: 97
Провел на форуме: 604635
Репутация:
15
|
|
Почему ни кто не сказал что Send не правильно используется? Она же возвращает сколько отправить смогла и заголовки могут отправиться не полностью если будет возвращено меньшее чем размер данных.
|
|
|

26.05.2010, 09:13
|
|
Постоянный
Регистрация: 13.12.2008
Сообщений: 354
Провел на форуме: 1747641
Репутация:
175
|
|
Сообщение от Jingo Bo
Почему ни кто не сказал что Send не правильно используется? Она же возвращает сколько отправить смогла и заголовки могут отправиться не полностью если будет возвращено меньшее чем размер данных.
Я сделал поправку в тех самых важных местах кода, которые необходимы для правильного результата.
Если уж на то пошло, то нужно еще проверять значения, возвращаемые GetLastError после функций WSAStartup, Socket, Connect и т д.
|
|
|

26.05.2010, 10:05
|
|
Постоянный
Регистрация: 20.01.2010
Сообщений: 338
Провел на форуме: 500264
Репутация:
69
|
|
ну спасибо всем! Chrome~, тебе отдельное спасибо! щас пишу модуль HTTPCli.pas и переведу свой компонент на сокеты..
|
|
|
|
 |
|
Похожие темы
|
| Тема |
Автор |
Раздел |
Ответов |
Последнее сообщение |
|
Всё для спамера
|
KPOT_f!nd |
E-Mail |
356 |
07.06.2010 23:40 |
|
Ссылки на трояны
|
TROJ@N |
Защита ОС: вирусы, антивирусы, файрволы. |
332 |
05.06.2008 16:06 |
|
чтиво для новичков
|
genom-- |
*nix |
5 |
20.10.2006 19:17 |
|
СОФТ ОБЗОР
|
TROJ@N |
Soft - Windows |
7 |
16.04.2006 12:28 |
|
Здесь присутствуют: 1 (пользователей: 0 , гостей: 1)
|
|
|
|