zquery.pas

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

{$ENDIF}
    { Clear all collections }
    Query.Close;
    SqlBuffer.ClearBuffer(False);
    CacheBuffer.ClearBuffer(False);
    { Open the query }
    Query.Open;
    if not Query.Active then
    begin
      if Assigned(TransactObj) then
        TransactObj.Recovery(True);
      DatabaseError(SDetailQueryError);
    end;
    { Initialize field and index defs }
    CurRec := -1;
    { Fetch records }
    if Active then
      QueryRecords(False);
  finally
{$IFNDEF NO_GUI}
    if doHourGlass in FOptions then
      Screen.Cursor := OldCursor;
{$ENDIF}
  end;
end;

{ Refresh computed fields }
function TZDataset.RefreshCurrentRow(RecordData: PRecordData): Boolean;
var
  I: Integer;
  Sql, Where: string;
  Query: TDirQuery;
  FieldDesc: PFieldDesc;
  IsNull: Boolean;
  FieldValue: string;
begin
  Result := False;

  { Check tables }
  if SqlParser.Tables.Count = 0 then Exit;
  { Form Sql command }
  Where := Trim(FormSqlWhere(SqlParser.Tables[0], RecordData));
  if Where = '' then Exit;
  Sql := 'SELECT * FROM ' + ProcessIdent(SqlParser.Tables[0]) + ' ' + Where;

  Query := TransactObj.QueryHandle;
  Query.Close;
  Query.Sql := Sql;
  Query.Open;
  if not Query.Active or Query.EOF then Exit;

  for I := 0 to SqlBuffer.SqlFields.Count-1 do
  begin
    FieldDesc := SqlBuffer.SqlFields[I];
    if FieldDesc.FieldNo < 0 then Continue;
    IsNull := Query.FieldIsNull(FieldDesc.FieldNo);

    if IsNull and not SqlBuffer.GetFieldNull(FieldDesc, RecordData) then
    begin
      SqlBuffer.SetFieldNull(FieldDesc, IsNull, RecordData);
      Result := True;
    end
    else   //refresh only for no blob field
    if FieldDesc.BlobType = btInternal then
    begin
      FieldValue := Query.Field(FieldDesc.FieldNo);
      if FieldValue <> SqlBuffer.GetField(FieldDesc, RecordData) then
      try
        SqlBuffer.SetField(FieldDesc,FieldValue,RecordData);
        Result := True;
      except
      end;
    end;
  end;
  Query.Close;
end;

{$IFNDEF VER100}

procedure TZDataset.ResetAggField(Field: TField);
var i :integer;
begin
 {
 if (Field<>nil) and (Field is TAggregateField) then
 (Field as TAggregateField).Active := False;
 }

  for I := 0 to AggFields.Count - 1 do
  if AggFields[I] = Field then
  begin
    (AggFields[I] as TAggregateField).Active := False;
    break;
  end;
end;


function TZDataset.GetAggregateValue(Field: TField): Variant;
begin
 Result := Field.Value;
end;

{$ENDIF}

{***************** Filter methods **************}

{ Find record in a filtered query }
function TZDataset.FindRecord(Restart, GoForward: Boolean): Boolean;
var
  Index: Integer;
  SaveFiltered: Boolean;
begin
  { Check state }
  CheckBrowseMode;
  DoBeforeScroll;
  Result := False;
  { Set position }
  if Restart then
  begin
    if GoForward then
      Index := 0
    else
    begin
      QueryRecords(True);
      Index := SqlBuffer.Count-1;
    end
  end
  else
  begin
    Index := CurRec;
    if GoForward then
      Inc(Index)
    else
      Dec(Index);
  end;
  { Find a record }
  SaveFiltered := FFiltered;
  try
    FFiltered := True;
    while (Index >= 0) and (Index < SqlBuffer.Count) do
    begin
      if CheckRecordByFilter(Index) then
      begin
        Result := True;
        Break;
      end;
      if not GoForward then
        Dec(Index)
      else begin
        Inc(Index);
        if (Index >= SqlBuffer.Count) and not Query.EOF then
          QueryOneRecord;
      end;
    end
  finally
    FFiltered := SaveFiltered;
  end;

  SetFound(Result);
  if Result then
  begin
    RecNo := Index + 1;
    DoAfterScroll;
  end;
end;

{ Turn off/on filtering }
procedure TZDataset.SetFiltered(Value: Boolean);
var
  Bookmark: TBookmark;
begin
  if Value <> Filtered then
  begin
    { Turn off controls and save current position }
    DisableControls;
    Bookmark := GetBookmark;
    try
      { Process filtered }
      FFiltered := Value and not (doSqlFilter in Options);
      inherited SetFiltered(Value);
      { Resync recordset }
      if not (State in [dsInactive]) and FFiltered  then
      begin
        Resync([]);
        First;
      end else
        if (doSqlFilter in Options) and (Filter <> '') then
          SqlFilterRefresh;

      { Restore position }
      if not Value then
        GotoBookmark(Bookmark);
    finally
      FreeBookmark(Bookmark);
      EnableControls;
    end;
  end;
end;

{ Set filter equation }
procedure TZDataset.SetFilterText(const Value: string);
var
  Bookmark: TBookmark;
begin
  inherited SetFilterText(Trim(Value));
  if Trim(Value) <> FParser.Equation then
  begin
    { Turn off controls and save current position }
    DisableControls;
    Bookmark := GetBookmark;
    try
      { Set new equation }
      FParser.Equation := Trim(Value);
      { Adjust position }
      if FFiltered and not (State in [dsInactive]) then
      begin
        Resync([]);
        if Trim(Value) <> '' then
          First
        else
          GotoBookmark(Bookmark);
      end else
      if Filtered and (doSqlFilter in Options) then
         SqlFilterRefresh;
    finally
      FreeBookmark(Bookmark);
      EnableControls;
    end;
  end;
end;

procedure TZDataset.SqlFilterRefresh;
begin
  if not (State in [dsInactive]) and
    (ConvertToSqlEnc(SqlParser.Text) <> Query.Sql) then
  begin
    Query.Sql := ConvertToSqlEnc(SqlParser.Text);
    ShortRefresh;
    First;
  end;
end;

{ Check is query sequensed? }
function TZDataset.IsSequenced: Boolean;
begin
  Result := (not Filtered);
end;

{ Check is record hided by filter? }
function TZDataset.CheckRecordByFilter(RecNo: LongInt): Boolean;
var
  I: Integer;
  OldCurRec: Integer;
  OldState: TDatasetState;
  FieldDesc: PFieldDesc;
  Value: Variant;
begin
  Result := True;
  { Check record index }
  if (RecNo < 0) or (RecNo >= SqlBuffer.Count) then
  begin
    Result := False;
    Exit;
  end;
  { Check record by OnFilterRecord event }
  if Filtered and Assigned(OnFilterRecord) then
  begin
    OldState  := State;
    OldCurRec := CurRec;
    try
      SetState(dsNewValue);
      CurRec := RecNo;
      OnFilterRecord(Self, Result);
    finally
      SetState(OldState);
      CurRec := OldCurRec;
    end;
  end;
  if not Result then Exit;
  { Check record by equation }
  if FFiltered and (FParser.Equation <> '') then
  begin
    { Fill field variables }
    for I := 0 to FParser.VarCount-1 do
    begin
      FieldDesc := SqlBuffer.SqlFields.FindByAlias(FParser.VarNames[I]);
      if not Assigned(FieldDesc) then Continue;
      FParser.Variables[FParser.VarNames[I]] :=
        SqlBuffer.GetFieldValue(FieldDesc, SqlBuffer[RecNo]);
    end;
    { Evalute the result }
    Value := FParser.Evalute;
    Result := (Value <> Null) and
      (StrToFloatDefEx(VarAsType(Value, varString),-1) <> 0);
  end;
end;

{***************** Extra methods ***************}

{ Process notification method }
procedure TZDataset.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if Operation <> opRemove then Exit;
  { Check if removing database object }
  if AComponent = FDatabase then
  begin
    Close;
    try
      FDatabase.RemoveDataset(Self);
    finally
      FDatabase := nil;
    end;
  end;
  { Check if removing transact object }
  if AComponent = FTransact then
  begin
    Close;
    RequestLive := False;
    FTransact   := nil;
  end;
  { Clear other external components }
  if AComponent = FUpdateObject then
    FUpdateObject := nil;
  if AComponent = FMasterLink.Datasource then
    FMasterLink.DataSource := nil;
  if AComponent = FDataLink.Datasource then
    FDataLink.DataSource := nil;
end;

{ Invoke OnProgress event }
procedure TZDataset.DoProgress(Stage: TZProgressStage;
  Proc: TZProgressProc; Position: Integer);
var
  Cancel: Boolean;
begin
  if Assigned(OnProgress) then
  begin
    Cancel := False;
    OnProgress(Self, Stage, Proc, Position,
      Max(SqlBuffer.Count, Query.RecordCount), Cancel);
  end;
end;

{******************* IndexDefs support routines *****************}

{ Set new IndexDefs }
procedure TZDataset.SetIndexDefs(Value: TIndexDefs);
begin
  IndexDefs.Assign(Value);
end;

{ Get current index name }
function TZDataset.GetIndexName: string;
begin
  if FFieldsIndex then Result := ''
  else Result := FIndexName;
end;

{ Set new index name }
procedure TZDataset.SetIndexName(const Value: string);
begin
  if (FIndexName <> Value) or (FFieldsIndex <> False) then
    SetIndex(Value, False);
end;

{ Get fields index }
function TZDataset.GetIndexFieldNames: string;
begin
  if FFieldsIndex then Result := FIndexName
  else Result := '';
end;

{ set fields index }
procedure TZDataset.SetIndexFieldNames(const Value: string);
begin
  if (FIndexName <> Value) or (FFieldsIndex <> True) then
    SetIndex(Value, True);
end;

{ Get field index count }
function TZDataset.GetIndexFieldCount: Integer;
begin
  Result := FieldCount;
end;

{ Get index field }
function TZDataset.GetIndexField(Index: Integer): TField;
begin
  Result := Fields[Index];
end;

{ Set index field }
procedure TZDataset.SetIndexField(Index: Integer; Value: TField);
begin
  GetIndexField(Index).Assign(Value);
end;

{ Set new index }
procedure TZDataset.SetIndex(const Value: string; FieldsIndex: Boolean);
var
  IndexDef: TIndexDef;
  Fields: string;
  SortType: TSortType;
begin
  { Set startup values }
  FIndexName := Value;
  FFieldsIndex := FieldsIndex;
  SortType := stAscending;
  { Get sorting fields }
  if FieldsIndex then
    Fields := Value
  else
    try
      if IndexDefs.IndexOf(Value) >= 0 then
      begin
        IndexDef := IndexDefs[IndexDefs.IndexOf(Value)];
        Fields := IndexDef.Fields;
        if ixDescending in IndexDef.Options then
          SortType := stDescending;
      end else
        Fields := '';
    except
      Fields := '';
    end;
  { Check state }
  InternalSort(Fields, SortType);
end;

{delphi str fields to sql str fields}
function TZDataset.FormatFieldsList(Value: string): string;
var
  FieldName: string;
  i: Integer;
begin
  i := 1;
  Result := '';
  while i <= Length(Value) do
  begin
   FieldName := ExtractFieldName(Value, i);
   if Result = '' then
      Result := ProcessIdent(FieldName)
    else
      Result := Re