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_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.

Delphi之MIDAS三層完美解決方案----中間層構建

Power Automate Desktop 安裝完，登錄後老是提示one driver 錯誤

再談23種設計模式（3）：行爲型模式（學習筆記）

微前端學習筆記(4):從微前端到微模塊之EMP與hel-micro方案探索

微前端學習筆記（1）：微前端總體架構概述，從微服務發微

985 碩士程序員，空窗 4 個月沒有 Offer！

一文搞懂 Spring 循環依賴

賽博鬥地主——使用大語言模型扮演Agent智能體玩牌類遊戲。

VScode右鍵打開(添加到右鍵)

記一次 .NET某工控視覺自動化系統卡死分析

WindowsServer--SQL Server搭建主從同步實現讀寫分離 - 事務性分發

分組字符合並SQL語句

一個簡易的加解密字符串函數

軟件在運行期，修改panel的位置與大小

uniGui 出現 [FireDAC][Phys][ODBC][Microsoft][ODBC SQL Server Driver]連接佔線導致另一個 hstmt

delphi bpl插件系統開發

Mac下配置sublime實現LaTeX

https://yachay.unat.edu.pe/blog/index.php?comment_area=format_blog&comment_component=blog&comment_co

linux以太網驅動總結