123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578 |
- unit customsqliteds;
- {
- This is TCustomSqliteDataset, a TDataset descendant class for use with fpc compiler
- Copyright (C) 2004 Luiz Américo Pereira Câmara
- Email: [email protected]
- This program is free software; you can redistribute it and/or modify
- it under the terms of the GNU Lesser General Public License as published by
- the Free Software Foundation; either version 2.1 of the License, or
- (at your option) any later version.
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU Lesser General Public License for more details.
- You should have received a copy of the GNU Lesser General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
- }
- {$Mode ObjFpc}
- {$H+}
- { $Define DEBUG}
- { $Define DEBUGACTIVEBUFFER}
- interface
- uses
- Classes, SysUtils, Db;
- type
- PDataRecord = ^DataRecord;
- PPDataRecord = ^PDataRecord;
- DataRecord = record
- Row: PPchar;
- BookmarkFlag: TBookmarkFlag;
- Next: PDataRecord;
- Previous: PDataRecord;
- end;
-
- TDSStream = class(TStream)
- private
- FActiveItem:PDataRecord;
- FFieldRow:PChar;
- FFieldIndex:Integer;
- FRowSize: Integer;
- FPosition: Longint;
- public
- constructor Create(const ActiveItem: PDataRecord; FieldIndex:Integer);
- function Write(const Buffer; Count: Longint): Longint; override;
- function Read(var Buffer; Count: Longint): Longint; override;
- function Seek(Offset: Longint; Origin: Word): Longint; override;
- end;
- //callback types
- TSqliteCdeclCallback = function (UserData:Pointer; Count:LongInt; Values:PPChar; Names:PPChar):LongInt;cdecl;
- TSqliteCallback = function (UserData:Pointer; Count:LongInt; Values:PPChar; Names:PPChar):LongInt of Object;
- TCallbackInfo = record
- Proc: TSqliteCallback;
- Data: Pointer;
- end;
- PCallbackInfo = ^TCallbackInfo;
-
- TRecordState = (rsAdded,rsDeleted,rsUpdated);
- TRecordStateSet = set of TRecordState;
- TQueryUpdatesCallback = procedure (UserData: Pointer; Values: PPChar; ABookmark: TBookmark; RecordState: TRecordState) of Object;
- TGetSqlStrFunction = function (APChar: PChar): String;
- { TCustomSqliteDataset }
- TCustomSqliteDataset = class(TDataSet)
- private
- {$ifdef DEBUGACTIVEBUFFER}
- FFCurrentItem: PDataRecord;
- {$else}
- FCurrentItem: PDataRecord;
- {$endif}
- FInternalActiveBuffer: PDataRecord;
- FInsertBookmark: PDataRecord;
- FBufferSize: Integer;
- FExpectedAppends: Integer;
- FExpectedDeletes: Integer;
- FExpectedUpdates: Integer;
- FOnCallback: TSqliteCallback;
- FSaveOnClose: Boolean;
- FSaveOnRefetch: Boolean;
- FAutoIncrementKey: Boolean;
- FMasterLink: TMasterDataLink;
- FIndexFieldNames: String;
- FIndexFieldList: TList;
- FSqlList:TStrings;
- procedure CopyCacheToItem(AItem: PDataRecord);
- function GetIndexFields(Value: Integer): TField;
- procedure UpdateIndexFields;
- function FindRecordItem(StartItem: PDataRecord; const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions; DoResync:Boolean):PDataRecord;
- protected
- FPrimaryKey: String;
- FPrimaryKeyNo: Integer;
- FFileName: String;
- FSql: String;
- FTableName: String;
- FSelectSqlStr: String;
- FAutoIncFieldNo: Integer;
- FNextAutoInc:Integer;
- FUpdatedItems: TFPList;
- FAddedItems: TFPList;
- FDeletedItems: TFPList;
- FOrphanItems: TFPList;
- FReturnCode: Integer;
- FSqliteHandle: Pointer;
- FDataAllocated: Boolean;
- FRowBufferSize: Integer;
- FRowCount: Integer;
- FRecordCount: Integer;
- FBeginItem: PDataRecord;
- FEndItem: PDataRecord;
- FCacheItem: PDataRecord;
- FGetSqlStr: array of TGetSqlStrFunction;
- function SqliteExec(Sql:PChar; ACallback: TSqliteCdeclCallback; Data: Pointer):Integer;virtual; abstract;
- procedure InternalCloseHandle;virtual;abstract;
- function InternalGetHandle: Pointer; virtual; abstract;
- procedure GetSqliteHandle;
- function GetSqliteVersion: String; virtual; abstract;
- procedure BuildLinkedList; virtual; abstract;
- procedure DisposeLinkedList;
- procedure SetDetailFilter;
- procedure MasterChanged(Sender: TObject);
- procedure MasterDisabled(Sender: TObject);
- procedure SetMasterFields(Value:String);
- function GetMasterFields:String;
- procedure SetMasterSource(Value: TDataSource);
- function GetMasterSource:TDataSource;
- procedure SetFileName(Value: String);
- function GetRowsAffected:Integer; virtual;abstract;
- //TDataSet overrides
- function AllocRecordBuffer: PChar; override;
- function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override;
- procedure DoAfterInsert; override;
- procedure DoBeforeInsert; override;
- procedure FreeRecordBuffer(var Buffer: PChar); override;
- procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
- function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
- function GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; override;
- function GetRecordCount: Integer; override;
- function GetRecNo: Integer; override;
- function GetRecordSize: Word; override;
- procedure InternalAddRecord(Buffer: Pointer; DoAppend: Boolean); override;
- procedure InternalClose; override;
- procedure InternalCancel; override;
- procedure InternalDelete; override;
- procedure InternalEdit; override;
- procedure InternalFirst; override;
- procedure InternalGotoBookmark(ABookmark: Pointer); override;
- procedure InternalInitRecord(Buffer: PChar); override;
- procedure InternalLast; override;
- procedure InternalOpen; override;
- procedure InternalPost; override;
- procedure InternalSetToRecord(Buffer: PChar); override;
- function IsCursorOpen: Boolean; override;
- procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;
- procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
- procedure SetExpectedAppends(AValue:Integer);
- procedure SetExpectedUpdates(AValue:Integer);
- procedure SetExpectedDeletes(AValue:Integer);
- procedure SetFieldData(Field: TField; Buffer: Pointer); override;
- procedure SetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean); override;
- procedure SetRecNo(Value: Integer); override;
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- function BookmarkValid(ABookmark: TBookmark): Boolean; override;
- function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Longint; override;
- function GetFieldData(Field: TField; Buffer: Pointer): Boolean; override;
- function GetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean): Boolean; override;
- function Locate(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions) : boolean; override;
- function LocateNext(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions) : boolean;
- function Lookup(const KeyFields: string; const KeyValues: Variant; const ResultFields: string): Variant;{$ifndef ver2_0_0}override;{$endif}
- // Additional procedures
- function ApplyUpdates: Boolean;
- function CreateTable: Boolean;
- function CreateTable(const ATableName: String): Boolean;
- procedure ExecCallback(const ASql: String; UserData: Pointer = nil);
- procedure ExecSQL;
- procedure ExecSQL(const ASql:String);
- procedure ExecSQLList;
- procedure ExecuteDirect(const ASql: String);virtual;abstract;
- procedure QueryUpdates(RecordStates: TRecordStateSet; Callback: TQueryUpdatesCallback; UserData: Pointer=nil);
- function QuickQuery(const ASql:String):String;overload;
- function QuickQuery(const ASql:String;const AStrList: TStrings):String;overload;
- function QuickQuery(const ASql:String;const AStrList: TStrings;FillObjects:Boolean):String;virtual;abstract;overload;
- procedure RefetchData;
- function ReturnString: String; virtual;abstract;
- function TableExists: Boolean;
- function TableExists(const ATableName:String):Boolean;
- function UpdatesPending: Boolean;
- {$ifdef DEBUGACTIVEBUFFER}
- procedure SetCurrentItem(Value:PDataRecord);
- property FCurrentItem: PDataRecord read FFCurrentItem write SetCurrentItem;
- {$endif}
- property ExpectedAppends: Integer read FExpectedAppends write SetExpectedAppends;
- property ExpectedUpdates: Integer read FExpectedUpdates write SetExpectedUpdates;
- property ExpectedDeletes: Integer read FExpectedDeletes write SetExpectedDeletes;
- property IndexFields[Value: Integer]: TField read GetIndexFields;
- property RowsAffected: Integer read GetRowsAffected;
- property ReturnCode: Integer read FReturnCode;
- property SqliteHandle: Pointer read FSqliteHandle;
- property SqliteVersion: String read GetSqliteVersion;
- property SQLList:TStrings read FSqlList;
- published
- property AutoIncrementKey: Boolean read FAutoIncrementKey write FAutoIncrementKey;
- property IndexFieldNames: string read FIndexFieldNames write FIndexFieldNames;
- property FileName: String read FFileName write SetFileName;
- property OnCallback: TSqliteCallback read FOnCallback write FOnCallback;
- property PrimaryKey: String read FPrimaryKey write FPrimaryKey;
- property SaveOnClose: Boolean read FSaveOnClose write FSaveOnClose;
- property SaveOnRefetch: Boolean read FSaveOnRefetch write FSaveOnRefetch;
- property SQL: String read FSql write FSql;
- property TableName: String read FTableName write FTableName;
- property MasterSource: TDataSource read GetMasterSource write SetMasterSource;
- property MasterFields: string read GetMasterFields write SetMasterFields;
-
- property Active;
-
- //Events
- 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;
-
- function Num2SqlStr(APChar: PChar): String;
- function Char2SqlStr(APChar: PChar): String;
- implementation
- uses
- strutils, variants, dbconst;
- const
- //sqlite2.x.x and sqlite3.x.x define these constants equally
- SQLITE_OK = 0;
- SQLITE_ROW = 100;
-
- NullString = 'NULL';
-
- function CallbackDispatcher(UserData:Pointer; Count:LongInt; Values:PPchar; Names:PPchar):LongInt;cdecl;
- begin
- with PCallbackInfo(UserData)^ do
- Result:= Proc(Data,Count,Values,Names);
- end;
-
- function Num2SqlStr(APChar: PChar): String;
- begin
- if APChar = nil then
- begin
- Result:=NullString;
- Exit;
- end;
- Result:=StrPas(APChar);
- end;
- function Char2SqlStr(APChar: PChar): String;
- begin
- if APChar = nil then
- begin
- Result:=NullString;
- Exit;
- end;
- //todo: create custom routine to directly transform PChar -> SQL str
- Result:=StrPas(APChar);
- if Pos('''',Result) > 0 then
- Result:=AnsiReplaceStr(Result,'''','''''');
- Result:=''''+Result+'''';
- end;
- // TDSStream
- constructor TDSStream.Create(const ActiveItem: PDataRecord; FieldIndex:Integer);
- begin
- inherited Create;
- FPosition:=0;
- FActiveItem:=ActiveItem;
- FFieldIndex:=FieldIndex;
- FFieldRow:=ActiveItem^.Row[FieldIndex];
- if FFieldRow <> nil then
- FRowSize:=StrLen(FFieldRow)
- else
- FRowSize:=0;
- end;
- function TDSStream.Seek(Offset: Longint; Origin: Word): Longint;
- begin
- Case Origin of
- soFromBeginning : FPosition:=Offset;
- soFromEnd : FPosition:=FRowSize+Offset;
- soFromCurrent : FPosition:=FPosition+Offset;
- end;
- Result:=FPosition;
- end;
- function TDSStream.Write(const Buffer; Count: Longint): Longint;
- var
- NewRow:PChar;
- begin
- Result:=Count;
- if Count = 0 then
- Exit;
- //FRowSize is always 0 when FPosition = 0,
- //so there's no need to check FPosition
- NewRow:=StrAlloc(FRowSize+Count+1);
- (NewRow+Count+FRowSize)^:=#0;
- if FRowSize > 0 then
- Move(FFieldRow^,NewRow^,FRowSize);
- Move(Buffer,(NewRow+FRowSize)^,Count);
- FActiveItem^.Row[FFieldIndex]:=NewRow;
- StrDispose(FFieldRow);
- {$ifdef DEBUG}
- WriteLn('##TDSStream.Write##');
- WriteLn(' FPosition(Before): ',FPosition);
- WriteLn(' FRowSize(Before): ',FRowSize);
- WriteLn(' FPosition(After): ',FPosition+Count);
- WriteLn(' FRowSize(After): ',StrLen(NewRow));
- //WriteLn(' Stream Value: ',NewRow);
- {$endif}
- FFieldRow:=NewRow;
- FRowSize:=StrLen(NewRow);
- Inc(FPosition,Count);
- end;
-
- function TDSStream.Read(var Buffer; Count: Longint): Longint;
- var
- BytesToMove:Integer;
- begin
- if (FRowSize - FPosition) >= Count then
- BytesToMove:=Count
- else
- BytesToMove:=FRowSize - FPosition;
- Move((FFieldRow+FPosition)^,Buffer,BytesToMove);
- Inc(FPosition,BytesToMove);
- Result:=BytesToMove;
- {$ifdef DEBUG}
- WriteLn('##TDSStream.Read##');
- WriteLn(' Bytes requested: ',Count);
- WriteLn(' Bytes moved: ',BytesToMove);
- WriteLn(' Stream.Size: ',FRowSize);
- //WriteLn(' Stream Value: ',FFieldRow);
- {$endif}
- end;
-
- // TCustomSqliteDataset override methods
- function TCustomSqliteDataset.AllocRecordBuffer: PChar;
- var
- APointer:Pointer;
- begin
- APointer := AllocMem(FBufferSize);
- PDataRecord(APointer^):=FBeginItem;
- Result:=APointer;
- end;
- constructor TCustomSqliteDataset.Create(AOwner: TComponent);
- begin
- // setup special items
- New(FBeginItem);
- New(FCacheItem);
- New(FEndItem);
-
- FBeginItem^.Previous:=nil;
- FEndItem^.Next:=nil;
-
- FBeginItem^.BookMarkFlag:=bfBOF;
- FEndItem^.BookMarkFlag:=bfEOF;
-
- FMasterLink:=TMasterDataLink.Create(Self);
- FMasterLink.OnMasterChange:=@MasterChanged;
- FMasterLink.OnMasterDisable:=@MasterDisabled;
- FIndexFieldList:=TList.Create;
- BookmarkSize := SizeOf(Pointer);
- FBufferSize := SizeOf(PPDataRecord);
- FUpdatedItems:= TFPList.Create;
- FAddedItems:= TFPList.Create;
- FOrphanItems:= TFPList.Create;
- FDeletedItems:= TFPList.Create;
- FSqlList:=TStringList.Create;
- inherited Create(AOwner);
- end;
- function TCustomSqliteDataset.CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream;
- begin
- if Mode = bmWrite then
- begin
- if not (State in [dsEdit, dsInsert]) then
- begin
- DatabaseErrorFmt(SNotInEditState,[Name],Self);
- Exit;
- end;
- StrDispose(FCacheItem^.Row[Field.FieldNo - 1]);
- FCacheItem^.Row[Field.FieldNo - 1]:=nil;
- end;
- Result:= TDSStream.Create(PPDataRecord(ActiveBuffer)^,Field.FieldNo - 1);
- end;
- procedure TCustomSqliteDataset.DoAfterInsert;
- begin
- //an append or an insert in an empty dataset
- if EOF then
- FInsertBookmark:=FEndItem
- else
- FInsertBookmark:=FInternalActiveBuffer;
- inherited DoAfterInsert;
- end;
- procedure TCustomSqliteDataset.DoBeforeInsert;
- begin
- FInternalActiveBuffer:=PPDataRecord(ActiveBuffer)^;
- inherited DoBeforeInsert;
- end;
- destructor TCustomSqliteDataset.Destroy;
- begin
- inherited Destroy;
- if FSqliteHandle <> nil then
- InternalCloseHandle;
- FUpdatedItems.Destroy;
- FAddedItems.Destroy;
- FDeletedItems.Destroy;
- FOrphanItems.Destroy;
- FMasterLink.Destroy;
- FIndexFieldList.Destroy;
- FSqlList.Destroy;
- // dispose special items
- Dispose(FBeginItem);
- Dispose(FCacheItem);
- Dispose(FEndItem);
- end;
- function TCustomSqliteDataset.BookmarkValid(ABookmark: TBookmark): Boolean;
- var
- TempItem: PDataRecord;
- begin
- Result:=False;
- TempItem:=FBeginItem^.Next;
- while TempItem <> FEndItem do
- begin
- if TempItem = PPDataRecord(ABookmark)^ then
- begin
- Result:=True;
- Exit;
- end;
- TempItem:=TempItem^.Next;
- end;
- end;
- function TCustomSqliteDataset.CompareBookmarks(Bookmark1, Bookmark2: TBookmark
- ): Longint;
- var
- TempItem: PDataRecord;
- begin
- if PPDataRecord(Bookmark1)^ = PPDataRecord(Bookmark2)^ then
- begin
- Result:=0;
- Exit;
- end;
- //assume Bookmark1 < Bookmark2
- Result:=-1;
- TempItem:=PPDataRecord(Bookmark1)^^.Previous;
- while TempItem <> FBeginItem do
- begin
- if TempItem = PPDataRecord(Bookmark2)^ then
- begin
- //Bookmark1 is greater than Bookmark2
- Result:=1;
- Exit;
- end;
- TempItem:=TempItem^.Previous;
- end;
- end;
- procedure TCustomSqliteDataset.CopyCacheToItem(AItem: PDataRecord);
- var
- i:Integer;
- begin
- for i := 0 to FRowCount - 1 do
- begin
- StrDispose(AItem^.Row[i]);
- AItem^.Row[i]:=FCacheItem^.Row[i];
- FCacheItem^.Row[i]:=nil;
- end;
- AItem^.BookmarkFlag:=FCacheItem^.BookmarkFlag;
- end;
- function TCustomSqliteDataset.GetIndexFields(Value: Integer): TField;
- begin
- if (Value < 0) or (Value > FIndexFieldList.Count - 1) then
- DatabaseError('Error acessing IndexFields: Index out of bonds',Self);
- Result:= TField(FIndexFieldList[Value]);
- end;
- procedure TCustomSqliteDataset.DisposeLinkedList;
- var
- TempItem:PDataRecord;
- Counter,I:Integer;
- begin
- //Todo: insert debug info
- //Todo: see if FDataAllocated is still necessary
- FDataAllocated:=False;
- TempItem:=FBeginItem^.Next;
- //Todo: see if is necessary to check if TempItem is nil (aparently is not)
- if TempItem <> nil then
- while TempItem^.Next <> nil do
- begin
- //Todo: Add procedure to Dispose and Free a Row ?
- for Counter:= 0 to FRowCount - 1 do
- StrDispose(TempItem^.Row[Counter]);
- FreeMem(TempItem^.Row,FRowBufferSize);
- TempItem:=TempItem^.Next;
- Dispose(TempItem^.Previous);
- end;
-
- //Dispose FBeginItem.Row
- FreeMem(FBeginItem^.Row,FRowBufferSize);
-
- //Dispose cache item
- for Counter:= 0 to FRowCount - 1 do
- StrDispose(FCacheItem^.Row[Counter]);
- FreeMem(FCacheItem^.Row,FRowBufferSize);
- //Dispose OrphanItems
- for Counter:= 0 to FOrphanItems.Count - 1 do
- begin
- TempItem:=PDataRecord(FOrphanItems[Counter]);
- for I:= 0 to FRowCount - 1 do
- StrDispose(TempItem^.Row[I]);
- FreeMem(TempItem^.Row,FRowBufferSize);
- Dispose(TempItem);
- end;
- end;
- procedure TCustomSqliteDataset.FreeRecordBuffer(var Buffer: PChar);
- begin
- FreeMem(Buffer);
- end;
- procedure TCustomSqliteDataset.GetBookmarkData(Buffer: PChar; Data: Pointer);
- begin
- Pointer(Data^) := PPDataRecord(Buffer)^;
- end;
- function TCustomSqliteDataset.GetBookmarkFlag(Buffer: PChar): TBookmarkFlag;
- begin
- Result := PPDataRecord(Buffer)^^.BookmarkFlag;
- end;
- function TCustomSqliteDataset.GetFieldData(Field: TField; Buffer: Pointer;
- NativeFormat: Boolean): Boolean;
- var
- ValError:Word;
- FieldRow:PChar;
- begin
- FieldRow:=PPDataRecord(ActiveBuffer)^^.Row[Field.FieldNo - 1];
- Result := FieldRow <> nil;
- if Result and (Buffer <> nil) then //supports GetIsNull
- begin
- case Field.Datatype of
- ftString:
- begin
- Move(FieldRow^,PChar(Buffer)^,StrLen(FieldRow)+1);
- end;
- ftInteger,ftAutoInc:
- begin
- Val(StrPas(FieldRow),LongInt(Buffer^),ValError);
- Result:= ValError = 0;
- end;
- ftBoolean,ftWord:
- begin
- Val(StrPas(FieldRow),Word(Buffer^),ValError);
- Result:= ValError = 0;
- end;
- ftFloat,ftDateTime,ftTime,ftDate,ftCurrency:
- begin
- Val(StrPas(FieldRow),Double(Buffer^),ValError);
- Result:= ValError = 0;
- end;
- ftLargeInt:
- begin
- Val(StrPas(FieldRow),Int64(Buffer^),ValError);
- Result:= ValError = 0;
- end;
- end;
- end;
- end;
- function TCustomSqliteDataset.GetFieldData(Field: TField; Buffer: Pointer): Boolean;
- begin
- Result:=GetFieldData(Field, Buffer, False);
- end;
- function TCustomSqliteDataset.GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult;
- begin
- Result := grOk;
- case GetMode of
- gmPrior:
- if (FCurrentItem^.Previous = FBeginItem) or (FCurrentItem = FBeginItem) then
- begin
- Result := grBOF;
- FCurrentItem := FBeginItem;
- end
- else
- FCurrentItem:=FCurrentItem^.Previous;
- gmCurrent:
- if (FCurrentItem = FBeginItem) or (FCurrentItem = FEndItem) then
- Result := grError;
- gmNext:
- if (FCurrentItem = FEndItem) or (FCurrentItem^.Next = FEndItem) then
- Result := grEOF
- else
- FCurrentItem:=FCurrentItem^.Next;
- end; //case
- if Result = grOk then
- begin
- PDataRecord(Pointer(Buffer)^):=FCurrentItem;
- FCurrentItem^.BookmarkFlag := bfCurrent;
- end
- else if (Result = grError) and DoCheck then
- DatabaseError('No records found',Self);
- end;
- function TCustomSqliteDataset.GetRecordCount: Integer;
- begin
- Result := FRecordCount;
- end;
- function TCustomSqliteDataset.GetRecNo: Integer;
- var
- TempItem,TempActive:PDataRecord;
- begin
- Result:= -1;
- if (FRecordCount = 0) or (State = dsInsert) then
- Exit;
- TempItem:=FBeginItem;
- TempActive:=PPDataRecord(ActiveBuffer)^;
- if TempActive = FCacheItem then // Record is being edited
- begin
- TempActive:=FInternalActiveBuffer;
- end;
- //RecNo is 1 based
- inc(Result);
- while TempActive <> TempItem do
- begin
- if TempItem^.Next <> nil then
- begin
- inc(Result);
- TempItem:=TempItem^.Next;
- end
- else
- begin
- Result:=-1;
- DatabaseError('GetRecNo - ActiveItem Not Found',Self);
- break;
- end;
- end;
- end;
- function TCustomSqliteDataset.GetRecordSize: Word;
- begin
- Result := FBufferSize; //??
- end;
- procedure TCustomSqliteDataset.InternalAddRecord(Buffer: Pointer; DoAppend: Boolean);
- var
- NewItem: PDataRecord;
- begin
- {$ifdef DEBUG}
- if PPDataRecord(Buffer)^ <> FCacheItem then
- DatabaseError('PPDataRecord(Buffer) <> FCacheItem - Problem',Self);
- {$endif}
- New(NewItem);
- GetMem(NewItem^.Row,FRowBufferSize);
- //necessary to nullify the Row before copy the cache
- FillChar(NewItem^.Row^,FRowBufferSize,#0);
- CopyCacheToItem(NewItem);
- //insert in the linked list
- FInsertBookmark^.Previous^.Next:=NewItem;
- NewItem^.Next:=FInsertBookmark;
- NewItem^.Previous:=FInsertBookmark^.Previous;
- FInsertBookmark^.Previous:=NewItem;
-
- //update the cursor
- FCurrentItem:=NewItem;
-
- Inc(FRecordCount);
- if FAutoIncFieldNo <> - 1 then
- Inc(FNextAutoInc);
- FAddedItems.Add(NewItem);
- end;
- procedure TCustomSqliteDataset.InternalClose;
- begin
- if FSaveOnClose then
- ApplyUpdates;
- //BindFields(False);
- if DefaultFields then
- DestroyFields;
- if FDataAllocated then
- DisposeLinkedList;
- FAddedItems.Clear;
- FUpdatedItems.Clear;
- FDeletedItems.Clear;
- FOrphanItems.Clear;
- FRecordCount:=0;
- end;
- procedure TCustomSqliteDataset.InternalCancel;
- var
- i: Integer;
- begin
- PPDataRecord(ActiveBuffer)^:=FInternalActiveBuffer;
- //free the cache
- for i:= 0 to FRowCount - 1 do
- begin
- StrDispose(FCacheItem^.Row[i]);
- FCacheItem^.Row[i]:=nil;
- end;
- end;
- procedure TCustomSqliteDataset.InternalDelete;
- var
- TempItem:PDataRecord;
- ValError,TempInteger:Integer;
- begin
- If FRecordCount = 0 then
- Exit;
- Dec(FRecordCount);
- TempItem:=PPDataRecord(ActiveBuffer)^;
- // Remove from changed list
- FUpdatedItems.Remove(TempItem);
- if FAddedItems.Remove(TempItem) = -1 then
- FDeletedItems.Add(TempItem);
- //Todo: see if FOrphanItems is necessary:
- // in ApplyUpdates a check could be done
- // to avoid "delete" the AddedItems
- FOrphanItems.Add(TempItem);
- TempItem^.Next^.Previous:=TempItem^.Previous;
- TempItem^.Previous^.Next:=TempItem^.Next;
- if FCurrentItem = TempItem then
- begin
- if FCurrentItem^.Previous <> FBeginItem then
- FCurrentItem:= FCurrentItem^.Previous
- else
- FCurrentItem:= FCurrentItem^.Next;
- end;
- // Dec FNextAutoInc (only if deleted item is the last record)
- if FAutoIncFieldNo <> -1 then
- begin
- Val(StrPas(TempItem^.Row[FAutoIncFieldNo]),TempInteger,ValError);
- if (ValError = 0) and (TempInteger = (FNextAutoInc - 1)) then
- Dec(FNextAutoInc);
- end;
- end;
- procedure TCustomSqliteDataset.InternalEdit;
- var
- i: Integer;
- begin
- FInternalActiveBuffer:=PPDataRecord(ActiveBuffer)^;
- //copy active item to cache
- for i:= 0 to FRowCount - 1 do
- FCacheItem^.Row[i]:=StrNew(FInternalActiveBuffer^.Row[i]);
- FCacheItem^.BookmarkFlag:=FInternalActiveBuffer^.BookmarkFlag;
- //now active buffer is the cache item
- PPDataRecord(ActiveBuffer)^:=FCacheItem;
- end;
- procedure TCustomSqliteDataset.InternalFirst;
- begin
- FCurrentItem := FBeginItem;
- end;
- procedure TCustomSqliteDataset.InternalGotoBookmark(ABookmark: Pointer);
- begin
- FCurrentItem := PDataRecord(ABookmark^);
- end;
- procedure TCustomSqliteDataset.InternalInitRecord(Buffer: PChar);
- var
- TempStr:String;
- begin
- if FAutoIncFieldNo <> - 1 then
- begin
- Str(FNextAutoInc,TempStr);
- FCacheItem^.Row[FAutoIncFieldNo]:=StrAlloc(Length(TempStr)+1);
- StrPCopy(FCacheItem^.Row[FAutoIncFieldNo],TempStr);
- end;
- PPDataRecord(Buffer)^:=FCacheItem;
- FCacheItem^.BookmarkFlag:=bfInserted;
- end;
- procedure TCustomSqliteDataset.InternalLast;
- begin
- FCurrentItem := FEndItem;
- end;
- procedure TCustomSqliteDataset.InternalOpen;
- var
- i:Integer;
- begin
- if MasterSource <> nil then
- begin
- //todo: retrieve only necessary fields
- FSql := 'Select * from '+FTableName+';'; // forced to obtain all fields
- FMasterLink.FieldNames:=FMasterLink.FieldNames; //workaround to fill MasterLinks.Fields
- //if FMasterLink.Fields.Count = 0 MasterChanged will not be called anyway so ignore it
- end;
- if FSql = '' then
- begin
- if FTablename = '' then
- DatabaseError('Tablename not set',Self);
- FSql := 'Select * from '+FTableName+';';
- end;
- if FSqliteHandle = nil then
- GetSqliteHandle;
-
- InternalInitFieldDefs;
- //todo: move this to InitFieldDefs
- FSelectSqlStr:='SELECT ';
- for i:= 0 to FieldDefs.Count - 2 do
- FSelectSqlStr:=FSelectSqlStr+FieldDefs[i].Name+',';
- FSelectSqlStr:=FSelectSqlStr+FieldDefs[FieldDefs.Count - 1].Name+
- ' FROM '+FTableName;
- if DefaultFields then
- CreateFields;
- BindFields(True);
- UpdateIndexFields;
- if FMasterLink.Active then
- begin
- if FIndexFieldList.Count <> FMasterLink.Fields.Count then
- DatabaseError('MasterFields count doesn''t match IndexFields count',Self);
- //Set FSql considering MasterSource active record
- SetDetailFilter;
- end;
- // Get PrimaryKeyNo if available
- if Fields.FindField(FPrimaryKey) <> nil then
- FPrimaryKeyNo:=Fields.FindField(FPrimaryKey).FieldNo - 1
- else
- FPrimaryKeyNo:=FAutoIncFieldNo; // -1 if there's no AutoIncField
- BuildLinkedList;
- FCurrentItem:=FBeginItem;
- end;
- procedure TCustomSqliteDataset.InternalPost;
- begin
- if State <> dsEdit then
- InternalAddRecord(ActiveBuffer,True)
- else
- begin
- CopyCacheToItem(FInternalActiveBuffer);
- PPDataRecord(ActiveBuffer)^:=FInternalActiveBuffer;
- if (FUpdatedItems.IndexOf(FInternalActiveBuffer) = -1) and
- (FAddedItems.IndexOf(FInternalActiveBuffer) = -1) then
- FUpdatedItems.Add(FInternalActiveBuffer);
- end;
- end;
- procedure TCustomSqliteDataset.InternalSetToRecord(Buffer: PChar);
- begin
- FCurrentItem:=PPDataRecord(Buffer)^;
- end;
- function TCustomSqliteDataset.IsCursorOpen: Boolean;
- begin
- Result := FDataAllocated;
- end;
- function TCustomSqliteDataset.FindRecordItem(StartItem: PDataRecord; const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions; DoResync:Boolean):PDataRecord;
- var
- ValueArray: array of string;
- IndexArray: array of integer;
- AFieldList: TList;
- i,AFieldCount:Integer;
- MatchRecord: Boolean;
- AValue:String;
- TempItem:PDataRecord;
- begin
- Result:=nil;
- // Currently ignore options
- AFieldList:=TList.Create;
- try
- GetFieldList(AFieldList,KeyFields);
- AFieldCount:=AFieldList.Count;
- if AFieldCount > 1 then
- begin
- if VarIsArray(KeyValues) then
- begin
- if Succ(VarArrayHighBound(KeyValues,1)) <> AFieldCount then
- DatabaseError('Number of fields does not correspond to number of values',Self);
- end
- else
- DatabaseError('Wrong number of values specified: expected an array of variants got a variant',Self);
- end;
-
- //set the array of values and indexes
- SetLength(ValueArray,AFieldCount);
- SetLength(IndexArray,AFieldCount);
- for i:= 0 to AFieldCount - 1 do
- with TField(AFieldList[i]) do
- begin
- //get float types in appropriate format
- if not (DataType in [ftFloat,ftDateTime,ftTime,ftDate]) then
- begin
- if VarIsArray(KeyValues) then
- ValueArray[i]:=keyvalues[i]
- else
- ValueArray[i]:=keyvalues;
- end
- else
- begin
- if VarIsArray(KeyValues) then
- Str(VarToDateTime(keyvalues[i]),AValue)
- else
- Str(VarToDateTime(keyvalues),AValue);
- ValueArray[i]:=Trim(AValue);
- end;
- IndexArray[i]:=FieldNo - 1;
- end;
- finally
- AFieldList.Destroy;
- end;
- {$ifdef DEBUG}
- writeln('##TCustomSqliteDataset.FindRecordItem##');
- writeln(' KeyFields: ',keyfields);
- writeln(' KeyValues: ',keyvalues);
- writeln(' AValue: ',AValue);
- {$endif}
- //Search the list
- TempItem:=StartItem;
- while TempItem <> FEndItem do
- begin
- MatchRecord:=True;
- for i:= 0 to AFieldCount - 1 do
- begin
- //todo: handle null values??
- if (TempItem^.Row[IndexArray[i]] = nil) or
- (StrComp(TempItem^.Row[IndexArray[i]],PChar(ValueArray[i])) <> 0) then
- begin
- MatchRecord:= False;
- Break;//for
- end;
- end;
- if MatchRecord then
- begin
- Result:=TempItem;
- if DoResync then
- begin
- FCurrentItem:=TempItem;
- Resync([]);
- end;
- Break;//while
- end;
- TempItem:=TempItem^.Next;
- end;
- end;
- procedure TCustomSqliteDataset.GetSqliteHandle;
- begin
- if FFileName = '' then
- DatabaseError ('Filename not set',Self);
- //todo:Handle opening non db files
- FSqliteHandle:=InternalGetHandle;
- end;
- function TCustomSqliteDataset.Locate(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions) : boolean;
- begin
- Result:=FindRecordItem(FBeginItem^.Next,KeyFields,KeyValues,Options,True) <> nil;
- end;
-
- function TCustomSqliteDataset.LocateNext(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions) : boolean;
- begin
- Result:=FindRecordItem(PPDataRecord(ActiveBuffer)^^.Next,KeyFields,KeyValues,Options,True) <> nil;
- end;
-
- function TCustomSqliteDataset.Lookup(const KeyFields: string; const KeyValues: Variant; const ResultFields: string): Variant;
- var
- TempItem:PDataRecord;
- begin
- TempItem:=FindRecordItem(FBeginItem^.Next,KeyFields,KeyValues,[],False);
- if TempItem <> nil then
- Result:=TempItem^.Row[FieldByName(ResultFields).FieldNo - 1]
- else
- Result:=False;
- end;
- procedure TCustomSqliteDataset.SetBookmarkData(Buffer: PChar; Data: Pointer);
- begin
- //The BookMarkData is the Buffer itself: no need to set nothing;
- end;
- procedure TCustomSqliteDataset.SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag);
- begin
- PPDataRecord(Buffer)^^.BookmarkFlag := Value;
- end;
- procedure TCustomSqliteDataset.SetExpectedAppends(AValue:Integer);
- begin
- FAddedItems.Capacity:=AValue;
- end;
- procedure TCustomSqliteDataset.SetExpectedUpdates(AValue:Integer);
- begin
- FUpdatedItems.Capacity:=AValue;
- end;
- procedure TCustomSqliteDataset.SetExpectedDeletes(AValue:Integer);
- begin
- FDeletedItems.Capacity:=AValue;
- FOrphanItems.Capacity:=AValue;
- end;
- procedure TCustomSqliteDataset.SetFieldData(Field: TField; Buffer: Pointer;
- NativeFormat: Boolean);
- var
- TempStr:String;
- begin
- if not (State in [dsEdit, dsInsert]) then
- begin
- DatabaseErrorFmt(SNotInEditState,[Name],Self);
- Exit;
- end;
- StrDispose(FCacheItem^.Row[Pred(Field.FieldNo)]);
- if Buffer <> nil then
- begin
- case Field.Datatype of
- ftString:
- begin
- FCacheItem^.Row[Pred(Field.FieldNo)]:=StrNew(PChar(Buffer));
- end;
- ftInteger:
- begin
- Str(LongInt(Buffer^),TempStr);
- FCacheItem^.Row[Pred(Field.FieldNo)]:=StrAlloc(Length(TempStr)+1);
- Move(PChar(TempStr)^,(FCacheItem^.Row[Pred(Field.FieldNo)])^,Length(TempStr)+1);
- end;
- ftBoolean,ftWord:
- begin
- Str(Word(Buffer^),TempStr);
- FCacheItem^.Row[Pred(Field.FieldNo)]:=StrAlloc(Length(TempStr)+1);
- Move(PChar(TempStr)^,(FCacheItem^.Row[Pred(Field.FieldNo)])^,Length(TempStr)+1);
- end;
- ftFloat,ftDateTime,ftDate,ftTime,ftCurrency:
- begin
- Str(Double(Buffer^),TempStr);
- FCacheItem^.Row[Pred(Field.FieldNo)]:=StrAlloc(Length(TempStr));
- //Skips the first space that str returns
- //todo: make a custom Str?
- Move((PChar(TempStr)+1)^,(FCacheItem^.Row[Pred(Field.FieldNo)])^,Length(TempStr));
- end;
- ftLargeInt:
- begin
- Str(Int64(Buffer^),TempStr);
- FCacheItem^.Row[Pred(Field.FieldNo)]:=StrAlloc(Length(TempStr)+1);
- Move(PChar(TempStr)^,(FCacheItem^.Row[Pred(Field.FieldNo)])^,Length(TempStr)+1);
- end;
- end;// case
- end//if
- else
- FCacheItem^.Row[Pred(Field.FieldNo)]:=nil;
- if not (State in [dsCalcFields, dsFilter, dsNewValue]) then
- DataEvent(deFieldChange, Ptrint(Field));
- end;
- procedure TCustomSqliteDataset.SetFieldData(Field: TField; Buffer: Pointer);
- begin
- SetFieldData(Field, Buffer, False);
- end;
- procedure TCustomSqliteDataset.SetRecNo(Value: Integer);
- var
- Counter:Integer;
- TempItem:PDataRecord;
- begin
- if (Value > FRecordCount) or (Value <= 0) then
- DatabaseError('Record Number Out Of Range',Self);
- CheckBrowseMode;
- TempItem:=FBeginItem;
- for Counter := 1 to Value do
- TempItem:=TempItem^.Next;
- FCurrentItem:=TempItem;
- Resync([]);
- end;
- // Specific functions
- procedure TCustomSqliteDataset.SetDetailFilter;
- function FieldToSqlStr(AField:TField):String;
- begin
- if not AField.IsNull then
- begin
- case AField.DataType of
- ftString,ftMemo: Result:='"'+AField.AsString+'"';//todo: handle " caracter properly
- ftDateTime,ftDate,ftTime:Str(AField.AsDateTime,Result);
- else
- Result:=AField.AsString;
- end;//case
- end
- else
- Result:=NullString;
- end;//function
- var
- AFilter:String;
- i:Integer;
- begin
- if FMasterLink.Dataset.RecordCount = 0 then //Retrieve all data
- FSql:='Select * from '+FTableName
- else
- begin
- AFilter:=' where ';
- for i:= 0 to FMasterLink.Fields.Count - 1 do
- begin
- AFilter:=AFilter + IndexFields[i].FieldName +' = '+ FieldToSqlStr(TField(FMasterLink.Fields[i]));
- if i <> FMasterLink.Fields.Count - 1 then
- AFilter:= AFilter + ' and ';
- end;
- FSql:='Select * from '+FTableName+AFilter;
- end;
- end;
- procedure TCustomSqliteDataset.MasterChanged(Sender: TObject);
- begin
- SetDetailFilter;
- {$ifdef DEBUG}
- writeln('##TCustomSqliteDataset.MasterChanged##');
- writeln(' SQL used to filter detail dataset:');
- writeln(' ',FSql);
- {$endif}
- RefetchData;
- end;
- procedure TCustomSqliteDataset.MasterDisabled(Sender: TObject);
- begin
- FSql:='Select * from '+FTableName+';';
- RefetchData;
- end;
- procedure TCustomSqliteDataset.SetMasterFields(Value: String);
- begin
- FMasterLink.FieldNames:=Value;
- if Active and FMasterLink.Active then
- begin
- UpdateIndexFields;
- if (FIndexFieldList.Count <> FMasterLink.Fields.Count) then
- DatabaseError('MasterFields count doesn''t match IndexFields count',Self);
- end;
- end;
- function TCustomSqliteDataset.GetMasterFields: String;
- begin
- Result:=FMasterLink.FieldNames;
- end;
- procedure TCustomSqliteDataset.UpdateIndexFields;
- begin
- FIndexFieldList.Clear;
- if FIndexFieldNames <> '' then
- begin
- try
- GetFieldList(FIndexFieldList, FIndexFieldNames);
- except
- FIndexFieldList.Clear;
- raise;
- end;
- end;
- end;
- function TCustomSqliteDataset.GetMasterSource: TDataSource;
- begin
- Result := FMasterLink.DataSource;
- end;
- procedure TCustomSqliteDataset.SetFileName(Value: String);
- begin
- if Value <> FFileName then
- begin
- if Active then
- DatabaseError('It''s not allowed to change Filename in an open dataset',Self);
- if FSqliteHandle <> nil then
- InternalCloseHandle;
- FFileName:=Value;
- end;
- end;
- procedure TCustomSqliteDataset.SetMasterSource(Value: TDataSource);
- begin
- FMasterLink.DataSource := Value;
- end;
- procedure TCustomSqliteDataset.ExecSQL(const ASql:String);
- begin
- if FSqliteHandle = nil then
- GetSqliteHandle;
- ExecuteDirect(ASql);
- end;
- procedure TCustomSqliteDataset.ExecSQLList;
- begin
- if FSqliteHandle = nil then
- GetSqliteHandle;
- SqliteExec(PChar(FSqlList.Text),nil,nil);
- end;
- procedure TCustomSqliteDataset.ExecSQL;
- begin
- ExecSQL(FSql);
- end;
- function TCustomSqliteDataset.ApplyUpdates:Boolean;
- var
- iFields,iItems,StatementsCounter:Integer;
- SqlTemp,WhereKeyNameEqual,ASqlLine,TemplateStr:String;
- begin
- if not UpdatesPending then
- begin
- Result:=True;
- Exit;
- end;
- Result:=False;
- if FPrimaryKeyNo <> -1 then
- begin
- StatementsCounter:=0;
- WhereKeyNameEqual:=' WHERE '+Fields[FPrimaryKeyNo].FieldName+' = ';
- {$ifdef DEBUG}
- WriteLn('##TCustomSqliteDataset.ApplyUpdates##');
- if FPrimaryKeyNo = FAutoIncFieldNo then
- WriteLn(' Using an AutoInc field as primary key');
- WriteLn(' PrimaryKey: ',WhereKeyNameEqual);
- WriteLn(' PrimaryKeyNo: ',FPrimaryKeyNo);
- {$endif}
- SqlTemp:='BEGIN;';
- // Delete Records
- if FDeletedItems.Count > 0 then
- TemplateStr:='DELETE FROM '+FTableName+WhereKeyNameEqual;
- for iItems:= 0 to FDeletedItems.Count - 1 do
- begin
- SqlTemp:=SqlTemp+(TemplateStr+
- StrPas(PDataRecord(FDeletedItems[iItems])^.Row[FPrimaryKeyNo])+';');
- inc(StatementsCounter);
- //ApplyUpdates each 400 statements
- if StatementsCounter = 400 then
- begin
- SqlTemp:=SqlTemp+'COMMIT;';
- FReturnCode:=SqliteExec(PChar(SqlTemp),nil,nil);
- StatementsCounter:=0;
- SqlTemp:='BEGIN;';
- end;
- end;
- // Update changed records
- if FUpdatedItems.Count > 0 then
- TemplateStr:='UPDATE '+FTableName+' SET ';
- for iItems:= 0 to FUpdatedItems.Count - 1 do
- begin
- ASqlLine:=TemplateStr;
- for iFields:= 0 to Fields.Count - 2 do
- begin
- ASqlLine:=ASqlLine + (Fields[iFields].FieldName +' = '+
- FGetSqlStr[iFields](PDataRecord(FUpdatedItems[iItems])^.Row[iFields])+',');
- end;
- iFields:=Fields.Count - 1;
- ASqlLine:=ASqlLine + (Fields[iFields].FieldName +' = '+
- FGetSqlStr[iFields](PDataRecord(FUpdatedItems[iItems])^.Row[iFields])+
- WhereKeyNameEqual+StrPas(PDataRecord(FUpdatedItems[iItems])^.Row[FPrimaryKeyNo])+';');
- SqlTemp:=SqlTemp + ASqlLine;
- inc(StatementsCounter);
- //ApplyUpdates each 400 statements
- if StatementsCounter = 400 then
- begin
- SqlTemp:=SqlTemp+'COMMIT;';
- FReturnCode:=SqliteExec(PChar(SqlTemp),nil,nil);
- StatementsCounter:=0;
- SqlTemp:='BEGIN;';
- end;
- end;
- // Add new records
- // Build TemplateStr
- if FAddedItems.Count > 0 then
- begin
- TemplateStr:='INSERT INTO '+FTableName+ ' (';
- for iFields:= 0 to Fields.Count - 2 do
- begin
- TemplateStr:=TemplateStr + Fields[iFields].FieldName+',';
- end;
- TemplateStr:= TemplateStr+Fields[Fields.Count - 1].FieldName+') VALUES (';
- end;
- for iItems:= 0 to FAddedItems.Count - 1 do
- begin
- ASqlLine:=TemplateStr;
- for iFields:= 0 to Fields.Count - 2 do
- begin
- ASqlLine:=ASqlLine + (FGetSqlStr[iFields](PDataRecord(FAddedItems[iItems])^.Row[iFields])+',');
- end;
- //todo: see if i can assume iFields = Fields.Count-2 safely
- iFields:=Fields.Count - 1;
- ASqlLine:=ASqlLine + (FGetSqlStr[iFields](PDataRecord(FAddedItems[iItems])^.Row[iFields])+');');
- SqlTemp:=SqlTemp + ASqlLine;
- inc(StatementsCounter);
- //ApplyUpdates each 400 statements
- if StatementsCounter = 400 then
- begin
- SqlTemp:=SqlTemp+'COMMIT;';
- FReturnCode:=SqliteExec(PChar(SqlTemp),nil,nil);
- StatementsCounter:=0;
- SqlTemp:='BEGIN;';
- end;
- end;
- SqlTemp:=SqlTemp+'COMMIT;';
- {$ifdef DEBUG}
- writeln(' SQL: ',SqlTemp);
- {$endif}
- FAddedItems.Clear;
- FUpdatedItems.Clear;
- FDeletedItems.Clear;
- FReturnCode:=SqliteExec(PChar(SqlTemp),nil,nil);
- Result:= FReturnCode = SQLITE_OK;
- end;
- {$ifdef DEBUG}
- writeln(' Result: ',Result);
- {$endif}
- end;
- function TCustomSqliteDataset.CreateTable: Boolean;
- begin
- Result:=CreateTable(FTableName);
- end;
- function TCustomSqliteDataset.CreateTable(const ATableName: String): Boolean;
- var
- SqlTemp:String;
- i:Integer;
- begin
- {$ifdef DEBUG}
- writeln('##TCustomSqliteDataset.CreateTable##');
- if ATableName = '' then
- WriteLn(' TableName Not Set');
- if FieldDefs.Count = 0 then
- WriteLn(' FieldDefs Not Initialized');
- {$endif}
- if (ATableName <> '') and (FieldDefs.Count > 0) then
- begin
- SqlTemp:='CREATE TABLE '+ATableName+' (';
- for i := 0 to FieldDefs.Count-1 do
- begin
- //todo: add index to autoinc field
- SqlTemp:=SqlTemp + FieldDefs[i].Name;
- case FieldDefs[i].DataType of
- ftInteger:
- SqlTemp:=SqlTemp + ' INTEGER';
- ftString:
- SqlTemp:=SqlTemp + ' VARCHAR';
- ftBoolean:
- SqlTemp:=SqlTemp + ' BOOL_INT';
- ftFloat:
- SqlTemp:=SqlTemp + ' FLOAT';
- ftWord:
- SqlTemp:=SqlTemp + ' WORD';
- ftDateTime:
- SqlTemp:=SqlTemp + ' DATETIME';
- ftDate:
- SqlTemp:=SqlTemp + ' DATE';
- ftTime:
- SqlTemp:=SqlTemp + ' TIME';
- ftLargeInt:
- SqlTemp:=SqlTemp + ' LARGEINT';
- ftCurrency:
- SqlTemp:=SqlTemp + ' CURRENCY';
- ftAutoInc:
- SqlTemp:=SqlTemp + ' AUTOINC_INT';
- ftMemo:
- SqlTemp:=SqlTemp + ' TEXT';
- else
- DatabaseError('Field type "'+FieldTypeNames[FieldDefs[i].DataType]+'" not supported',Self);
- end;
- if UpperCase(FieldDefs[i].Name) = UpperCase(FPrimaryKey) then
- SqlTemp:=SqlTemp + ' PRIMARY KEY';
- if i <> FieldDefs.Count - 1 then
- SqlTemp:=SqlTemp+ ' , ';
- end;
- SqlTemp:=SqlTemp+');';
- {$ifdef DEBUG}
- writeln(' SQL: ',SqlTemp);
- {$endif}
- ExecSQL(SqlTemp);
- Result:= FReturnCode = SQLITE_OK;
- end
- else
- Result:=False;
- end;
- procedure TCustomSqliteDataset.ExecCallback(const ASql: String; UserData: Pointer = nil);
- var
- CallbackInfo: TCallbackInfo;
- begin
- if not Assigned(FOnCallback) then
- DatabaseError('OnCallback property not set',Self);
- if FSqliteHandle = nil then
- GetSqliteHandle;
- CallbackInfo.Data:=UserData;
- CallbackInfo.Proc:=FOnCallback;
- SqliteExec(PChar(ASql),@CallbackDispatcher,@CallbackInfo);
- end;
- procedure TCustomSqliteDataset.QueryUpdates(RecordStates: TRecordStateSet; Callback: TQueryUpdatesCallback;
- UserData: Pointer = nil);
- var
- i: Integer;
- TempItem: PDataRecord;
- begin
- if not Assigned(Callback) then
- DatabaseError('Callback parameter not set',Self);
- if rsDeleted in RecordStates then
- with FDeletedItems do
- for i:= 0 to Count - 1 do
- Callback(UserData,PDataRecord(Items[i])^.Row,nil,rsDeleted);
- if rsUpdated in RecordStates then
- with FUpdatedItems do
- for i:= 0 to Count - 1 do
- begin
- TempItem:=PDataRecord(Items[i]);
- Callback(UserData,TempItem^.Row,TBookmark(@TempItem),rsUpdated);
- end;
- if rsAdded in RecordStates then
- with FAddedItems do
- for i:= 0 to Count - 1 do
- begin
- TempItem:=PDataRecord(Items[i]);
- Callback(UserData,TempItem^.Row,TBookmark(@TempItem),rsAdded);
- end;
- end;
- procedure TCustomSqliteDataset.RefetchData;
- var
- i:Integer;
- begin
- //Close
- if FSaveOnRefetch then
- ApplyUpdates;
- if FDataAllocated then
- DisposeLinkedList;
- FAddedItems.Clear;
- FUpdatedItems.Clear;
- FDeletedItems.Clear;
- FOrphanItems.Clear;
- //Reopen
- BuildLinkedList;
- FCurrentItem:=FBeginItem;
- for i := 0 to BufferCount - 1 do
- PPDataRecord(Buffers[i])^:=FBeginItem;
- Resync([]);
- DoAfterScroll;
- end;
- function TCustomSqliteDataset.TableExists: Boolean;
- begin
- Result:=TableExists(FTableName);
- end;
- function TCustomSqliteDataset.TableExists(const ATableName: String): Boolean;
- begin
- Result:=False;
- if not (ATableName = '') and FileExists(FFileName) then
- begin
- ExecSql('SELECT name FROM SQLITE_MASTER WHERE type = ''table'' AND name LIKE '''+ ATableName+ ''';');
- Result:=FReturnCode = SQLITE_ROW;
- end;
- end;
- function TCustomSqliteDataset.UpdatesPending: Boolean;
- begin
- Result:= (FUpdatedItems.Count > 0) or
- (FAddedItems.Count > 0) or (FDeletedItems.Count > 0);
- end;
- function TCustomSqliteDataset.QuickQuery(const ASql:String):String;
- begin
- Result:=QuickQuery(ASql,nil,False);
- end;
- function TCustomSqliteDataset.QuickQuery(const ASql:String;const AStrList: TStrings):String;
- begin
- Result:=QuickQuery(ASql,AStrList,False)
- end;
- {$ifdef DEBUGACTIVEBUFFER}
- procedure TCustomSqliteDataset.SetCurrentItem(Value:PDataRecord);
- var
- ANo:Integer;
- function GetItemPos:Integer;
- var
- TempItem:PDataRecord;
- begin
- Result:= -1;
- TempItem:=FBeginItem;
- if Value = FCacheItem then
- Result:=-2
- else
- while Value <> TempItem do
- begin
- if TempItem^.Next <> nil then
- begin
- inc(Result);
- TempItem:=TempItem^.Next;
- end
- else
- begin
- Result:=-1;
- break;
- end;
- end;
- end;
- begin
- if Value = FBeginItem then
- begin
- writeln('FCurrentItem set to FBeginItem: ',IntToHex(Integer(Value),0));
- FFCurrentItem:=Value;
- end
- else
- if Value = FEndItem then
- begin
- writeln('FCurrentItem set to FEndItem: ',IntToHex(Integer(Value),0));
- FFCurrentItem:=Value;
- end
- else
- if Value = FCacheItem then
- begin
- writeln('FCurrentItem set to FCacheItem: ',IntToHex(Integer(Value),0));
- FFCurrentItem:=Value;
- end
- else
- begin
- writeln('FCurrentItem set from ',IntToHex(Integer(FFCurrentItem),0),' to ',IntToHex(Integer(Value),0));
- Ano:=GetItemPos;
- writeln('Item position is ',ANo);
- FFCurrentItem:=Value;
- end;
- end;
- {$endif}
- end.
|