http://read.pudn.com/downloads55/sourcecode/app/189290/群星商业通医药连锁经营管理系统/源代码/Components/ckDBClient.pas__.htm

unit ckDBClient; 
 
{=======================================组件说明=========================================== 
1.在BeforeApplyUpdates/BeforeGetParams/BeforeGetRecords/BeforeRowRequest/BeforeExecute 
　之前，将客户端的ID加入到OwnerData参数中传递给应用服务器，使其为客户端做特定的初始化。 
　并且，当在应用服务器的数据集中使用了参数时，原控件不能正确的处理该参数(即无法重建现场)， 
　在此控件中通过将参数传递到应用服务器并使之为特定的客户端还原现场，以保证数据可以正常提交。 
2.将Field must have a value的错误信息转换为中文。 
3.在Post前将字符串字段中的''值(非null)转换为null，以更好的处理外键关联，但条件是该字段的 
　Origin属性必须为';'号。(另：Origin属性是一个在BDE中才会被用到的属性，所以拿来用作它途) 
　 
===========================================================================================} 
 
interface 
 
uses Classes, SysUtils, DB, DBClient, Forms, Variants, IMainFrm; 
 
type 
  TckClientDataSet = Class(TClientDataSet) 
  protected 
    OldOnPostError: TDataSetErrorEvent; 
    procedure MyOnPostError(DataSet: TDataSet; E: EDatabaseError; var Action: TDataAction); 
    procedure DoBeforeApplyUpdates(var OwnerData: OleVariant); override; 
    procedure DoBeforeGetParams(var OwnerData: OleVariant); override; 
    procedure DoBeforeGetRecords(var OwnerData: OleVariant); override; 
    procedure DoBeforeRowRequest(var OwnerData: OleVariant); override; 
    procedure DoBeforeExecute(var OwnerData: OleVariant); override; 
    procedure DoBeforePost; override; 
    procedure DoAfterClose; override; 
    procedure Loaded; override; 
  public 
    constructor Create(AOwner: TComponent); override; 
 
  published 
  end; 
 
procedure Register; 
 
implementation 
 
procedure Register; 
begin 
  RegisterComponents('Data Access', [TckClientDataSet]); 
end; 
 
{ TckClientDataSet } 
 
constructor TckClientDataSet.Create(AOwner: TComponent); 
begin 
  inherited; 
{  if ComponentState<>[csDesigning] then 
    Tag := (Application.MainForm as IMainForm).ClientID;} 
end; 
 
procedure TckClientDataSet.DoBeforeApplyUpdates(var OwnerData: OleVariant); 
var i, k: integer; 
begin 
  if {(Tag>0)and}(RemoteServer<>nil)and not (csDesigning in ComponentState) then begin 
    k := Params.Count; 
    if k>0 then begin 
      OwnerData := VarArrayCreate([0,k], varOleStr); 
      OwnerData[0] := (Application.MainForm as IMainForm).IFmMainEx.ClientID; 
      for i:=0 to k-1 do 
        OwnerData[i+1] := Params.Items[i].Value; 
    end else 
      OwnerData := (Application.MainForm as IMainForm).IFmMainEx.ClientID; 
  end; 
  inherited; 
end; 
 
procedure TckClientDataSet.DoBeforeExecute(var OwnerData: OleVariant); 
begin 
  if {(Tag>0)and}(RemoteServer<>nil)and not (csDesigning in ComponentState) then 
    OwnerData := (Application.MainForm as IMainForm).IFmMainEx.ClientID; 
  inherited; 
 
end; 
 
procedure TckClientDataSet.DoBeforeGetParams(var OwnerData: OleVariant); 
begin 
  if {(Tag>0)and}(RemoteServer<>nil)and not (csDesigning in ComponentState) then 
    OwnerData := (Application.MainForm as IMainForm).IFmMainEx.ClientID; 
  inherited; 
 
end; 
 
procedure TckClientDataSet.DoBeforeGetRecords(var OwnerData: OleVariant); 
begin 
  if {(Tag>0)and}(RemoteServer<>nil)and not (csDesigning in ComponentState) then 
    OwnerData := (Application.MainForm as IMainForm).IFmMainEx.ClientID; 
  inherited DoBeforeGetRecords(OwnerData); 
{  if csLoading in ComponentState then 
    Application.MessageBox('ComponentState include [csLoading]', '', 0); 
  if csReading in ComponentState then 
    Application.MessageBox('ComponentState include [csReading]', '', 0); 
  if csWriting in ComponentState then 
    Application.MessageBox('ComponentState include [csWriting]', '', 0); 
  if csDestroying in ComponentState then 
    Application.MessageBox('ComponentState include [csDestroying]', '', 0); 
  if csDesigning in ComponentState then 
    Application.MessageBox('ComponentState include [csDesigning]', '', 0); 
  if csAncestor in ComponentState then 
    Application.MessageBox('ComponentState include [csAncestor]', '', 0); 
  if csUpdating in ComponentState then 
    Application.MessageBox('ComponentState include [csUpdating]', '', 0); 
  if csFixups in ComponentState then 
    Application.MessageBox('ComponentState include [csFixups]', '', 0); 
  if csFreeNotification in ComponentState then 
    Application.MessageBox('ComponentState include [csFreeNotification]', '', 0); 
  if csInline in ComponentState then 
    Application.MessageBox('ComponentState include [csInline]', '', 0); 
  if csDesignInstance in ComponentState then 
    Application.MessageBox('ComponentState include [csDesignInstance]', '', 0);} 
end; 
 
procedure TckClientDataSet.DoBeforeRowRequest(var OwnerData: OleVariant); 
begin 
  if {(Tag>0)and}(RemoteServer<>nil)and not (csDesigning in ComponentState) then 
    OwnerData := (Application.MainForm as IMainForm).IFmMainEx.ClientID; 
  inherited; 
 
end; 
 
procedure TckClientDataSet.MyOnPostError(DataSet: TDataSet; E: EDatabaseError; 
  var Action: TDataAction); 
const 
  cMsg = '必须在%s字段中输入一个值！'; 
var i: integer; 
    s: String; 
begin 
  s := E.Message; 
  i := AnsiPos('must have a value', s); 
  if i>0 then 
  begin 
    s := Copy(s, 6, i-6); 
    E.Message := Format(cMsg, [s]); 
  end else if E.Message='Key violation.' then 
    E.Message := '主键重复，请不要多次输入相同的记录。'; 
  if Assigned(OldOnPostError) then 
    OldOnPostError(DataSet, E, Action); 
end; 
 
procedure TckClientDataSet.Loaded; 
begin 
  inherited; 
  OldOnPostError := OnPostError; 
  OnPostError := MyOnPostError; 
end; 
 
procedure TckClientDataSet.DoBeforePost; 
var i, k: integer; 
    Field: TField; 
begin 
  inherited; 
  k := self.FieldCount; 
  for i:=0 to k-1 do 
  begin 
    Field := Fields[i]; 
    if (Field is TStringField)and(Field.AsString='') then 
    begin 
      if Field.Origin=';' then//当Origin属性必须为';'号时才将''值(非null)转换为null 
        Field.AsVariant := null; 
    end; 
  end; 
end; 
 
procedure TckClientDataSet.DoAfterClose; 
begin 
  inherited; 
  IndexName := ''; 
end; 
 
end. 
 
 
//此源码由程序太平洋收集整理发布,任何人都可自由转载,但需保留本站信息 
//╭⌒╮┅~ ¤　欢迎光临程序太平洋╭⌒╮ 
//╭⌒╭⌒╮╭⌒╮～╭⌒╮  ︶  ,︶︶ 
//,︶︶︶︶,''︶~~ ,''~︶︶　 ,'' 
//╔　╱◥███◣═╬╬╬╬╬╬╬╬╬╗ 
//╬ ︱田︱田 田 ︱　　　　　　　　　 ╬ 
//╬　　　　　　　http://www.5ivb.net ╬ 
//╬　 ╭○╮●　                   　╬ 
//╬　　/■\/■\　　                  ╬ 
//╬　　 <|　||　   有希望,就有成功！ ╬ 
//╬　　　　　　　　　　　　　　　　　╬ 
//╚╬╬╬╬╬╬╬╬╬╬╗  ╔╬╬╬╬╝ 
// 
//说明： 
//专业提供VB、．NET、Delphi、ASP、PB源码下载 
//包括:程序源码,控件,商业源码,系统方案，开发工具，书籍教程，技术文档