www.pudn.com > DelphiXMLCode.zip > ClientMain.pas, change:2003-06-21,size:4357b


unit ClientMain; 
 
{ 
  Demonstrate calling Web services through this client. 
  Calls one local Web service written in Delphi to retrieve movie information, 
  and one remote Web service written in MS .NET to send e-mail. 
 
  Copyright  Keith Wood (kbwood@iprimus.com.au) 
  Written 17 September, 2002. 
} 
 
interface 
 
uses 
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
  Dialogs, StdCtrls, ComCtrls, Rio, SOAPHTTPClient, FindMoviesIntf, ccomms, 
  Types, StrUtils; 
 
type 
  TfrmClientMain = class(TForm) 
    Label1: TLabel; 
    cbxRating: TComboBox; 
    btnFind: TButton; 
    pgcMain: TPageControl; 
    tabResults: TTabSheet; 
    lbxMovies: TListBox; 
    tabRequest: TTabSheet; 
    memRequest: TMemo; 
    tabResponse: TTabSheet; 
    memResponse: TMemo; 
    edtEmail: TEdit; 
    btnTell: TButton; 
    rioMovies: THTTPRIO; 
    procedure FormCreate(Sender: TObject); 
    procedure btnFindClick(Sender: TObject); 
    procedure btnTellClick(Sender: TObject); 
    procedure lbxMoviesDblClick(Sender: TObject); 
    procedure rioAfterExecute(const MethodName: String; 
      SOAPResponse: TStream); 
    procedure rioBeforeExecute(const MethodName: String; 
      var SOAPRequest: WideString); 
  private 
  public 
  end; 
 
var 
  frmClientMain: TfrmClientMain; 
 
implementation 
 
uses 
  ClientDetail; 
 
{$R *.dfm} 
 
{ Initialise the list of ratings } 
procedure TfrmClientMain.FormCreate(Sender: TObject); 
var 
  Rating: TMovieRating; 
begin 
  for Rating := Low(TMovieRating) to High(TMovieRating) do 
    cbxRating.Items.Add(Ratings[Rating]); 
  cbxRating.ItemIndex := 0; 
end; 
 
{ Retrieve the array of movies matching the specified rating. 
  Trap any exception from the Web service and display it. 
  Otherwise place the movie names into the listbox. } 
procedure TfrmClientMain.btnFindClick(Sender: TObject); 
var 
  Movies: TStringDynArray; 
  Index: Integer; 
begin 
  Screen.Cursor   := crHourGlass; 
  btnFind.Enabled := False; 
  try 
    lbxMovies.Items.Clear; 
    pgcMain.ActivePage := tabResults; 
    try 
      Movies := (rioMovies as IFindMovies). 
        FindMovies(TMovieRating(cbxRating.ItemIndex)); 
      for Index := 0 to Length(Movies) - 1 do 
        lbxMovies.Items.Add(Movies[Index]); 
    except on E: EFindMoviesException do 
      MessageDlg(E.Message + ' ' + E.ExtraMessage, mtError, [mbOK], 0); 
    end; 
  finally 
    Screen.Cursor   := crDefault; 
    btnFind.Enabled := True; 
  end; 
end; 
 
{ Call a third-party Web service to send off an e-mail } 
procedure TfrmClientMain.btnTellClick(Sender: TObject); 
begin 
  Screen.Cursor   := crHourGlass; 
  btnTell.Enabled := False; 
  try 
    GetccommsSoap().SendEmail('a.friend@the_movies.com', edtEmail.Text, 
      'Movies', 'I thought you might be interested in these movies' + 
      IfThen(cbxRating.ItemIndex > 0, ' rated ' + cbxRating.Items[cbxRating.ItemIndex], '') + 
      #13 + lbxMovies.Items.CommaText, ccomms.Text); 
  finally 
    Screen.Cursor   := crDefault; 
    btnTell.Enabled := True; 
  end; 
end; 
 
{ Bring up details for a selected movie with another Web service call. 
  Trap any exception from the Web service and display it. } 
procedure TfrmClientMain.lbxMoviesDblClick(Sender: TObject); 
var 
  Movie: TMovieDetails; 
begin 
  Screen.Cursor := crHourGlass; 
  try 
    with lbxMovies do 
      if ItemIndex > -1 then 
        try 
          Movie := (rioMovies as IFindMovies). 
            GetMovieDetails(lbxMovies.Items[lbxMovies.ItemIndex]); 
          TfrmClientDetail.Display(Movie); 
        except on E: EFindMoviesException do 
          MessageDlg(E.Message + ' ' + E.ExtraMessage, mtError, [mbOK], 0); 
        end; 
  finally 
    Screen.Cursor := crDefault; 
  end; 
end; 
 
{ Display the SOAP response } 
procedure TfrmClientMain.rioAfterExecute(const MethodName: String; 
  SOAPResponse: TStream); 
var 
  StrStream: TStringStream; 
begin 
  StrStream := TStringStream.Create(''); 
  try 
    StrStream.CopyFrom(SOAPResponse, 0); 
    SOAPResponse.Position  := 0; 
    memResponse.Lines.Text := StrStream.DataString; 
  finally 
    StrStream.Free; 
  end; 
end; 
 
{ Display the SOAP request } 
procedure TfrmClientMain.rioBeforeExecute(const MethodName: String; 
  var SOAPRequest: WideString); 
begin 
  memRequest.Lines.Text := SOAPRequest; 
end; 
 
end.