用戶端遠程方法調用

unit uDM;

interface
{$WARN SYMBOL_PLATFORM OFF}
uses
  SysUtils, Classes, Controls,DB, DBClient, MConnect, SConnect, Dialogs,
  Variants, ADODB, IniFiles, Forms, MidServer_TLB, uFun;

type
  TSvrRec = record       // socketConnection's property
    Address: string;
    Port: Integer;
    ServerName: string;
  end;

  Tdm = class(TDataModule)
    Conn: TSocketConnection;
    ParamsADO: TADOQuery;
    cdsCaption: TClientDataSet;
    cdsRights: TClientDataSet;
    procedure DataModuleCreate(Sender: TObject);
    procedure DataModuleDestroy(Sender: TObject);
  private
    svrRec: TSvrRec;
    procedure GetConfig;
    function tryConnect:Boolean;
    procedure DisConn;
    function Loader: ITestDisp;
  public
    { Public declarations }
    function GetData(cds: TClientDataSet; const ModuleId: String; SqlId: integer; haveParams: Boolean = False):Boolean;
    function ExecSQL(const ModuleId: string; SqlId: integer;haveParams:Boolean=False):Integer;
    function GetStoredData(cds: TClientDataSet; const ModuleId: string; SqlId: integer;haveParams:Boolean=False):Boolean;
    function ExecStored(const ModuleId: string; SqlId: integer;haveParams:Boolean=False):integer;
    procedure ApplyUpdate(Const ModuleId: String; SqlId: integer; Cds: TClientDataSet);
    procedure ClearParameters;
    procedure ApplyUpdates(const moduleId:string;sqlId:Integer;delta0,delta1,delta2,delta3:OleVariant);
    procedure AddParameter(const ParamName: string;
      DataType: TFieldType; Value: OleVariant);
    procedure SetFieldsDef(const ModuleId: string; SqlId: Integer; Cds: TClientDataSet);
    procedure SetCaptions(form: TForm; const ModuleId: string);
    procedure GetRightsList(const UserId,ModuleId:string;RightsList:TStringList);
    function CheckUser(const UserId,Password:string):Integer;
  end;

var
  dm: Tdm;

implementation

{$R *.dfm}

uses ZLibEx;

procedure tdm.AddParameter(const ParamName: string;
  DataType: TFieldType; Value: OleVariant);
begin
  try
    ParamsADO.Parameters.CreateParameter(ParamName, DataType, pdInput, SizeOf(Value), Value);
  except
    exit;
  end;
end;
{
procedure AddParam(Params: TParams; const ParamName: string;
  DataType: TFieldType; Value: OleVariant);
var
  p: TParam;
begin
  try
    p := Params.CreateParam(DataType, ParamName, ptInput);
    p.Value := Value;
    p.Size := SizeOf(Value);
  except
    exit;
  end;
end;    }

procedure Tdm.ApplyUpdate(const ModuleId: String; SqlId: integer;
  Cds: TClientDataSet);
var
  r:Shortint;
begin
  tryConnect;
  if Cds.State in [dsEdit, dsInsert] then cds.Post;
  if Cds.ChangeCount=0 then exit;
  r :=loader.ApplyUpdate(ModuleId, SqlId, CompressData(Cds.Delta));
  if r=1 then
    Cds.MergeChangeLog
  else raise Exception.Create('post data fail');
end;

function Tdm.ExecSQL(const ModuleId: string; SqlId: integer; haveParams: Boolean=False):Integer;
begin
  tryConnect;
  if haveParams then
    Result := loader.ExecSQL(ModuleId, SqlId, ParametersToVariant(ParamsADO.Parameters))
  else
    Result := loader.ExecSQL(ModuleId, SqlId, Null);
end;

function Tdm.GetData(cds: TClientDataSet; const ModuleId: String;
  SqlId: integer; haveParams: Boolean = False):Boolean;
begin
  tryConnect;
  if haveParams then
    cds.Data := DeCompressData(loader.QryData(ModuleId, SqlId, ParametersToVariant(ParamsADO.Parameters)))
  else
    cds.Data := DeCompressData(loader.QryData(ModuleId, SqlId, null));
  Result :=not cds.IsEmpty;
end;

function Tdm.TryConnect:Boolean;
begin
  Result := False;
  if not self.Conn.Connected then
  begin
    try
      self.Conn.Address:=svrRec.Address;  
      self.Conn.Port:=svrRec.Port;
      Conn.ServerName := svrRec.ServerName;
      self.Conn.Connected:=True;
      Result:=True;
    Except
      on E:Exception do
        raise Exception.Create('串連伺服器失敗'+e.Message);
    end;
  end;
end;

procedure Tdm.GetConfig;
var
  ini: TIniFile;
begin
  ini := TIniFile.Create(ExtractFilePath(Application.ExeName)+'client.ini');
  svrRec.Address := ini.ReadString('server', 'address', '');
  svrRec.Port := ini.ReadInteger('server', 'port', 211);
  svrRec.ServerName := ini.ReadString('server', 'servername', '');
  ini.Free;
end;

procedure Tdm.DataModuleCreate(Sender: TObject);
begin
  GetConfig;
  tryConnect;
end;

function Tdm.Loader: ITestDisp;
begin
  Result := ITestDISP(IDispatch(Conn.Appserver));
end;

function Tdm.GetStoredData(cds: TClientDataSet; const ModuleId: string;
  SqlId: integer;haveParams:Boolean=False):Boolean;
begin
  tryConnect;
  if haveParams then
    cds.Data := DeCompressData(Loader.GetStoredData(ModuleId, SqlId, ParametersToVariant(ParamsADO.Parameters)))
  else
    cds.Data := DeCompressData(Loader.GetStoredData(ModuleId, SqlId, Null));
  Result :=not cds.IsEmpty;
end;

function Tdm.ExecStored(const ModuleId: string; SqlId: integer;haveParams:Boolean=False):Integer;
begin
  tryConnect;
  if haveParams then
    Result := Loader.ExecStored(ModuleId, SqlId, ParametersToVariant(ParamsADO.Parameters))
  else
    Result := Loader.ExecStored(ModuleId, SqlId, Null);
end;

procedure Tdm.DisConn;
begin
  Conn.Close;
end;

procedure Tdm.ClearParameters;
begin
  ParamsADO.Parameters.Clear;
end;

procedure Tdm.SetFieldsDef(const ModuleId: string; SqlId: Integer;
  Cds: TClientDataSet);
var
  tmpCDS: TClientDataSet;
  Field: TField;
  sIndexFieldsName: string;
begin
  tmpCDS := TClientDataSet.Create(self);
  try
    tmpCDS.Data := Loader.GetFieldsDef(ModuleId, SqlId);
    if not tmpCDS.IsEmpty then
    begin
      sIndexFieldsName := '';
      tmpCDS.First;
      while tmpCDS.Eof do
      begin
        Field := Cds.FindField(tmpCDS.Fieldbyname('fieldName').AsString);
        if Assigned(Field) then
        begin
          Field.DisplayLabel := tmpCDS.fieldbyname('cnName').AsString;
          Field.Index := tmpCDS.fieldbyname('index').AsInteger;
          Field.DisplayWidth := tmpCDS.fieldbyname('width').AsInteger;
          Field.ReadOnly := tmpCDS.FieldByName('readOnly').AsBoolean;
          Field.Visible := tmpCDS.FieldByName('visible').AsBoolean;
          Field.Required := tmpCDS.FieldByName('isSave').AsBoolean;
          if tmpCDS.FieldByName('isKey').AsBoolean then
            sIndexFieldsName := sIndexFieldsName + ';' + Field.FieldName;
        end;
        tmpCDS.Next;
      end;
      if Length(sIndexFieldsName) > 1 then
      begin
        sIndexFieldsName := Copy(sIndexFieldsName, 2, Length(sIndexFieldsName));
        Cds.IndexFieldNames := sIndexFieldsName;
      end;
    end;
  finally
    tmpCDS.Free;
  end;
end;

procedure Tdm.DataModuleDestroy(Sender: TObject);
begin
  DisConn;
end;

procedure Tdm.SetCaptions(form: TForm; const ModuleId: string);
begin
  cdsCaption.Data := Loader.GetCaptions(ModuleId);
  if (cdsCaption.Active) and (not cdsCaption.IsEmpty) then
  begin
    cdsCaption.First;
    while not cdsCaption.Eof do
    begin
      TForm(form.FindComponent(cdsCaption.fieldbyname('controlName').AsString)).Caption := cdsCaption.fieldbyname('cnName').AsString;
      cdsCaption.Next;
    end;
  end;
end;

procedure Tdm.ApplyUpdates(const moduleId: string; sqlId: Integer; delta0,
  delta1, delta2, delta3: OleVariant);
begin
  if Loader.ApplyUpdates(moduleId,sqlId,delta0,delta1,delta2,delta3) = 0 then
    raise Exception.Create('post data fail');
end;

procedure Tdm.GetRightsList(const UserId,ModuleId:string;RightsList:TStringList);
var
  i:Integer;
begin
  if UserId ='' then Exit;
  if ModuleId ='' then Exit;
  if not Assigned(RightsList) then Exit;
  cdsRights.Data :=Loader.GetRights(UserId,ModuleId);
  if (cdsRights.IsEmpty) or (cdsRights.FieldCount =0) then exit;
  RightsList.Clear;
  for i :=0 to cdsRights.FieldCount - 1 do
  begin
    if cdsRights.Fields[i].AsBoolean then
      RightsList.Add(cdsRights.Fields[i].FieldName);
  end;
end;

function Tdm.CheckUser(const UserId, Password: string):Integer;
begin
  Result := Loader.CheckUser(UserId,Password);
end;

end.