delphiXE7异步WebAPI

废话不多说 直接上源码：

unit Unit1;

interface

uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs,msxml2_tlb, Vcl.StdCtrls,comobj;

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);
destructor Destroy; override;
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;
end;

type
TForm1 = class(TForm)
Button1: TButton;
m_result: TMemo;
Edit1: TEdit;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
procedure EventHandl(d: Variant);
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}
{ 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
Result:=0;
if DispID <> 0 then
begin
Result := E_INVALIDARG;
exit;
end;
if Assigned(func) and not VarIsNull(d) then
func(d);
end;

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

procedure TForm1.Button1Click(Sender: TObject);
var
xmlhttp: IXMLHTTPRequest;
begin
try
xmlhttp := CreateOleObject('MSXML2.XMLHttp.3.0') as IXMLHTTPRequest;
xmlhttp.Open('POST', Edit1.Text, false,EmptyParam, EmptyParam);
xmlhttp.setRequestHeader('Accept', 'application/json');
xmlhttp.setRequestHeader('Content-Type', 'application/json');
xmlhttp.onreadystatechange := TAjaxEvent.Create(xmlhttp, EventHandl) as IDispatch;
xmlhttp.send('');
xmlhttp := nil;
except
on e:Exception do
begin
ShowMessage('异常:'+e.Message);
end;
end;
end;

end.