uaclientdataset.pas

基于Midas 技术的多层应用开发包

{******************************************************************************************}
{                                                                                          }
{       Universal Agent on demond SDK                                                      }
{                                                                                          }
{                                                                                          }
{ COPYRIGHT                                                                                }
{ =========                                                                                }
{ The UA SDK (software) is Copyright (C) 2001-2003, by vinson zeng(曾胡龙).                }
{ All rights reserved.                                                                     }
{ The authors - vinson zeng (曾胡龙),                                                      }
{ exclusively own all copyrights to the Advanced Application                               }
{ Controls (AppControls) and all other products distributed by Utilmind Solutions(R).      }
{                                                                                          }
{ LIABILITY DISCLAIMER                                                                     }
{ ====================                                                                     }
{ THIS SOFTWARE IS DISTRIBUTED "AS IS" AND WITHOUT WARRANTIES AS TO PERFORMANCE            }
{ OF MERCHANTABILITY OR ANY OTHER WARRANTIES WHETHER EXPRESSED OR IMPLIED.                 }
{ YOU USE IT AT YOUR OWN RISK. THE AUTHOR WILL NOT BE LIABLE FOR DATA LOSS,                }
{ DAMAGES, LOSS OF PROFITS OR ANY OTHER KIND OF LOSS WHILE USING OR MISUSING THIS SOFTWARE.}
{                                                                                          }
{ RESTRICTIONS                                                                             }
{ ============                                                                             }
{ You may not attempt to reverse compile, modify,                                          }
{ translate or disassemble the software in whole or in part.                               }
{ You may not remove or modify any copyright notice or the method by which                 }
{ it may be invoked.                                                                       }
{******************************************************************************************}

{*
update history**
 如果是Master/Detail,那么必须在设计期出现
 是否有数据完整强制性检查 --- add by vinson zeng for JTService 



*}


unit UAClientDataSet;

interface
uses
   Windows, Variants, ActiveX, Classes,
   Dialogs,DBClient,DB,SysUtils,DSIntf,Forms,
   Controls,UADataPacket,UAServiceClient;

{$I UaSdk.inc}


type

    TRemoteServiceEvent = procedure (Sender:TObject;var CustomData:OleVariant) of Object;
    TUpdateErrorEvent = procedure (Sender:TObject;ErrorCode:integer; var bContinue:Boolean) of Object;
   
    //----- add by vinson zeng 2004 -06-18--------
    //提供数据完整性检查的事件处理，且必须以事件回叫主数据集，Event 
    TConfirmForUpdateEvent = procedure (Sender:TObject;var bContinue:Boolean ) of Object; 
    //----- %% end of %% -------------------------

    TUAOption = (uoAutoRequestNext,uoAutoUpdate,uoAutoCatchError,uoAutoMergeAll);
    TUAOptions = set of TUAOption;

    TOperateOption = (ooRequest,ooRequestNext,ooRequestCustom,ooUpdate,ooUpdateCustom,ooRefreshAllData,
                      ooRefreshSelected,ooQueryData);

    TOperateOptions= set of TOperateOption;

    TDataSetType = (dtSingle,dtMaster,dtDetail,dtBoth,dtNone); // add define for multi table process  by vinson zeng

    CharSet = set of Char;

    TUAClientDataSet = class;

    TUAFieldsDesigner = class(TPersistent)
    private
      FOwnerDataSet:TUAClientDataSet;
      function  GetOwnerDataSet: TUAClientDataSet;
      procedure SetOwnerDataSet(const Value: TUAClientDataSet);
    protected
    public
      constructor Create;
    published
      property OwnerDataSet:TUAClientDataSet read GetOwnerDataSet write SetOwnerDataSet;
    end;

    TUAClientDataSet = class(TClientDataSet)
    private

      FAllRecCount:Integer;
      FUAServiceClient:TUAServiceClient;
      FMasterUAServiceClient:TUAServiceClient; // add by vinson zeng
      FAliasTableName:string;
      FKeyFields:string;
      FFetchNextDataPacket:Boolean;
      FCanUpdate:Boolean;

      FBeforeRequest:TNotifyEvent;
      FAfterRequest:TRemoteServiceEvent;
      FBeforeUpdate:TNotifyEvent;
      FAfterUpadte:TNotifyEvent;

      FUAOptions:TUAOptions;
      FOperateOptions:TOperateOptions;
      FUpdateErrorEvent:TUpdateErrorEvent;

      FSqlScript:string;

      FOpenAllData:Boolean;
      FFieldsDesigner:TUAFieldsDesigner;

      FDataInfo:string;
      FConfirmNotFound:Boolean;
      FRelaCheck:Boolean;
      FDataSetType:TDataSetType;
      FUAAutoRequestNext:Boolean;
      FDesignActive:Boolean;
      
      

      function  GetUAServiceClient: TUAServiceClient;
      procedure SetUAServiceClient(const Value: TUAServiceClient);
      function  GetAllRecCount: Integer;
      procedure SetAllRecCount(const Value: Integer);
      function  GetAliasTableName: string;
      procedure SetAliasTableName(const Value: string);
      function  GetFetchNextDataPacket: Boolean;
      procedure SetFetchNextDataPacket(const Value: Boolean);
      function  GetKeyFields: string;
      procedure SetKeyFields(const Value: string);
      function  GetCanUpdate: Boolean;
      procedure SetUAOptions(const Value: TUAOptions);
      procedure SetSqlScript(const Value: string);
      procedure SetOpenAllData(const Value: Boolean);
      function  GetDataInfo: string;
      // add by vinson zeng 2004-01-05
      function  GetConfirmNotFound: Boolean;
      procedure SetConfirmNotFound(const Value: Boolean);
      //--------%% end of %% -----------------
      procedure SetUAAutoRequestNext(const Value: Boolean);
      procedure SetDesignActive(const Value: Boolean); //2004-03-07

    protected

      FDataSheetList:TUAParams;
      FRowSheetList:TUAParams;
      FMasterLinkList:TUAParams;

      function   GetDataSetType:TDataSetType;
      procedure  CheckNextDataPacket; virtual;
      procedure  CheckForUpdate; //??
      function   CheckOperateState(const OperateIndex:integer = -1):Boolean;
      function   GetMasterUAServiceClient:TUAServiceClient;

      procedure  DeleteDetailRecords(MasterDataSet:TUAClientDataSet);virtual; //????
      procedure  DoDesignActive; //2004-3-26 modify by vinson zeng

      function   GetMasterLinkScript(Sender:TObject):string;
      function   BuildRequestDataParam(Sender:TObject):integer;
      function   BuildDeltaParam(UAClientDataSet:TUAClientDataSet):Boolean;
      function   BuildRefreshDataScript(Sender:TObject;var sSqlScript:string;const bAll :Boolean = false):Boolean;
      procedure  AddReturnDataPacket(const vData:OleVariant);
      function   GetIndexFields(DataSet:TDataSet):string; // add by vinson zeng for multi table applyupdates process

      //----Inherited from TCustomClientDataSet---------
      procedure  DataEvent(Event: TDataEvent; Info: Longint); override;
      procedure  AddDataPacket(const Data: OleVariant; HitEOF: Boolean); override;
      procedure  CheckDetailRecords; override;
      procedure  InternalDelete; override;
      procedure  InternalPost; override;
      procedure  InternalCancel; override;
      procedure  InternalOpen; override;
      procedure  InternalInsert; override;
      procedure  InternalEdit; override;
      procedure  InternalRefresh; override;
      procedure  DoOnNewRecord; override;
      procedure  Notification(AComponent: TComponent; Operation: TOperation);override;
      //-------%% end of %%---------------------
    public

      constructor Create(AOwner: TComponent); override;
      destructor  Destroy; override;
      procedure   Loaded; override;

      procedure  RefreshAllData(Sender:TObject; const bAll :Boolean = false);
      procedure  MergeAllChangeLog; ///???
      procedure  CancelSubmitAllDelta; virtual;///?????
      procedure  ClearAllData;virtual;

      procedure  QueryData(Sender:TObject;const ClearData:Boolean = false);
      function   DoRequest(const RequestIndex:Integer= -1):OleVariant;virtual;
      procedure  DoUpdate (const UpdateIndex:Integer = -1);virtual;

      procedure  ClearAllParams;

      procedure  CloseAutoRequestNext(const bClose:Boolean = true);

      property DataInfo:string read GetDataInfo;
      property AllRecCount:Integer read GetAllRecCount write SetAllRecCount;
      property CanUpdate:Boolean read GetCanUpdate  default false;
      property FetchNextDataPacket:Boolean read GetFetchNextDataPacket write SetFetchNextDataPacket default false;

      property OperateOptions:TOperateOptions read FOperateOptions  default[];
      property ConfirmNotFound:Boolean read GetConfirmNotFound write SetConfirmNotFound default false;

      property DataSetType:TDataSetType read GetDataSetType;
      property MasterUAServiceClient:TUAServiceClient read GetMasterUAServiceClient; // add by vinson zeng
      property UAAutoRequestNext:Boolean read FUAAutoRequestNext write SetUAAutoRequestNext;

    published

      property FieldsDesigner:TUAFieldsDesigner read FFieldsDesigner;
      //-----extenal with UA-----------------
      property OpenAllData:Boolean read FOpenAllData write SetOpenAllData;

      property UAOptions:TUAOptions read FUAOptions write SetUAOptions  default [uoAutoRequestNext];
      property UAServiceClient:TUAServiceClient read GetUAServiceClient write SetUAServiceClient;
      property AliasTableName:string read GetAliasTableName write SetAliasTableName;
      property KeyFields:string read GetKeyFields write SetKeyFields;

      property BeforeRequest:TNotifyEvent read FBeforeRequest write FBeforeRequest;
      property AfterRequest:TRemoteServiceEvent read FAfterRequest write FAfterRequest;
      property BeforeUpdate:TNotifyEvent read FBeforeUpdate write FBeforeUpdate;
      property AfterUpadte:TNotifyEvent read FAfterUpadte write FAfterUpadte;
      property UpdateErrorEvent:TUpdateErrorEvent read FUpdateErrorEvent write FUpdateErrorEvent;
      property SqlScript:string read FSqlScript write SetSqlScript;
      property DesignActive:Boolean read FDesignActive write SetDesignActive;

      //-----------%% end of %%--------------------
    end;


const

  crUAWait = 5;
  SupportFieldTypes = [ftString, ftWideString, ftSmallint, ftInteger, ftAutoInc, ftWord, ftBoolean, ftLargeint, ftFloat, ftCurrency, ftDate, ftTime, ftDateTime, ftBlob, ftMemo];
  SNotSupportFieldType = 'Field type is not supported by TUAClientDataSet. '#13 +
    'Valid types is String, WideString, Smallint, Integer, Word, Boolean, Largeint, Float, Currency, Date, Time, DateTime, Blob, Memo';


function xStrSplit(str:String; chars:CharSet; tsStrs:TStrings;AutoClear: Boolean; bTrim:Boolean):integer;

implementation


function xStrSplit(str:String; chars:CharSet; tsStrs:TStrings;AutoClear: Boolean; bTrim:Boolean):integer;
var
    n, i, k : integer;
    s : string;
begin
  Result := 0;
  if chars=[] then
  	chars := [',',';'];
  if tsStrs=nil then Exit;
  if AutoClear then
	  tsStrs.Clear;
  k := Length(str);
  if (k=0) then Exit;
  i := 1;
  for n:=1 to k do
    if str[n] in chars then begin
      s := Copy(Str, i, n-i);
      if bTrim then s:=Trim(s);
      tsStrs.Add(s);
      i := n+1;
      Inc(Result);
    end;
  if i<=k then begin
    s := Copy(Str, i, n-i);
    if bTrim then s:=Trim(s);
    tsStrs.Add(s);
    Inc(Result);
  end;
end;


{ TUAClientDataSet }

procedure TUAClientDataSet.AddDataPacket(const Data: OleVariant;HitEOF: Boolean);
begin
  inherited;
end;

{-----------------------------------------------------------------------------
  Procedure: TUAClientDataSet.CheckForUpdate
  Author:    vinson zeng
  Date:      05-三月-2003
  Arguments: None
  Result:    None
-----------------------------------------------------------------------------}

procedure TUAClientDataSet.CheckForUpdate;
var
  i:integer;
  lList:TList;
  bCheckDetail:Boolean;
            function CheckForUpdateWithDetail(aDetail:TUAClientDataSet):Boolean;
            var
              j:integer;
              lList1:TList;
              bSubDetail:Boolean;
            begin
              bSubDetail := false;
              with aDetail do
              begin
                CheckBrowseMode;
                Result := ChangeCount > 0;
                lList1 := TList.Create;
                GetDetailDataSets(lList1);
                try
                  for j := 0 to lList1.Count -1 do
                    bSubDetail := CheckForUpdateWithDetail(TUAClientDataSet(lList1.Items[j]));
                  Result := Result or bSubDetail;
                finally
                  if Assigned(lList1) then
                    FreeAndNil(lList1);
                end;
              end;
            end;
begin
  bCheckDetail := false;
  lList := TList.Create;
  try
    try
      case DataSetType of
        dtSingle,dtDetail: begin
               CheckBrowseMode;
               FCanUpdate := ChangeCount > 0;
            end;
        dtMaster,dtBoth:
           begin
             CheckBrowseMode;
             FCanUpdate := ChangeCount > 0;
             GetDetailDataSets(lList);
             for i := 0 to lList.Count -1 do
               bCheckDetail := CheckForUpdateWithDetail(TUAClientDataSet(lList.Items[i]));
             FCanUpdate := FCanUpdate or bCheckDetail;
           end;
      end;
    except
      FCanUpdate := false;
    end;
  finally
    if Assigned(lList) then
      FreeAndNil(lList);
  end;

//  Assert(FCanUpdate,'check for update is false');

end;


{-----------------------------------------------------------------------------
  Procedure: TUAClientDataSet.CheckNextDataPacket
  Author:    vinson zeng
  Date:      05-三月-2003
  Arguments: None
  Result:    None
-----------------------------------------------------------------------------}


procedure TUAClientDataSet.CheckNextDataPacket;
begin

  if not UAAutoRequestNext then Exit;
  
  UpdateCursorPos;

  FetchNextDataPacket := (MasterUAServiceClient <> nil) and Eof
                          and (RecordCount < AllRecCount)
                          and Active and (not (State in [dsInsert,dsEdit,dsInactive]))
                          and (ChangeCount = 0);

  try
    if FetchNextDataPacket and (uoAutoRequestNext in FUAOptions)
       and ( (DataSetType = dtMaster) or (DataSetType = dtSingle)) then
    begin
      Include(FOperateOptions,ooRequestNext);
      DoRequest(1);
    end;
  except
    //do not do anything ,reverse event for catch error!
  end;

end;

constructor TUAClientDataSet.Create(AOwner: TComponent);
begin

  inherited;

  FAllRecCount := 0;
  FFetchNextDataPacket := false;
  FCanUpdate := false;

  FDataSheetList := TUAParams.Create(true);
  FRowSheetList:= TUAParams.Create(true);
  FMasterLinkList := TUAParams.Create(true);
  FFieldsDesigner := TUAFieldsDesigner.Create;
  FFieldsDesigner.OwnerDataSet := Self;

  Include(FUAOptions,uoAutoRequestNext);
  Include(FUAOptions,uoAutoUpdate);

  FOperateOptions := [];
  FConfirmNotFound  := false;
  FRelaCheck  := true;
  FDataSetType := dtNone;
  FUAAutoRequestNext := true;

  Screen.Cursors[crUAWait] := LoadCursor(HInstance, 'UAWait');


end;

procedure TUAClientDataSet.DataEvent(Event: TDataEvent; Info: Integer);
begin

{$define chineseinfo}
  try
    case Event of
      deCheckBrowseMode:  // add by vinson zeng for bug on delete record not effect
        begin
        end;
      deDataSetScroll:
        begin
          CheckNextDataPacket;
          if Active then
          begin
            {$ifdef chineseinfo}
            FDataInfo := Format('共计 %s 条记录，当前为已打开 %s条中的第 %s 条记录',[IntToStr(AllRecCount),IntToStr(RecordCount),IntToStr(RecNo)]);
            {$else}
            FDataInfo := Format('Total RecordCount Is  %s , Local RecordCount Is  %s  Currrent RecNo Is %s ',[IntToStr(AllRecCount),IntToStr(RecordCount),IntToStr(RecNo)]);
            {$endif}
          end