delphi 使用xmlhttprequest 同步和异步方法

DELPHI7 中使用XMLHTTPRequest

在delphi中使用

Its type library is present in msxml3.dll file in windows system folder.

procedure TForm1.Button1Click(Sender: TObject);
var
d: OleVariant;
begin
d := CreateOleObject('MSXML2.XMLHttp');
d.open('get', 'http://www.somewhere.com', false, EmptyParam, EmptyParam);
d.send('');
if (d.readyState = 4) and (d.status = 200) then
Memo1.Lines.Text := d.responseText;
d.Free;
end;
复制代码
如果你更喜欢静态绑定，那么就需要导入Microsoft XML 3.0的type library，那么代码可以改为

复制代码
uses msxml2_tlb;

procedure TForm1.Button1Click(Sender: TObject);
var
d: IXMLHTTPRequest;
begin
d := CoXMLHTTP40.Create;
d.open('get', 'http://www.somewhere.com', false, EmptyParam, EmptyParam);
d.send('');
if (d.readyState = 4) and (d.status = 200) then
Memo1.Lines.Text := d.responseText;
end;
复制代码
但是你会发现这样做是同步操作，会阻塞当前的UI刷新，所以我们需要用到多线程或者把它改造成异步操作

考虑到OnReadyStateChange只用于js或者vbs，如果要在delphi中使用OnReadyStateChange，需要模拟js。

复制代码
uses comobj, msxml2_tlb;

type
TAjaxEvenFunc = procedure (d: Variant) of object;
TAjaxEvent = class(TInterfacedObject, IDispatch)
private
d: Variant;
func: TAjaxEvenFunc;
public
constructor Create(const d: Variant; const func: TAjaxEvenFunc);
function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
Flags: Word; var Params; VarResult: Pointer; ExcepInfo: Pointer;
ArgErr: Pointer): HRESULT; stdcall;
function GetIDsOfNames(const IID: TGUID; Names: Pointer; NameCount: Integer;
LocaleID: Integer; DispIDs: Pointer): HRESULT; stdcall;
function GetTypeInfo(Index: Integer; LocaleID: Integer;
out TypeInfo): HRESULT; stdcall;
function GetTypeInfoCount(out Count: Integer): HRESULT; stdcall;
destructor Destroy; override;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
d: IXMLHTTPRequest;
begin
d := CreateOleObject('MSXML2.XMLHttp.3.0') as IXMLHTTPRequest;
d.open('get', 'http://www.onet.pl', true, EmptyParam, EmptyParam);
d.onreadystatechange := TAjaxEvent.Create(d, EventHandl) as IDispatch;
d.send('');
d := nil;
end;

procedure TForm1.EventHandl(d: Variant);
begin
if (d.readyState = 4) and (d.status = 200) then
Memo1.Lines.Text := d.responseText;
end;

{ TAjaxEvent }

constructor TAjaxEvent.Create(const d: Variant;
const func: TAjaxEvenFunc);
begin
inherited Create;
self.d := d;
self.func := func;
end;

destructor TAjaxEvent.Destroy;
begin
func := nil;
d := Null;
inherited;
end;

function TAjaxEvent.GetIDsOfNames(const IID: TGUID; Names: Pointer; NameCount,
LocaleID: Integer; DispIDs: Pointer): HRESULT;
begin
Result := E_NOTIMPL;
end;

function TAjaxEvent.GetTypeInfo(Index, LocaleID: Integer;
out TypeInfo): HRESULT;
begin
Result := E_NOTIMPL;
end;

function TAjaxEvent.GetTypeInfoCount(out Count: Integer): HRESULT;
begin
Result := E_NOTIMPL;
end;

function TAjaxEvent.Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HRESULT;
begin
if DispID <> 0 then
begin
Result := E_INVALIDARG;
exit;
end;
if Assigned(func) and not VarIsNull(d) then
func(d);
end;