初学http多线程,自己需要的小功能基本实现,请大家再指导一下,有什么地方需要再改进的(50)

  • 主题发起人 主题发起人 delhpi
  • 开始时间 开始时间
D

delhpi

Unregistered / Unconfirmed
GUEST, unregistred user!
{本身的目标是,软件在运行时会得到N个合法的URL,点击软件上的按钮后,对于每个URL用一个线程来取得相应网页的源码,然后软件会对相应的源码进行分析。做了一个类似的例子,用了StringGrid,URL在第二列,取得的源码要求放在相应行的第3列。程序能正常运行,基本的功能好像已经实现。请大家再指点一下,有什么地方需要改进的。另外,如何知道所有的线程都已经执行完毕?怎么样中途 取消还没有完成的所有线程?谢谢。}unit UnitMain;interfaceuses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Grids;type TForm1 = class(TForm) StringGrid1: TStringGrid;
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
private { Private declarations } procedure ThreadDone(Sender:TObject);
procedure GetPageHtml(aUrl:string;aR:integer);
public { Public declarations } end;
var Form1: TForm1;implementation{$R *.dfm}uses WinInet,StrUtils;//自定义的线程代码 转自网上一个流行的例子,有部分属性这个例子里用不到type TRemarkThread = class(TThread) private FTAcceptTypes, FTAgent, FTURL, FTFileName, FTStringResult, FTUserName, FTPassword, FTPostQuery, FTReferer: String;
FTBinaryData, FTUseCache: Boolean;
FTResult: Boolean;
FTFileSize: Integer;
FTToFile: Boolean;
BytesToRead, BytesReaded: DWord;// FTProgress: TOnProgressEvent;
FSgRow:Integer;// procedure UpdateProgress;
protected procedure Execute;
override;
public constructor Create(aAcceptTypes, aAgent, aURL, aFileName, aUserName, aPassword, aPostQuery, aReferer: String;
aBinaryData, aUseCache: Boolean;
{aProgress: TOnProgressEvent;} aToFile: Boolean);
end;
{ TRemarkThread }constructor TRemarkThread.Create(aAcceptTypes, aAgent, aURL, aFileName, aUserName, aPassword, aPostQuery, aReferer: String;
aBinaryData, aUseCache, aToFile: Boolean);
begin
FreeOnTerminate := True;
inherited Create(True);
FTAcceptTypes := aAcceptTypes;
FTAgent := aAgent;
FTURL := aURL;
FTFileName := aFileName;
FTUserName := aUserName;
FTPassword := aPassword;
FTPostQuery := aPostQuery;
FTReferer := aReferer;// FTProgress := aProgress;
FTBinaryData := aBinaryData;
FTUseCache := aUseCache;
FTToFile := aToFile;
Resume;
end;
procedure TRemarkThread.Execute;var hSession, hConnect, hRequest: hInternet;
HostName, FileName: String;
f: File;
Buf: Pointer;
dwBufLen, dwIndex: DWord;
Data: Array[0..$400] of Char;
TempStr: String;
RequestMethod: PChar;
InternetFlag: DWord;
AcceptType: LPStr;
procedure ParseURL(URL: String;
var HostName, FileName: String);
procedure ReplaceChar(c1, c2: Char;
var St: String);
var p: Integer;
begin
while Truedo
begin
p := Pos(c1, St);
if p = 0 then
Break else
St[p] := c2;
end;
end;
var i: Integer;
begin
if Pos('http://', LowerCase(URL)) <> 0 then
System.Delete(URL, 1, 7);
i := Pos('/', URL);
HostName := Copy(URL, 1, i);
FileName := Copy(URL, i, Length(URL) - i + 1);
if (Length(HostName) > 0) and (HostName[Length(HostName)] = '/') then
SetLength(HostName, Length(HostName) - 1);
end;
procedure CloseHandles;
begin
InternetCloseHandle(hRequest);
InternetCloseHandle(hConnect);
InternetCloseHandle(hSession);
end;
begin
try ParseURL(FTURL, HostName, FileName);
if Terminated then
begin
FTResult := False;
Exit;
end;
if FTAgent <> '' then
hSession := InternetOpen(PChar(FTAgent), INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0) else
hSession := InternetOpen(nil, INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
hConnect := InternetConnect(hSession, PChar(HostName), INTERNET_DEFAULT_HTTP_PORT, PChar(FTUserName), PChar(FTPassword), INTERNET_SERVICE_HTTP, 0, 0);
if FTPostQuery = '' then
RequestMethod := 'GET' else
RequestMethod := 'POST';
if FTUseCache then
InternetFlag := 0 else
InternetFlag := INTERNET_FLAG_RELOAD;
AcceptType := PChar('Accept: ' + FTAcceptTypes);
hRequest := HttpOpenRequest(hConnect, RequestMethod, PChar(FileName), 'HTTP/1.0', PChar(FTReferer), @AcceptType, InternetFlag, 0);
if FTPostQuery = '' then
HttpSendRequest(hRequest, nil, 0, nil, 0) else
HttpSendRequest(hRequest, 'Content-Type: application/x-www-form-urlencoded', 47, PChar(FTPostQuery), Length(FTPostQuery));
if Terminated then
begin
CloseHandles;
FTResult := False;
Exit;
end;
dwIndex := 0;
dwBufLen := 1024;
GetMem(Buf, dwBufLen);
FTResult := HttpQueryInfo(hRequest, HTTP_QUERY_CONTENT_LENGTH, Buf, dwBufLen, dwIndex);
if Terminated then
begin
FreeMem(Buf);
CloseHandles;
FTResult := False;
Exit;
end;
if FTResult or not FTBinaryData then
begin
if FTResult then
FTFileSize := StrToInt(StrPas(Buf));
BytesReaded := 0;
if FTToFile then
begin
AssignFile(f, FTFileName);
Rewrite(f, 1);
end else
FTStringResult := '';
while Truedo
begin
if Terminated then
begin
if FTToFile then
CloseFile(f);
FreeMem(Buf);
CloseHandles;
FTResult := False;
Exit;
end;
if not InternetReadFile(hRequest, @Data, SizeOf(Data), BytesToRead) then
Break else
if BytesToRead = 0 then
Break else
begin
if FTToFile then
BlockWrite(f, Data, BytesToRead) else
begin
TempStr := Data;
SetLength(TempStr, BytesToRead);
FTStringResult := FTStringResult + TempStr;
end;
inc(BytesReaded, BytesToRead);// if Assigned(FTProgress) then
// Synchronize(UpdateProgress);
end;
end;
if FTToFile then
FTResult := FTFileSize = Integer(BytesReaded) else
begin
SetLength(FTStringResult, BytesReaded);
FTResult := BytesReaded <> 0;
end;
if FTToFile then
CloseFile(f);
end;
FreeMem(Buf);
CloseHandles;
except end;
end;
procedure TForm1.Button1Click(Sender: TObject);var i:integer;
begin
with StringGrid1do
for i := 1 to RowCount - 1do
GetPageHtml(cells[1,i],i);//每个URL,创建一个线程来取得网页源码end;
procedure TForm1.FormCreate(Sender: TObject);var i:integer;const UrlArr:array[1..4] of string=('http://www.163.com/','http://www.baidu.com/','http://www.google.com/','http://www.delphibbs.com/');
begin
with StringGrid1do
begin
rows[0].CommaText:='序号,网址,网页源码';
for I := low(urlarr) to high(urlarr)do
begin
cells[0,i]:=inttostr(i);
cells[1,i]:=urlarr;
end;
end;
Width:=screen.WorkAreaWidth;
end;
procedure TForm1.GetPageHtml(aUrl: string;
aR: integer);
begin
with TRemarkThread.Create('*/*', '', aURL, '', '', '', '', '', false, false, False)do
begin
FSgRow:=aR;//传递对应URL在哪行,线程结束时用到 OnTerminate := ThreadDone;
end;
end;
procedure TForm1.ThreadDone(Sender: TObject);var w:WideString;
begin
with StringGrid1do
begin
w:= TRemarkThread(Sender).FTStringResult;
cells[2,TRemarkThread(Sender).FSgRow]:= leftstr(w,100);//假设取前100个字符//实际需要中,会对源码进行分析,比如判断是否POST或GET成功,然后将分析的结果写入到单元格中。 end;
end;
end.
 
无人指点,谁顶一下,我结贴。
 
太多了,大概看了下,异步处理要使用InternetReadFileEx 而不是InternetReadFile;另外再加个处理进度会好一些
 
其实 代码结构很简单,只是下载网页源码的过程比较长而已。进度的问题,发帖子时还不会搞。今天上午又“研究”了一下,在主线程里可以用进度条动态指示,有几个线程已经完成了。而且也能中途取消没有完成的线程。关于读取网页源码的WININET函数,我根本不懂,这部分代码本身就是复制别人的。看了你的回复,感觉对那部分代码有点不放心了。不过从运行的结果来看,好像各个线程都正确的取到了网页源码。
 
接受答案了.
 
后退
顶部