Шустрый
Профиль
Группа: Участник
Сообщений: 148
Регистрация: 8.9.2003
Репутация: нет
Всего: нет
|
У меня такая проблема. Пытаюсь скачать страницу в асинхроне, но после чтения в цикле InternetReadFile получаю только часть страницы, иногда вообще 0. Не асинхронный режим работает нормально, получаю всю страницу. Ниже два кода, которые я использую : Не асинхронный режим: | Код |
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, WinInet;
type
TForm1 = class(TForm)
btnStart: TButton;
btnPause: TButton;
btnStop: TButton;
Memo1: TMemo;
Label1: TLabel;
Label2: TLabel;
Memo2: TMemo;
Label3: TLabel;
Edit1: TEdit;
Button1: TButton;
Edit2: TEdit;
procedure btnStartClick(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
hSession: HINTERNET;
hConnect: HINTERNET;
hRequest: HINTERNET;
userAgent: string;
public
{ Public declarations }
MS: TMemoryStream;
procedure Init;
function GetUrl(Aurl: string): Boolean;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
var
userAgent: string='User-Agent: Mozilla/4.0 (compatible; MSIE 5.01; Windows NT 5.0)';
procedure TForm1.Init;
begin
Memo1.Clear;
Memo2.Clear;
end;
procedure TForm1.btnStartClick(Sender: TObject);
begin
btnStart.Enabled:=false;
btnStop.Tag:=0;
Init;
MS:=TMemoryStream.Create;
try
if GetUrl(Edit1.Text) then // процедура закачки файла
begin
MS.Position:=0;
Memo1.Lines.LoadFromStream(MS); // показываем код страницы в Memo1
end;
finally
MS.Free;
btnStart.Enabled:=true;
end;
end;
function TForm1.GetUrl(Aurl: string): Boolean;
var
Buffer: array [0..1023] of byte;
lBytesToRead, lReadBytes: cardinal;
rst: Boolean;
lDataSize: DWORD;
procedure CloseConnect;
begin
if Assigned(hRequest) then InternetCloseHandle(hRequest);
hRequest:=nil;
if Assigned(hConnect) then InternetCloseHandle(hConnect);
hConnect:=nil;
if Assigned(hSession) then InternetCloseHandle(hSession);
hSession:=nil;
end;
begin
result:=false;
if not Assigned(hSession) then
hSession:=InternetOpen(PChar(userAgent), INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
if not Assigned(hSession) then exit;
hRequest:=InternetOpenUrl(hSession,Pchar(Aurl),'',0,INTERNET_FLAG_RELOAD or INTERNET_FLAG_NO_CACHE_WRITE, 0);
if Assigned(hRequest) then
if InternetQueryDataAvailable(hRequest, lDataSize,0,0) then
begin
result:=true;
lBytesToRead:=length(Buffer);
repeat
Application.ProcessMessages;
if btnStop.Tag=1 then
begin
Result:=false;
break;
end;
lReadBytes:=0;
rst:=InternetReadFile(hRequest, @Buffer, lBytesToRead, lReadBytes);
if rst and (lReadBytes>0) then MS.WriteBuffer(Buffer, lReadBytes);
until lReadBytes<=0;
end;
CloseConnect;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Memo1.Lines.SaveToFile(Edit2.Text);
end;
end.
|
Асинхронный режим: | Код |
unit Unit1;
// закачка файла через InternetOpenURL в асинхроне
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, WinInet;
type
TForm1 = class(TForm)
btnStart: TButton;
btnPause: TButton;
btnStop: TButton;
Memo1: TMemo;
Label1: TLabel;
Label2: TLabel;
Memo2: TMemo;
Label3: TLabel;
Edit1: TEdit;
Button1: TButton;
Edit2: TEdit;
procedure btnStartClick(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
hSession: HINTERNET;
hConnect: HINTERNET;
hRequest: HINTERNET;
FConnectClosing: Boolean;
FConnectClosed: Boolean;
FHandleClosing: Boolean;
FRespReceived: Boolean;
FBytesRead: integer;
FContext: integer;
userAgent: string;
public
{ Public declarations }
MS: TMemoryStream;
procedure Init;
function GetUrl(Aurl: string): Boolean;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
var
userAgent: string='User-Agent: Mozilla/4.0 (compatible; MSIE 5.01; Windows NT 5.0)';
procedure TForm1.Init;
begin
Memo1.Clear;
Memo2.Clear;
end;
procedure TForm1.btnStartClick(Sender: TObject);
begin
btnStart.Enabled:=false;
btnStop.Tag:=0;
Init;
MS:=TMemoryStream.Create;
try
if GetUrl(Edit1.Text) then // процедура закачки
begin
MS.Position:=0;
Memo1.Lines.LoadFromStream(MS); // показываем код страницы в Memo1
end;
finally
MS.Free;
btnStart.Enabled:=true;
end;
end;
// процедура обратного вызова
procedure InternetStatusCallBack(
AInetHandle: HINTERNET;
AContext: Pointer;
AInternetStatus: DWORD;
AStatusInformation: Pointer;
AStatusInfoSize: DWORD
); stdcall;
begin
case AInternetStatus of
INTERNET_STATUS_CLOSING_CONNECTION:
Form1.FConnectClosing:=true;
INTERNET_STATUS_CONNECTION_CLOSED:
Form1.FConnectClosed:=true;
INTERNET_STATUS_HANDLE_CLOSING:
Form1.FHandleClosing:=true;
INTERNET_STATUS_HANDLE_CREATED:
Form1.hConnect:=HINTERNET(PInternetAsyncResult(AStatusInformation)^.dwResult);
INTERNET_STATUS_REQUEST_COMPLETE:
Form1.hRequest:=HINTERNET(PInternetAsyncResult(AStatusInformation)^.dwResult);
INTERNET_STATUS_RESPONSE_RECEIVED:
begin
Form1.FBytesRead:=Cardinal(AStatusInformation^);
Form1.FRespReceived:=true;
end;
end;
end;
function TForm1.GetUrl(Aurl: string): Boolean;
var
Buffer: array [0..1023] of byte;
lBytesToRead, lReadBytes: cardinal;
rst: Boolean;
lDataSize: DWORD;
sum: integer;
procedure CloseConnect;
begin
if Assigned(hRequest) then InternetCloseHandle(hRequest);
hRequest:=nil;
if Assigned(hConnect) then InternetCloseHandle(hConnect);
hConnect:=nil;
if Assigned(hSession) then InternetCloseHandle(hSession);
hSession:=nil;
end;
begin
result:=false;
if not Assigned(hSession) then
hSession:=InternetOpen(PChar(userAgent), INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, INTERNET_FLAG_ASYNC);
if not Assigned(hSession) then exit;
InternetSetStatusCallback(hSession, @InternetStatusCallBack);
FConnectClosing:=false;
FConnectClosed:=false;
FHandleClosing:=false;
Form1.FRespReceived:=false;
hRequest:=nil;
sum:=0;
InternetOpenUrl(hSession,Pchar(Aurl),'',0,INTERNET_FLAG_RELOAD or INTERNET_FLAG_NO_CACHE_WRITE or INTERNET_FLAG_KEEP_CONNECTION, Cardinal(@FContext));
while true do // цикл ожидания вызова callback функции
begin
Application.ProcessMessages;
if btnStop.Tag=1 then
begin
CloseConnect;
break;
end;
if Form1.FRespReceived then //and (Form1.hRequest<>nil)
begin
break;
end;
sleep(100);
end;
if Assigned(hRequest) then
if InternetQueryDataAvailable(hRequest, lDataSize,0,0) then
begin
result:=true;
lBytesToRead:=length(Buffer);
repeat
Application.ProcessMessages;
if btnStop.Tag=1 then // если нажата кнопка стоп выходим
begin
Result:=false;
break;
end;
lReadBytes:=0;
rst:=InternetReadFile(hRequest, @Buffer, lBytesToRead, lReadBytes);
if (lReadBytes>0) then MS.WriteBuffer(Buffer, lReadBytes);
//-- Debug
sum:=sum+lReadBytes;
Memo2.Lines.Add('lReadBytes='+IntToStr(lReadBytes));
//---------
until lReadBytes<=0;
end;
Memo2.Lines.Add('sum='+IntToStr(sum)); // debug сколько всего скачано байт
CloseConnect;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Memo1.Lines.SaveToFile(Edit2.Text);
end;
end.
|
|
Асинхронный вызов InternetOpenUrl 
Загрузка ...
