unit UIDTcpClientThread;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP,
IniFiles;
const
MAXBUFF = 100000;
type
TIDTcpClientThread = class(TThread)
private
bRun: Boolean;
protected
// Response2: TStringStream;
StringList: TStringList;
IdHTTPWeb: TIdHTTP;
procedure Execute; override;
procedure OutPutData();
procedure ThreadExeProcedure();
procedure AnalysisData();
public
URLBuffer: array[1..MAXBUFF] of string;
iCurrentRecord: integer;
iAlreadyRecord: integer;
bBeginToTerminate: Boolean;
constructor Create();
destructor Destroy; override;
procedure AppendURLToIDTcpClientThread(URL: string);
procedure CloseThread();
procedure OutPutURL(URL: string);
end;
implementation
uses Unit1, UHandleURLThread;
{ TIDTcpClientThread }
procedure TIDTcpClientThread.ThreadExeProcedure;
var
s: string;
begin
if iCurrentRecord <> iAlreadyRecord then begin
inc(iAlreadyRecord);
if iAlreadyRecord > MAXBUFF then iAlreadyRecord := 1;
try
// Response2.Free;
//Response2 := TStringStream.Create('');
StringList.Clear;
s := IdHTTPWeb.Get(URLBuffer[iAlreadyRecord]);
// s := Response2.DataString;
//s := Utf8ToAnsi(s);
StringList.Text := s;
AnalysisData();
except
on E: Exception do begin
//
end;
end;
end;
end;
procedure TIDTcpClientThread.AppendURLToIDTcpClientThread(URL: string);
var
iCurrentRecord_Temp: integer;
begin
iCurrentRecord_Temp := iCurrentRecord;
inc(iCurrentRecord_Temp);
if iCurrentRecord_Temp > MAXBUFF then iCurrentRecord_Temp := 1;
URLBuffer[iCurrentRecord_Temp] := URL;
iCurrentRecord := iCurrentRecord_Temp;
end;
procedure TIDTcpClientThread.CloseThread;
begin
end;
constructor TIDTcpClientThread.Create;
begin
inherited Create(false);
StringList := TStringList.Create;
IdHTTPWeb := TIdHTTP.Create(nil);
// Response2 := TStringStream.Create('');
IdHTTPWeb.HandleRedirects := true;
IdHTTPWeb.Request.ContentType := 'application/x-www-form-urlencoded';
StringList.Clear;
bBeginToTerminate := true;
bRun := false;
iCurrentRecord := 1;
iAlreadyRecord := 1;
end;
destructor TIDTcpClientThread.Destroy;
begin
StringList.Clear;
StringList.Free;
IdHTTPWeb.Free;
inherited;
end;
procedure TIDTcpClientThread.Execute;
begin
inherited;
while bBeginToTerminate do begin
if not bRun then begin
bRun := true;
try
sleep(10);
ThreadExeProcedure;
except
on E: Exception do begin
//
end;
end;
bRun := false;
end;
end;
bBeginToTerminate := true;
end;
procedure TIDTcpClientThread.OutPutData;
begin
end;
procedure TIDTcpClientThread.OutPutURL(URL: string);
begin
EnterCriticalSection(CriticalSection);
if assigned(HandleURLThread) then HandleURLThread.AppendURLToThread(URL);
LeaveCriticalSection(CriticalSection);
end;
{var
indexHashed: integer;
begin
indexHashed := HashedStringList.IndexOf(URL);
if indexHashed = -1 then begin
HashedStringList.Add(URL);
inc(indexofthread);
if indexofthread >= MAXTHREAD then indexofthread := 0;
IDTcpClientThread[indexofthread].AppendURLToIDTcpClientThread(URL);
// Form1.Memo1.Lines.Add(URL);
end;
end;
}
procedure TIDTcpClientThread.AnalysisData();
const
HEADSTRING = 'href="';
ENDSTRING = '"';
var
ts, TempURL: string;
i, j, sIndex, sEnd, sLen, ps: integer;
begin
//<a href=" ">
// " , http ,
//½ØÈ¡ Ö÷ÍøÒ³£¬Á½¸öhTTP
//<a href="mailto:sales@calarm.cn">sales@calarm.cn</a>
for i := 0 to StringList.Count - 1 do begin
ts := Lowercase(StringList.Strings[i]);
sIndex := Pos(HEADSTRING, ts);
sLen := Length(ts);
while sIndex > 0 do begin
delete(ts, 1, sIndex + Length(HEADSTRING) - 1);
for j := 1 to MaxMailz do begin
if Pos(Mailz[j], ts) > 0 then begin
if assigned(SendEmailThread) then SendEmailThread.AppendURLToThread(ts);
break;
end;
end;
sEnd := Pos(ENDSTRING, ts);
TempURL := Copy(ts, 1, sEnd - 1);
if
(Pos('.com', ts) > 0) or (Pos('.cn', ts) > 0) or (Pos('.mobi', ts) > 0) or (Pos('.tel', ts) > 0) or
(Pos('.asia', ts) > 0) or (Pos('.net', ts) > 0) or (Pos('.org', ts) > 0) or (Pos('.name', ts) > 0) or
(Pos('.me', ts) > 0) or (Pos('.tv', ts) > 0) or (Pos('.hk', ts) > 0) or (Pos('.biz', ts) > 0) or
(Pos('.info', ts) > 0)
then begin //.com.cn.mobi.tel.asia.net.org.name.me.tv.hk.biz.info
OutPutURL(TempURL);
end;
delete(ts, 1, sEnd);
sIndex := Pos(HEADSTRING, ts);
end;
end;
end;
end.