hmclientdataset.pas

Delphi三层原代码掩饰及补丁

unit hmClientDataSet;

interface

uses
  Windows, Messages, SysUtils, Classes, DB, DBClient, Variants, hmOleVariant, Dialogs, hmUniKey,
  hmStatusIntf, hmOleDataSet;

type
  TOnLoadOleData = procedure(Sender: TObject; Name: WideString) of object;

type
  THMOleClientDataSet = class(THMCustomOleClientDataSet)
  protected
    function GetData: OleVariant; override; safecall;
    procedure SetData(Value: OleVariant); override; safecall;
  public
    procedure LoadData; override; safecall;
    procedure LoadDataEx(var Data: OleVariant); override; safecall;
    procedure LoadOleData(Name: Widestring); override; safecall;
  end;

  THMClientDataSet = class(TClientDataSet)
  private
    Msg: OleVariant;
    FOle: THMOleVariant;
    FIDataSet: THMOleClientDataSet;
    FOnLoadOleData: TOnLoadOleData;
    FDemoActive: Boolean;
    FDemoView: integer;
    function GetNotEmpty: Boolean;
    function GetEmpty: Boolean;
    function GetDV(index: string): TDatetime;
    function GetFV(index: string): Double;
    function GetIV(index: string): Integer;
    function GetSV(index: string): string;
    procedure SetDV(index: string; const Value: TDatetime);
    procedure SetFV(index: string; const Value: Double);
    procedure SetIV(index: string; const Value: Integer);
    procedure SetSV(index: string; const Value: string);
    function GetBV(index: string): Boolean;
    procedure SetBV(index: string; const Value: Boolean);
    function GetLastMsg: string;
    function GetIDataSet: IHMOleClientDataSet;
    procedure SetDemoActive(const Value: Boolean);
  protected
    { Protected declarations }
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure BeginOle;
    function OpenView(ViewIndex: integer): Boolean;
    function OpenStoreProc(StoreProcIndex: integer): Boolean;
    function OpenData(ModuleIndex: integer): Boolean;
    function CheckNullField(FieldName: string): Boolean;

    procedure SetUniKey(FieldName: string; CheckNull: Boolean = True);

    property LastMsg: string read GetLastMsg;
    property Ole: THMOleVariant read FOle;
    property NotEmpty: Boolean read GetNotEmpty;
    property Empty: Boolean read GetEmpty;
    property SV[index: string]: string read GetSV write SetSV;
    property DV[index: string]: TDatetime read GetDV write SetDV;
    property IV[index: string]: Integer read GetIV write SetIV;
    property FV[index: string]: Double read GetFV write SetFV;
    property BV[index: string]: Boolean read GetBV write SetBV;
    property IDataSet: IHMOleClientDataSet read GetIDataSet;
  published
    property DemoView: integer read FDemoView write FDemoView;
    property DemoActive: Boolean read FDemoActive write SetDemoActive;
    property OnLoadOleData: TOnLoadOleData read FOnLoadOleData write FOnLoadOleData;
  end;

  THMClientCommand = class(TComponent)
  private
    Msg: OleVariant;
    FOle: THMOleVariant;
    FRemoteServer: TCustomRemoteServer;
    FAutoShowMessage: Boolean;
    FData: OleVariant;
    procedure SetAutoShowMessage(const Value: Boolean);
    function GetLastMsg: string;
  protected
    { Protected declarations }
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure BeginOle;
    function Execute(ModuleIndex: integer): Boolean;
    function ExecuteStoreProc(Index: integer): Boolean;
    function ApplyUpdates: Boolean; overload;
    function ApplyUpdates(DataSet: TClientDataSet; TableName: string; KeyField: string): Boolean; overload;
    property LastMsg: string read GetLastMsg;
    property Data: OleVariant read FData;
    property Ole: THMOleVariant read FOle;
  published
    property AutoShowMessage: Boolean read FAutoShowMessage write SetAutoShowMessage;
    property RemoteServer: TCustomRemoteServer read FRemoteServer write FRemoteServer;
  end;

implementation

{ THMClientDataSet }

procedure THMClientDataSet.BeginOle;
begin
  Ole.Clear;
end;

function THMClientDataSet.CheckNullField(FieldName: string): Boolean;
begin
  Result := FieldByName(FieldName).IsNull;
end;

constructor THMClientDataSet.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Msg := Null;
  FOle := THMOleVariant.Create;
  FIDataSet := THMOleClientDataSet.Create(Self);
end;

destructor THMClientDataSet.Destroy;
begin
  FOle.Free;
  FIDataSet.Free;
  inherited Destroy;
end;

function THMClientDataSet.GetBV(index: string): Boolean;
begin
  Result := FieldByName(index).AsBoolean;
end;

function THMClientDataSet.GetDV(index: string): TDatetime;
begin
  if FieldByName(Index).IsNull then
    Result := 0
  else
    Result := FieldByName(index).AsDateTime;
end;

function THMClientDataSet.GetEmpty: Boolean;
begin
  Result := not GetNotEmpty;
end;

function THMClientDataSet.GetFV(index: string): Double;
begin
  if FieldByName(Index).IsNull then
    Result := 0.00
  else
    Result := FieldByName(index).AsFloat;
end;

function THMClientDataSet.GetIDataSet: IHMOleClientDataSet;
begin
  Result := FIDataSet;
end;

function THMClientDataSet.GetIV(index: string): Integer;
begin
  if FieldByName(Index).IsNull then
    Result := 0
  else
    Result := FieldByName(Index).AsInteger;
end;

function THMClientDataSet.GetLastMsg: string;
begin
  Result := VarToStr(Msg);
end;

function THMClientDataSet.GetNotEmpty: Boolean;
begin
  Result := Active and (RecordCount > 0)
end;

function THMClientDataSet.GetSV(index: string): string;
begin
  if FieldByName(Index).IsNull then
    Result := ''
  else
    Result := FieldByName(index).AsString;
end;

function THMClientDataSet.OpenData(ModuleIndex: integer): Boolean;
var
  vParam, vData: OleVariant;
begin
  if Assigned(RemoteServer) then
    begin
      Ole.SaveToOle(vParam);
      Result := RemoteServer.AppServer.DataModule(ModuleIndex, vParam, vData, Msg);
      if Result then
        begin
          Self.Active := False;
          Self.Data := vData;
          Self.Active := True;
        end
      else
        ShowMessage(VarToStr(Msg));
    end
  else
    raise Exception.Create('RemoteServer not Assigned');
end;

function THMClientDataSet.OpenStoreProc(StoreProcIndex: integer): Boolean;
var
  vParam, vData: OleVariant;
begin
  if Assigned(RemoteServer) then
    begin
      Ole.Action := 902;
      Ole.StoreProcIndex := StoreProcIndex;
      Ole.SaveToOle(vParam);
      Result := RemoteServer.AppServer.DefaultModule(vParam, vData, Msg);
      if Result then
        begin
          Self.Active := False;
          Self.Data := vData;
          Self.Active := True;
        end
      else
        ShowMessage(VarToStr(Msg));
    end
  else
    raise Exception.Create('RemoteServer not Assigned');
end;

function THMClientDataSet.OpenView(ViewIndex: integer): Boolean;
var
  vParam, vData: OleVariant;
begin
  if Assigned(RemoteServer) then
    begin
      Ole.Action := 901;
      Ole.ViewIndex := ViewIndex;
      Ole.SaveToOle(vParam);
      Result := RemoteServer.AppServer.DefaultModule(vParam, vData, Msg);
      if Result then
        begin
          Self.Active := False;
          Self.Data := vData;
          Self.Active := True;
        end
      else
        ShowMessage(VarToStr(Msg));
    end
  else
    raise Exception.Create('RemoteServer not Assigned');
end;

procedure THMClientDataSet.SetBV(index: string; const Value: Boolean);
begin
  FieldByName(index).AsBoolean := Value;
end;

procedure THMClientDataSet.SetDemoActive(const Value: Boolean);
begin
  if (FDemoView > 0) and Value and (csDesigning in ComponentState) then
    begin
      Self.OpenStoreProc(FDemoView);
      FDemoActive := Active;
    end
  else
    begin
      if Active then Close;
      FDemoActive := False;
    end;
end;

procedure THMClientDataSet.SetDV(index: string; const Value: TDatetime);
begin
  FieldByName(index).AsFloat := Value;
end;

procedure THMClientDataSet.SetFV(index: string; const Value: Double);
begin
  FieldByName(index).AsFloat := Value;
end;

procedure THMClientDataSet.SetIV(index: string; const Value: Integer);
begin
  FieldByName(index).AsInteger := Value;
end;

procedure THMClientDataSet.SetSV(index: string; const Value: string);
begin
  FieldByName(index).AsString := Value;
end;

procedure THMClientDataSet.SetUniKey(FieldName: string; CheckNull: Boolean);
begin
  if (CheckNull and CheckNullField(FieldName)) or (not CheckNull) then
    FieldByName(FieldName).Value := UniKey;
end;

{ THMClientCommand }

function THMClientCommand.ApplyUpdates: Boolean;
var
  vParam: OleVariant;
begin
  Ole.Action := 905;
  Ole.SaveToOle(vParam);
  Result := RemoteServer.AppServer.DefaultModule(vParam, FData, Msg);
  if Result then
    begin
      if FAutoShowMessage then
        ShowMessage(VarToStr(Msg));
    end
  else
    ShowMessage(VarToStr(Msg));
end;

function THMClientCommand.ApplyUpdates(DataSet: TClientDataSet; TableName,
  KeyField: string): Boolean;
var
  vParam: OleVariant;
begin
  if DataSet.Modified then DataSet.Post;
  if DataSet.ChangeCount > 0 then
    begin
      Ole.Action := 905;
      Ole.Clear;
      Ole['Delta'] := DataSet.Delta;
      Ole['TableName'] := TableName;
      Ole['KeyField'] := KeyField;
      Ole.SaveToOle(vParam);
      Result := RemoteServer.AppServer.DefaultModule(vParam, FData, Msg);
      if Result then
        begin
          DataSet.MergeChangeLog;
          if FAutoShowMessage then
            ShowMessage(VarToStr(Msg));
        end
      else
        ShowMessage(VarToStr(Msg));
    end
  else
    Result := False;
end;

procedure THMClientCommand.BeginOle;
begin
  Ole.Clear;
end;

constructor THMClientCommand.Create(AOwner: TComponent);
begin
  inherited;
  Msg := Null;
  FData := Null;
  FOle := THMOleVariant.Create;
  FAutoShowMessage := False;
end;

destructor THMClientCommand.Destroy;
begin
  FOle.Free;
  inherited;
end;

function THMClientCommand.Execute(ModuleIndex: integer): Boolean;
var
  vParam: OleVariant;
begin
  Ole.SaveToOle(vParam);
  Result := RemoteServer.AppServer.DataModule(ModuleIndex, vParam, FData, Msg);
  if Result then
    begin
      if FAutoShowMessage then
        ShowMessage(VarToStr(Msg));
    end
  else
    ShowMessage(VarToStr(Msg));
end;

function THMClientCommand.ExecuteStoreProc(Index: integer): Boolean;
var
  vParam: OleVariant;
begin
  Ole.Action := 903;
  Ole.StoreProcIndex := Index;
  Ole.SaveToOle(vParam);
  Result := RemoteServer.AppServer.DefaultModule(vParam, FData, Msg);
  if Result then
    begin
      if FAutoShowMessage then
        ShowMessage(VarToStr(Msg));
    end
  else
    ShowMessage(VarToStr(Msg));
end;

function THMClientCommand.GetLastMsg: string;
begin
  Result := VarToStr(Msg);
end;

procedure THMClientCommand.SetAutoShowMessage(const Value: Boolean);
begin
  FAutoShowMessage := Value;
end;

{ THMOleClientDataSet }

function THMOleClientDataSet.GetData: OleVariant;
begin
  Result := (Parent as THMClientDataSet).Data;
end;

procedure THMOleClientDataSet.LoadData;
begin
  (Parent as THMClientDataSet).Open;
end;

procedure THMOleClientDataSet.LoadDataEx(var Data: OleVariant);
begin
  (Parent as THMClientDataSet).Data := Data;
  (Parent as THMClientDataSet).Open;
end;

procedure THMOleClientDataSet.LoadOleData(Name: Widestring);
begin
  if Assigned((Parent as THMClientDataSet).FOnLoadOleData) then
    (Parent as THMClientDataSet).FOnLoadOleData(Parent, Name);
end;

procedure THMOleClientDataSet.SetData(Value: OleVariant);
begin
  (Parent as THMClientDataSet).Data := Value;

end;

end.