Remote Data Module-remote method definition

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: Short int; Delta: OleVariant): Short int; safecall;
Function ExecSQL (const ModuleId: WideString; SqlId: Short int; Params: OleVariant): Short int; safecall;
Function GetStoredData (const ModuleId: WideString; SqlId: Shortint; Params: OleVariant): OleVariant; safecall;
Function ExecStored (const ModuleId: WideString; SqlId: Negative int; Params: OleVariant): Negative int; 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): Random int; safecall;
Function GetCaptions (const ModuleId: WideString): OleVariant; safecall;
Function ChangePassword (const UserId: WideString; const OldPassword: WideString;
Const NewPassword: WideString): cipher int; safecall;
Function CheckUser (const UserId: WideString; const Password: WideString): Random int; 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: Short int; Delta: OleVariant): Short int;
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): argument int;
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 ('leleid'). 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): argument int;
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: levint): 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 ('leleid'). 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 ('leleid'). 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): Random int;
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): Invalid int;
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): vertex int;
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_r1_ B on a. userid = B. userid' +
'Left join sys_rights c on B. rulerid = c. rulerid '+
'Where a. userid =: userid and c. moduleid =: leleid ';
Qry. Parameters. ParamByName ('userid'). Value: = userid;
Qry. Parameters. ParamByName ('leleid'). 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.