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.