productbinding.pas

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

unit ProductBinding;

interface
   uses xmldom,XMLDoc, XMLIntf, SysUtils,dbclient,Classes,imageinfo;
const
  ServiceID='6C4CFBAE-DB92-4160-B40B-DA1301075F3B';
  ServiceIDNode='ServiceID';
  BODY='Body';
  ROW='Row';
  HEAD='Head';
  ProductGetRequestNode='ProductGetRequest';
  ProductGetResponseNode='ProductGetResponse';
  ProductUpdateRequestNode='ProductUpdateRequest';
  ProductUpdateResponseNode='ProductUpdateResponse';
  GetProductByDateResponseNode='GetProductByDateResponse';
  GetGroductByDateRequestNode='GetGroductByDateRequest';
  PostProductImageRequestNode='PostProductImageRequest';
  PostProductImageResponsNode='PostProductImageResponse';
  GetProductImageRequestNode='GetProductImageRequest';
  GetProductImageResponsNode='GetProductImageResponse';
  LoginRequestNode='LoginRequest';
  LoginResponseNode ='LoginReponse';
  ProductID='Pid';
  ImageCodeNode='ImageCode';
  ErrorByXml01='XML描述不全';
  ErrorByXml02='XML描述不全,不是一个XML文件';
  ResultCode='ResultCode';
  ResultDesc='ResultDesc';
  SuccessMsg='成功';
  FalseMsg='失败';
  DBError01='数据连接失败';
  UserError='不是合法用户';
 type
   TUser=record
    UserID:string;
    PassWord:string;
   end;
   TDateType =record
     DateType :string;
     DateFieldName:string;
     Days :Integer;
   end;
   TReturnMsg =record
     NodeName :string;
     ResultCode:string;
     ResultDesc:string;
     ServiceID:string;
     ImageStr:WideString;
   end;
    TReturnListMsg =record
     ResultCode:string;
     ResultDesc:string;
     ProductList:Tstrings;
   end;
    TReturnPtypeListMsg =record
     ResultCode:string;
     ResultDesc:string;
     ProductList:TList;
   end;

   IXmlProductType=interface(IXMLNode)
  end;
  TXmlProductType=class
    Function CheckUserID():Boolean;
  public
    id :Integer;
    pid:string;  // 编号
    name:string;  // 名称
    model:string;// 型号
    sunit:string;// 单位
    thecurrency :string;// 币种
    category :string;// 分类
    pictures :string;// 图片标记
    onsaledate :string;// 上架日期 近期15天查询
    withdrawdate :string;// 下架日期 商品批量输出  日期范围
    weight :Integer;//重量 （克）
    originalcode :string;// 厂家代码
    summary :string;// 说明
    locus :string;//货栈
    psize :string;//尺,码
    color :string;//颜色
    grade :string;//等级
    UserCode:string;//经销商或供应商的代号
  end;
 Function CheckUser(ClientId:string):boolean;
 function CreateProductsXML64(cds:Tclientdataset;functionName:string;ErrrMsg:string):WideString;
 function NewXMLDocument: IXMLDocument;
 function GetPidFromRequest(Xmldata:WideString):string;
 function GetXmlDocFromString(Xmldata:WideString):IXMLDocument;
 function ReadProductFromXml(XmlData:WideString):TXmlProductType;
 function CreateMsgXml(functionName:string;RCode:string;RDesc:string;hasid:boolean=False):WideString;
 Function GetUserInfoXml(Xmldata:Widestring):TUser;
 function GetDateType(Xmldata:WideString):TDateType;
 function CreatePictureXml(imageinfo:TImageInfo;Rcode,Rdesc:string):WideString;
 function GetPictureFromXml(XmlData:WideString;validuser:Boolean=True):TImageInfo;
 function CreateGetImageXml(pid,imagecode:string):WideString;
 Function ReadXmlBody(XmlData:WideString;ValidUser:Boolean=True):IXMLNode;
 Function WriteXmlBody(RootNode:string;hasServiceID:Boolean=True):IXMLNode;

 Function CreateLoginXML(userid,password:string):widestring;
 function GetResultMsg(xmldata:WideString):TReturnMsg;
 function CreateXmlFromProduct(product:TXmlProductType):Widestring;
 Function CreateGetImageResponse(dataXml:WideString):TReturnMsg;
 Function CreateDateXml(datetype:TdateType):WideString;
 Function ReadProdcutList(DataXml:WideString):TReturnListMsg;
 Function CreatePidXml(pid:String):WideString;
 Function GetProductinfo(dataXml:WideString):TReturnPtypeListMsg;
 var
 XmlRef:IXMLDocument;

 implementation
Function TXmlProductType.CheckUserID():Boolean;
var
  substr:string;
begin
   Result :=False;
   substr:=UserCode+'.';
   if Pos(substr,pid)>0 then Result :=True;
  end;

Function ReadXmlBody(XmlData:WideString;ValidUser:Boolean=True):IXMLNode;
 var
   xmldoc :IXMLDocument;
   Node1,Node2:IXMLNode;
begin
  try
    xmldoc := GetXmlDocFromString(Xmldata);
    xmldoc.Active :=True;
    Node1:=xmldoc.DocumentElement;
    if ValidUser then
    begin
      if not CheckUser(Node1.ChildNodes[ServiceIDNode].Text) then
       raise Exception.Create(UserError);
    end;
    Node2:=Node1.ChildNodes.FindNode(BODY);
    Result :=Node2;
   except on E:Exception do
     raise Exception.Create(E.Message);
   end;
  end;



function GetDateType(Xmldata:WideString):TDateType;
 var
   Node2:IXMLNode;
   datatype:TDateType;
 begin
   try
    Node2:=ReadXmlBody(Xmldata);
    datatype.DateType := Node2.ChildNodes['DateType'].Text;
    datatype.DateFieldName :=datatype.DateType;
    datatype.Days :=strtointdef(Node2.ChildNodes['Days'].Text,0);
    Result :=datatype;
    node2.OwnerDocument.Active :=false;
   except on E:Exception do
     raise Exception.Create(E.Message+ErrorByXml01);
   end;
 end;
Function CheckUser(ClientID:string):boolean;
begin
  if(ClientID=ServiceID) then
    Result :=True
    else
    Result :=False;
end;
function NewXMLDocument: IXMLDocument;
begin
  Result := XMLDoc.NewXMLDocument;
  Result.Active := True;
  Result.Version := '1.0';
  Result.Encoding := 'Gb2312';
  Result.Options :=[doNodeAutoCreate];
  XmlRef:=Result as IXMLDocument;
end;
 Function WriteXmlBody(RootNode:string;hasServiceID:Boolean=True):IXMLNode;
var
  Node1 : IXMLNode;
  Node2 : IXMLNode;
  XMLDoc :IXMLDocument;
begin
    XMLDoc :=NewXMLDocument;
    XMLDoc.DocumentElement := XMLDoc.CreateNode(RootNode);
    Node1 := XMLDoc.DocumentElement;
    Node1.AddChild(HEAD);
    if hasServiceID then
     Node1.AddChild(ServiceIDNode).Text :=ServiceID;
    Node2:=Node1.AddChild(BODY);
    Result :=Node2;
  end;

function CreateMsgXml(functionName:string;RCode:string;RDesc:string;hasid:boolean=False):WideString;
var
  Node2 : IXMLNode;
  Node3 : IXMLNode;
  XMLWString:WideString;
begin
    Node2:=WriteXmlBody(functionName,hasid);
    Node3:=Node2.AddChild(ResultCode);
    Node3.Text :=Rcode;
    Node3:=Node2.AddChild(ResultDesc);
    Node3.Text :=Rdesc;
    Node3.OwnerDocument.SaveToXML(XMLWString);
    Result :=XMLWString;
end;
// 从xml中读取供应商编号和密码
Function GetUserInfoXml(Xmldata:Widestring):TUser;
 var
  Node2:IXMLNode;
  User:TUser;
 begin
   try
    Node2:=ReadXmlBody(Xmldata,False);
    User.UserID := Node2.ChildNodes['UserID'].Text;
    User.PassWord := Node2.ChildNodes['Password'].Text;   //明文
    Result :=User;
   except on E:Exception do
     raise Exception.Create(E.Message+ErrorByXml01);
   end;
 end;

function CreateProductsXML64(cds:Tclientdataset;functionName:string;ErrrMsg:string):WideString;
var
  Node2 : IXMLNode;
  Node3 : IXMLNode;
  Node4: IXMLNode;
  i:Integer;
  XMLWString:DOMString;
begin
  try
    Node2:=WriteXmlBody(functionName);
    if Assigned(cds) then
    begin
     Node3:=Node2.AddChild(ResultCode);
     Node3.Text :='1';
     Node3:=Node2.AddChild(ResultDesc);
     Node3.Text :=SuccessMsg;
    while not cds.Eof do
    begin
        Node3:=Node2.AddChild(ROW);
        for i:=0 to cds.Fields.Count-1 do
        begin
         Node4:=Node3.AddChild(cds.Fields[i].FieldName);
         Node4.Text :=Trim(cds.Fields[i].AsString);
        end;
        cds.Next;
      end;
    end else
    begin
     Node3:=Node2.AddChild(ResultCode);
     Node3.Text :='0';
     Node3:=Node2.AddChild(ResultDesc);
     Node3.Text :=ErrrMsg;
    end;
    Node2.OwnerDocument.SaveToXML(XMLWString);
    Result :=XMLWString;
  finally
   Node2.OwnerDocument.Active :=False;

  end;
end;
 {读取一个商品}
function ReadProductFromXml(XmlData:WideString):TXmlProductType;