Delphi之MIDAS三层完美解决方案----中间层构建

最新推荐文章于 2023-03-14 17:10:20 发布
最新推荐文章于 2023-03-14 17:10:20 发布
阅读量2.1k 收藏 8
点赞数 2
分类专栏： 编程技术 数据库类

思路：中间层与客户端通过三个关键的接口过程进行交互操作(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_dspName, app_spName: String;  //提交更新的dsp 控件名 调用过程名
  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 self.ComponentCount - 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;
  TmpCDS.CommandText := 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;
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
 begin
  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.

/***********************************************************///
U_RDM.dfm文件

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
    Value = Null
   end
   item
    Name = '@dsp_nm'
    Attributes = [paNullable]
    DataType = ftString
    Size = 50
    Value = Null
   end
   item
    Name = '@spName'
    Attributes = [paNullable]
    DataType = ftString
    Direction = pdInputOutput
    Size = 50
    Value = Null
   end
   item
    Name = '@Pstr1'
    Attributes = [paNullable]
    DataType = ftString
    Direction = pdInputOutput
    Size = 255
    Value = Null
   end
   item
    Name = '@Pstr2'
    Attributes = [paNullable]
    DataType = ftString
    Direction = pdInputOutput
    Size = 255
    Value = Null
   end
   item
    Name = '@Pstr3'
    Attributes = [paNullable]
    DataType = ftString
    Direction = pdInputOutput
    Size = 255
    Value = Null
   end
   item
    Name = '@Chkstr'
    Attributes = [paNullable]
    DataType = ftString
    Direction = pdInputOutput
    Size = 255
    Value = Null
   end>
  Prepared = True
  Left = 386
  Top = 16
 end
 object sp_get_spNm: TADOStoredProc
  Connection = BesConnection
  ProcedureName = 'Bes_S_GetspQuery;1'
  Parameters = <
   item
    Name = '@RETURN_VALUE'
    DataType = ftInteger
    Direction = pdReturnValue
    Precision = 10
    Value = Null
   end
   item
    Name = '@UserID'
    Attributes = [paNullable]
    DataType = ftString
    Size = 50
    Value = Null
   end
   item
    Name = '@dstnm'
    Attributes = [paNullable]
    DataType = ftString
    Size = 50
    Value = Null
   end
   item
    Name = '@spNm'
    Attributes = [paNullable]
    DataType = ftString
    Direction = pdInputOutput
    Size = 50
    Value = Null
   end>
  Left = 386
  Top = 72
 end
 object dsp_get_spQuery: TDataSetProvider
  DataSet = sp_get_Data
  Left = 385
  Top = 126
 end
 object sp_get_Data: TADOStoredProc
  Connection = BesConnection
  CommandTimeout = 800
  Parameters = <>
  Left = 120
  Top = 80
 end
 object sp_exec: TADOStoredProc
  Connection = BesConnection
  CommandTimeout = 500
  Parameters = <>
  Left = 192
  Top = 80
 end
end



/***********************************************************///
/公用单元文件 U_PublicFun.pas
unit U_PublicFun;

interface
uses SysUtils, IniFiles, Forms;

Function EncrypKey(Src:String; Key:String='wtgvkssqyouvkxnn2'):string;
Function UncrypKey(Src:String; Key:String='wtgvkssqyouvkxnn2'):string;
Function GetServerConnetionStr: String;  //获取数据库接字符串
Function UnionStr(const Str1,Str2: String):String;
Function ReplaceSQLSafe(var SQLStr: String): String;
Function GetUnChar: String;  //在表达式中替换连接符 值固定为:'+"'+unchar+'"+'
Function NegToZero(value: Integer): Integer; //如果是负值，则转为0
Function VarCntbool(value: Integer): Boolean; overload;
Function VarCntbool(value: string): Boolean; overload;

const
 Unchar = ' -- '; //多字段之间的连接分隔符
 Pubchar = 'SUPER'; //公用数据编码 或 用户编码
implementation

Function EncrypKey (Src:String; Key:String):string;
var
 KeyLen, KeyPos, offset, SrcPos, SrcAsc, Range :Integer;
 dest :string;
begin
 KeyLen:=Length(Key);
 if KeyLen = 0 then key:='wtgvkssqyouvkxnn2';
 KeyPos:=0;
 Range:=256;
 Randomize;
 offset:=Random(Range);
 dest:=format('%1.2x',[offset]);
 for SrcPos := 1 to Length(Src) do
 begin
  SrcAsc:=(Ord(Src[SrcPos]) + offset) MOD 255;
  if KeyPos < KeyLen then KeyPos:= KeyPos + 1 else KeyPos:=1;
  SrcAsc:= SrcAsc xor Ord(Key[KeyPos]);
  dest:=dest + format('%1.2x',[SrcAsc]);
  offset:=SrcAsc;
 end;
 Result:=Dest;
end;

Function UncrypKey (Src:String; Key:String):string;
var
 KeyLen, KeyPos, offset, SrcPos, SrcAsc, TmpSrcAsc :Integer;
 dest :string;
begin
 KeyLen:=Length(Key);
 if KeyLen = 0 then key:='wtgvkssqyouvkxnn2';
 KeyPos:=0;
 offset:=StrToInt('$'+ copy(src,1,2));
 SrcPos:=3;
 repeat
  try
   SrcAsc:=StrToInt('$'+ copy(src,SrcPos,2));
   if KeyPos < KeyLen Then KeyPos := KeyPos + 1
   else KeyPos := 1;
   TmpSrcAsc := SrcAsc xor Ord(Key[KeyPos]);
   if TmpSrcAsc <= offset then TmpSrcAsc := 255 + TmpSrcAsc - offset
   else TmpSrcAsc := TmpSrcAsc - offset;
   dest := dest + chr(TmpSrcAsc);
   offset:=srcAsc;
   SrcPos:=SrcPos + 2;
  except
  end;
 until SrcPos >= Length(Src);
 Result:=Dest;
end;

{ 获取数据库接字符串   BES96261  2003-11-18 18:50 }
Function GetServerConnetionStr: String;
var tempIni: TIniFile;
begin
  tempIni := TIniFile.Create(ExtractFilePath(Application.ExeName)+'ServerConfig.ini');
  Try
   Result := 'Provider=SQLOLEDB.1;Password='+UncrypKey(tempIni.ReadString('SYSTEM', 'PassWord', ''))+
   ';Persist Security Info=True;User ID='+UncrypKey(tempIni.ReadString('SYSTEM', 'UserID', ''))+
   ';Initial Catalog='+tempIni.ReadString('SYSTEM', 'DBNAME', '')+
   ';Data Source='+tempIni.ReadString('SYSTEM', 'SERVER', '')
  Finally
   tempIni.Free;
  End;
end;

{ 连接字符串，当Str2为空时返回空串  BES96261 2003-11-23 22:10  }
Function UnionStr(const Str1,Str2: String):String;
begin
 If Length(Str2) = 0 then
  Result := ''
 else
  Result := Str1 + ' ' + Str2;
end;

{ 过滤从客户端传来SQL参数中的不安全关键字  BES96261 2003-11-23 10:15  }
Function ReplaceSQLSafe(var SQLStr: String): String;
var S: String;
begin
 S := StringReplace(SQLStr,'--','',[rfReplaceAll, rfIgnoreCase]);
 S := StringReplace(S,'/*','',[rfReplaceAll, rfIgnoreCase]);
 S := StringReplace(S,'Delete ','',[rfReplaceAll, rfIgnoreCase]);
 S := StringReplace(S,'Drop ','',[rfReplaceAll, rfIgnoreCase]);
 S := StringReplace(S,'Exec ','',[rfReplaceAll, rfIgnoreCase]);
 S := StringReplace(S,'Create ','',[rfReplaceAll, rfIgnoreCase]);
 S := StringReplace(S,'Alter ','',[rfReplaceAll, rfIgnoreCase]);
 S := StringReplace(S,'Update ','',[rfReplaceAll, rfIgnoreCase]);
 Result := S;
end;

{ 在表达式中替换连接符   BES96261  2003-12-09 23:21  }
Function GetUnChar: String;
begin
 Result := '+'+QuotedStr(Unchar)+'+';
end;

{ 若数值为负,则转为0输出  BES96261  2003-12-09 23:07 }
Function NegToZero(Value: Integer): Integer;
begin
 If Value < 0 then Result := 0
  else Result := Value
end;

Function VarCntbool(value: Integer): Boolean;
begin
 Result := (value <> 0);
end;

Function VarCntbool(value: string): Boolean;
begin
 If (Trim(value)='') or (Trim(value)='0') then
  Result := False
 else
  Result := True;
end;

end.

aroc_lo
关注
专栏目录
DELPHI中间层
09-25
DELPHI简易中间层
Delphi三层架构中间服务器设计解决方案
12-10
Embarcadero RAD Studio 10 Seattle FDConnection1 + FDQuery1 + DataSetProvider1
ScktSrvr源码 Delphi三层的中间件
gareth_952的博客
11-22 743
delphi三层开发中间件。
delphi三层 源码 中间件 框架【web API】
最新发布
173713873
03-14 1296
delphi 三层 data snap http
Delphi之MIDAS三层完美解决方案
09-09
### Delphi之MIDAS三层完美解决方案 #### 一、MIDAS三层架构概述 MIDAS三层架构是一种用于Delphi应用程序开发的架构模式，它将应用分为客户端、中间层和数据库三个部分，以实现软件的高效管理和维护。这种分层架构...
MIDASv2.3.zip_ADL midas_ADL-MIDAS_DCC-MIDAS_dcc garch MATLAB_d
07-15
估计DCC-MIDAS adl-MIDAS DCC-GARCH
A Visual Attention-based Method to Address the Midas Touch Problem Existing in Gesture-based Interaction
02-10
The “Midas Touch” problem has long been a difficult problem existing in gesture-based interaction. This paper proposes a visual attention-based method to address this problem from the ...
ＭＩＤＡＳ.zip_DCC-MIDAS_midas混频_混频_混频数据_经济建模
09-24
对宏观低频经济数据与微观高频数据进行混频数据建模
Delphi-开发的三层源码
06-06
一个DELPHI研发的三层技术源码。业务逻辑层在中间层实现。欢迎下载。
delphi写的三层框架
03-21
客户端其实只要一个KJInit.exe就行了,在安装完服务器端和数据库后， 在TSS_DataDefine表里可以设置客户端程序自动更新的目录，
delphi三层架构简单实例源码
11-30
delphi三层架构简单实例源码 包括中间件和客户端
delphi 三层 源码 中间件 框架【数据操作】
173713873
03-14 923
datasnap 三层 delphi 中间件
delphi三层中间件 框架【首页】
173713873
03-09 622
delphi源码三层中间件 框架 datasnap
delphi 三层 源码 中间件 框架【发送邮件】
173713873
03-14 493
delphi 发送邮件 三层 datasnap idsmtp
delphi 三层 源码 中间件 框架【企业微信】
173713873
03-13 696
delphi 三层 源码 中间件 框架
咏南中间件支持DELPHI低版本开发的两层程序平稳升级到三层
weixin_34050389的博客
01-08 468
提供DELPHI中间件及中间件集群，有意请联系。 N年前，我们用DELPHI低版本开发的两层程序（比如工厂ERP系统），现在仍然在企业广泛地得到使用，但老系统有些跟不上企业的发展需要了。主要表现在：虽然我们的老系统对企业的业务实现得很好，可以很好地满足企业目前的业务需求，但现在企业要求我们的服务器要能够远程分布式地布署，于是我们自然会想到将原来的两层程序升级为三层，这样无疑将满足企业新的需求。大...
DELPHI三层结构
注重长远 天天积累 cqujsjcyj
05-13 92
  所谓的三层结构简单理解就是：     一个公司小的时候一个领导多个兵，所有一切快速反应     当公司大一点以后，设置多个部门，领导的意见先传达到部门经理然后到兵，兵的意见先到部门经理汇总后再到公司领导     所以问题出在这里：如果一个公司就少数几个人，设置多个部门会是什么后果？         如果公司继续庞大，完全可以采用兵和领导直接汇报方式，这个时候采取“有事奏本，无事退朝”的方式即B...
评论 1
添加红包

请填写红包祝福语或标题

个

红包个数最小为10个

元

红包金额最低5元

当前余额3.43元 前往充值 >
需支付：10.00元
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付元
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明：

1.余额是钱包充值的虚拟货币，按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载，可以购买VIP、付费专栏及课程。

余额充值