远程数据模块远程方法定义

unit uTestSvr;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses
  Windows, Messages, SysUtils, Classes, ComServ, ComObj, VCLCom, DataBkr,
  DBClient, MidServer_TLB, StdVcl, DB, ADODB, Provider, Variants,
  Forms, ThreadComLib;

type
  TsvrDM = class(TRemoteDataModule, ITest)
  private
    { Private declarations }
    function GetSqlCommand(ModuleId: string; SqlId: Integer): string;
  protected
    class procedure UpdateRegistry(Register: Boolean; const ClassID, ProgID: string); override;
    function GetDateTime: TDateTime; safecall;
    function GetDate: TDateTime; safecall;
    function QryData(const ModuleId: WideString; SqlId: ShortInt; Params: OleVariant): OleVariant; safecall;
    function ApplyUpdate(const ModuleId: WideString; SqlId: Shortint; Delta: OleVariant): Shortint; safecall;
    function ExecSQL(const ModuleId: WideString; SqlId: Shortint; Params: OleVariant): Shortint; safecall;
    function GetStoredData(const ModuleId: WideString; SqlId: Shortint; Params: OleVariant): OleVariant; safecall;
    function ExecStored(const ModuleId: WideString; SqlId: Shortint; Params: OleVariant):ShortInt; safecall;
    function DownloadFile(const FileName: WideString): OleVariant; safecall;
    function GetFieldsDef(const ModuleId: WideString; SqlId: Shortint): OleVariant; safecall;
    function ApplyUpdates(const ModuleId: WideString; SqlId: ShortInt; Delta0: OleVariant;
                          Delta1: OleVariant; Delta2: OleVariant; Delta3: OleVariant): Shortint; safecall;
    function GetCaptions(const ModuleId: WideString): OleVariant; safecall;
    function ChangePassword(const UserId: WideString; const OldPassword: WideString;
                            const NewPassword: WideString): Shortint; safecall;
    function CheckUser(const UserId: WideString; const Password: WideString): Shortint; safecall;
    function GetRights(const UserId: WideString; const ModuleId:WideString): OleVariant; safecall;                       
  public
    { Public declarations }
  end;

implementation

uses uMain, ZLibEx, AdoconnectPool, AdoqueryPool, DSPPool, ProcPool, uFun;

{$R *.DFM}

var
  tableList:TStringList;

class procedure TsvrDM.UpdateRegistry(Register: Boolean; const ClassID, ProgID: string);
begin
  if Register then
  begin
    inherited UpdateRegistry(Register, ClassID, ProgID);
    EnableSocketTransport(ClassID);
    EnableWebTransport(ClassID);
  end
  else
  begin
    DisableSocketTransport(ClassID);
    DisableWebTransport(ClassID);
    inherited UpdateRegistry(Register, ClassID, ProgID);
  end;
end;

function TsvrDM.QryData(const ModuleId: WideString; SqlId: ShortInt;
  Params: OleVariant): OleVariant;
var
  conn: TADOConnection;
  qry: TADOQuery;
  dsp: TDataSetProvider;
begin                      
  try
    Result := Null;
    if ModuleId ='' then Exit;
    if SqlId =0 then Exit;
    conn := ConnPool.Lock;
    qry := QryPool.Lock;
    dsp := DSPPooler.Lock;
    try
      qry.Close;
      qry.Connection := conn;
      qry.SQL.Clear;
      qry.SQL.Text := GetSqlCommand(ModuleId, SqlId);
      if Params<>Null then                   // have params
        VariantToParameters(Params, qry.Parameters);
      qry.Open;
      if (qry.Active) and (not qry.IsEmpty) then     // have data
      begin
        dsp.DataSet := qry;
        Result := CompressData(dsp.Data);
      end;
      qry.Close;
    finally
      ConnPool.UnLock(conn);
      QryPool.UnLock(qry);
      DSPPooler.UnLock(dsp);
    end;
  except
    Result :=Null;
    Exit;
  end;
end;

function TsvrDM.ApplyUpdate(const ModuleId: WideString;
  SqlId: Shortint; Delta: OleVariant): Shortint;
const
  sql='Select * from %s where 1<>1';
var
  ErrCount:Integer;
  conn:TADOConnection;
  qry:TADOQuery;
  dsp:TDataSetProvider;
begin
  try
    Result:=0;
    if ModuleId ='' then Exit;
    if SqlId =0 then Exit;
    if Delta = Null then Exit;
    conn := ConnPool.Lock;
    qry:=QryPool.Lock;
    dsp:=DSPPooler.Lock;
    try
      qry.Connection := conn;
      qry.Close;
      qry.SQL.Clear;
      qry.SQL.Text:=Format(sql,[GetSqlCommand(ModuleId,SqlId)]);  // table name
      qry.Open;
      dsp.DataSet := qry;
      dsp.ApplyUpdates(DeCompressData(Delta),0,ErrCount);
      qry.Close;
    finally
      ConnPool.UnLock(conn);
      QryPool.UnLock(qry);
      DSPPooler.UnLock(dsp);
    end;
    Result :=1;
  Except
    Result:=0;
    Exit;
  end;
end;

function TsvrDM.ExecSQL(const ModuleId: WideString; SqlId: Shortint;
  Params: OleVariant): Shortint;
var
  conn:TADOConnection;
  qry:TADOQuery;
begin
  try
    Result := 0;
    if ModuleId ='' then Exit;
    if SqlId =0 then Exit;
    conn:=ConnPool.Lock;
    qry:=QryPool.Lock;
    try
      qry.Close;
      qry.Connection :=conn;
      qry.SQL.Clear;
      qry.SQL.Text := GetSqlCommand(ModuleId, SqlId);
      if Params <>null then                            // have params
        VariantToParameters(Params, qry.Parameters);
      qry.ExecSQL;
      qry.Close;
    finally
      ConnPool.UnLock(conn);
      QryPool.UnLock(qry);
    end;
    Result :=1;
  except
    Result := 0;
    Exit;
  end; 
end;

function TsvrDM.GetDateTime: TDateTime;
begin
  Result := Now;
end;

function TsvrDM.GetSqlCommand(ModuleId: string; SqlId: Integer): string;
var
  conn:TADOConnection;
  qry:TADOQuery;
begin
  try
    Result :='';
    if ModuleId ='' then Exit;
    if SqlId = 0 then Exit;
    conn :=ConnPool.Lock;
    qry:=QryPool.Lock;
    try
      qry.Close;
      qry.Connection :=conn;
      qry.SQL.Clear;
      qry.SQL.Text := 'select sqlcommand from sys_sql where moduleid =:moduleid and sqlid =:sqlid';
      qry.Parameters.ParamByName('moduleid').Value := ModuleId;
      qry.Parameters.ParamByName('sqlid').Value :=SqlId;
      qry.Open;
      if qry.Active and not qry.IsEmpty then            // have data
        Result := qry.fieldbyname('sqlcommand').AsString;
    finally
      ConnPool.Unlock(conn);
      QryPool.UnLock(qry);
    end;
  except
    Result :='';
    Exit;
  end;
end;

function TsvrDM.GetStoredData(const ModuleId: WideString; SqlId: Shortint;
  Params: OleVariant): OleVariant;
var
  conn:TADOConnection;
  stored: TADOStoredProc;
  dsp:TDataSetProvider;
begin
  try
    Result :=Null;
    if ModuleId = '' then Exit;
    if SqlId =0 then Exit;
    conn:=ConnPool.Lock;
    stored :=ProcPooler.Lock;
    dsp:=DSPPooler.Lock;
    try
      Stored.Close;
      Stored.Connection :=conn;
      Stored.ProcedureName := GetSqlCommand(ModuleId, SqlId);   // stored procedure name
      if Params <>Null then                              // have params
        VariantToParameters(Params, Stored.Parameters);
      Stored.Prepared := True;
      Stored.Open;
      if (stored.Active) and (not stored.IsEmpty) then    // have data
      begin
        dsp.DataSet :=stored;
        Result := CompressData(dsp.Data);
      end;
      Stored.Close;
    finally
      ConnPool.UnLock(conn);
      ProcPooler.Unlock(stored);
      DSPPooler.Unlock(dsp);
    end;
  except
    Result :=Null;
    Exit;
  end;
end;

function TsvrDM.ExecStored(const ModuleId: WideString; SqlId: Shortint;
  Params: OleVariant):ShortInt;
var
  conn:TADOConnection;
  stored:TADOStoredProc;
begin
  try
    Result :=0;
    if ModuleId ='' then Exit;
    if SqlId =0 then exit;
    conn :=ConnPool.Lock;
    stored :=ProcPooler.Lock;
    try
      Stored.Close;
      Stored.Connection :=conn;
      Stored.ProcedureName := GetSqlCommand(ModuleId, SqlId);   // stored procedure name
      if Params<>Null then  // have params
        VariantToParameters(Params, Stored.Parameters);
      Stored.ExecProc;
      Stored.Close;
    finally
      ConnPool.UnLock(conn);
      ProcPooler.UnLock(stored);
    end;
    Result :=1;
  except
    Result :=0;
    Exit;
  end;
end;

function TsvrDM.DownloadFile(const FileName: WideString): OleVariant;
var
  v: OleVariant;
begin
  Result :=Null;
  if FileName ='' then exit;
  if not FileExists(ExtractFilePath(Application.ExeName) + 'download\' + FileName) then Exit;
  try
    try
      g_DownStream.Clear;
      g_DownStream.LoadFromFile(FileName);
      StreamToVariant(g_DownStream, v);
      Result := CompressData(v);
    finally
      g_DownStream.Clear;
    end;
  except
    Result :=Null;
    Exit;
  end;
end;

function TsvrDM.GetDate: TDateTime;
begin
  Result :=Date;
end;

function TsvrDM.GetFieldsDef(const ModuleId: WideString;
  SqlId: Shortint): OleVariant;
var
  conn:TADOConnection;
  qry:TADOQuery;
  dsp:TDataSetProvider;
begin
  try
    Result :=Null;
    if ModuleId ='' then Exit;
    if SqlId =0 then Exit;
    conn :=ConnPool.Lock;
    qry:=QryPool.Lock;
    dsp:=DSPPooler.Lock;
    try
      qry.Close;
      qry.Connection :=conn;
      qry.SQL.Clear;
      qry.SQL.Text := 'select fieldname, cnName, moduleid, tablename,'+
        'sqlid, index, width, readonly, visible, iskey, issave '
        +'from sys_FieldsDef where moduleid = :moduleid and sqlid = :sqlid';
      qry.Parameters.ParamByName('moduleid').Value := ModuleId;
      qry.Parameters.ParamByName('sqlid').Value :=SqlId;
      qry.Open;
      if (qry.Active) and (not qry.IsEmpty) then  // have data
      begin
        dsp.DataSet := qry;
        Result := CompressData(dsp.Data);
      end;
      qry.Close;
    finally
      ConnPool.Unlock(conn);
      QryPool.UnLock(qry);
      DSPPooler.UnLock(dsp);
    end;
  except
    Result :=Null;
    Exit;
  end;
end;

function TsvrDM.GetCaptions(const ModuleId: WideString): OleVariant;
var
  conn: TADOConnection;
  qry: TADOQuery;
  dsp: TDataSetProvider;
begin
  try
    Result :=Null;
    if ModuleId ='' then Exit;
    conn :=ConnPool.Lock;
    qry:=QryPool.Lock;
    dsp:=DSPPooler.Lock;
    try
      qry.Close;
      qry.Connection :=conn;
      qry.SQL.Clear;
      qry.SQL.Text := 'select moduleId,controlName,cnName from sys_captions '+
        'where moduleid=:moduleid';
      qry.Parameters.ParamByName('moduleid').Value :=ModuleId;
      qry.Open;
      if (qry.Active) and (not qry.IsEmpty) then   // have data
      begin
        dsp.DataSet := qry;
        Result := CompressData(dsp.Data);
      end;
      qry.Close;
    finally
      ConnPool.Unlock(conn);
      QryPool.UnLock(qry);
      DSPPooler.UnLock(dsp);
    end;
  except
    Result:=Null;
    Exit;
  end;
end;

function TsvrDM.ApplyUpdates(const ModuleId: WideString;sqlId:ShortInt; Delta0,
  Delta1, Delta2, Delta3: OleVariant): Shortint;
const
  sql='Select * from %s where 1<>1'; 
var
  aData: array of OleVariant;
  i:integer;
  conn:TADOConnection;
  qry:TADOQuery;
  dsp:TDataSetProvider;
  errCount:integer;
begin
  try
    Result :=0;
    tableList.Clear;
    tableList.DelimitedText:=GetSqlCommand(ModuleId,sqlid); // table name list
    if tableList.Count = 0 then
    begin
      Result :=0;
      exit;
    end;
    if Delta0 <>Null then
    begin
      SetLength(aData, 1);
      aData[0]:=DeCompressData(Delta0);
    end;
    if Delta1<>Null then
    begin
      SetLength(aData,1);
      aData[1]:=DeCompressData(Delta1);
    end;
    if Delta2<>Null then
    begin
      SetLength(aData,2);
      aData[2]:=DeCompressData(Delta2);
    end;
    if Delta3<>Null then
    begin
      SetLength(aData,3);
      aData[3]:=DeCompressData(Delta3);
    end;
    conn:=ConnPool.Lock;
    qry:=QryPool.Lock;
    dsp:=DSPPooler.Lock;
    conn.BeginTrans;
    try
      try
        qry.Connection := conn;
        dsp.DataSet := qry;
        for i:=Low(adata) to High(adata) do
        begin
          qry.Close;
          qry.SQL.Clear;
          qry.SQL.Text:=Format(sql,[tableList.Strings[i]]);  // table name
          qry.Open;
          if (qry.Active) and (aData[i]<>Null) then
            dsp.ApplyUpdates(aData[i],0,ErrCount);
          qry.Close;
        end;
      finally
        ConnPool.Unlock(conn);
        QryPool.UnLock(qry);
        DSPPooler.UnLock(dsp);
      end;
      conn.CommitTrans;
    except
      Result:=0;
      conn.RollbackTrans;
      Exit;
    end;
    Result :=1;
  except
    Result :=0;
    Exit;
  end;
end;

function TsvrDM.ChangePassword(const UserId, OldPassword,
  NewPassword: WideString): Shortint;
var
  conn:TADOConnection;
  qry:TADOQuery;
begin
  try
    Result :=0;
    if UserId = '' then Exit;
    if OldPassword ='' then exit;
    if NewPassword = '' then Exit;
    if CheckUser(UserId, OldPassword)=0 then Exit;
    conn:=ConnPool.Lock;
    qry:=QryPool.Lock;
    try
      qry.Connection :=conn;
      qry.close;
      qry.SQL.Clear;
      qry.SQL.Text :='update sys_user set password=:password where userid=:userid';
      qry.Parameters.ParamByName('password').Value :=NewPassword;
      qry.Parameters.ParamByName('userid').Value :=UserId;
      qry.ExecSQL;
      qry.Close;
    finally
      ConnPool.Unlock(conn);
      QryPool.UnLock(qry);
    end;
    Result :=1;
  except
    Result :=0;
    Exit;
  end;
end;

function TsvrDM.CheckUser(const UserId, Password: WideString): Shortint;
var
  conn:TADOConnection;
  qry:TADOQuery;
begin
  try
    Result :=0;
    if UserId ='' then Exit;
    if Password ='' then Exit;
    conn :=ConnPool.Lock;
    qry:=QryPool.Lock;
    try
      qry.Connection :=conn;
      qry.Close;
      qry.SQL.Clear;
      qry.SQL.Text :='select userid from sys_user where userid=:userid '+
        'and password=:password and valid=1';
      qry.Parameters.ParamByName('userid').Value := UserId;
      qry.Parameters.ParamByName('password').Value := Password;
      qry.Open;
      if (qry.Active) and (not qry.IsEmpty) then
        Result :=1;
      qry.Close;
    finally
      ConnPool.Unlock(conn);
      QryPool.UnLock(qry);
    end;  
  except
    Result :=0;
    Exit;
  end;
end;

function TsvrDM.GetRights(const UserId: WideString; const ModuleId:WideString): OleVariant;
var
  conn: TADOConnection;
  qry: TADOQuery;
  dsp: TDataSetProvider;
begin                      
  try
    Result := Null;
    if UserId ='' then Exit;
    if ModuleId ='' then Exit;
    conn := ConnPool.Lock;
    qry := QryPool.Lock;
    dsp := DSPPooler.Lock;
    try
      qry.Close;
      qry.Connection := conn;
      qry.SQL.Clear;
      qry.SQL.Text := 'select c.canbrowse,c.caninsert,c.canedit,c.candelete, '+
        'c.canpost,c.canprint,c.canimport,c.canexport,c.canverify '+
        'from sys_user a inner join sys_ruler b on a.userid=b.userid '+
        'left join sys_rights c on b.rulerid=c.rulerid '+
        'where a.userid=:userid and c.moduleid=:moduleid';
      qry.Parameters.ParamByName('userid').Value :=UserId;
      qry.Parameters.ParamByName('moduleid').Value :=ModuleId;
      qry.Open;
      if (qry.Active) and (not qry.IsEmpty) then     // have data
      begin
        dsp.DataSet := qry;
        Result := CompressData(dsp.Data);
      end;
      qry.Close;
    finally
      ConnPool.UnLock(conn);
      QryPool.UnLock(qry);
      DSPPooler.UnLock(dsp);
    end;
  except
    Result :=Null;
    Exit;
  end;
end;

initialization
  TThreadedClassFactory.Create (ComServer, TsvrDM, CLASS_Test,   // create com thread pooling
    ciMultiInstance);
  tableList :=TStringList.Create;
  tableList.Delimiter:=';';
finalization
  FreeAndNil(tableList);

end.