Delphi2009でXMLデータバインディングを使ってみようと思って、試しにTwitterのタイムラインをとってくるアプリケーションを書いてみた。
HTTP通信はSynapseを使いたかったけど、2009に対応していないので付属のIndyを使うことにした。
XMLデータバインディングはDelphi2006以降のPro以上で使えるようです。
プロジェクトを開いた状態で[新規作成]の画面のXMLより利用できます。
選択してOKをクリックすると、ウィザードが起動します。
Webブラウザなどで適当にAPIを叩いてとってきたサンプルのXMLファイルを指定して進めると、XMLのインターフェースを定義したユニットが生成されます。
自動生成されたTimelineData.pas
{***********************************************************} { } { twitter timeline } { } { } {***********************************************************} unit TimelineData; interface uses xmldom, XMLDoc, XMLIntf; type { 前方宣言 } IXMLStatusesType = interface; IXMLStatusType = interface; IXMLUserType = interface; { IXMLStatusesType } IXMLStatusesType = interface(IXMLNodeCollection) ['{2385C67A-C57A-45E4-B9B4-FF2B977510D1}'] { プロパティ参照関数 } function Get_Type_: WideString; function Get_Status(Index: Integer): IXMLStatusType; procedure Set_Type_(Value: WideString); { メソッドとプロパティ } function Add: IXMLStatusType; function Insert(const Index: Integer): IXMLStatusType; property Type_: WideString read Get_Type_ write Set_Type_; property Status[Index: Integer]: IXMLStatusType read Get_Status; default; end; { IXMLStatusType } IXMLStatusType = interface(IXMLNode) ['{B782F3C3-C4A2-4B83-8923-3F46CD417E2B}'] { プロパティ参照関数 } function Get_Created_at: WideString; function Get_Id: Integer; function Get_Text: WideString; function Get_Source: WideString; function Get_Truncated: WideString; function Get_In_reply_to_status_id: WideString; function Get_In_reply_to_user_id: WideString; function Get_Favorited: WideString; function Get_In_reply_to_screen_name: WideString; function Get_User: IXMLUserType; procedure Set_Created_at(Value: WideString); procedure Set_Id(Value: Integer); procedure Set_Text(Value: WideString); procedure Set_Source(Value: WideString); procedure Set_Truncated(Value: WideString); procedure Set_In_reply_to_status_id(Value: WideString); procedure Set_In_reply_to_user_id(Value: WideString); procedure Set_Favorited(Value: WideString); procedure Set_In_reply_to_screen_name(Value: WideString); { メソッドとプロパティ } property Created_at: WideString read Get_Created_at write Set_Created_at; property Id: Integer read Get_Id write Set_Id; property Text: WideString read Get_Text write Set_Text; property Source: WideString read Get_Source write Set_Source; property Truncated: WideString read Get_Truncated write Set_Truncated; property In_reply_to_status_id: WideString read Get_In_reply_to_status_id write Set_In_reply_to_status_id; property In_reply_to_user_id: WideString read Get_In_reply_to_user_id write Set_In_reply_to_user_id; property Favorited: WideString read Get_Favorited write Set_Favorited; property In_reply_to_screen_name: WideString read Get_In_reply_to_screen_name write Set_In_reply_to_screen_name; property User: IXMLUserType read Get_User; end; { IXMLUserType } IXMLUserType = interface(IXMLNode) ['{36CB586C-1FFB-4EA7-8328-0FE798053947}'] { プロパティ参照関数 } function Get_Id: Integer; function Get_Name: WideString; function Get_Screen_name: WideString; function Get_Location: WideString; function Get_Description: WideString; function Get_Profile_image_url: WideString; function Get_Url: WideString; function Get_Protected_: WideString; function Get_Followers_count: Integer; procedure Set_Id(Value: Integer); procedure Set_Name(Value: WideString); procedure Set_Screen_name(Value: WideString); procedure Set_Location(Value: WideString); procedure Set_Description(Value: WideString); procedure Set_Profile_image_url(Value: WideString); procedure Set_Url(Value: WideString); procedure Set_Protected_(Value: WideString); procedure Set_Followers_count(Value: Integer); { メソッドとプロパティ } property Id: Integer read Get_Id write Set_Id; property Name: WideString read Get_Name write Set_Name; property Screen_name: WideString read Get_Screen_name write Set_Screen_name; property Location: WideString read Get_Location write Set_Location; property Description: WideString read Get_Description write Set_Description; property Profile_image_url: WideString read Get_Profile_image_url write Set_Profile_image_url; property Url: WideString read Get_Url write Set_Url; property Protected_: WideString read Get_Protected_ write Set_Protected_; property Followers_count: Integer read Get_Followers_count write Set_Followers_count; end; { 前方宣言 } TXMLStatusesType = class; TXMLStatusType = class; TXMLUserType = class; { TXMLStatusesType } TXMLStatusesType = class(TXMLNodeCollection, IXMLStatusesType) protected { IXMLStatusesType } function Get_Type_: WideString; function Get_Status(Index: Integer): IXMLStatusType; procedure Set_Type_(Value: WideString); function Add: IXMLStatusType; function Insert(const Index: Integer): IXMLStatusType; public procedure AfterConstruction; override; end; { TXMLStatusType } TXMLStatusType = class(TXMLNode, IXMLStatusType) protected { IXMLStatusType } function Get_Created_at: WideString; function Get_Id: Integer; function Get_Text: WideString; function Get_Source: WideString; function Get_Truncated: WideString; function Get_In_reply_to_status_id: WideString; function Get_In_reply_to_user_id: WideString; function Get_Favorited: WideString; function Get_In_reply_to_screen_name: WideString; function Get_User: IXMLUserType; procedure Set_Created_at(Value: WideString); procedure Set_Id(Value: Integer); procedure Set_Text(Value: WideString); procedure Set_Source(Value: WideString); procedure Set_Truncated(Value: WideString); procedure Set_In_reply_to_status_id(Value: WideString); procedure Set_In_reply_to_user_id(Value: WideString); procedure Set_Favorited(Value: WideString); procedure Set_In_reply_to_screen_name(Value: WideString); public procedure AfterConstruction; override; end; { TXMLUserType } TXMLUserType = class(TXMLNode, IXMLUserType) protected { IXMLUserType } function Get_Id: Integer; function Get_Name: WideString; function Get_Screen_name: WideString; function Get_Location: WideString; function Get_Description: WideString; function Get_Profile_image_url: WideString; function Get_Url: WideString; function Get_Protected_: WideString; function Get_Followers_count: Integer; procedure Set_Id(Value: Integer); procedure Set_Name(Value: WideString); procedure Set_Screen_name(Value: WideString); procedure Set_Location(Value: WideString); procedure Set_Description(Value: WideString); procedure Set_Profile_image_url(Value: WideString); procedure Set_Url(Value: WideString); procedure Set_Protected_(Value: WideString); procedure Set_Followers_count(Value: Integer); end; { グローバル関数 } function Getstatuses(Doc: IXMLDocument): IXMLStatusesType; function Loadstatuses(const FileName: WideString): IXMLStatusesType; function Newstatuses: IXMLStatusesType; const TargetNamespace = ''; implementation { グローバル関数 } function Getstatuses(Doc: IXMLDocument): IXMLStatusesType; begin Result := Doc.GetDocBinding('statuses', TXMLStatusesType, TargetNamespace) as IXMLStatusesType; end; function Loadstatuses(const FileName: WideString): IXMLStatusesType; begin Result := LoadXMLDocument(FileName).GetDocBinding('statuses', TXMLStatusesType, TargetNamespace) as IXMLStatusesType; end; function Newstatuses: IXMLStatusesType; begin Result := NewXMLDocument.GetDocBinding('statuses', TXMLStatusesType, TargetNamespace) as IXMLStatusesType; end; { TXMLStatusesType } procedure TXMLStatusesType.AfterConstruction; begin RegisterChildNode('status', TXMLStatusType); ItemTag := 'status'; ItemInterface := IXMLStatusType; inherited; end; function TXMLStatusesType.Get_Type_: WideString; begin Result := AttributeNodes['type'].Text; end; procedure TXMLStatusesType.Set_Type_(Value: WideString); begin SetAttribute('type', Value); end; function TXMLStatusesType.Get_Status(Index: Integer): IXMLStatusType; begin Result := List[Index] as IXMLStatusType; end; function TXMLStatusesType.Add: IXMLStatusType; begin Result := AddItem(-1) as IXMLStatusType; end; function TXMLStatusesType.Insert(const Index: Integer): IXMLStatusType; begin Result := AddItem(Index) as IXMLStatusType; end; { TXMLStatusType } procedure TXMLStatusType.AfterConstruction; begin RegisterChildNode('user', TXMLUserType); inherited; end; function TXMLStatusType.Get_Created_at: WideString; begin Result := ChildNodes['created_at'].Text; end; procedure TXMLStatusType.Set_Created_at(Value: WideString); begin ChildNodes['created_at'].NodeValue := Value; end; function TXMLStatusType.Get_Id: Integer; begin Result := ChildNodes['id'].NodeValue; end; procedure TXMLStatusType.Set_Id(Value: Integer); begin ChildNodes['id'].NodeValue := Value; end; function TXMLStatusType.Get_Text: WideString; begin Result := ChildNodes['text'].Text; end; procedure TXMLStatusType.Set_Text(Value: WideString); begin ChildNodes['text'].NodeValue := Value; end; function TXMLStatusType.Get_Source: WideString; begin Result := ChildNodes['source'].Text; end; procedure TXMLStatusType.Set_Source(Value: WideString); begin ChildNodes['source'].NodeValue := Value; end; function TXMLStatusType.Get_Truncated: WideString; begin Result := ChildNodes['truncated'].Text; end; procedure TXMLStatusType.Set_Truncated(Value: WideString); begin ChildNodes['truncated'].NodeValue := Value; end; function TXMLStatusType.Get_In_reply_to_status_id: WideString; begin Result := ChildNodes['in_reply_to_status_id'].Text; end; procedure TXMLStatusType.Set_In_reply_to_status_id(Value: WideString); begin ChildNodes['in_reply_to_status_id'].NodeValue := Value; end; function TXMLStatusType.Get_In_reply_to_user_id: WideString; begin Result := ChildNodes['in_reply_to_user_id'].Text; end; procedure TXMLStatusType.Set_In_reply_to_user_id(Value: WideString); begin ChildNodes['in_reply_to_user_id'].NodeValue := Value; end; function TXMLStatusType.Get_Favorited: WideString; begin Result := ChildNodes['favorited'].Text; end; procedure TXMLStatusType.Set_Favorited(Value: WideString); begin ChildNodes['favorited'].NodeValue := Value; end; function TXMLStatusType.Get_In_reply_to_screen_name: WideString; begin Result := ChildNodes['in_reply_to_screen_name'].Text; end; procedure TXMLStatusType.Set_In_reply_to_screen_name(Value: WideString); begin ChildNodes['in_reply_to_screen_name'].NodeValue := Value; end; function TXMLStatusType.Get_User: IXMLUserType; begin Result := ChildNodes['user'] as IXMLUserType; end; { TXMLUserType } function TXMLUserType.Get_Id: Integer; begin Result := ChildNodes['id'].NodeValue; end; procedure TXMLUserType.Set_Id(Value: Integer); begin ChildNodes['id'].NodeValue := Value; end; function TXMLUserType.Get_Name: WideString; begin Result := ChildNodes['name'].Text; end; procedure TXMLUserType.Set_Name(Value: WideString); begin ChildNodes['name'].NodeValue := Value; end; function TXMLUserType.Get_Screen_name: WideString; begin Result := ChildNodes['screen_name'].Text; end; procedure TXMLUserType.Set_Screen_name(Value: WideString); begin ChildNodes['screen_name'].NodeValue := Value; end; function TXMLUserType.Get_Location: WideString; begin Result := ChildNodes['location'].Text; end; procedure TXMLUserType.Set_Location(Value: WideString); begin ChildNodes['location'].NodeValue := Value; end; function TXMLUserType.Get_Description: WideString; begin Result := ChildNodes['description'].Text; end; procedure TXMLUserType.Set_Description(Value: WideString); begin ChildNodes['description'].NodeValue := Value; end; function TXMLUserType.Get_Profile_image_url: WideString; begin Result := ChildNodes['profile_image_url'].Text; end; procedure TXMLUserType.Set_Profile_image_url(Value: WideString); begin ChildNodes['profile_image_url'].NodeValue := Value; end; function TXMLUserType.Get_Url: WideString; begin Result := ChildNodes['url'].Text; end; procedure TXMLUserType.Set_Url(Value: WideString); begin ChildNodes['url'].NodeValue := Value; end; function TXMLUserType.Get_Protected_: WideString; begin Result := ChildNodes['protected'].Text; end; procedure TXMLUserType.Set_Protected_(Value: WideString); begin ChildNodes['protected'].NodeValue := Value; end; function TXMLUserType.Get_Followers_count: Integer; begin Result := ChildNodes['followers_count'].NodeValue; end; procedure TXMLUserType.Set_Followers_count(Value: Integer); begin ChildNodes['followers_count'].NodeValue := Value; end; end.
このユニットとTXMLDocumentと組み合わせることで、XMLを簡単に扱うことができます。
Unit1.pas
メインウィンドウのユニット。
unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP, TimelineData, XMLDoc, ComCtrls; type TForm1 = class(TForm) Button1: TButton; ListView1: TListView; Label1: TLabel; Label2: TLabel; Edit1: TEdit; Label3: TLabel; Edit2: TEdit; procedure Button1Click(Sender: TObject); procedure ListView1Click(Sender: TObject); private { Private 宣言 } public { Public 宣言 } end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.Button1Click(Sender: TObject); var HTTP: TIdHTTP; Timeline: IXMLStatusesType; XML: TXMLDocument; I: Integer; ListItem: TListItem; begin HTTP := TIdHTTP.Create; try XML := TXMLDocument.Create(Self); try HTTP.Request.Username := Edit1.Text; HTTP.Request.Password := Edit2.Text; HTTP.Request.BasicAuthentication := True; try XML.LoadFromXML(HTTP.Get('http://twitter.com/statuses/friends_timeline.xml')); except on e: EIdHTTPProtocolException do if e.ErrorCode = 401 then ShowMessage('認証に失敗しました'); end; Timeline := Getstatuses(XML); for I := 0 to Timeline.Count - 1 do begin ListItem := ListView1.Items.Add; ListItem.Caption := Timeline.Status[I].User.Name; ListItem.SubItems.Add(Timeline.Status[I].Text); ListItem.SubItems.Add(Timeline.Status[I].Created_at); end; finally FreeAndNil(XML); end; finally FreeAndNil(HTTP); end; end; procedure TForm1.ListView1Click(Sender: TObject); begin if ListView1.ItemIndex > 0 then begin Label1.Caption := ListView1.Selected.SubItems[1]; end; end; end.
完成。文字コードで一切はまらなかったあたりが2009のいいところか。