ckdbclient.pas

群星医药系统源码

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.