zquery.pas

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

    if doHourGlass in FOptions then
      Screen.Cursor := crSqlWait;
{$ENDIF}

    Value := Max(1, Value);

    { Invoke on progress event }
    DoProgress(psStarting, ppFetching, SqlBuffer.Count);
    { Fetch one record from server }
    while not Query.EOF and (Value > SqlBuffer.Count) do
      QueryRecord;
    { Invoke on progress event }
    DoProgress(psEnding, ppFetching, SqlBuffer.Count);

    if Value <= SqlBuffer.Count then
      CurRec := Value - 1
    else
      CurRec := SqlBuffer.Count - 1;
    if not (State in [dsInactive]) then Resync([]);
  finally
{$IFNDEF NO_GUI}
    if doHourGlass in FOptions then
      Screen.Cursor := OldCursor;
{$ENDIF}
  end;
end;

{ Define is query editable? }
function TZDataset.GetCanModify: Boolean;
begin
  Result := FRequestLive;
end;

{*** Bookmarks processing methods ***}

{ Internal go to bookmark }
procedure TZDataset.InternalGotoBookmark(Bookmark: Pointer);
var
  Index: Integer;
begin
  Index := PInteger(Bookmark)^;
  CurRec := SqlBuffer.IndexOfIndex(Index);
  if CurRec < 0 then
    DatabaseError(SBookmarkNotFound);
end;

{ Internal go to defined record }
procedure TZDataset.InternalSetToRecord(Buffer: PChar);
begin
  InternalGotoBookmark(@PRecordData(Buffer).Index);
end;

{ Get bookmark flag }
function TZDataset.GetBookmarkFlag(Buffer: PChar): TBookmarkFlag;
begin
  Result := PRecordData(Buffer).BookmarkFlag;
end;

{ Set bookmark flag }
procedure TZDataset.SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag);
begin
  PRecordData(Buffer).BookmarkFlag := Value;
end;

{ Get bookmark data }
procedure TZDataset.GetBookmarkData(Buffer: PChar; Data: Pointer);
begin
  PInteger(Data)^ := PRecordData(Buffer).Index;
end;

{ Set boomark data }
procedure TZDataset.SetBookmarkData(Buffer: PChar; Data: Pointer);
begin
  PRecordData(Buffer).Index := PInteger(Data)^;
end;

{ Compare two bookmarks }
function TZDataset.CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer;
var
  Index1, Index2: Integer;
begin
  Result := 0;
  if not Assigned(Bookmark1) or not Assigned(Bookmark2) then
    Exit;
  Index1 := SqlBuffer.IndexOfIndex(PInteger(Bookmark1)^);
  Index2 := SqlBuffer.IndexOfIndex(PInteger(Bookmark2)^);
  if Index1 < Index2 then Result := -1
  else if Index1 > Index2 then Result := 1;
end;

{ Validate book }
function TZDataset.BookmarkValid(Bookmark: TBookmark): Boolean;
begin
  Result := False;
  if Active and Assigned(Bookmark) then
    try
      Result := (SqlBuffer.IndexOfIndex(PInteger(Bookmark)^) >= 0)
    except
      Result := False;
    end;
end;

{*************** Updating methods **************}

{ Update record after initialization }
procedure TZDataset.UpdateAfterInit(RecordData: PRecordData);
var
  I: Integer;
  FieldDesc: PFieldDesc;
  RecordBlob: PRecordBlob;
begin
  { Correct blobs description }
  for I := 0 to SqlBuffer.SqlFields.Count-1 do
  begin
    FieldDesc := SqlBuffer.SqlFields[I];
    if FieldDesc.FieldType in [ftBlob, ftMemo, ftGraphic, ftFmtMemo] then
    begin
      RecordBlob := PRecordBlob(@RecordData.Bytes[FieldDesc.Offset+1]);
      RecordBlob.BlobType := FieldDesc.BlobType;
      RecordBlob.Data := nil;
      RecordBlob.Size := 0;
      RecordBlob.Handle.Ptr := 0;
      RecordBlob.Handle.PtrEx := 0;
    end;
  end;
end;

{ Clear and initialize new record buffer }
procedure TZDataset.InternalInitRecord(Buffer: PChar);
var
  I: Integer;
  FieldDesc: PFieldDesc;
begin
  { Initiate buffer }
  SqlBuffer.FreeRecord(PRecordData(Buffer), True);
  { Put default expressions }
  for I := 0 to SqlBuffer.SqlFields.Count-1 do
  begin
    FieldDesc := SqlBuffer.SqlFields[I];
    if FieldDesc.FieldObj.DefaultExpression <> '' then
    begin
      if doCalcDefault in Options then
        { Calculate default expression }
        SqlBuffer.SetField(FieldDesc,
          EvaluteDef(FieldDesc.FieldObj.DefaultExpression), PRecordData(Buffer))
      else
        { Copy default expression }
        SqlBuffer.SetField(FieldDesc, FieldDesc.FieldObj.DefaultExpression,
          PRecordData(Buffer));
    end else
      if ((FieldDesc.Default <> '') or (not FieldDesc.IsNull
        and (doAutoFillDefs in Options))) and (FieldDesc.AutoType = atNone) then
        { Calculate sql field default value }
        SqlBuffer.SetField(FieldDesc, EvaluteDef(FieldDesc.Default),
          PRecordData(Buffer));
  end;
  { Put link values from master dataset }
  if FMasterLink.Active and (FMasterLink.Fields.Count > 0) then
  begin
    if FMasterIndex = -1 then
      MasterDefine;
    if FMasterIndex <> -1 then
      for I := 0 to SqlBuffer.FilterFieldCount-1 do
      begin
        FieldDesc := SqlBuffer.SqlFields[SqlBuffer.FilterFields[I]];
        SqlBuffer.SetFieldValue(FieldDesc,
          SqlBuffer.GetFieldValue(FieldDesc, SqlBuffer.FilterBuffer),
          PRecordData(Buffer));
      end;
  end;
  { Update record by local init }
  UpdateAfterInit(PRecordData(Buffer));
end;

{ Evalute default value }
function TZDataset.EvaluteDef(Value: string): string;
  { Try to count equation }
  function Evalute(Buffer: string; var Value: string): Boolean;
  var
    CmdNo: Integer;
    TokenType: TTokenType;
  begin
    TokenType := ExtractHighToken(Buffer, nil, Value, CmdNo);
    DeleteQuotes(Value);
    if (TokenType in [ttString, ttDigit]) and (Trim(Buffer) = '') then
      Result := True
    else
      Result := False;
  end;
begin
  Result := '';
  if Value = '' then Exit;
  try
    if not Evalute(Value, Result) then
      Result := FTransact.ExecFunc(Value)
  except
  end;
end;

{ Internal edit mode setting }
procedure TZDataset.InternalEdit;
var
  ActiveData: PRecordData;
begin
  if not CachedUpdates and (doRefreshBeforeEdit in Options) then
  begin
    if not GetActiveRecBuf(ActiveData) then Exit;
    if RefreshCurrentRow(ActiveData) then
    begin
      SqlBuffer.CopyRecord(ActiveData, SqlBuffer[CurRec], False);
      Resync([]);
    end;
  end;
end;

{ Internal updates store }
procedure TZDataset.InternalUpdate;
var
  ActiveData: PRecordData;
  SaveRecord: PRecordData;
  CacheRecord: PRecordData;
  Index: Integer;
begin
  { Get current buffer }
  if not GetActiveRecBuf(ActiveData) then Exit;
  { Change record tyoe }
  SaveRecord := PRecordData(AllocRecordBuffer);
  SqlBuffer.CopyRecord(SqlBuffer[CurRec], SaveRecord, False);
  if SqlBuffer[CurRec].RecordType = ztUnmodified then
    SqlBuffer[CurRec].RecordType := ztModified;
  { Copy old record content into cache }
  if CacheBuffer.IndexOfIndex(SqlBuffer[CurRec].Index) < 0 then
  begin
    CacheRecord := CacheBuffer.Add;
    SqlBuffer.CopyRecord(SqlBuffer[CurRec], CacheRecord, True);
  end else
    CacheRecord := nil;
  { Save current data and post updates }
  SqlBuffer.CopyRecord(ActiveData, SqlBuffer[CurRec], False);
  { Filter updated record }
  if SqlBuffer.FilterItem(CurRec) then
    CurRec := Min(SqlBuffer.Count-1, CurRec);
  { Post updates }
  try
    if not CachedUpdates then Flush;
  except
    SqlBuffer.CopyRecord(SaveRecord, SqlBuffer[CurRec], False);
    if Assigned(CacheRecord) then
      CacheBuffer.Remove(CacheRecord);
    FreeRecordBuffer(PChar(SaveRecord));
    raise;
  end;
  FreeRecordBuffer(PChar(SaveRecord));
  { Resort query }
  if (SqlBuffer.SortFieldCount > 0) or (SqlBuffer.IsSortInverse) then
  begin
    Index := SqlBuffer[CurRec].Index;
    SqlBuffer.SortRestore;
    CurRec := SqlBuffer.IndexOfIndex(Index);
  end;
end;

{ Internal add new record }
procedure TZDataset.InternalAddRecord(Buffer: Pointer; Append: Boolean);
var
  ActiveData: PRecordData;
  AddRecord: PRecordData;
  CacheRecord: PRecordData;
  Index: Integer;
begin
  { Get and check current buffer }
  if not GetActiveRecBuf(ActiveData) then Exit;
  if ActiveData <> Buffer then
    DatabaseError(Format(SIntFuncError,['InternalAddRecord']));
  { Append or insert a new record }
  if Append or (CurRec < 0) or (CurRec >= SqlBuffer.Count) then
  begin
    InternalLast;
    AddRecord := SqlBuffer.Add;
    CurRec := SqlBuffer.Count-1;
  end else
    AddRecord := SqlBuffer.Insert(CurRec);
  { Fill inserted record with current values }
  SqlBuffer.CopyRecord(ActiveData, AddRecord, False);
  AddRecord.RecordType := ztInserted;
  ChangeAddBuffer(AddRecord);
  { Add a record into the cache and post updates }
  CacheRecord := CacheBuffer.Add;
  SqlBuffer.CopyRecord(AddRecord, CacheRecord, True);
  { Filter inserted record }
  if SqlBuffer.FilterItem(CurRec) then
    CurRec := Min(SqlBuffer.Count-1, CurRec);
  { Post changes }
  try
    if not CachedUpdates then Flush;
  except
    SqlBuffer.Remove(AddRecord);
    CacheBuffer.Remove(CacheRecord);
    raise;
  end;
  { Resort query }
  if (SqlBuffer.SortFieldCount > 0) or (SqlBuffer.IsSortInverse) then
  begin
    Index := SqlBuffer[CurRec].Index;
    SqlBuffer.SortRestore;
    CurRec := SqlBuffer.IndexOfIndex(Index);
  end;
end;

{ Internal procedure for change inserting data }
procedure TZDataset.ChangeAddBuffer(AddRecord: PRecordData);
begin
end;

{ Internal post updates }
procedure TZDataset.InternalPost;
var
  ActiveData: PRecordData;
begin
  { Get current buffer }
  GetActiveRecBuf(ActiveData);

  CheckContraints;

  { Update or insert record according dataset state }
  if State = dsEdit then
    InternalUpdate
  else
    InternalAddRecord(ActiveData, False);
end;

{ Internal delete record }
procedure TZDataset.InternalDelete;
var
  ActiveData: PRecordData;
  Index: Integer;
begin
  CheckBrowseMode;
  if not CanModify then
    DatabaseError('Cannot modify a read-only dataset');
  { Get and check current buffer }
  if not GetActiveRecBuf(ActiveData) then Exit;
  { Check record type and delete (if inserted) or mark the record }
  if SqlBuffer[CurRec].RecordType = ztInserted then
  begin
    CacheBuffer.Delete(CacheBuffer.IndexOfIndex(SqlBuffer[CurRec].Index));
    SqlBuffer.Delete(CurRec);
  end
  else
  begin
    SqlBuffer[CurRec].RecordType := ztDeleted;
    Index := CacheBuffer.IndexOfIndex(SqlBuffer[CurRec].Index);
    { If record already in buffer - mark, else add }
    if Index < 0 then
      SqlBuffer.CopyRecord(SqlBuffer[CurRec], CacheBuffer.Add, True)
    else
      CacheBuffer[Index].RecordType := ztDeleted;
  end;
  { Filter updated record }
  if CurRec < SqlBuffer.Count then
    SqlBuffer.FilterItem(CurRec);
  CurRec := Min(SqlBuffer.Count-1, CurRec);
  { Post changes }
  if not CachedUpdates then Flush;
end;

{ Internal refresh query }
procedure TZDataset.InternalRefresh;
var
  Error: string;
  KeyFields: string;
  KeyValues: Variant;
  RecordCount: Integer;
{$IFNDEF NO_GUI}
  OldCursor: TCursor;
{$ENDIF}
begin
{$IFNDEF NO_GUI}
  OldCursor := Screen.Cursor;
{$ENDIF}
  try
{$IFNDEF NO_GUI}
    if doHourGlass in FOptions then
       Screen.Cursor := crSqlWait;
{$ENDIF}
    { Store record params }
    RecordCount := Self.RecordCount;
    FormKeyValues(KeyFields, KeyValues);
    { Clear all collections }
    Query.Close;
    SqlBuffer.ClearBuffer(False);
    CacheBuffer.ClearBuffer(False);
    { Open the query }
    if Trim(Query.Sql) = '' then
      DatabaseError('Empty Query');
    Query.Open;
    if not Query.Active then
    begin
      Error := ConvertFromSqlEnc(Query.Error);
      if Assigned(TransactObj) then
        TransactObj.Recovery(True);
      DatabaseError(Error);
    end;
    { Set mail query params }
    FRowsAffected := 0;
    CurRec := -1;

    { Invoke on progress event }
    DoProgress(psStarting, ppFetching, SqlBuffer.Count);
    { Fetch fields }
    while (not Query.EOF) and ((RecordCount > 0) or FetchAll) do
    begin
      QueryRecord;
      Dec(RecordCount);
    end;
    { Invoke on progress event }
    DoProgress(psEnding, ppFetching, SqlBuffer.Count);

    { Sort with old method }
    SqlBuffer.SortRestore;
    { Locate to old position }
    if KeyFields <> '' then
      Locate(KeyFields, KeyValues, []);
    { Resync records }
    if not (State in [dsInactive]) then Resync([]);
  finally
{$IFNDEF NO_GUI}
    if doHourGlass in FOptions then
      Screen.Cursor := OldCursor;
{$ENDIF}
  end;
end;

{ Short refresh dataset }
procedure TZDataset.ShortRefresh;
{$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;