clienttest.pas

delphi实现 webservice的例子.有服务端和客户段 利用xml交互.

unit ClientTest;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, InvokeRegistry, StdCtrls, Rio, SOAPHTTPClient,IProductService_WAD1,
  ComCtrls,xmldom, XMLDoc, XMLIntf,EncdDecd,ProductBinding, msxmldom,
  DBXpress, Grids, DBGrids, DB, DBClient, SimpleDS, SqlExpr,
  CRSQLConnection, FMTBcd, ExtCtrls,ComFun,jpeg,imageinfo,VCLZip;

type
  TaTestForm = class(TForm)
    htpr1: THTTPRIO;
    cbb1: TComboBox;
    btn2: TButton;
    pgc1: TPageControl;
    ts1: TTabSheet;
    ts2: TTabSheet;
    mmo1: TMemo;
    btn1: TButton;
    mmo2: TMemo;
    btn3: TButton;
    mmo3: TMemo;
    XMLDocument1: TXMLDocument;
    ts3: TTabSheet;
    mmo4: TMemo;
    mmo5: TMemo;
    btn4: TButton;
    SysSQLConnection: TCRSQLConnection;
    SDS_User: TSimpleDataSet;
    ds1: TDataSource;
    ts4: TTabSheet;
    dbgrd1: TDBGrid;
    mmo6: TMemo;
    btn5: TButton;
    ts5: TTabSheet;
    Memo1: TMemo;
    Memo2: TMemo;
    Button1: TButton;
    rb1: TRadioButton;
    rb2: TRadioButton;
    edt1: TEdit;
    sds_product: TSimpleDataSet;
    Q_Product: TSQLQuery;
    ts6: TTabSheet;
    mmo7: TMemo;
    btn6: TButton;
    mmo8: TMemo;
    btn7: TButton;
    btn8: TButton;
    dlgOpen1: TOpenDialog;
    btn9: TButton;
    btn10: TButton;
    grp1: TGroupBox;
    img1: TImage;
    ts7: TTabSheet;
    GroupBox1: TGroupBox;
    Image1: TImage;
    Button2: TButton;
    Button3: TButton;
    Memo3: TMemo;
    Memo4: TMemo;
    btn11: TButton;
    btn12: TButton;
    btn13: TButton;
    btn14: TButton;
    btn15: TButton;
    Function GetService():IProductService_WAD;
    procedure btn1Click(Sender: TObject);
    procedure btn2Click(Sender: TObject);
    procedure btn3Click(Sender: TObject);
    function GetXmlDocFromString(Xmldata:WideString):IXMLDocument;
    procedure btn4Click(Sender: TObject);


    function UpdateProduct(Product:TXmlProductType):Integer;
    procedure btn5Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure btn8Click(Sender: TObject);
    function CreatePictureXml():WideString;
    procedure btn6Click(Sender: TObject);
    procedure btn9Click(Sender: TObject);
    procedure btn10Click(Sender: TObject);
    procedure btn7Click(Sender: TObject);
    procedure btn11Click(Sender: TObject);
    procedure btn12Click(Sender: TObject);
    procedure btn13Click(Sender: TObject);
    procedure btn14Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
var
  aTestForm: TaTestForm;

implementation
   uses
      clientcfg_u;
{$R *.dfm}
Function TaTestForm.GetService():IProductService_WAD;
begin
   result:= htpr1 as IProductService_WAD;
  end;

procedure TaTestForm.btn1Click(Sender: TObject);
var
  Service :IProductService_WAD;
  str:WideString;
begin
  Service :=GetService;
  str :=mmo6.Lines.Text;
  str :=StringReplace(str,   #$D,   '',   [rfReplaceAll]);
  str :=StringReplace(str,   #$A,   '',   [rfReplaceAll]);
  str := Service.GetProduct(str);
  str :=StringReplace(str,   #$D,   '',   [rfReplaceAll]);
  str :=StringReplace(str,   #$A,   '',   [rfReplaceAll]);
  mmo1.Lines.Text :=str;
  XMLDocument1.XML.Text :=str;
  str :=ansitoutf8(str);
  GetXmlDocFromString(str).SaveToFile('tempxml.xml');
end;
 function TaTestForm.GetXmlDocFromString(Xmldata:WideString):IXMLDocument;
 var
   xmldoc :IXMLDocument;
   StrStr: TStringStream;
   stream :TMemoryStream;
   begin
     xmldoc :=NewXMLDocument();
     stream:=TMemoryStream.Create;
     StrStr := TStringStream.Create(Xmldata);
    try
      Stream.CopyFrom(StrStr, 0);
      xmldoc.LoadFromStream(Stream,xetUnknown);
      Result :=xmldoc;
    finally
      StrStr.Free;
      stream.Free;
    end;
     end;
procedure TaTestForm.btn2Click(Sender: TObject);
begin
  htpr1.URL :=cbb1.Text;
end;

procedure TaTestForm.btn3Click(Sender: TObject);
var
 str:WideString;
 Service :IProductService_WAD;
// xmldoc:TXMLDocument;
begin
//  xmldoc :=TXMLDocument.Create('product.xml');
  str:=mmo3.Lines.Text;
  str :=StringReplace(str,   #$D,   '',   [rfReplaceAll]);
  str :=StringReplace(str,   #$A,   '',   [rfReplaceAll]);
  Service :=GetService;
  mmo2.text :=Service.UpdateProduct(str);
end;

procedure TaTestForm.btn4Click(Sender: TObject);
var
  str:WideString;
  i:integer;
  Service :IProductService_WAD;
begin
  Service :=GetService;
  str :=mmo5.Lines.Text;
  mmo4.text :=Service.Login(str);

end;


//更新一条商品记录
function TaTestForm.UpdateProduct(Product:TXmlProductType):Integer;
//var
  //product1:TXmlProductType;
  var
     str:Widestring;
begin
     SysSQLConnection.Open;
     Product.pid :='000015';
     Product.name :='hxg' ;
     sds_Product.Close;
     sds_product.DataSet.CommandText :='select 2 as a,to_char(max(id)) maxid from product '+
     ' union Select distinct 1 as a,pid from product where pid='''+product.pid+''' order by a';
     sds_product.Open;
     sds_product.First;
     Product.id :=sds_product.Fields[1].AsInteger+1;
     if sds_product.RecordCount>1 then
     begin
       Q_Product.Close;
       Q_Product.SQL.Clear;
       Q_Product.SQL.Add('Update product set name =:name,model=:model,unit=:unit,thecurrency=:thecurrency,');
       Q_Product.SQL.Add('category=:category,pictures=:pictures,onsaledate=:onsaledate,withdrawdate =:withdrawdate,');
       Q_Product.SQL.Add('weight=:weight,originalcode=:originalcode,summary=:summary,locus=:locus,');
       Q_Product.SQL.Add('psize=:psize,color =:color,grade=:grade Where pid=:pid');
     end
     else
     begin
       Q_Product.Close;
       Q_Product.SQL.Clear;
       Q_Product.SQL.Add('Insert into Product(id,pid,name,model,unit,thecurrency,category,pictures,');
       Q_Product.SQL.Add('onsaledate,withdrawdate,weight,originalcode,summary,locus,psize,color,grade)values');
       Q_Product.SQL.Add('(:id,:pid,:name,:model,:unit,:thecurrency,:category,:pictures,');
       Q_Product.SQL.Add(':onsaledate,:withdrawdate,:weight,:originalcode,:summary,:locus,:psize,:color,:grade)');
       Q_Product.Params.ParamByName('id').AsBCD:=Product.id;
     end;
     Q_Product.Params.ParamByName('Pid').AsString :=Product.pid;
     Q_Product.Params.ParamByName('name').AsString :=Product.name;
     Q_Product.Params.ParamByName('model').AsString :=Product.model;
     Q_Product.Params.ParamByName('unit').AsString :=Product.sunit;
     Q_Product.Params.ParamByName('thecurrency').AsString :=Product.thecurrency;
     Q_Product.Params.ParamByName('category').AsString :=Product.category;
     Q_Product.Params.ParamByName('pictures').AsString :=Product.pictures;
     if(Product.onsaledate='') then
      Q_Product.Params.ParamByName('onsaledate').AsString:=''
     else
      Q_Product.Params.ParamByName('onsaledate').Value :=StrToDate(Product.onsaledate);
     if(Product.withdrawdate='') then
      Q_Product.Params.ParamByName('withdrawdate').AsString:=''
     else
      Q_Product.Params.ParamByName('withdrawdate').AsDate:=StrToDate(Product.withdrawdate);
     Q_Product.Params.ParamByName('weight').AsBCD:=Product.weight;
     Q_Product.Params.ParamByName('originalcode').AsString :=Product.originalcode;
     Q_Product.Params.ParamByName('summary').AsString :=Product.summary;
     Q_Product.Params.ParamByName('locus').AsString :=Product.locus;
     Q_Product.Params.ParamByName('psize').AsString :=Product.psize;
     Q_Product.Params.ParamByName('color').AsString :=Product.color;
     Q_Product.Params.ParamByName('grade').AsString :=Product.grade;
     Result:=Q_Product.ExecSQL();
     SysSQLConnection.Close;
   end;



procedure TaTestForm.btn5Click(Sender: TObject);
begin
  UpdateProduct(TXmlProductType.Create);
end;

procedure TaTestForm.Button1Click(Sender: TObject);
var
 str:WideString;
 Service :IProductService_WAD;
 xmldoc:TXMLDocument;
begin
  xmldoc :=TXMLDocument.Create(nil);
  str:=Memo1.Lines.Text;
  str :=StringReplace(str,   #$D,   '',   [rfReplaceAll]);
 // str :=StringReplace(str,   #$A,   '',   [rfReplaceAll]);
  Service :=GetService;
  XMLDocument1.XML.Text :=str;
  str :=ansitoutf8(str);
  GetXmlDocFromString(str).SaveToFile('tempxml.xml');
  Memo2.text :=Service.GetProductByDate(str);
end;

procedure TaTestForm.btn8Click(Sender: TObject);
begin
  if dlgOpen1.Execute then
    if dlgOpen1.FileName<>'' then
     img1.Picture.LoadFromFile(dlgOpen1.FileName);
end;


function TaTestForm.CreatePictureXml():WideString;
var
   imageinfo :TImageInfo;
begin
   imageinfo :=Timageinfo.Create(dlgOpen1.FileName,'000015','001#003#bmp');
   result:=ProductBinding.CreatePictureXml(imageinfo,'','');
end;

procedure TaTestForm.btn6Click(Sender: TObject);
begin
 mmo8.Lines.Text := CreatePictureXml();
end;

procedure TaTestForm.btn9Click(Sender: TObject);
begin
img1.Picture :=nil;
end;

procedure TaTestForm.btn10Click(Sender: TObject);
var
   str:WideString;
   imageinfo :TImageInfo;
   bmp :TBitmap;
   stream:TStream;
begin
  str :=mmo8.Lines.Text;
  str :=StringReplace(str,   #$D,   '',   [rfReplaceAll]);
  //str :=StringReplace(str,   #$A,   '',   [rfReplaceAll]);

  imageinfo := GetPictureFromXml(str);
  bmp :=TBitmap.Create;
  try
   stream :=imageinfo.ImageStream;
   stream.Position :=0;
   bmp.LoadFromStream(stream);
   img1.Picture.Bitmap.Assign(bmp);
  finally
   stream.Free;
   bmp.FreeImage;
  end;

end;

procedure TaTestForm.btn7Click(Sender: TObject);
var
 str:WideString;
 Service :IProductService_WAD;
begin
  str :=CreatePictureXml();
  Service :=GetService;
 // GetXmlDocFromString(str).SaveToFile('tempxml.xml');
  mmo7.Lines.Text :=Service.PostProductImage(str);
end;

procedure TaTestForm.btn11Click(Sender: TObject);
var
   str:WideString;
begin
  str := CreateGetImageXml('000015','001#003#bmp');
  Memo4.Lines.Text :=str;
end;

procedure TaTestForm.btn12Click(Sender: TObject);
var
   Service :IProductService_WAD;
   str:widestring;
begin
    str := CreateGetImageXml('000015','001#003#bmp');
    Service :=GetService;
    str :=Service.GetProductImage(str);
    Memo3.Lines.Text :=str;
end;

procedure TaTestForm.btn13Click(Sender: TObject);
var
   str:WideString;
   imageinfo :TImageInfo;
   bmp :TBitmap;
   stream:TStream;
begin
  str :=Memo3.Lines.Text;
//  str :=StringReplace(str,   #$D,   '',   [rfReplaceAll]);
 // str :=StringReplace(str,   #$A,   '',   [rfReplaceAll]);

  imageinfo := GetPictureFromXml(str,false);
  bmp :=TBitmap.Create;
  try
   stream :=imageinfo.ImageStream;
   stream.Position :=0;
   bmp.LoadFromStream(stream);
   Image1.Picture.Bitmap.Assign(bmp);
  finally
   stream.Free;
   bmp.FreeImage;
  end;

end;

procedure TaTestForm.btn14Click(Sender: TObject);
begin
 aClentcfgForm :=TaClentcfgForm.Create(nil);
 aClentcfgForm.ShowModal;
 FreeAndNil(aClentcfgForm);
end;

end.