uasrvobjdesi.pas

基于Midas 技术的多层应用开发包第二版（带开发文档）

{******************************************************************************************}
{                                                                                          }
{       Universal Agent on demond SDK                                                      }
{                                                                                          }
{                                                                                          }
{ COPYRIGHT                                                                                }
{ =========                                                                                }
{ The UA SDK (software) is Copyright (C) 2001-2003, by vinson zeng(曾胡龙).                }
{ All rights reserved.                                                                     }
{ The authors - vinson zeng (曾胡龙),                                                      }
{ exclusively own all copyrights to the Advanced Application                               }
{ Controls (AppControls) and all other products distributed by Utilmind Solutions(R).      }
{                                                                                          }
{ LIABILITY DISCLAIMER                                                                     }
{ ====================                                                                     }
{ THIS SOFTWARE IS DISTRIBUTED "AS IS" AND WITHOUT WARRANTIES AS TO PERFORMANCE            }
{ OF MERCHANTABILITY OR ANY OTHER WARRANTIES WHETHER EXPRESSED OR IMPLIED.                 }
{ YOU USE IT AT YOUR OWN RISK. THE AUTHOR WILL NOT BE LIABLE FOR DATA LOSS,                }
{ DAMAGES, LOSS OF PROFITS OR ANY OTHER KIND OF LOSS WHILE USING OR MISUSING THIS SOFTWARE.}
{                                                                                          }
{ RESTRICTIONS                                                                             }
{ ============                                                                             }
{ You may not attempt to reverse compile, modify,                                          }
{ translate or disassemble the software in whole or in part.                               }
{ You may not remove or modify any copyright notice or the method by which                 }
{ it may be invoked.                                                                       }
{******************************************************************************************}

unit uaSrvObjDesi;

interface
uses
  Windows, Messages, SysUtils, Classes, {ComServ, ComObj, VCLCom,} DataBkr,
  DBClient, StdVcl,AdoDb,Contnrs,Variants,Provider,Forms,Dialogs,
  uaSrvObj,UAServiceObjectPool,UADataPacket,UAUnits;
type

  TSrvObjDesign = class(TuaServerObject )
  private
    FAdoDsDesign:TAdoDataSet;
    FdspDesign:TDataSetProvider;
    FcdsDesign:TClientDataSet;

  protected


  public
    constructor Create; override;
    destructor  Destroy; override;

    procedure Request(ServiceName: WideString; DataIn: OleVariant;var DataOut: OleVariant); override;
    procedure Update (ServiceName: WideString; DataIn: OleVariant;var DataOut: OleVariant); override;
    procedure Execute(ServiceName: WideString; DataIn: OleVariant;var DataOut: OleVariant); override;

  published

  end;


implementation
uses UASystem;

//-----------------begin declare-------------------

const
   Srv_Obj_Name = 'srvobjdesign';

type
   TMgrSrvObjDesign = class(TCustomPoolManager)
     function  InternalCreateNewInstance: TCustomPoolObject; override;
   end;

var
  aMgrSrvObjDesign: TMgrSrvObjDesign;


//------------------%% end of %% ------------------


{ TSrvObjDegign }

constructor TSrvObjDesign.Create;
begin
  inherited;

  FAdoDsDesign := TAdoDataSet.Create(Application);
  FAdoDsDesign.Name :='adodsdesign';
  FdspDesign := TDataSetProvider.Create(Application);
  FdspDesign.Name := 'dspdesign';
  FcdsDesign := TClientDataSet.Create(Application);
  FcdsDesign.Name := 'cdsdesign';

end;

destructor TSrvObjDesign.Destroy;
begin
  FAdoDsDesign.Free;
  FdspDesign.Free;
  FcdsDesign.Free;
  inherited;
end;

procedure TSrvObjDesign.Execute(ServiceName: WideString;
  DataIn: OleVariant; var DataOut: OleVariant);
begin

  //'getaccountlist'
  if LowerCase(ServiceName) = 'getaccountlist' then
  begin
    DataOut := G_UASystem.AccountData;
  end;

end;

procedure TSrvObjDesign.Request(ServiceName: WideString;
  DataIn: OleVariant; var DataOut: OleVariant);
var
  sSql:string;
  sTmp:string;
  sTbl:string;
  sDB:string;
  iPos:integer;
  adoConn:TAdoConnection;
begin
  // modify by vinson zeng 2004-3-17

  sTmp := VarToStr(DataIn);
  iPos := AnsiPos('-',sTmp);

  sTbl := Copy(sTmp,0,iPos -1);
  sDb  := Copy(sTmp,iPos+1,Length(sTmp)-iPos);
  DBName := sDb;

  adoConn := TAdoConnection.Create(nil);
  adoConn.ConnectionString := Format(StrDbConn,['','sa',DBName,'(Local)']);
  try
    try
      adoConn.Connected := true;
      if LowerCase(ServiceName) = 'requesttblstrus' then
      begin
        sSql := Format('select top 0 * from  %s',[sTbl]);
        if trim(sSql)<> '' then begin
          FAdoDsDesign.Connection := adoConn;
          FAdoDsDesign.Name := 'ado_Design';
          FAdoDsDesign.EnableBCD := true;
          FAdoDsDesign.CommandText := sSql;
          if OpenSrvData(FAdoDsDesign,FdspDesign,FcdsDesign) <> -1 then
          begin
            if FcdsDesign.Active then
              DataOut := FcdsDesign.Data;
          end;
        end;
      end;
    except
      on E:Exception do
         begin
           MakeUAExceptionMsg(UA_E_GET_TABLE_STRUC,E,ServiceName+sTmp);
         end;
    end;

  finally
    if Assigned(adoConn) then
      FreeAndNil(adoConn);
  end;

end;

procedure TSrvObjDesign.Update(ServiceName: WideString; DataIn: OleVariant;
  var DataOut: OleVariant);
begin
  inherited;

end;



{ TMgrSrvObjDesign }

function TMgrSrvObjDesign.InternalCreateNewInstance: TCustomPoolObject;
var
  aSrvObjDesign:TSrvObjDesign;
begin
  aSrvObjDesign := TSrvObjDesign.Create;
  Result := TCustomPoolObject(aSrvObjDesign);
end;

initialization

  aMgrSrvObjDesign := TMgrSrvObjDesign.Create(3,5000);
  RegisterPoolManager(Srv_Obj_Name, TCustomPoolManager(aMgrSrvObjDesign));

finalization

  aMgrSrvObjDesign.Free;


end.