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

编程技术 同时被 2 个专栏收录
151 篇文章 0 订阅
85 篇文章 1 订阅

思路:中间层与客户端通过三个关键的接口过程进行交互操作(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.

  • 2
    点赞
  • 1
    评论
  • 4
    收藏
  • 一键三连
    一键三连
  • 扫一扫,分享海报

关于本书 本书是针对中高级的专业和准专业的程序开发人员而编写的。全书共分五篇:第一篇简要介绍了分布式结构及Delphi 6对 它的支持;第二篇讲述了分布式组件的实现,篇中分别讲述了DCOM架构的基元&mdash;&mdash;COM的编程基础,创建DCOM客户端用& 务器应用以及COM十分布式应用的开发;第三篇讲了另一种分布式技术CORBA的原理及实现;第四篇讲多层分布式数据库系 统,从数据库的链接讲起,由浅入深地讲了MIDAS的概念,它的DCOM及CORBA的实现方式,最后深入剖析了它的结构;第五 篇讲了分布式Web技术,包括现在流行的 Web技术及 Internet Express的应用。本书的各个部分,都辅之有详尽的例子, 您会一步步学习构建各种分布式应用程序。相信,在仔细研读和亲手实践了这些程序之后,您一定会成为分布式开发的能 手。由于计算机技术的可操作性很强,所以,在本书的学习过程中,希望读者一定要亲手操作,边看书边实践,这样才会 达到更好的学习效果。 第一篇 分布式结构介绍 第1章 分布式结构与多层应用系统概述 1.1 分布式结构简介 1.1.1 现有的分布式结构 1.1.2 各种分布式结构的比较 1.2 分布式结构的优点 1.3 多层应用系统介绍 1.4 分布式应用的意义 1.5 用delphi进行分布式应用程序的开发 1.5.1 delphi 6支持的分布式组件技术 1.5.2 开发midas应用 1.5.3 开发分布式web技术 第二篇 delphi 6的 comidcom/com十编程 第 2章 delphi 6的 com编程基础 2.1 com的概念及特性 2.1.1 com简介 2.1.2 com的特性 2.1.3 com的优点 2.2 创建com对象 2.2.l 规划com对象 2.2.2 com对象向导 2.2.3 automation对象向导 2.2.4 定义接口 2.2.5 注册com对象 2.2.6 测试com服务程序 2.3 对象接口介绍 2.3.l 接口的作用 2.3.2 接口的语法 2.3.3 iunknown接口 2.3.4 接口的实现 2.3.5 接口的引用 2.3.6 双重接口 2.4 type library的使用 2.4.1 type library编辑器介绍 2.4.2 type librny的基本操作 第3章 com的高级技术 3.1 dll中对象的实现 3.1.l 编写dll的一般方法 3.1.2 dll的创建 3.1.3 应用程序的创建 3.2 com接口的实现 3.2.1 tinterfacedobject类的接口实现 3.2.2 tinterfacedobject类的多接口实现 3.3 利用类型库进行com编程 3.3.l typedcomobject类概述 3.3.2 创建dll服务程序 3.3.3 创建客户应用程序 第4章 创建dcom客户端用&务器应用 4.1 dcom系统结构及技术特性 4.1.1 dcom的系统结构 4.1.2 dcom的技术特性 4.1.3 com与dcom的比较 4.2 dcom服务器的创建 4.2.l 创建自动化对象 4.2.2 dcom服务器的安装 4.3 dcom客户程序的创建 第5章 com十分布式应用的开发 5.1 com十系统构架 5.1.1 com十简介 5.1.2 com十的系统构架 5.2 com十组件的开发 5.3 客户应用程序的开发 第三篇 delphi 6的 corba编程 第6章 corba编程基础 6.1 corba技术简介 6.2 coana的基本概念 6.2.1 corba对象 6.2.2 接口定义语言idl 6.2.3 对象请求代理orb 6.2.4 根程序stub和框架程序skeleton 6.3 delphi 6对 corba的支持 6.3.1 visibroker技术 6.3.2 sined agent 6.3.3 corba对象接口的实现 6.4 delphi 6中开发 corba的工具介绍 6.4.1 type librny编辑器 6.4.2 支持coana中的类 6.4.3 corba对象向导 6.4.4 corba数据模块向导 6.4.5 coana clientheerver应用程序 6.5 corba对象向导的使用 6.5.1 解析 corba对象向导 6.5.2 创建corba服务器 6.5.3 创建客户程序 6.6 多线程corba应用的开发 6.6.1 创建支持多线程的corba对象 6.6.2 客户端程序的开发 第7章 高级corba编程 7.1 idl语言基础 7.1.1 一个典型的idl 7.1.2 idl常规术语 7.l.3 idl语法 7.l.4 corba模块 7.2 开发corba高级应用程序 7.3 corba客户端/服务器应用程序向导的使用 7.3.1 idl文件的生成 7.3.2 创建corba服务器 7.3.3 创建corba客户应用程序 第四篇 多层分布式数据库系统midas的开发 第8章 数据库的链接 8.l 数据库的建立 8.2 数据库应用程序的开发步骤 8.3 delphi 6数据库应用开发概述 8.3.1 boriand数据库引擎bde 8.3.2 数据库工具 sql explorer 8.3.3 用bde链接本地数据库的一个简单例子 8. 3. 4 delphi中数据存取总结 8.4 odbc技术 8.4.1 odbc的创建 8.4.2 odbc的概念 8.4.3 odbc解决方案 8.4.4 odbc总体结构 8.5 ado 8.5.1 ado本地数据访问的解决方案 8.5.2 基本的ado编程模型 8.5.3 远程数据访问rds的解决方案 8.5.4 delphi 6中的 tado组件的介绍 8.5.5 一个ado具体的例子 8.6 interbase数据库服务器及ibx组件 8.6.1 inierbase的简要介绍 8.6.2 一个ibx的例子 8.7 多层应用处理数据的一些技巧 8.7.1 数据库链接中的 connection pooling链接技术 8.7.2 多层应用处理数据的原理 8.7.3 处理大型数据集的技巧 第9章 用dcom数据模块来实现基本多层分布式系统 9. l 平滑过渡到h层体系结构 9.2 关于多层应用程序 9&middot;3 delphi 6开发基本多层分布式系统 9.3.1 配置数据库 9.3.2 创建应用服务器 9.3.3 创建客户应用程序 9.4 本地数据库查询操作localquers 9.5 delphi 6开发基本多层分布式系统详解 9.5.1 简单应用服务器程序的具体设置 9.5.2 简单客户端程序的具体设置 第10章 midas的高级应用开发 10.1 在 delphi 6开发 midas三层应用程序 10.1.1 在 delphi 6中创建应用服务器 10.1. 2 在delphi 6中创建客户程序 10.1.3 与应用服务器链接 10.1.4 调用服务器上的接口 10.1.5 在客户端纠错 10. 1.6 更新数据 10.2 midas多层应用程序的开发 10. 2.1 delphi 6中无状态的中间层数据存取 10. 2.2 多层体系结构下的事务 10.2.3 一个基本的midas例子 10.2.4 公文包模式介绍以及具体例子 10.2.5 datapooler技术的例子 10. 3 在 midas中使用 activex 10. 3.1 activex控件开发过程 10.3.2 扩展 activex 10.3.3 注册和安装 10. 3.4 发布 activex 10.3.5 一个 midas的 activexform例子 第11章 用 corba数据模块来实现 midas 11.1 corba数据模块向导介绍 11.2 corba服务器的创建 11.2.1 创建 corba数据模块 11.2.2 添加 corba数据模块组件 11.2.3 运行 coana服务器 11.3 客户程序的创建 11.3.1 程序窗体设计 11.3.2 组件设置 11.3.3 添加代码 11.3.4 运行程序 第五篇 分布式web应用开发 第12章 分布式 web应用开发 12.1 现有 web技术 12.1.1 html技术 12.1.2 javascript技术 12.l.3 asp技术 12.1.4 cgi技术 12.1.5 isapi技术 12.2 用internetexpress开发web分布式应用 12.2.1 delphi 6对传统 web技术的支持 12.2.2 internetexpress工作原理 12.2.3 internetexpress组件介绍 12.2.4 web服务器和 internetexpress的通信 12.2.5 internetexpress实用编程 12.3 开发web服务 12.3.1 web服务概念 12.3.2 web服务协议 12.3.3 web服务应用
©️2021 CSDN 皮肤主题: 大白 设计师:CSDN官方博客 返回首页
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

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

余额充值