一个小型浏览器架构：HTTP通讯、COOKIE处理、HTML解析、JS模拟、表单处理
前段时间作了一个HTML的解析类，方便在蜘蛛、信息发布、小偷程序中正确抓取网页内容。
有人可能会说，为啥不用Webbrowser呢。
1，首先是效率问题，Webbrowser太慢了。
2，你无法操作Webbrowser上传一个文件。
3，你无法操作Webbrowser跨域的Iframe
4，你不能不按套路出牌，例如页面setTimeout 100秒输出一个div，你也只能100秒后才能获取到。
5，如果你只想在后台解析HTML，不想让用户看到浏览器，Webbrowser会很碍事。
6，阻止浏览器下载图片、CSS、Flash不是一件容易的事情，而这写内容通常没啥用。
。。。。
因为是一个商业软件，不太方便直接公开全部源代码，列出各头大家了解一下吧。如果大家比较感兴趣，稍后我会核心部分做一个说明。
HTTP通讯部分
type
ETCPSocket = class(Exception);
ESSLTCPSocket = class(Exception);
ECookies = class(Exception);
EHTTP = class(Exception);
TSockEvent = (sSend,sRecv);
TSocketNotify = procedure(Event:TSockEvent; Bytes: Int64) of object;
TTCPSocket = class
strict private
FTimeOut: DWORD;
FSocketNotify: TSocketNotify;
procedure SetTimeOut(Ms : DWORD);
function GetTimeOut : DWORD;
protected
FSocket: TSocket;
public
constructor Create;
destructor Destroy; override;
function Open(const Host : String; const Port : WORD) : Boolean;
function Send(const Buffer : RawByteString) : Boolean;
function Recv(var Buffer : RawByteString) : Boolean;
procedure Close; virtual;
function HostToIP(const Name:String):String;
property TimeOut : DWORD read GetTimeOut write SetTimeOut;
property OnNotify: TSocketNotify read FSocketNotify write FSocketNotify;
end;
TSSLTCPSocket = class(TTCPSocket)
strict private
FCTXClient: PSSL_CTX;
FSSLClient: PSSL;
protected
{ protected declarations }
public
constructor Create;
function Open(const Host : String; const Port : WORD) : Boolean;
function Send(const Buffer : RawByteString) : Boolean;
function Recv(var Buffer : RawByteString) : Boolean;
procedure Close; override;
end;
TCookieData = class
Domain,
Path,
Name,
Value:String;
end;
TCookies = class
private
FList:TObjectList;
function GetCount:Integer;
function GetItems(Index: Integer):TCookieData;
procedure SetItems(Index: Integer; CookieData:TCookieData);
function InDomain(const Domain,Domain2:String):Boolean;
function InPath(const Path,Path2:String):Boolean;
procedure UpdateCookies(const CookieDomain,CookiePath,CookieName,CookieValue:String);
protected
{ protected declarations }
public
constructor Create;
destructor Destroy; override;
procedure Clear;
procedure Add(Domain,Path,Name,Value:String); overload;
procedure Add(Domain,Path,Cookie:String); overload;
procedure Delete(Index:Integer);
property Count:Integer read GetCount;
property Items[Index: Integer]:TCookieData read GetItems write SetItems; default;
procedure Update(const Domain,Path,Header:String);
function GetCookies(const Domain,Path:String): String;
procedure SetCookies(Domain,Path,Cookies:String);
end;
THTTPProtocol = (hpHTTP, hpHTTPS);
THTTPCommand = (hcGet, hcPost, hcHead, hcDownload);
TLocation = record
Protocol: THTTPProtocol;
Domain: String;
Path: String;
Port: Integer;
end;
THTTPRequest = record
Url:String;
CharSet:String;
Referer:String;
CMD:THTTPCommand;
Buffer:RawByteString;
PostData:RawByteString;
AddonsHeader:String;
ContentType:RawByteString;
StartTime:Cardinal;
FinishTime:Cardinal;
end;
THTTPResponse = record
Url:String;
Header:RawByteString;
RawCode:RawByteString;
RedirectCount:Integer;
RedirectPages: Array of RawByteString;
end;
THTTPOnRequest = function(Sender:TObject):Boolean of object;
THTTPOnResponse = function(Sender:TObject):Boolean of object;
THTTPOnProgress = function(Sender:TObject; ContentSize,Received:Integer):Boolean of object;
THTTPManage = class;
THTTP = class
private
FOwner:THTTPManage;
FCookies:TCookies;
FFreeCookies:Boolean;
FTCPSocket:TTCPSocket;
FSSLTCPSocket:TSSLTCPSocket;
FFileHandle:THandle;
FAgentHost:String;
FAgentPort:Integer;
FMaxRedirect:Integer;
FMaxRecvByte:Int64;
FInterval:Cardinal;
FTimeOut:Cardinal;
FDownloadTimeOut:Cardinal;
FSupportSSL:Boolean;
FOnNotify: TSocketNotify;
FOnRequest: THTTPOnRequest;
FOnResponse: THTTPOnResponse;
FOnProgress: THTTPOnProgress;
procedure SetTimeOut(val: DWORD);
function GetCookie : String;
procedure SetCookie(val : String);
procedure SetNotify(const Value: TSocketNotify);
protected
function SendRequest:Boolean;
procedure MakeRequestBuffer;
function ParseUrl(const URL:String):Boolean;
property TCPSocket:TTCPSocket read FTCPSocket;
property SSLSocket: TSSLTCPSocket read FSSLTCPSocket;
public
Location:TLocation;
Request:THTTPRequest;
Response:THTTPResponse;
constructor Create(const SupportSSL:Boolean=True; const ACookies:TCookies=nil; const AOwner:THTTPManage=nil);
destructor Destroy; override;
procedure Init;
function Head(Url:string):Integer;
function Get(Url:string):Integer; overload;
function Get(Url:string; GetField:array of String):Integer; overload;
function Post(Url:string; PostData:RawByteString):Integer; overload;
function Post(Url:string; PostField:array of String):Integer; overload;
function Post(Url:string; PostField:array of String; FileIndex: array of String; Multipart:Boolean):Integer; overload;
function Redirect(CMD: THTTPCommand; Url:String; PostData:RawByteString; ContentType:RawByteString):Integer;
function DoRequest(CMD:THTTPCommand; Url:String; PostData:RawByteString; ContentType:RawByteString):Integer;
function Download(const Url: string; const SaveTo: string):Integer;
function Encoding(Text:String; HTTPConvert:Boolean):RawByteString;
property Cookie : String read GetCookie write SetCookie;
property Cookies : TCookies read FCookies write FCookies;
property Interval: Cardinal read FInterval write FInterval;
property AgentHost : String read FAgentHost write FAgentHost;
property AgentPort : Integer read FAgentPort write FAgentPort;
property TimeOut : Cardinal read FTimeOut write SetTimeOut;
property DownloadTimeOut : Cardinal read FDownloadTimeOut write FDownloadTimeOut;
property MaxRedirect : Integer read FMaxRedirect write FMaxRedirect;
property MaxRecvByte : Int64 read FMaxRecvByte write FMaxRecvByte;
property OnNotify: TSocketNotify read FOnNotify write SetNotify;
property OnRequest : THTTPOnRequest read FOnRequest write FOnRequest;
property OnResponse : THTTPOnResponse read FOnResponse write FOnResponse;
property OnProgress : THTTPOnProgress read FOnProgress write FOnProgress;
end;
THTTPManage = class
private
FCri:TRTLCriticalSection;
FSendBytes,
FRecvBytes,
FLastSendBytes,
FLastRecvBytes,
FSeekSend,
FSeekRecv:Int64;
FSupportSSL:Boolean;
FSendAverage:Array [0..AverageCycle-1] Of Int64;
FRecvAverage:Array [0..AverageCycle-1] Of Int64;
//Config
FTimeOut:Cardinal;
FAgentHost:String;
FAgentPort,
FDownloadTimeOut,
FInterval,
FMaxRedirect,
FMaxRecvByte :Integer;
function GetAgentHost:String;
procedure SetAgentHost(val:String);
procedure SetAgentPort(val:Integer);
procedure SetTimeOut(val:Cardinal);
procedure SetDownloadTimeOut(val:Integer);
procedure SetInterval(val:Integer);
procedure SetMaxRedirect(val:Integer);
procedure SetMaxRecvByte(val:Integer);
protected
FHTTPList:TList;
procedure Lock;
procedure UnLock;
public
constructor Create(const SupportSSL:Boolean=True);
destructor Destroy; override;
function CreateHTTP(const Cookies:TCookies=nil):THTTP;
procedure FreeHTTP(HTTP:THTTP);
procedure Close; virtual;
procedure Notify(AObject: Tobject; Operation: TOperation); virtual;
procedure SocketEvent(Event:TSockEvent; Bytes: Int64);
procedure Average(var AvgSend,AvgRecv:Int64);
procedure StatClear;
property SendBytes: Int64 read FSendBytes;
property RecvBytes: Int64 read FRecvBytes;
//Config
property AgentHost: String read GetAgentHost write SetAgentHost;
property AgentPort: Integer read FAgentPort write SetAgentPort;
property TimeOut: Cardinal read FTimeOut write SetTimeOut;
property DownloadTimeOut: Integer read FDownloadTimeOut write SetDownloadTimeOut;
property Interval: Integer read FInterval write SetInterval;
property MaxRedirect: Integer read FMaxRedirect write SetMaxRedirect;
property MaxRecvByte: Integer read FMaxRecvByte write SetMaxRecvByte;
end;
function HostToIP(const Name:String):String;
procedure LoadSSLLibrary;
HTML解析部分
const
DoNotPush:set of TLabelEnum=[csTitle,csImg,csStyle,csScript,csInput,csTextArea];
TLabelNames:Array [TLabelEnum] of String = (
'a','img','style','link','script','title','form','input','select',
'button','textarea','option','');
DelimiterWord:array[0..6] of String = ('','//','/*','*/','');
DelimiterChar= ['<','>','/','\','=','&',';','"','''',' ',#9,#13,#10];
WhiteSpaceChar= [' ',#9,#13,#10];
type
TFindin = (fiAll,fiForms,fiFields,fiAnchors,fiImages,fiStyles,fiScripts);
THTMLDocument = class;
THTMLParser = class;
THTMLElementCollection = class;
THTMLElement = class
private
FID:String;
FName:String;
FTagName:String;
FParent:THTMLElement;
FChildElements:THTMLElementCollection;
FDocument:THTMLDocument;
FAttributes:TDictionary;
procedure Assign(Target:THTMLElement); virtual;
function GetInnerHTML:String;
procedure SetInnerHTML(val:String);
function GetOuterHTML:string;
procedure SetOuterHTML(val:String);
procedure AppendChildElement(Element:THTMLElement);
procedure RemoveChildElement(Element:THTMLElement);
public
constructor Create(Parent:THTMLElement); virtual;
destructor Destroy; override;
function Clone:THTMLElement; virtual;
procedure SetAttribute(AName,AValue:String); virtual;
function GetAttribute(AName:String):String; virtual;
function GetElementById(AID:String):THTMLElement;
function GetElementsByName(AName:String):THTMLElementCollection;
function GetElementsByTagName(ATagName:String):THTMLElementCollection;
function HasChildElement(Child:THTMLElement):Boolean;
property Document:THTMLDocument read FDocument write FDocument;
property Attributes: TDictionary read FAttributes;
property ChildElements: THTMLElementCollection read FChildElements;
property Attribute[Name:String]:string read GetAttribute write SetAttribute;
property Parent:THTMLElement read FParent;
property ParentNode:THTMLElement read FParent;
property ID:String read FID write FID;
property Name:String read FName write FName;
property TagName:String read FTagName write FTagName;
property InnerHTML:String read GetInnerHTML write SetInnerHTML;
property OuterHTML:String read GetOuterHTML write SetOuterHTML;
end;
THTMLClass = class of THTMLElement;
THTMLCollection = class(TList)
private
FDocument:THTMLDocument;
function GetCount: Integer;
public
function Item(Index:Integer): T;
property Length:Integer read GetCount;
property Document:THTMLDocument read FDocument write FDocument;
end;
THTMLScript = class(THTMLElement)
private
FSrc:String;
FType:String;
FText:String;
FLanguage:String;
public
function GetAttribute(AName:String):String; override;
procedure SetAttribute(AName,AValue:String); override;
property Src:String read FSrc write FSrc;
property AType:String read FType write FType;
property Text:String read FText write FText;
property Language:String read FLanguage write FLanguage;
end;
THTMLStyle = class(THTMLElement)
private
FCSSText :String;
public
function GetAttribute(AName:String):String; override;
procedure SetAttribute(AName,AValue:String); override;
property CSSText:String read FCSSText write FCSSText;
end;
THTMLImage = class(THTMLElement)
private
FAlt:String;
FTitle:String;
FSrc:String;
function GetTextValue: string;
public
function GetAttribute(AName:String):String; override;
procedure SetAttribute(AName,AValue:String); override;
property Alt:String read FAlt write FAlt;
property Title:String read FTitle write FTitle;
property Src:String read FSrc write FSrc;
property TextValue:string read GetTextValue;
end;
THTMLAnchor =class(THTMLElement)
private
FHref:String;
FDisplay:String;
public
function GetAttribute(AName:String):String; override;
procedure SetAttribute(AName,AValue:String); override;
property Href:String read FHref write FHref;
property Display:String read FDisplay write FDisplay;
end;
THTMLForm = class;
THTMLField = class(THTMLElement)
private
FValue:String;
FDisplay:String;
procedure Assign(Target:THTMLElement); override;
function GetActive:Boolean; virtual; abstract;
protected
FParentForm:THTMLForm;
public
destructor Destroy; override;
function GetAttribute(AName:String):String; override;
procedure SetAttribute(AName,AValue:String); override;
property Active:Boolean read GetActive;
property ParentForm:THTMLForm read FParentForm;
property Value:String read FValue write FValue;
property Display:String read FDisplay write FDisplay;
end;
THTMLTextArea = class(THTMLField)
private
function GetActive:Boolean; override;
public
procedure Random;
end;
THTMLButton = class(THTMLField)
private
FType:String;
procedure Assign(Target:THTMLElement); override;
function GetActive:Boolean; override;
public
constructor Create(Parent:THTMLElement); override;
function GetAttribute(AName:String):String; override;
procedure SetAttribute(AName,AValue:String); override;
property AType:String read FType write FType;
end;
THTMLSelect = class;
THTMLOption = class(THTMLField)
private
FSelected: Boolean;
FParentSelect: THTMLSelect;
procedure Assign(Target:THTMLElement); override;
function GetActive:Boolean; override;
procedure SetSelected(val:Boolean);
public
destructor Destroy; override;
function GetAttribute(AName:String):String; override;
procedure SetAttribute(AName,AValue:String); override;
property ParentSelect:THTMLSelect read FParentSelect;
property Selected: Boolean read FSelected write SetSelected;
end;
THTMLInput = class(THTMLField)
private
FType:String;
FChecked: Boolean;
procedure Assign(Target:THTMLElement); override;
function GetActive:Boolean; override;
procedure SetChecked(val:Boolean);
public
constructor Create(Parent:THTMLElement); override;
function GetAttribute(AName:String):String; override;
procedure SetAttribute(AName,AValue:String); override;
procedure Random;
property AType:string read FType write FType;
property Checked: Boolean read FChecked write SetChecked;
end;
THTMLOptionCollection = class;
THTMLSelect = class(THTMLField)
private
FSelected: THTMLOption;
FOptions: THTMLOptionCollection;
procedure Assign(Target:THTMLElement); override;
function GetActive:Boolean; override;
procedure SetSelected(val: THTMLOption);
procedure SetParentFrom(const Value: THTMLForm);
public
constructor Create(Parent:THTMLElement); override;
destructor Destroy; override;
procedure Random;
procedure AddOption(val:THTMLOption);
procedure Notify(Element: THTMLOption; Operation: TOperation);
property ParentFrom:THTMLForm read FParentForm write SetParentFrom;
property Selected:THTMLOption read FSelected write SetSelected;
property Options:THTMLOptionCollection read FOptions;
end;
TRadioFields = Array of THTMLInput;
THTMLFieldCollection = class;
THTMLForm = class(THTMLElement)
private
FMethod:String;
FENCType:String;
FAction:String;
FReferer:String;
FFields:THTMLFieldCollection;
procedure Assign(Target:THTMLElement); override;
function GetRadioFields(AName:String):TRadioFields;
function GetActiveFields(AName:String):THTMLField;
function GetFieldValues(AName:String):String;
procedure SetFieldValues(AName,AValue:String);
public
constructor Create(Parent:THTMLElement); override;
destructor Destroy; override;
procedure AddField(val:THTMLField);
procedure Notify(Element: THTMLField; Operation: TOperation);
function Find(Keys,Values:string):THTMLField; overload;
function Find(Keys,Values:string; Match:TMatch):THTMLField; overload;
function Find(Keys,Values:array of string):THTMLField; overload;
function Find(Keys,Values:array of string; Match:TMatch):THTMLField; overload;
function GetAttribute(AName:String):String; override;
procedure SetAttribute(AName,AValue:String); override;
function Submit(PostField:array of String; const ButtonName:string=''):Integer;
function CheckBox(Checked:Boolean):Boolean; overload;
function CheckBox(AName:String; Checked:Boolean):Boolean; overload;
property Fields:THTMLFieldCollection read FFields;
property ActiveFields[Name:String]:THTMLField read GetActiveFields;
property RadioFields[Name:String]:TRadioFields read GetRadioFields;
property FieldValues[Name:String]:String read GetFieldValues write SetFieldValues;
property Method:String read FMethod write FMethod;
property ENCType:String read FENCType write FENCType;
property Action:String read FAction write FAction;
end;
THTMLElementCollection = class(THTMLCollection);
THTMLScriptCollection = class(THTMLCollection);
THTMLStyleCollection = class(THTMLCollection);
THTMLImageCollection = class(THTMLCollection);
THTMLAnchorCollection = class(THTMLCollection);
THTMLFieldCollection = class(THTMLCollection);
THTMLOptionCollection = class(THTMLCollection);
THTMLFormCollection = class(THTMLCollection)
public
function Find(Keys,Values:String):THTMLForm; overload;
function Find(Keys,Values:String; Match:TMatch):THTMLForm; overload;
function Find(Keys,Values:array of String; Match:TMatch):THTMLForm; overload;
function FindByField(Keys,Value:String):THTMLForm; overload;
function FindByField(Keys,Value:String; Match:TMatch):THTMLForm; overload;
function FindByField(Keys,Values:array of String; Match:TMatch):THTMLForm; overload;
function FindWithField(FormKeys,FormValues:String;
FieldKeys,FieldValues:String):THTMLForm; overload;
function FindWithField(FormKeys,FormValues:String; FormMatch:TMatch;
FieldKeys,FieldValues:String; FieldMatch:TMatch):THTMLForm; overload;
function FindWithField(FormKeys,FormValues:array of String; FormMatch:TMatch;
FieldKeys,FieldValues:array of String; FieldMatch:TMatch):THTMLForm; overload;
end;
TEvalEvent = function(Sender:TObject; Script:string):Variant of object;
TSubmitEvent = procedure(Sender:TObject; Return:Integer) of object;
TChangedEvent = procedure(Sender:TObject; Obj:THTMLElement; Operation:TOperation) of object;
THTMLDocument = class
private
FHTTP:THTTP;
FURL:String;
FTitle:String;
FSource:String;
FDisplay:String;
FRoot:THTMLElementCollection;
FAll:THTMLElementCollection;
FForms:THTMLFormCollection;
FFields:THTMLFieldCollection;
FAnchors:THTMLAnchorCollection;
FImages:THTMLImageCollection;
FStyles:THTMLStyleCollection;
FScripts:THTMLScriptCollection;
FFinds:THTMLElementCollection;
FOnEval: TEvalEvent;
FOnSubmit:TSubmitEvent;
FOnChanged:TChangedEvent;
function GetMetaRefresh: string;
public
constructor Create(AHTTP:THTTP);
destructor Destroy; override;
procedure Clear;
procedure Notify(Element: THTMLElement; Operation: TOperation); virtual;
function Find(Keys,Values:array of String):THTMLElement; overload;
function Find(Keys,Values:array of String; Match:TMatch):THTMLElement; overload;
function Find(Keys,Values:array of String; FindIn:TFindin):THTMLElement; overload;
function Find(Keys,Values:array of String; Parent:THTMLElement):THTMLElement; overload;
function Find(Keys,Values:array of String; Match:TMatch; FindIn:TFindin):THTMLElement; overload;
function Find(Keys,Values:array of String; Match:TMatch; Parent:THTMLElement):THTMLElement; overload;
function Find(Keys,Values:array of String; Match:TMatch; FindIn:TFindin; Parent:THTMLElement):THTMLElement; overload;
function Finds(Keys,Values:array of String):THTMLElementCollection; overload;
function Finds(Keys,Values:array of String; Match:TMatch):THTMLElementCollection; overload;
function Finds(Keys,Values:array of String; FindIn:TFindin):THTMLElementCollection; overload;
function Finds(Keys,Values:array of String; Parent:THTMLElement):THTMLElementCollection; overload;
function Finds(Keys,Values:array of String; Match:TMatch; FindIn:TFindin):THTMLElementCollection; overload;
function Finds(Keys,Values:array of String; Match:TMatch; Parent:THTMLElement):THTMLElementCollection; overload;
function Finds(Keys,Values:array of String; Match:TMatch; FindIn:TFindin; Parent:THTMLElement):THTMLElementCollection; overload;
property URL:String read FURL;
property Title:String read FTitle;
property Source:String read FSource;
property Display:String read FDisplay;
property All:THTMLElementCollection read FAll;
property Root:THTMLElementCollection read FRoot;
property Forms:THTMLFormCollection read FForms;
property Fields:THTMLFieldCollection read FFields;
property Anchors:THTMLAnchorCollection read FAnchors;
property Images:THTMLImageCollection read FImages;
property Styles:THTMLStyleCollection read FStyles;
property Scripts:THTMLScriptCollection read FScripts;
property MetaRefresh:string read GetMetaRefresh;
property OnEval:TEvalEvent read FOnEval write FOnEval;
property OnSubmit:TSubmitEvent read FOnSubmit write FOnSubmit;
property OnChanged:TChangedEvent read FOnChanged write FOnChanged;
end;
THTMLToken = class
private
FIndex: Integer;
FTokenList: TList;
function GetEOF:Boolean;
function GetCurrToken:String;
function GetNextToken:string;
function GetNextNextToken:string;
function GetPrevToken:String;
function GetToken(Index:Integer):String;
public
constructor Create;
destructor Destroy; override;
procedure Clear;
procedure Process(Source:String);
function IsSpace(Token:String):Boolean;
function MoveNext:Boolean;
function SkipSpace:Boolean;
function SkipToken(Token:String):Boolean;
function Preview(Tokens:array of String):Boolean;
function MatchToken(Token:String):Boolean; overload;
function MatchToken(Tokens:array of String):Boolean; overload;
property EOF:Boolean read GetEOF;
property CurrToken:String read GetCurrToken;
property NextToken:String read GetNextToken;
property NextNextToken:String read GetNextNextToken;
property PrevToken:String read GetPrevToken;
property Items[Index:Integer]: String read GetToken; default;
end;
TParseEvent = procedure(Sender:TObject) of object;
THTMLParser = class
type
TransferType = (ttNone,ttHTML,ttScript,ttStyle);
BlockType = (btNone,btRegExp,btString,btComments);
private
FOwner:THTMLParser;
FDocument:THTMLDocument;
FLastContent:String;
FBlock: BlockType;
FEndBlock: TList;
FTransferType:TransferType;
FTokenList:THTMLToken;
FStack:TStack;
procedure CheckBlock;
function GetValue:String;
function GetTransfer:String;
function GetInner(TagName:String):String;
function CheckName(Name:String):Boolean;
procedure Pop(T:TClass);
function Peek:THTMLElement;
procedure Push(Element:THTMLElement);
procedure AddContent(Text:String);
procedure Addobject(Element:THTMLElement);
procedure UpdateParent(Text:String; Element:THTMLElement);
function LabelInfo(TagName:String; var LabelClass:THTMLClass):TLabelEnum;
procedure Process(ASource:String);
procedure ProcessToken;
procedure ProcessLabel;
procedure ProcessCDATA;
procedure ProcessContent;
procedure ProcessComments;
procedure ProcessLabelOpen(Name:String);
procedure ProcessLabelClose(Name:String);
function ProcessLabelValue(Element:THTMLElement):Boolean;
public
constructor Create(ADocument:THTMLDocument; const AOwner:THTMLParser=nil);
destructor Destroy; override;
procedure Clear;
end;
THTMLEngine = class(THTMLDocument)
private
FCharset:String;
FParser:THTMLParser;
FRawCode:RawByteString;
FMetaRefreshEnable:Boolean;
FOnBeforeParse:TParseEvent;
FOnAfterParse:TParseEvent;
function GetCharset:String; overload;
procedure SetCharset(const Value: String);
public
constructor Create(AHTTP:THTTP);
destructor Destroy; override;
procedure Clear;
procedure Load(AUrl:string; ARawCode:RawByteString);
procedure InsertSource(AddCode:String);
function Translate(const Text:string):String;
function GetCharset(const RawCode:RawByteString):String; overload;
function Decoding(const RawCode:RawByteString):String; overload;
function Decoding(const RawCode:RawByteString; ACharSet:String):String; overload;
property Charset:String read FCharset write SetCharset;
property MetaRefreshEnable:Boolean read FMetaRefreshEnable write FMetaRefreshEnable;
property OnBeforeParse:TParseEvent read FOnBeforeParse write FOnBeforeParse;
property OnAfterParse:TParseEvent read FOnAfterParse write FOnAfterParse;
end;
Javascript模拟部分
type
TScriptEngine=Class;
TScriptBase = class
private
FHTML:THTMLEngine;
FScript:TScriptEngine;
public
constructor Create(AScriptEngine:TScriptEngine);
property HTMLEngine:THTMLEngine read FHTML write FHTML;
property ScriptEngine:TScriptEngine read FScript write FScript;
end;
TScriptNavigator = class(TScriptBase)
private
FappCodeName,FappMinorVersion,FappName,FappVersion,
FbrowserLanguage,FcookieEnabled,FcpuClass,FonLine,
Fplatform,FsystemLanguage,FuserAgent,FuserLanguage:Variant;
public
constructor Create(AScriptEngine:TScriptEngine);
function javaEnabled:Boolean;
function taintEnabled:Boolean;
property appCodeName:Variant read FappCodeName write FappCodeName;
property appMinorVersion:Variant read FappMinorVersion write FappMinorVersion;
property appName:Variant read FappName write FappName;
property appVersion:Variant read FappVersion write FappVersion;
property browserLanguage:Variant read FbrowserLanguage write FbrowserLanguage;
property cookieEnabled:Variant read FcookieEnabled write FcookieEnabled;
property cpuClass:Variant read FcpuClass write FcpuClass;
property onLine:Variant read FonLine write FonLine;
property platform:Variant read Fplatform write Fplatform;
property systemLanguage:Variant read FsystemLanguage write FsystemLanguage;
property userAgent:Variant read FuserAgent write FuserAgent;
property userLanguage:Variant read FuserLanguage write FuserLanguage;
end;
TScriptScreen = class(TScriptBase)
private
FavailHeight,FavailWidth,FbufferDepth,FcolorDepth,
FdeviceXDPI,FdeviceYDPI,FfontSmoothingEnabled,
Fheight,FlogicalXDPI,FlogicalYDPI,FpixelDepth,
FupdateInterval,Fwidth:Variant;
public
constructor Create(AScriptEngine:TScriptEngine);
property availHeight:Variant read FavailHeight write FavailHeight;
property availWidth:Variant read FavailWidth write FavailWidth;
property bufferDepth:Variant read FbufferDepth write FbufferDepth;
property colorDepth:Variant read FcolorDepth write FcolorDepth;
property deviceXDPI:Variant read FdeviceXDPI write FdeviceXDPI;
property deviceYDPI:Variant read FdeviceYDPI write FdeviceYDPI;
property fontSmoothingEnabled:Variant read FfontSmoothingEnabled write FfontSmoothingEnabled;
property height:Variant read Fheight write Fheight;
property logicalXDPI:Variant read FlogicalXDPI write FlogicalXDPI;
property logicalYDPI:Variant read FlogicalYDPI write FlogicalYDPI;
property pixelDepth:Variant read FpixelDepth write FpixelDepth;
property updateInterval:Variant read FupdateInterval write FupdateInterval;
property width:Variant read Fwidth write Fwidth;
end;
TScriptHistory = class(TScriptBase)
private
Flength:Integer;
public
constructor Create(AScriptEngine:TScriptEngine);
property length:Integer read Flength write Flength;
procedure back();
procedure forward();
procedure go();
end;
TScriptLocation = class(TScriptBase)
private
Fhash,Fhost,Fhostname,Fhref,Fpathname,Fport,Fprotocol,Fsearch:Variant;
procedure SetHref(const Value: Variant);
public
constructor Create(AScriptEngine:TScriptEngine);
procedure assign(URL:Variant);
procedure reload();
procedure replace(URL:Variant);
property hash:Variant read Fhash write Fhash;
property host:Variant read Fhost write Fhost;
property hostname:Variant read Fhostname write Fhostname;
property href:Variant read Fhref write SetHref;
property pathname:Variant read Fpathname write Fpathname;
property port:Variant read Fport write Fport;
property protocol:Variant read Fprotocol write Fprotocol;
property search:Variant read Fsearch write Fsearch;
end;
TScriptDocument = class(TScriptBase)
private
Fall,Fanchors,Fapplets,Fforms,Fimages,Flinks,Fbody:Variant;
Fcookie,Fdomain,FlastModified,Freferrer,Ftitle,FURL:Variant;
public
constructor Create(AScriptEngine:TScriptEngine);
procedure close();
function getElementById(id:Variant):Variant;
function getElementsByName(name:Variant):Variant;
function getElementsByTagName(tagname:Variant):Variant;
function open(mimetype,replace:Variant):Variant;
procedure write(exp:Variant);
procedure writeln(exp:Variant);
property cookie:Variant read Fcookie write Fcookie;
property domain:Variant read Fdomain write Fdomain;
property lastModified:Variant read FlastModified write FlastModified;
property referrer:Variant read Freferrer write Freferrer;
property title:Variant read Ftitle write Ftitle;
property URL:Variant read FURL write FURL;
property all:Variant read Fall write Fall;
property anchors:Variant read Fanchors write Fanchors;
property applets:Variant read Fapplets write Fapplets;
property forms:Variant read Fforms write Fforms;
property images:Variant read Fimages write Fimages;
property links:Variant read Flinks write Flinks;
property body:Variant read Fbody write Fbody;
end;
TScriptWindow = class(TScriptBase)
private
ObjDocument:TScriptDocument;
ObjHistory:TScriptHistory;
ObjNavigator:TScriptNavigator;
ObjScreen:TScriptScreen;
ObjLocation:TScriptLocation;
FTemp,
Fclosed,FdefaultStatus,Finnerheight,Finnerwidth,Flength,
Fname,Fouterheight,Fouterwidth,FpageXOffset,FpageYOffset,
Fstatus,FscreenLeft,FscreenTop,FscreenX,FscreenY,
Fframes,Fdocument,Fhistory,FNavigator,FScreen,Fwindow,Flocation:Variant;
procedure SetLocation(const Value: Variant);
public
constructor Create(AScriptEngine:TScriptEngine);
destructor Destroy; override;
procedure alert(msg:Variant);
procedure blur();
procedure clearInterval(id:Variant);
procedure clearTimeout(id:Variant);
procedure close();
procedure confirm(msg:Variant);
function createPopup():Variant;
procedure focus();
procedure moveBy(x,y:Variant);
procedure moveTo(x,y:Variant);
function open(url,name,features,replace:Variant):Variant;
procedure print();
function prompt(text,defaultText:Variant):Variant;
procedure resizeBy(width,height:Variant);
procedure resizeTo(width,height:Variant);
procedure scrollBy(xnum,ynum:Variant);
procedure scrollTo(xpos,ypos:Variant);
function setInterval(code,millisec:Variant):Variant;
function setTimeout(code,millisec:Variant):Variant;
function getElementById(id:Variant):Variant;
function getElementsByName(name:Variant):Variant;
function getElementsByTagName(tagname:Variant):Variant;
property closed:Variant read Fclosed write Fclosed;
property defaultStatus:Variant read FdefaultStatus write FdefaultStatus;
property innerheight:Variant read Finnerheight write Finnerheight;
property innerwidth:Variant read Finnerwidth write Finnerwidth;
property length:Variant read Flength write Flength;
property name:Variant read Fname write Fname;
property outerheight:Variant read Fouterheight write Fouterheight;
property outerwidth:Variant read Fouterwidth write Fouterwidth;
property pageXOffset:Variant read FpageXOffset write FpageXOffset;
property pageYOffset:Variant read FpageYOffset write FpageYOffset;
property status:Variant read Fstatus write Fstatus;
property screenLeft:Variant read FscreenLeft write FscreenLeft;
property screenTop:Variant read FscreenTop write FscreenTop;
property screenX:Variant read FscreenX write FscreenX;
property screenY:Variant read FscreenY write FscreenY;
property frames:Variant read Fframes write Fframes;
property self:Variant read Fwindow write FTemp;
property opener:Variant read Fwindow write FTemp;
property top:Variant read Fwindow write FTemp;
property window:Variant read Fwindow write FTemp;
property document:Variant read Fdocument write FTemp;
property history:Variant read Fhistory write Fhistory;
property Navigator:Variant read FNavigator write FNavigator;
property Screen:Variant read FScreen write FScreen;
property location:Variant read Flocation write SetLocation;
end;
TScriptLanguage = (slJavaScript,slVBScript);
TScriptEngine=Class
private
FHTTP:THTTP;
FDocument:THTMLEngine;
FWindow:TScriptWindow;
FRefManage:TRefManage;
FLanguage:TScriptLanguage;
FVBScriptEngine:Variant;
FJavaScriptEngine:Variant;
FNeedRedirect:Boolean;
FRedirectUrl:String;
procedure CreateInstance;
public
constructor Create(AHTTP:THTTP; AHTML:THTMLEngine);
destructor Destroy; override;
procedure Reset;
procedure BeforeProcess(Sender:TObject);
procedure AfterProcess(Sender:TObject);
function ProcessEval(Sender:TObject; Script:string):Variant;
procedure ProcessObject(Sender:TObject; Obj:THTMLElement; Operation:TOperation);
procedure Execute(const Code:string; ALanguage:TScriptLanguage);
function Eval(const Expression:string; ALanguage:TScriptLanguage):Variant;
function Transform(Obj:TObject; Owned:Boolean=False):Variant;
property Document:THTMLEngine read FDocument write FDocument;
property Language:TScriptLanguage read FLanguage;
End;
三个部分协调控制类
type
TWebbotSupport = set of (wsHTTPS,wsHTML,wsScript);
TWebbotManage = class;
TWebbot = class
private
FHTTP:THTTP;
FDocument:THTMLEngine;
FCookies:TCookies;
FFreeCookies:Boolean;
FScript:TScriptEngine;
FOwner:TWebbotManage;
FSupport:TWebbotSupport;
procedure OnSubmit(Sender:TObject; Return:Integer);
public
constructor Create(const ASupport:TWebbotSupport=[wsHTTPS,wsHTML,wsScript]; const ACookies:TCookies=nil; const AOwner:TWebbotManage=nil);
destructor Destroy; override;
function Clone:TWebbot;
function Get(Url:string):Integer;
function Post(Url:string; PostData:AnsiString):Integer; overload;
function Post(Url:string; PostField:array of String):Integer; overload;
property HTTP:THTTP read FHTTP;
property Document:THTMLEngine read FDocument;
property Cookies:TCookies read FCookies;
property Script:TScriptEngine read FScript;
end;
TWebbotManage = class(THTTPManage)
private
FWebbotList:TList<TWebbot>;
FSupport:TWebbotSupport;
public
constructor Create(const ASupport:TWebbotSupport=[wsHTTPS,wsHTML,wsScript]); overload;
destructor Destroy; override;
procedure Notify(AObject: Tobject; Operation: TOperation); override;
function CreateWebbot(const Cookies:TCookies=nil):TWebbot;
procedure FreeWebbot(Browser:TWebbot);
end;
