zquery.pas

控件名称：WINZEOS.ZIP 2002年08月03日 作者：CapellaDevelopment Zeos系列构件套件包含一组可直接存取Linux知名的免费数据库MySQL、Postgre

    class procedure CheckTypeSize(Value: Integer); override;
    function GetAsCurrency: Currency; override;
    function GetAsString: string; override;
    function GetAsVariant: Variant; override;
{-$IFDEF VER130ABOVE}
    function GetDataSize: Integer; override;
{-$ELSE}
    //function GetDataSize: Word; override;
{-$ENDIF}
   public
     constructor Create(AOwner: TComponent); override;
   published
     //property Size default 8;
   end;

implementation

uses ZExtra, ZDBaseConst, ZList, ZConvert
{$IFNDEF LINUX}
  ,Forms{$IFNDEF NO_GUI}, Controls{$ENDIF}
{$ELSE}
  ,QForms{$IFNDEF NO_GUI}, QControls{$ENDIF}
{$ENDIF};

{*************** TZDataset class implemantation ****************}

{*** Class constructors and destructors ***}

{ Class constructor }
constructor TZDataset.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  { Create internal objects }
  FParams := TParams.Create{$IFNDEF VER100}(Self){$ENDIF};
  FSqlParser := TSqlParser.Create(Self);
  FSqlBuffer := TSqlBuffer.Create(Self);
  FCacheBuffer := TSqlBuffer.CreateCache(FSqlBuffer);
  FIndexDefs := TIndexDefs.Create(Self);
  FParser := TZParser.Create(nil);
  FCCParser := TZParser.Create(nil);
  FDataLink := TZQueryDataLink.Create(Self);

  { Initialize properties }
  FParamCheck := True;
  FOptions := [doHourGlass, doAutoFillDefs, doUseRowId];
  FDatabaseType := dtUnknown;
  BookmarkSize := SizeOf(Integer);
  FLinkOptions := [loAlwaysResync];

  { Master-detail links }
  FMasterLink := TMasterDataLink.Create(Self);
  FMasterLink.OnMasterChange  := MasterChanged;
  FMasterLink.OnMasterDisable := MasterDisabled;
  FMasterIndex := -1;
  FVersion := ZDBO_VERSION;
end;

{ Class destructor }
destructor TZDataset.Destroy;
begin
  FOnProgress := nil;
  if Assigned(FDatabase) then
    FDatabase.RemoveDataset(Self);
  inherited Destroy;

  FParams.Free;
  FSqlParser.Free;
  FCacheBuffer.Free;
  FSqlBuffer.Free;
  FIndexDefs.Free;
  FParser.Free;
  FCCParser.Free;
  FDataLink.Free;
  FMasterLink.Free;
  FQuery.Free;
end;

{*** Private property processing methods ***}

{ Set connect to database component }
procedure TZDataset.SetDatabase(Value: TZDatabase);
begin
  if FDatabase = Value then Exit;

  if Active then Close;
  try
    if Assigned(FDatabase) then
      FDatabase.RemoveDataset(Self);
    if Assigned(Value) then
    begin
      FQuery.Connect := Value.Handle;
      Value.AddDataset(Self);
      if (not Assigned(FTransact) or (FTransact.Database <> Value)) and
        not (csLoading in ComponentState) then
        SetTransact(TZTransact(Value.DefaultTransaction));
    end
    else
    begin
      FQuery.Connect := nil;
      if Assigned(FTransact) and Assigned(FTransact.Database) then
        SetTransact(nil);
    end;
  finally
    FDatabase := Value;
  end;
end;

{ Set connect to transaction component }
procedure TZDataset.SetTransact(Value: TZTransact);
begin
  if FTransact = Value then Exit;

  if Active then Close;
  FTransact := Value;
  if Assigned(FTransact) then
  begin
    FQuery.Transact := Value.Handle;
    if (FDatabase <> FTransact.Database)
      and not (csLoading in ComponentState) then
      FDatabase := FTransact.Database;
  end else
    FQuery.Transact := nil;
end;

{ Set update Sql object }
procedure TZDataset.SetUpdateObject(Value: TZUpdateSql);
begin
  if FUpdateObject <> Value then
  begin
    if Assigned(FUpdateObject) then
      FUpdateObject.Dataset := nil;
    FUpdateObject := Value;
    if Assigned(FUpdateObject) then
      FUpdateObject.Dataset := Self;
  end;
end;

{ Auto fill database and transaction objects }
procedure TZDataset.AutoFillObjects;
begin
  if Assigned(TransactObj) and not Assigned(TransactObj.Database) then
    TransactObj.Database := Database;
  if not Assigned(DatabaseObj) and Assigned(TransactObj) then
    DatabaseObj := TransactObj.Database;
  if Assigned(DatabaseObj) and not Assigned(TransactObj) then
    TransactObj := TZTransact(DatabaseObj.DefaultTransaction);
end;

{ Assign new table name value }
procedure TZDataset.SetTableName(Value: string);
begin
  if FTableName <> Value then
  begin
    Close;
    FTableName := Value;
    SqlParser.Sql.Clear;
    SqlParser.Sql.Add('SELECT * FROM ' + ProcessIdent(Value));
    SqlParser.ExtraOrderBy := FormTableSqlOrder;
  end;
end;

{ Get current sql query }
function TZDataset.GetSql: TStrings;
begin
  Result := SqlParser.Sql;
end;

{ Set new Sql query }
procedure TZDataset.SetSql(Value: TStrings);
begin
  if SqlParser.Sql.Text <> Value.Text then
  begin
    Close;
    SqlParser.Sql := Value;
  end;
end;

{ Get ReadOnly property }
function TZDataset.GetReadOnly: Boolean;
begin
  Result := not RequestLive;
end;

{ Set ReadOnly property }
procedure TZDataset.SetReadOnly(Value: Boolean);
begin
  RequestLive := not Value;
end;

procedure TZDataset.SetOptions(Value: TZDatasetOptions);
var
  SqlFilterChange: Boolean;
begin
  if FOptions <> Value then
  begin
    SqlFilterChange := (doSqlFilter in FOptions) <> (doSqlFilter in Value);
    FOptions := Value;
    FFiltered := Filtered and not (doSqlFilter in Value);
    if SqlFilterChange and Filtered and (Filter <> '') then
      SqlFilterRefresh;
  end;
end;

{*** Method for processing Sql parameters ***}

{ Get parameters count }
function TZDataset.GetParamsCount: Word;
begin
  Result := FParams.Count;
end;

{ Set Sql query parameters list }
procedure TZDataset.SetParamsList(Value: TParams);
begin
  FParams.AssignValues(Value);
end;

{ Get query parameter by name }
function TZDataset.ParamByName(const Value: string): TParam;
begin
  Result := FParams.ParamByName(Value);
end;

{$IFNDEF VER100}
{ Define properties of Sql params }
procedure TZDataset.DefineProperties(Filer: TFiler);
  function WriteData: Boolean;
  begin
    if Filer.Ancestor <> nil then
      Result := not FParams.IsEqual(TZDataset(Filer.Ancestor).FParams)
    else
      Result := (FParams.Count > 0);
  end;
begin
  inherited DefineProperties(Filer);
  Filer.DefineProperty('ParamData', ReadParamData, WriteParamData, WriteData);
end;

{ Read Sql params from DFM file }
procedure TZDataset.ReadParamData(Reader: TReader);
begin
  Reader.ReadValue;
  Reader.ReadCollection(FParams);
end;

{ Write Sql params into DFM file }
procedure TZDataset.WriteParamData(Writer: TWriter);
begin
  Writer.WriteCollection(Params);
end;
{$ENDIF}

{*** Internal getting field and navigation methods ***}

{ Get visible updated records types }
function TZDataset.GetUpdateRecord: TZUpdateRecordTypes;
begin
  Result := SqlBuffer.FilterTypes;
end;

{ Set visible updated records types }
procedure TZDataset.SetUpdateRecord(Value: TZUpdateRecordTypes);
var
  Index: Integer;
begin
  SqlBuffer.FilterTypes := Value;
  if (SqlBuffer.Count > 0) and (CurRec >= 0) then
  begin
    Index := SqlBuffer[CurRec].Index;
    SqlBuffer.Filter;
    CurRec := SqlBuffer.IndexOfIndex(Index);
  end else
    SqlBuffer.Filter;
  if (CurRec < 0) and (SqlBuffer.Count > 0) then
    CurRec := 0;
  if not (State in [dsInactive]) then Resync([]);
end;

{ Read all records from server }
procedure TZDataset.QueryRecords(Force: Boolean);
{$IFNDEF NO_GUI}
var
  OldCursor: TCursor;
{$ENDIF}
begin
{$IFNDEF NO_GUI}
  OldCursor := Screen.Cursor;
{$ENDIF}
  try
{$IFNDEF NO_GUI}
    if doHourGlass in FOptions then
      Screen.Cursor := crSqlWait;
{$ENDIF}
    { Check current fetch state }
    if not ((not Query.EOF) and ((doQueryAllRecords in Options)
      or (Query.RecNo < MIN_FETCH_ROWS) or Force or FetchAll)) then
      Exit;
    { Invoke on progress event }
    DoProgress(psStarting, ppFetching, SqlBuffer.Count);
    { Query records }
    while (not Query.EOF) and ((doQueryAllRecords in Options)
      or (Query.RecNo < MIN_FETCH_ROWS) or Force) do
      QueryRecord;
    { Invoke on progress event }
    DoProgress(psEnding, ppFetching, SqlBuffer.Count);
  finally
{$IFNDEF NO_GUI}
    if doHourGlass in FOptions then
      Screen.Cursor := OldCursor;
{$ENDIF}
  end;
end;

{ Read one record from server }
procedure TZDataset.QueryOneRecord;
begin
  { Invoke on progress event }
  DoProgress(psStarting, ppFetching, SqlBuffer.Count);
  { Query records }
  QueryRecord;
  { Invoke on progress event }
  DoProgress(psEnding, ppFetching, SqlBuffer.Count);
end;

{ Send events to inherited dataset }
procedure TZDataset.DataEvent(Event: TDataEvent; Info: Longint);
begin
  inherited DataEvent(Event, Info);
end;

{ Fetching query records }
function TZDataset.GetRecord(Buffer: PChar; GetMode: TGetMode;
  DoCheck: Boolean): TGetResult;
var
  TempRec: LongInt;
  CanFetch: Boolean;
begin
  CanFetch := True;
  Result := grOK;
  case GetMode of
    gmNext:
      begin
        TempRec := CurRec;
        while Result <> grEOF do
        begin
          if TempRec < SqlBuffer.Count - 1 then
            Inc(TempRec)
          else
            if FQuery.EOF or (not CanFetch) then
              Result := grEOF
            else begin
              QueryOneRecord;
              if FQuery.EOF then
                Result := grEOF
              else if SqlBuffer.Count = 0 then
                Continue
              else
                Inc(TempRec);
            end;
          if Result = grEOF then
            Break;
          if CheckRecordByFilter(TempRec) then
            Break;
        end;
        if Result = grOk then
          CurRec := TempRec;
      end;
    gmPrior:
      begin
        TempRec := CurRec;
        while Result <> grBOF do
        begin
          if TempRec <= 0 then
            Result := grBOF
          else
            Dec(TempRec);
          if Result = grBOF then
            Break;
          if CheckRecordByFilter(TempRec) then
            Break;
        end;
        if Result = grOk then
          CurRec := TempRec;
      end;
    gmCurrent:
      begin
        TempRec := CurRec;
        while Result <> grError do
        begin
          if (TempRec < 0) or (TempRec >= SqlBuffer.Count) then
          begin
            if FQuery.EOF or (not CanFetch) then
              Result := grError
            else begin
              QueryOneRecord;
              if FQuery.EOF then
                Result := grError;
            end;
          end;
          if Result = grError then
            Break;
          if CheckRecordByFilter(TempRec) then
            Break;
          Inc(TempRec);
        end;
        if Result = grOk then
          CurRec := TempRec;
      end;
  end;

  if Result = grOK then
  begin
    SqlBuffer.CopyRecord(SqlBuffer[CurRec], PRecordData(Buffer), True);
    with PRecordData(Buffer)^ do
      BookmarkFlag := bfCurrent;
    GetCalcFields(Buffer);
  end
  else if (Result = grError) and DoCheck then
    DatabaseError(SNoMoreRec);
end;

{*** Internal updating fields methods *** }

{ Store record buffer into TField }
function TZDataset.GetFieldData(Field: TField; Buffer: Pointer): Boolean;
var
  Index: Integer;
  RecBuffer: PRecordData;
  FieldDesc: PFieldDesc;
  TempCurr: System.Currency;
begin
  Result := False;

  if not GetActiveRecBuf(RecBuffer) then Exit;

  if State = dsOldValue then
  begin
     if (CurRec >= 0) and (CurRec < SqlBuffer.Count) then
     begin
       Index := CacheBuffer.IndexOfIndex(SqlBuffer[CurRec].Index);
       if Index >= 0 then
         RecBuffer := CacheBuffer[Index]
     end
  end;

  FieldDesc := SqlBuffer.SqlFields.FindByField(Field);
  if not Assigned(FieldDesc) then