Delphi之MIDAS三层完美解决方案

思路：中间层与客户端通过三个关键的接口过程进行交互操作(GetData,SetData,GetspData)

GetData：获取数据集。客户端传递数据集名称给中间层，中间层根据请求的数据集名称从数据库的配置文件中获取相关信息，与客户的的条件集合一起给合成SQL语句

SetData：提交数据集。客户端传递修改后的数据集Delta与名称给中间层，中间层根据请求的数据集名称从数据库的配置文件中获取相关信息，然后解释Delta并执行相关规则进行数据更新

GetRecStrs：获取下拉列表信息

GetspData：执行存储过程，并返回结果集

ExecProd：执行存储过程，返回提示信息

优点：

因为获取数据与更新数据过程的配置文件在存储在数据库中，那么更改与配置更为灵活，对SQL语句不再存在限据，对权限方面可进行更格的控制(达到录入记录控制)

数据提交时使用自定义更新过程，无论从速度、控制、安全等方面来说，都不是一件坏事(能使用附加工具快速生成标准的存储过程与配置信息)

维护简单，更新业务逻辑时仅需更新相应的存储过程中，无需更改中间层与客户端

能应付多变的系统开发过程，即使系统的流程或逻辑发生重大变更修改也相当简单，尤其是在需求不是相当明确的时候(有几个系统在上线实施之前能做到需求明细呢？^_^)

缺点：

即使系统再简单，若仅存在一个窗体的话，也必须将基类架设完整，与书本上一般开发过程存在差异，新手需一周左右时候才能上手

中间层代码：

/////***********************************************************///

/////单元文件U_RDM.pas

unit U_RDM;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses

Windows, Messages, SysUtils, Classes, ComServ, ComObj, VCLCom, DataBkr, DBClient, MRPManange_TLB, StdVcl, DB, ADODB, Provider, Variants, StrUtils;

type

THPMRP = class(TRemoteDataModule, IHPMRP)

sp_Pub_Ref: TADOStoredProc;

get_Q_RecStrs: TADOQuery;

BesConnection: TADOConnection;

TmpCDS: TClientDataSet;

tmpdsp: TDataSetProvider;

Q_tmp: TADOQuery;

sp_get_apply: TADOStoredProc;

sp_get_spNm: TADOStoredProc;

dsp_get_spQuery: TDataSetProvider;

sp_get_Data: TADOStoredProc;

sp_exec: TADOStoredProc;

procedure RemoteDataModuleCreate(Sender: TObject);

private { Private declarations }

app_ChkNull, app_ParameStr, app_ParamSet: WideString; //不为空约束，更新参数

Procedure LoginServer;

Function GetSQL(UserID, dstNm, Corp_No, Cust_No, swhExpr: WideString; ParamStr: OleVariant): WideString; //取数据语句

Function CannotNull(FieldStr: String; DeltaDS:TCustomClientDataSet; UpdKind: String=''): String; //不为空校验

Function UpdKindStr(var Kind: TUpdateKind): String; //数据更改的状态：Ins, Upd, Del

Function SetspParam(spName:String; DeltaDS:TCustomClientDataSet; //存储过程更新数据

ParameStr,ParamSet:WideString; UpdKind: String=''): WideString;

procedure PubBeforeUpdateRecord(Sender: TObject; //数据提交公用过程

SourceDS: TDataSet; DeltaDS: TCustomClientDataSet;

UpdateKind: TUpdateKind; var Applied: Boolean);

Function SetspParameters(UserID, dstNm: String; ParamStr: OleVariant; run_sp_Nm: TADOStoredProc): Boolean;

Function varTypeCntInt(varType: TDataType): Integer;

protected

class procedure UpdateRegistry(Register: Boolean; const ClassID, ProgID: string); override;

procedure GetRecStrs(const UserID, Corp_No, TabName, ColName,

ExprStr: WideString; out RstStrs: OleVariant); safecall;

function GetData(const UserID, dstNm, Corp_No, Cust_No: WideString;

ParamStr: OleVariant; const sExpr: WideString): OleVariant; safecall;

function SetData(const UserID, dstNm, ParamStr: WideString;

vData: OleVariant): OleVariant; safecall;

function GetAuth(const UserID, dstNm, GrpTyp: WideString): OleVariant;

safecall;

function GetspData(const UserID, dstNm: WideString;

ParamStr: OleVariant): OleVariant; safecall;

procedure GetColStrs(const UserID, Corp_No, TabName, ColName,

ExprStr: WideString; out RstStrs: OleVariant); safecall;

function ExecProc(const UserID, Corp_No, dstNm: WideString;

ParamStr: OleVariant): Shortint; safecall;

public { Public declarations }

end;

implementation

uses U_PublicFun, U_MRPServer;

{$R *.DFM}

class procedure THPMRP.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;

{ 创建数据模块数据库连接 BES96261 }

Procedure THPMRP.LoginServer;

begin

BESConnection.Connected := False;

BESConnection.ConnectionString := GetServerConnetionStr;

BESConnection.Connected := True;

end;

procedure THPMRP.RemoteDataModuleCreate(Sender: TObject);

var I: Integer;

begin

LoginServer;

{ 使用自定义更新过程 }

For I := 0 to https://www.360docs.net/doc/8f293203.html,ponentCount - 1 do

begin

If (Components[I] is TDataSetProvider) and (Components[I].Tag = 100) then

(Components[I] as TDataSetProvider).BeforeUpdateRecord := PubBeforeUpdateRecord; end;

end;

{ 根据条件返回指定列字段数据 BES96261 }

procedure THPMRP.GetRecStrs(const UserID, Corp_No, TabName, ColName,

ExprStr: WideString; out RstStrs: OleVariant);

var sSQL, sExpr: String;

I: Integer;

begin

sExpr := ExprStr;

If Trim(sExpr) <> '' then sExpr := ' where '+sExpr;

sSQL := Format('select %s from %s'+sExpr,[ColName,TabName,ExprStr]);

with get_Q_RecStrs do

begin

Close;

SQL.Clear;

SQL.Add(StringReplace(ReplaceSQLSafe(sSQL),',',GetUnChar,[rfReplaceAll]));

Open;

RstStrs := VarArrayCreate([0,NegToZero(RecordCount-1)],VarOleStr);

I := 0;

First;

while not Eof do

begin

RstStrs[I] := Fields[0].AsString;

Inc(I);

Next;

end;

Close;

end;

end;

{ 根据用户及条件提取相关需求数据 BES96261

UserID: 用户编码

dstNm: 需求数据集名称

Corp_No: 公司编码

Cust_No 客户编码(提取指定客户的数据)

ParamStr: 条件值的集合，使用'@' 作分隔符

sExpr: 前台传来的附带查询条件的SQL语句 }

function THPMRP.GetData(const UserID, dstNm, Corp_No, Cust_No: WideString; ParamStr: OleVariant; const sExpr: WideString): OleVariant;

begin

Try

TmpCDS.Close;

https://www.360docs.net/doc/8f293203.html,mandText := GetSQL(UserID,dstNm,Corp_No,Cust_No,sExpr,ParamStr);

TmpCDS.Open;

Result := TmpCDS.Data;

Finally

TmpCDS.Close;

End;

end;

{ 根据用户和请求的数据及条件返回取值SQL语句 BES96261 }

Function THPMRP.GetSQL(UserID, dstNm, Corp_No, Cust_No, swhExpr: WideString; ParamStr: OleVariant): WideString;

var sSQL, sExpr, sCrpExpr, sCstExpr: String;

I: Integer;

{ sSQL: 最终组合的SQL语句

sExpr: 数据库表中的指定条件，通常为主从连接

sCrpExpr: 提取指定公司的数据条件

sCstExpr: 提取指定客户的数据条件

}

begin

If Trim(UserID) = '' then UserID := U_PublicFun.Pubchar;

//临时赋值{ ------------------------ }

UserID := 'SUPER';

sSQL := Format('select * from Sys_GetData where UserID=%s and FrmNm=%s',

[Quotedstr(UserID),Quotedstr(dstNm)]);

with get_Q_RecStrs do

begin

Close;

SQL.Clear;

SQL.Add(ReplaceSQLSafe(sSQL));

Open;

sSQL := '';

If RecordCount <> 0 then

begin

If (not VarIsArray(ParamStr)) or (VarArrayHighBound(ParamStr,1) < 0) then sExpr := ''

else sExpr := FieldByName('Expr').AsString;

{ 根据条件初始化SQL语句将条件中的参数变量具体化 }

I := 0;

while Pos('@',sExpr)<>0 do

begin

if VarIsArray(ParamStr) and (VarArrayHighBound(ParamStr,1)>= I) then

sExpr := StringReplace(sExpr,'@',ParamStr[I],[rfIgnoreCase])

else sExpr := StringReplace(sExpr,'@',QuotedStr('0'),[rfIgnoreCase]);

Inc(I);

end;

{ 客户权限 }

sCstExpr := FieldByName('CstExpr').AsString;

If Trim(sCstExpr) <> '' then

sCstExpr := StringReplace(sCstExpr,'@Cust_No',QuotedStr(Cust_No),[rfIgnoreCase])

else

sCstExpr := '';

//公司权限

sCrpExpr := FieldByName('CrpExpr').AsString;

If Trim(sCrpExpr) <> '' then

sCrpExpr := StringReplace(sCstExpr,'@Corp_No',QuotedStr(Corp_No),[rfIgnoreCase])

else

sCrpExpr := '';

//处理附带的SQL条件表达式

If Trim(swhExpr) <> '' then

begin

If (UpperCase(LeftStr(Trim(swhExpr),2)) <> 'OR') and (UpperCase(LeftStr(Trim(swhExpr),3)) <> 'AND') then

begin

If Trim(sExpr+sCstExpr+sCrpExpr)<>'' then swhExpr := ' And '+swhExpr

else swhExpr := ' where '+swhExpr;

end else

begin

If Trim(sExpr+sCstExpr+sCrpExpr) ='' then swhExpr := ' where 1=1 '+swhExpr;

end;

end;

{ 生成SQL语句 }

sSQL := 'Select '+FieldByName('MaxRec').AsString+' '+FieldByName('ColNm').AsString+ ' '+FieldByName('TabNm').AsString+

' '+sExpr+' '+sCrpExpr+' '+ sCstExpr+' '+swhExpr +

' '+FieldByName('OrdSQL').AsString;

end;

Close;

end;

Result := sSQL;

end;

{ 校验字段是否为空BES96261 }

Function THPMRP.CannotNull(FieldStr: String; DeltaDS:TCustomClientDataSet; UpdKind: String=''):String; var I:Integer;

FieldNm, VisField:String; //Field Name

begin

Result := '';

If UpdKind = 'Del' then Exit;

If Trim(FieldStr)='' then Exit;

While Trim(FieldStr)<>'' do

begin

I:=Pos(';',FieldStr);

If I<=0 then

begin

FieldNm := FieldStr;

FieldStr := '';

end else

begin

FieldNm := Copy(FieldStr,1,I-1);

FieldStr := Copy(FieldStr,I+1,Length(FieldStr)-I);

End;

VisField := Copy(FieldNm,Pos(',',FieldNm)+1,length(FieldNm)-Pos(',',FieldNm));

FieldNm := Trim(Copy(FieldNm,1,Pos(',',FieldNm)-1));

If (VarIsEmpty(DeltaDS.FieldByName(FieldNm).NewValue) or

(VarToStr(DeltaDS.FieldByName(FieldNm).NewValue) = ''))

and ((UpdKind='Ins') or ((UpdKind='Upd') and VarIsEmpty(DeltaDS.FieldByName(FieldNm).OldValue))) then

begin

Result := 'Please input '+quotedstr(VisField)+' value.';

Exit;

End;

End;

end;

{ 使用存储过程更新数据集时赋相应参数值 BES96261

spName: 需调用的更新存储过程名

DeltaDS: 需更新的数据集

ParmaeStr: 存储过程参数名及对应的取值字段名

ParameSet: 存储过程参数名及对应的取(Oldvalue)值字段名，用于关键字

UpdKind: 数据更新类型 --修改，新增，删除}

Function THPMRP.SetspParam(spName:String; DeltaDS:TCustomClientDataSet;

ParameStr,ParamSet:WideString; UpdKind: String=''): WideString;

var I: Integer;

S, ParamName,FieldName: String;

begin

If Trim(ParameStr) = '' then Exit;

{ 获取存储过程名及相关参数}

sp_pub_ref.ProcedureName := spName;

sp_pub_ref.Parameters.Refresh;

{ 根据参数名赋需更新数据集对应字段值 }

While Trim(ParameStr) <> '' do

begin

I := Pos(';',ParameStr);

If I <= 0 then

begin

S := ParameStr;

ParameStr := '';

end else

begin

S := Copy(ParameStr,1,I-1);

ParameStr := Copy(ParameStr,I+1,Length(ParameStr)-I);

End;

ParamName := Trim(Copy(S,1,Pos(',',S)-1));

FieldName := Trim(Copy(S,Pos(',',S)+1,length(S)-Pos(',',S)));

if FieldName = '-' then FieldName := Trim(copy(ParamName,2,length(ParamName)-1));

if (VarIsEmpty(DeltaDS.FieldByName(FieldName).NewValue) and (UpdKind<>'Ins')) or (UpdKind='Del') then

sp_pub_ref.Parameters.ParamByName(ParamName).Value :=

DeltaDS.FieldByName(FieldName).OldValue

else

sp_pub_ref.Parameters.ParamByName(ParamName).Value :=

DeltaDS.FieldByName(FieldName).NewValue;

End; //end while

{ 赋数据更新类型值}

if Trim(UpdKind) <> '' then

sp_pub_ref.Parameters.ParamByName('@UpdateKind').Value := UpdKind;

{ 根据关键字参数名赋所对应Old值 }

While Trim(ParamSet) <> '' do

begin

I := Pos(';',ParamSet);

If I <= 0 then

begin

S := ParamSet;

ParamSet := '';

end else

begin

S := Copy(ParamSet,1,I-1);

ParameStr := Copy(ParamSet,I+1,Length(ParamSet)-I);

End;

ParamName := Trim(Copy(S,1,Pos(',',S)-1));

FieldName := Trim(Copy(S,Pos(',',S)+1,length(S)-Pos(',',S)));

if FieldName = '-' then FieldName := Trim(copy(ParamName,2,length(ParamName)-1));

sp_pub_ref.Parameters.ParamByName(ParamName).Value := DeltaDS.FieldByName(FieldName).OldValue End; //end while

sp_pub_ref.ExecProc;

Result := sp_pub_ref.Parameters.ParamByName('@rststr').Value;

end;

{ 根据数据集更新状态返加对应的字符串BES96261 }

Function THPMRP.UpdKindStr(var Kind: TUpdateKind): String;

begin

if Kind = ukModify then Result := 'Upd';

if Kind = ukInsert then Result := 'Ins';

if Kind = ukDelete then Result := 'Del';

end;

{ 数据公用更新过程 BES96261 2003-12-25 17:02 }

procedure THPMRP.PubBeforeUpdateRecord(Sender: TObject;

SourceDS: TDataSet; DeltaDS: TCustomClientDataSet;

UpdateKind: TUpdateKind; var Applied: Boolean);

var sMsg, spName: String;

ChkNull, ParameStr, ParamSet:WideString;

UpdKind: ShortString;

begin

spName := app_spName;

ParameStr := app_ParameStr;

ParamSet := app_ParamSet;

ChkNull := app_ChkNull;

sMsg := '';

UpdKind := UpdKindStr(UpdateKind);

{ 不为空检测 }

sMsg := CannotNull(ChkNull, DeltaDS, UpdKind);

if Trim(sMsg) <> '' then //

raise Exception.Create(IntToStr(DeltaDS.RecNo) + Unchar + UpdKind + Unchar + sMsg); { 数据更新 }

If Trim(sMsg) = '' then

begin

sMsg := SetspParam(spName,DeltaDS,ParameStr,ParamSet,UpdKind);

if Trim(sMsg) <> '' then //

raise Exception.Create(IntToStr(DeltaDS.RecNo) + Unchar + UpdKind + Unchar + sMsg); end;

Applied := True;

end;

{ 数据公用提交过程 BES96261

UserID: 用户编码，用以权限判断

dstNm: 提交的功能数据集

Parmastr: 更新参数

vData: 需更新的数据集

Result: 更新过程中需返回的列表}

function THPMRP.SetData(const UserID, dstNm, ParamStr: WideString;

vData: OleVariant): OleVariant;

var ErrCount: Integer;

begin

If GetAuth(UserID,dstNm,'Apply') = 1000 then

begin

{ 此次更新与上次更新数据集不相同则从后台取更新数据参数值 }

If dstNm <> app_dspName then

begin

app_dspName := dstNm;

with sp_get_apply do

begin

Close;

Parameters.ParamByName('@dsp_nm').Value := app_dspName;

ExecProc;

app_spName := Parameters.ParamByName('@spName').Value;

app_ParameStr :=

Parameters.ParamByName('@Pstr1').Value+Parameters.ParamByName('@Pstr2').Value;

app_ParamSet := Parameters.ParamByName('@Pstr3').Value;

app_ChkNull := Parameters.ParamByName('@Chkstr').Value;

end;

end;

Result := tmpdsp.ApplyUpdates(vData,-1,ErrCount);

end;

{ 操作数据集时权限判断BES96261 }

function THPMRP.GetAuth(const UserID, dstNm, GrpTyp: WideString): OleVariant; begin

Result := 1000;

end;

{ 使用存储过程查询，并返回结果值 BES96261 }

function THPMRP.GetspData(const UserID, dstNm: WideString;

ParamStr: OleVariant): OleVariant;

begin

FrmServer.Memo1.Lines.Add(UserID + '---' + dstNm);

{ Open Query and Result Data}

If SetspParameters(UserID, dstNm, ParamStr, sp_get_Data) then

begin

sp_get_Data.Open;

Result := dsp_get_spQuery.Data;

sp_get_Data.Close;

end;

end;

{ 执行存储过程，无结果集返回 }

function THPMRP.ExecProc(const UserID, Corp_No, dstNm: WideString; ParamStr: OleVariant): Shortint;

begin

Result := -1;

FrmServer.Memo1.Lines.Add(UserID + '---Exec Procedure---' + dstNm);

{ Exec Procedure }

If SetspParameters(UserID, dstNm, ParamStr, sp_exec) then

sp_exec.ExecProc;

Result := 1;

end;

end;

{ 执行存储过程或通过存储过程查询数据时设置存储过程参数 BES96261 } Function THPMRP.SetspParameters(UserID, dstNm: String; ParamStr: OleVariant; run_sp_Nm: TADOStoredProc): Boolean;

var spNm: String; //存储过程名称

I: Integer;

begin

Result := False;

If Trim(dstNm) = '' then Exit;

If GetAuth(UserID,dstNm,'Query') <> 1000 then Exit;

with sp_get_spNm do

begin

Close;

Parameters.ParamByName('@UserID').Value := UserID;

Parameters.ParamByName('@dstnm').Value := dstNm;

ExecProc;

spNm := Parameters.ParamByName('@spNm').Value;

end;

If Trim(spNm) = '' then Exit;

{ Exec Proc }

run_sp_Nm.Close;

run_sp_Nm.ProcedureName := spNm;

run_sp_Nm.Parameters.Refresh;

If not varIsNull(ParamStr) and VarIsArray(ParamStr) then

begin

For I:=0 to VarArrayHighBound(ParamStr,1) do

begin

case varTypeCntInt(run_sp_Nm.Parameters[I+1].DataType) of

2: run_sp_Nm.Parameters[I+1].Value := StrToFloat(ParamStr[I]);

3: run_sp_Nm.Parameters[I+1].Value := VarCntbool(ParamStr[I]);

else run_sp_Nm.Parameters[I+1].Value := ParamStr[I];

end;

FrmServer.Memo1.Lines.Add(ParamStr[I]);

end; //end for

end;

Result := True;

end;

{ 判数参数类型 }

Function THPMRP.varTypeCntInt(varType: TDataType): Integer;

begin

Case varType of

ftString, ftDate, ftTime, ftDateTime, ftWideString,ftFixedChar :

Result := 1;

ftSmallint, ftInteger, ftWord, ftFloat, ftCurrency, ftBCD, ftLargeint,

ftBytes, ftVarBytes :

Result := 2;

ftBoolean : Result := 3;

else

Result := 1;

end;

end;

{ 根据条件返回指定列字段数据BES96261 } procedure THPMRP.GetColStrs(const UserID, Corp_No, TabName, ColName,

ExprStr: WideString; out RstStrs: OleVariant);

var sSQL, sExpr: String;

I: Integer;

begin

sExpr := ExprStr;

If Trim(sExpr) <> '' then sExpr := ' where '+sExpr;

sSQL := Format('select %s from %s'+sExpr,[ColName,TabName,ExprStr]); with get_Q_RecStrs do

begin

Close;

SQL.Clear;

SQL.Add(sSQL);

Open;

RstStrs := VarArrayCreate([0,NegToZero(Fields.Count-1)],VarOleStr);

If RecordCount > 0 then

begin

For I := 0 to Fields.Count - 1 do

RstStrs[I] := Fields[I].AsString;

end;

Close;

end;

end;

initialization

TComponentFactory.Create(ComServer, THPMRP,

Class_HPMRP, ciMultiInstance, tmFree);

end.

/////***********************************************************///

object HPMRP: THPMRP OldCreateOrder = False

OnCreate = RemoteDataModuleCreate Left = 196

Top = 124

Height = 203

Width = 481

object sp_Pub_Ref: TADOStoredProc

Connection = BesConnection

Parameters = <>

Left = 32

Top = 80

end

object get_Q_RecStrs: TADOQuery

Connection = BesConnection

Parameters = <>

Left = 112

Top = 16

end

object BesConnection: TADOConnection ConnectionTimeout = 5

LoginPrompt = False

Provider = 'SQLOLEDB.1'

Left = 32

Top = 16

end

object TmpCDS: TClientDataSet

Aggregates = <>

Params = <>

ProviderName = 'tmpdsp'

Left = 192

Top = 16

end

object tmpdsp: TDataSetProvider

Tag = 100

DataSet = Q_tmp

Options = [poAllowCommandText] UpdateMode = upWhereKeyOnly

Left = 240

Top = 16

end

object Q_tmp: TADOQuery

Connection = BesConnection

CursorType = ctStatic

Parameters = <>

SQL.Strings = (

'')

Left = 288

Top = 16

end

object sp_get_apply: TADOStoredProc Connection = BesConnection ProcedureName = 'Bes_S_GetApplyParame;1' Parameters = <

item

Name = '@RETURN_VALUE'

DataType = ftInteger

Direction = pdReturnValue

Precision = 10