www.pudn.com > sybase_dblib4.zip > SybDataSet.pas

unit SybDataSet; 
interface 
uses Windows, Db, Classes, 
     SybBaseQuery, 
     SybDatabase; 
 
type 
  PSybData = ^TSybData; 
  TSybData = record 
    Name  :array[0..29] of char; 
    Id    :array[0..10] of char; 
  end; 
 
type 
  // Bookmark information record to support TDataset bookmarks: 
  PSybBookmarkInfo = ^TSybBookmarkInfo; 
  TSybBookmarkInfo = record 
    BookmarkData: Integer; 
    BookmarkFlag: TBookmarkFlag; 
  end; 
 
  TSybDataSet = class(TDataSet) 
  private 
  public 
    FQuery     :TSybBaseQuery; 
    FTableName: string; 
    FRecordPos: Integer; 
    FRecordSize: Integer; 
    FBufferSize: Integer; 
    procedure SetTableName(const Value: string); 
  protected 
    { Mandatory overrides } 
    // Record buffer methods: 
    function AllocRecordBuffer: PChar; override; 
    procedure FreeRecordBuffer(var Buffer: PChar); override; 
    procedure InternalInitRecord(Buffer: PChar); override; 
    function GetRecord(Buffer: PChar; GetMode: TGetMode; 
      DoCheck: Boolean): TGetResult; override; 
    function GetRecordSize: Word; override; 
    procedure SetFieldData(Field: TField; Buffer: Pointer); override; 
    // Bookmark methods: 
    procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override; 
    function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override; 
    procedure InternalGotoBookmark(Bookmark: Pointer); override; 
    procedure InternalSetToRecord(Buffer: PChar); override; 
    procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override; 
    procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override; 
    // Navigational methods: 
    procedure InternalFirst; override; 
    procedure InternalLast; override; 
    // Editing methods: 
    procedure InternalAddRecord(Buffer: Pointer; Append: Boolean); override; 
    procedure InternalDelete; override; 
    procedure InternalPost; override; 
    // Misc methods: 
    procedure InternalClose; override; 
    procedure InternalHandleException; override; 
    procedure InternalInitFieldDefs; override; 
    procedure InternalOpen; override; 
    function IsCursorOpen: Boolean; override; 
    { Optional overrides } 
    function GetRecordCount: Integer; override; 
    function GetRecNo: Integer; override; 
    procedure SetRecNo(Value: Integer); override; 
  public 
    constructor Create(AOwner: TComponent); override; 
    destructor Destroy; override; 
    function GetFieldData(Field: TField; Buffer: Pointer): Boolean; override; 
 
  published 
    property Active; 
    property TableName: string read FTableName write SetTableName; 
    property BufferCount; 
 
    property BeforeOpen; 
    property AfterOpen; 
    property BeforeClose; 
    property AfterClose; 
    property BeforeInsert; 
    property AfterInsert; 
    property BeforeEdit; 
    property AfterEdit; 
    property BeforePost; 
    property AfterPost; 
    property BeforeCancel; 
    property AfterCancel; 
    property BeforeDelete; 
    property AfterDelete; 
    property BeforeScroll; 
    property AfterScroll; 
    property OnDeleteError; 
    property OnEditError; 
  end; 
 
procedure Register; 
 
implementation 
 
uses BDE, DBTables, SysUtils, DBConsts, Forms, Controls, Dialogs; 
 
procedure Register; 
begin 
  RegisterComponents('Sybase DBLIB', [TSybDataSet]); 
end; 
{ TSybDataSet } 
 
function TSybDataSet.AllocRecordBuffer: PChar; 
begin 
  Result := AllocMem(FBufferSize); 
end; 
 
constructor TSybDataSet.Create(AOwner: TComponent); 
begin 
  inherited Create(AOwner); 
  FRecordSize := SizeOf(TSybData); 
  FBufferSize := FRecordSize + SizeOf(TSybBookmarkInfo); 
 
  FQuery:=TSybBaseQuery.create(nil); 
  FQuery.DbName:='db'; 
end; 
 
destructor TSybDataSet.Destroy; 
begin 
  inherited Destroy; 
end; 
 
procedure TSybDataSet.FreeRecordBuffer(var Buffer: PChar); 
begin 
  FreeMem(Buffer); 
end; 
 
procedure TSybDataSet.GetBookmarkData(Buffer: PChar; Data: Pointer); 
begin 
  PInteger(Data)^ := PSybBookmarkInfo(Buffer + FRecordSize)^.BookmarkData; 
end; 
 
function TSybDataSet.GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; 
begin 
  Result := PSybBookmarkInfo(Buffer + FRecordSize)^.BookmarkFlag; 
end; 
 
function TSybDataSet.GetFieldData(Field: TField; Buffer: Pointer): Boolean; 
begin 
  Result := True; 
  case Field.Index of 
    0:begin 
        Move(PSybData(ActiveBuffer)^.Name, Buffer^, Field.DataSize); 
      end; 
    1:begin 
        Move(PSybData(ActiveBuffer)^.Id, Buffer^, Field.DataSize); 
      end 
  end; 
end; 
 
function TSybDataSet.GetRecNo: Integer; 
begin 
  UpdateCursorPos; 
  if (FRecordPos = -1) and (RecordCount > 0) then 
    Result := 1 
  else 
    Result := FRecordPos + 1; 
end; 
 
function TSybDataSet.GetRecord(Buffer: PChar; GetMode: TGetMode; 
  DoCheck: Boolean): TGetResult; 
var 
  IndexPos: Integer; 
begin 
  if FQuery.RowsAffected < 1 then 
    Result := grEOF 
  else 
  begin 
    Result := grOk; 
    case GetMode of 
      gmPrior: 
        if FRecordPos <= 0 then 
        begin 
          Result := grBOF; 
          FRecordPos := -1; 
        end 
        else 
          Dec(FRecordPos); 
      gmCurrent: 
        if (FRecordPos < 0) or (FRecordPos >= RecordCount) then 
           Result := grError; 
      gmNext: 
        if FRecordPos >= RecordCount-1 then 
          Result := grEOF 
        else 
          Inc(FRecordPos); 
    end; 
    if Result = grOk then 
    begin 
      FQuery.GetRow(FRecordPos+1); 
 
      strpcopy(PSybData(Buffer)^.Name,FQuery.Column(1)); 
      strpcopy(PSybData(Buffer)^.Id,FQuery.Column(2)); 
 
      with PSybBookmarkInfo(Buffer + FRecordSize)^ do 
      begin 
        BookmarkData := FRecordPos; 
        BookmarkFlag := bfCurrent; 
      end; 
    end 
    else if (Result = grError) and DoCheck then 
      DatabaseError('No records'); 
  end; 
end; 
 
function TSybDataSet.GetRecordCount: Integer; 
begin 
  Result := FQuery.RowsAffected; 
end; 
 
function TSybDataSet.GetRecordSize: Word; 
begin 
  Result := FRecordSize; 
end; 
 
procedure TSybDataSet.InternalAddRecord(Buffer: Pointer; Append: Boolean); 
begin 
// 
end; 
 
procedure TSybDataSet.InternalClose; 
begin 
  if DefaultFields then 
    DestroyFields; 
  FRecordPos := -1; 
end; 
 
procedure TSybDataSet.InternalDelete; 
begin 
// 
end; 
 
procedure TSybDataSet.InternalFirst; 
begin 
  FRecordPos := -1; 
end; 
 
procedure TSybDataSet.InternalGotoBookmark(Bookmark: Pointer); 
begin 
  FRecordPos := Integer(Bookmark); 
end; 
 
procedure TSybDataSet.InternalHandleException; 
begin 
  // standard implementation for this method: 
  Application.HandleException(Self); 
end; 
 
procedure TSybDataSet.InternalInitFieldDefs; 
var i       :integer; 
begin 
  // create FieldDefs which map to each field in the data record 
  FieldDefs.Clear; 
 
//  TFieldDef.Create(FieldDefs, FQuery.heading(1), ftString, FQuery.collength(1), False, 1); 
//  TFieldDef.Create(FieldDefs, FQuery.heading(2), ftString, 11, False, 2); 
 
  for i:=1 to FQuery.Numcols do 
  begin 
    TFieldDef.Create(FieldDefs, FQuery.heading(i), ftString, FQuery.collength(i), False, i); 
  end; 
end; 
 
procedure TSybDataSet.InternalInitRecord(Buffer: PChar); 
begin 
  FillChar(Buffer^, FBufferSize, 0); 
end; 
 
procedure TSybDataSet.InternalLast; 
begin 
  FRecordPos := FQuery.RowsAffected; 
end; 
 
procedure TSybDataSet.InternalOpen; 
begin 
//  if not FQuery.Active then 
//  begin 
//    MessageBox(GetActiveWindow,'Not connected to database','DB-Library error',mb_ok+mb_iconexclamation); 
//    exit; 
//  end; 
 
  FQuery.Active:=True; 
  FQuery.sql:='select name,id from develop..t_cursor'; 
  FQuery.sqlexec; 
  while FQuery.nextrow = -1 do; 
  try 
    FRecordPos := -1;                   // initial record pos before BOF 
    BookmarkSize := SizeOf(Integer);   // initialize bookmark size for VCL 
    InternalInitFieldDefs;              // initialize FieldDef objects 
 
    // Create TField components when no persistent fields have been created 
    if DefaultFields then 
      CreateFields; 
 
    BindFields(True);                 // bind FieldDefs to actual data 
  except 
    raise; 
  end; 
end; 
 
procedure TSybDataSet.InternalPost; 
begin 
// 
end; 
 
procedure TSybDataSet.InternalSetToRecord(Buffer: PChar); 
begin 
  FRecordPos := PSybBookmarkInfo(Buffer + FRecordSize)^.Bookmarkdata; 
end; 
 
function TSybDataSet.IsCursorOpen: Boolean; 
begin 
  Result:=FQuery.Active; 
end; 
 
procedure TSybDataSet.SetBookmarkData(Buffer: PChar; Data: Pointer); 
begin 
  PSybBookmarkInfo(Buffer + FRecordSize)^.BookmarkData := PInteger(Data)^; 
end; 
 
procedure TSybDataSet.SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); 
begin 
  PSybBookmarkInfo(Buffer + FRecordSize)^.BookmarkFlag := Value; 
end; 
 
procedure TSybDataSet.SetFieldData(Field: TField; Buffer: Pointer); 
begin 
  case Field.Index of 
    0: Move(Buffer^, PSybData(ActiveBuffer)^.Name, Field.Size); 
    1: Move(Buffer^, PSybData(ActiveBuffer)^.Id, Field.DataSize); 
  end; 
  DataEvent(deFieldChange, Longint(Field)); 
end; 
 
procedure TSybDataSet.SetRecNo(Value: Integer); 
begin 
  if (Value >= 0) and (Value <= FQuery.RowsAffected-1) then 
  begin 
    FRecordPos := Value - 1; 
    Resync([]); 
  end; 
end; 
 
procedure TSybDataSet.SetTableName(const Value: string); 
begin 
  CheckInactive; 
  FTableName := Value; 
end; 
 
end.