dm.~pas

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

Unit Dm;

interface

uses SysUtils, Classes, InvokeRegistry, Midas, SOAPMidas, SOAPDm, DBXpress,ProductBinding,
  DB, DBClient, SimpleDS, SqlExpr,DataServer, IniFiles,forms,
  FMTBcd,Variants, CRSQLConnection,imageinfo;//CRSQLConnection;

type
  IDataModule_U = interface(IAppServerSOAP)
    ['{3C21C91D-9318-4510-8B43-8A3F9B4F8EE4}']
  end;

 // TDataModule_U = class(TSoapDataModule, IDataModule_U, IDataServer)
    TDataModule_U = class(TDataModule,IDataServer)
    SDS_Product: TSimpleDataSet;
    SDS_User: TSimpleDataSet;
    Q_Product: TSQLQuery;
    SysSQLConnection: TCRSQLConnection;
    function  SetConnection:Boolean;
  private
  
  public
     function GetProduct(Pid:string):OleVariant;
     function GetProductsByDate(datetype :TDateType):OleVariant;
     function UpdateProduct(Product:TXmlProductType):Integer;
     Function Login(Pid:string;Password:string):boolean;
     function GetProductImage(pid,labelcode:string):TImageInfo;
     function PostProductImage(imageinfo:TImageInfo):Integer;
  end;

implementation

{$R *.DFM}
//通过Pid获取商品
Function TDataModule_U.GetProduct(Pid:string):OleVariant;
begin
  if not SetConnection then
  begin
    Result :=varempty;
    Exit;
    end;
  sds_product.Close();
 // sds_product.DataSet.CommandText :='Select * from t_bm where id=1';
  sds_product.DataSet.CommandText :='Select id,pid,name,model,unit,thecurrency,category, '+
  'pictures,onsaledate,withdrawdate,weight,originalcode,summary,locus,psize,color,grade ' +
  ' from Product where Pid='''+Pid+'''';
  sds_product.Open();
  result :=sds_product.Data;
  sds_product.Close;
end;

//更新一条商品记录
function TDataModule_U.UpdateProduct(Product:TXmlProductType):Integer;
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;
//按上架下架日期
Function TDataModule_U.GetProductsByDate(datetype :TDateType):OleVariant;
begin
  sds_product.Close();
  sds_product.DataSet.CommandText :=Format('Select pid,name from Product where  %s>=sysdate-%d and %s<=sysdate',
  [datetype.DateFieldName,datetype.Days,datetype.DateFieldName]);
  sds_product.Open();
  result :=sds_product.Data;
  sds_product.Close;
end;
//
//pid :分销商 、供应商 id
//Password :密码
Function TDataModule_U.Login(Pid:string;Password:string):boolean;
begin
   if not SetConnection then
  begin
    Result :=false;
    Exit;
    end;
  SysSQLConnection.Connected :=True;
  sds_user.Close();
  sds_user.DataSet.CommandText :='Select userid from usertest_hxg where userid ='''+
  Pid+''' and Password='''+Password+'''';
  sds_user.Open();
  if(sds_user.IsEmpty) or (sds_user.RecordCount=0)  then
     result :=false
  else
     result :=true;
  sds_user.Close();
  SysSQLConnection.Connected :=False;
end;
function TDataModule_U.GetProductImage(pid,labelcode:string):TImageInfo;
var
  imageinfo :Timageinfo;
  stream :TMemoryStream;
begin
   Result :=nil;
   stream :=TMemoryStream.Create;
   SysSQLConnection.Open;
   try
   Q_Product.Close;
   Q_Product.SQL.Clear;
   Q_Product.SQL.Add('Select pid,pic from pictures where pid='''+pid+''' and label='''+labelcode+'''');
   Q_Product.Open;
   if(Q_Product.RecordCount>0) then
   begin
      imageinfo :=TImageInfo.Create('',pid,labelcode);
      TBlobField(Q_Product.FieldByName('pic')).SaveToStream(stream);
      imageinfo.SetBase64FromStream(stream);
      Result :=imageinfo;
     end;
   finally

      SysSQLConnection.Close();
     end;
  end;


  { CREATE   SEQUENCE   pic_seq_id       
  INCREMENT   BY   1       
  START     WITH     1     
  MAXVALUE     99999       
  CYCLE     NOCACHE;  }
function TDataModule_U.PostProductImage(imageinfo:TImageInfo):Integer;
begin
   Result :=0;
   SysSQLConnection.Open;
   Q_Product.Close;
   Q_Product.SQL.Clear;
   Q_Product.SQL.Add('Select pid,pic from pictures where pid='''+imageinfo.Pid+''' and label='''+imageinfo.LabelCode+'''');
   Q_Product.Open;
   try
   if Q_Product.RecordCount>0 then
    begin
     Q_Product.Close;
     Q_Product.SQL.Clear;
     Q_Product.SQL.Add('update pictures set pic =:pic where pid=:pid and label=:label');
     Q_Product.Params.ParamByName('pid').AsString :=imageinfo.Pid;
     Q_Product.Params.ParamByName('label').AsString :=imageinfo.LabelCode;
     Q_Product.Params.ParamByName('pic').LoadFromStream(imageinfo.ImageStream,ftBlob);
     Result :=Q_Product.ExecSQL();
      end else
      begin
       Q_Product.Close;
       Q_Product.SQL.Clear;
       Q_Product.SQL.Add('insert into pictures(id,pid,label,picsize,pic)values(pic_seq_id.nextval,:pid,:label,:picsize,:pic)');     // pic_seq_id.nextval使用序列id
       Q_Product.Params.ParamByName('pid').AsString :=imageinfo.Pid;
       Q_Product.Params.ParamByName('label').AsString :=imageinfo.LabelCode;
       Q_Product.Params.ParamByName('picsize').AsBCD :=imageinfo.ImageStream.Size;
       Q_Product.Params.ParamByName('pic').LoadFromStream(imageinfo.ImageStream,ftBlob);
       Result := Q_Product.ExecSQL();
        end;
     finally
       SysSQLConnection.Close();
     end;
end;

procedure TDataModule_UCreateInstance(out obj: TObject);
begin
 obj := TDataModule_U.Create(nil);
end;


function  TDataModule_U.SetConnection:Boolean;
var iniFile: TIniFile;
    path: array[0..1024] of Char;
    e:PChar;
    sSysUser,sServer,sDatabase: string;
begin
  StrPCopy( path,Application.ExeName );
  e := StrRScan( path,'\' );
  if e<>nil then e[0] := #0;
     IniFile := TIniFile.Create(Path+'\wd.ini');
  try
      sSysUser := iniFile.ReadString('Login','SysUser','wd');
      sSysUser := StrLower( PChar(sSysUser) );
      sServer := iniFile.ReadString('Sys','Server','localhost');
      sDatabase := iniFile.ReadString('Sys','Database','');
      SysSQLConnection.Params.Values['DataBase'] := sDatabase;
      SysSQLConnection.Params.Values['User_Name'] := sSysUser;
      SysSQLConnection.Params.Values['Password'] := '979979';
      try
        SysSQLConnection.Connected :=True;
        Result :=True;
       except
          Result :=False;
       end;
  finally
     IniFile.Free;
  end;
  end;

initialization
  // InvRegistry.RegisterInvokableClass(TDataModule_U, TDataModule_UCreateInstance);
 //  InvRegistry.RegisterInterface(TypeInfo(IDataModule_U));
end.