12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943 |
- unit CustomSqliteDS;
- {
- This is TCustomSqliteDataset, a TDataset descendant class for use with fpc compiler
- Copyright (C) 2004-2007 Luiz Américo Pereira Câmara
- Email: [email protected]
- This library is free software; you can redistribute it and/or modify it
- under the terms of the GNU Library General Public License as published by
- the Free Software Foundation; either version 2 of the License, or (at your
- option) any later version with the following modification:
- As a special exception, the copyright holders of this library give you
- permission to link this library with independent modules to produce an
- executable, regardless of the license terms of these independent modules,and
- to copy and distribute the resulting executable under terms of your choice,
- provided that you also meet, for each linked independent module, the terms
- and conditions of the license of that module. An independent module is a
- module which is not derived from or based on this library. If you modify
- this library, you may extend this exception to your version of the library,
- but you are not obligated to do so. If you do not wish to do so, delete this
- exception statement from your 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 Library General Public License
- for more details.
- You should have received a copy of the GNU Library General Public License
- along with this library; if not, write to the Free Software Foundation,
- Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
- }
- {$Mode ObjFpc}
- {$H+}
- {.$Define DEBUG_SQLITEDS}
- {.$Define DEBUGACTIVEBUFFER}
- interface
- uses
- Classes, SysUtils, db;
- const
- DefaultStringSize = 255;
- type
- TCustomSqliteDataset = class;
- PDataRecord = ^DataRecord;
- PPDataRecord = ^PDataRecord;
- DataRecord = record
- Row: PPAnsiChar;
- BookmarkFlag: TBookmarkFlag;
- Next: PDataRecord;
- Previous: PDataRecord;
- end;
-
- { TDSStream }
- //todo: refactor into two or three classes
- TDSStream = class(TStream)
- private
- FEditItem: PDataRecord;
- FDataset: TCustomSqliteDataset;
- FFieldRow: PAnsiChar;
- FField: TField;
- FFieldOffset: Integer;
- FRowSize: Int64;
- FPosition: Int64;
- FWriteMode: Boolean;
- protected
- function GetPosition: Int64; override;
- function GetSize: Int64; override;
- public
- constructor Create(Dataset: TCustomSqliteDataset; Field: TField;
- FieldOffset: Integer; EditItem: PDataRecord; WriteMode: Boolean);
- destructor Destroy; override;
- function Write(const Buffer; Count: LongInt): LongInt; override;
- function Read(var Buffer; Count: LongInt): LongInt; override;
- function Seek(const Offset: int64; Origin: TSeekOrigin): int64; override;
- end;
- //callback types
- TSqliteCdeclCallback = function(UserData: Pointer; Count: LongInt; Values: PPAnsiChar; Names: PPAnsiChar): LongInt; cdecl;
- TSqliteCallback = function(UserData: Pointer; Count: LongInt; Values: PPAnsiChar; Names: PPAnsiChar): 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: PPAnsiChar; ABookmark: TBookmark; RecordState: TRecordState) of object;
- TGetSqlStrFunction = function(APChar: PAnsiChar): String;
- TSqliteOption = (soWildcardKey);
- TSqliteOptions = set of TSqliteOption;
- { TCustomSqliteDataset }
- TCustomSqliteDataset = class(TDataSet)
- private
- {$ifdef DEBUGACTIVEBUFFER}
- FFCurrentItem: PDataRecord;
- {$else}
- FCurrentItem: PDataRecord;
- {$endif}
- FInternalActiveBuffer: PDataRecord;
- FInsertBookmark: PDataRecord;
- FOnCallback: TSqliteCallback;
- FMasterLink: TMasterDataLink;
- FIndexFieldNames: String;
- FIndexFieldList: TList;
- FOnGetHandle: TDataSetNotifyEvent;
- FOptions: TSqliteOptions;
- FSQLList: TStrings;
- FStoreDefs: Boolean;
- procedure CopyCacheToItem(AItem: PDataRecord);
- function GetIndexFields(Value: Integer): TField;
- function GetSQLList: TStrings;
- procedure SetMasterIndexValue;
- procedure SetOptions(const AValue: TSqliteOptions);
- procedure UpdateCalcFieldList;
- procedure UpdateIndexFieldList;
- function FindRecordItem(StartItem: PDataRecord; const KeyFields: string; const KeyValues: Variant; LocateOptions: TLocateOptions; DoResync: Boolean): PDataRecord;
- procedure UpdateMasterDetailProperties;
- protected
- FPrimaryKey: String;
- FPrimaryKeyNo: Integer;
- FFileName: UTF8String;
- FSQL: String;
- FEffectiveSQL: String;
- FTableName: String;
- FSqlFilterTemplate: String;
- FAutoIncFieldNo: Integer;
- FNextAutoInc: Integer;
- FUpdatedItems: TFPList;
- FAddedItems: TFPList;
- FDeletedItems: TFPList;
- FCalcFieldList: TFPList;
- FReturnCode: Integer;
- FSqliteHandle: Pointer;
- FRowBufferSize: Integer;
- FRowCount: Integer;
- FRecordCount: Integer;
- FBeginItem: PDataRecord;
- FEndItem: PDataRecord;
- FCacheItem: PDataRecord;
- FGetSqlStr: array of TGetSqlStrFunction;
- FSaveOnClose: Boolean;
- FSaveOnRefetch: Boolean;
- FAutoIncrementKey: Boolean;
- FDataAllocated: Boolean;
- function SqliteExec(Sql: PAnsiChar; ACallback: TSqliteCdeclCallback; Data: Pointer): Integer; virtual; abstract;
- procedure InternalCloseHandle; virtual; abstract;
- function InternalGetHandle: Pointer; virtual; abstract;
- function FieldDefsStored: Boolean;
- function GetLastInsertRowId: Int64; virtual; abstract;
- procedure GetSqliteHandle;
- procedure BuildLinkedList; virtual; abstract;
- procedure FreeItem(AItem: PDataRecord);
- procedure DisposeLinkedList;
- procedure SetDetailFilter;
- procedure MasterChanged(Sender: TObject);
- procedure SetMasterFields(const Value: String);
- function GetMasterFields: String;
- procedure SetMasterSource(Value: TDataSource);
- function GetMasterSource: TDataSource;
- procedure SetFileName(const Value: UTF8String);
- function GetRowsAffected: Integer; virtual; abstract;
- procedure RetrieveFieldDefs; virtual; abstract;
- //TDataSet overrides
- function AllocRecordBuffer: TRecordBuffer; override;
- procedure ClearCalcFields(Buffer: TRecordBuffer); override;
- procedure DoBeforeClose; override;
- procedure DoAfterInsert; override;
- procedure DoBeforeInsert; override;
- procedure FreeRecordBuffer(var Buffer: TRecordBuffer); override;
- procedure GetBookmarkData(Buffer: TRecordBuffer; Data: Pointer); override;
- function GetBookmarkFlag(Buffer: TRecordBuffer): TBookmarkFlag; override;
- function GetRecord(Buffer: TRecordBuffer; 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 InternalInitFieldDefs; override;
- procedure InternalInitRecord(Buffer: TRecordBuffer); override;
- procedure InternalLast; override;
- procedure InternalOpen; override;
- procedure InternalPost; override;
- procedure InternalSetToRecord(Buffer: TRecordBuffer); override;
- function IsCursorOpen: Boolean; override;
- procedure SetBookmarkData(Buffer: TRecordBuffer; Data: Pointer); override;
- procedure SetBookmarkFlag(Buffer: TRecordBuffer; Value: TBookmarkFlag); override;
- procedure SetExpectedAppends(AValue: Integer);
- procedure SetExpectedUpdates(AValue: Integer);
- procedure SetExpectedDeletes(AValue: Integer);
- 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 CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; 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; LocateOptions: TLocateOptions) : Boolean; override;
- function LocateNext(const KeyFields: String; const KeyValues: Variant; LocateOptions: TLocateOptions) : Boolean;
- function Lookup(const KeyFields: String; const KeyValues: Variant; const ResultFields: String): Variant; override;
- procedure SetFieldData(Field: TField; Buffer: Pointer); override;
- procedure SetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean); override;
- // Additional procedures
- function ApplyUpdates: Boolean;
- procedure ClearUpdates(RecordStates: TRecordStateSet = [rsAdded, rsDeleted, rsUpdated]);
- 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 ExecSQL(ASqlList: TStrings);
- procedure ExecSQLList;
- procedure ExecuteDirect(const ASql: String); virtual; abstract;
- function GetSQLValue(Values: PPAnsiChar; FieldIndex: Integer): String;
- 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;
- class function SqliteVersion: 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 write SetExpectedAppends;
- property ExpectedUpdates: Integer write SetExpectedUpdates;
- property ExpectedDeletes: Integer write SetExpectedDeletes;
- property IndexFields[Value: Integer]: TField read GetIndexFields;
- property LastInsertRowId: Int64 read GetLastInsertRowId;
- property RowsAffected: Integer read GetRowsAffected;
- property ReturnCode: Integer read FReturnCode;
- property SqliteHandle: Pointer read FSqliteHandle;
- property SQLList: TStrings read GetSQLList;
- published
- property AutoIncrementKey: Boolean read FAutoIncrementKey write FAutoIncrementKey default False;
- property IndexFieldNames: string read FIndexFieldNames write FIndexFieldNames;
- property FileName: UTF8String read FFileName write SetFileName;
- property OnCallback: TSqliteCallback read FOnCallback write FOnCallback;
- property OnGetHandle: TDataSetNotifyEvent read FOnGetHandle write FOnGetHandle;
- property Options: TSqliteOptions read FOptions write SetOptions default [];
- property PrimaryKey: String read FPrimaryKey write FPrimaryKey;
- property SaveOnClose: Boolean read FSaveOnClose write FSaveOnClose default False;
- property SaveOnRefetch: Boolean read FSaveOnRefetch write FSaveOnRefetch default False;
- property SQL: String read FSQL write FSQL;
- property StoreDefs: Boolean read FStoreDefs write FStoreDefs default False;
- property TableName: String read FTableName write FTableName;
- property MasterSource: TDataSource read GetMasterSource write SetMasterSource;
- property MasterFields: String read GetMasterFields write SetMasterFields;
-
- property Active;
- property FieldDefs stored FieldDefsStored;
- //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 BeforeRefresh;
- property AfterRefresh;
- property OnCalcFields;
- property OnDeleteError;
- property OnEditError;
- property OnNewRecord;
- property OnPostError;
- end;
-
- function Num2SQLStr(APChar: PAnsiChar): String;
- function Char2SQLStr(APChar: PAnsiChar): String;
- implementation
- uses
- strutils, variants, dbconst;
- const
- //sqlite2.x.x and sqlite3.x.x define these constants equally
- SQLITE_OK = 0;
- SQLITE_ROW = 100;
- SQLITE_DONE = 101;
-
- NullString = 'NULL';
-
- function CallbackDispatcher(UserData: Pointer; Count: LongInt; Values: PPAnsiChar; Names: PPAnsiChar): LongInt; cdecl;
- begin
- with PCallbackInfo(UserData)^ do
- Result:= Proc(Data, Count, Values, Names);
- end;
-
- function Num2SQLStr(APChar: PAnsiChar): String;
- begin
- if APChar = nil then
- begin
- Result := NullString;
- Exit;
- end;
- Result := String(APChar);
- end;
- function Char2SQLStr(APChar: PAnsiChar): String;
- begin
- if APChar = nil then
- begin
- Result := NullString;
- Exit;
- end;
- //todo: create custom routine to directly transform PAnsiChar -> SQL str
- Result := String(APChar);
- if Pos('''', Result) > 0 then
- Result := AnsiReplaceStr(Result, '''', '''''');
- Result := '''' + Result + '''';
- end;
- // TDSStream
- function TDSStream.GetPosition: Int64;
- begin
- Result:=FPosition;
- end;
- function TDSStream.GetSize: Int64;
- begin
- Result:=FRowSize;
- end;
- constructor TDSStream.Create(Dataset: TCustomSqliteDataset; Field: TField;
- FieldOffset: Integer; EditItem: PDataRecord; WriteMode: Boolean);
- begin
- inherited Create;
- //FPosition := 0;
- FDataset := Dataset;
- FField := Field;
- FFieldOffset := FieldOffset;
- FWriteMode := WriteMode;
- FEditItem := EditItem;
- FFieldRow := FEditItem^.Row[FFieldOffset];
- if FFieldRow <> nil then
- FRowSize := StrLen(FFieldRow);
- //else
- // FRowSize := 0;
- end;
- destructor TDSStream.Destroy;
- begin
- if FWriteMode and not (FDataset.State in [dsCalcFields, dsFilter, dsNewValue]) then
- FDataset.DataEvent(deFieldChange, PtrInt(FField));
- inherited Destroy;
- end;
- function TDSStream.Seek(const Offset: int64; Origin: TSeekOrigin): int64;
- begin
- Case Origin of
- soBeginning : FPosition := Offset;
- soEnd : FPosition := FRowSize + Offset;
- soCurrent : FPosition := FPosition + Offset;
- end;
- Result := FPosition;
- end;
- function TDSStream.Write(const Buffer; Count: LongInt): LongInt;
- var
- NewRow: PAnsiChar;
- begin
- Result := Count;
- if Count > 0 then
- begin
- //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);
- FEditItem^.Row[FFieldOffset] := NewRow;
- StrDispose(FFieldRow);
- {$ifdef DEBUG_SQLITEDS}
- 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;
- 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_SQLITEDS}
- 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: TRecordBuffer;
- begin
- Result := AllocMem(SizeOf(PPDataRecord));
- PDataRecord(Pointer(Result)^) := FBeginItem;
- end;
- procedure TCustomSqliteDataset.ClearCalcFields(Buffer: TRecordBuffer);
- var
- i: Integer;
- RecordItem: PDataRecord;
- begin
- if FCalcFieldList = nil then
- Exit;
- RecordItem := PPDataRecord(Buffer)^;
- for i := FieldDefs.Count to FieldDefs.Count + FCalcFieldList.Count - 1 do
- begin
- StrDispose(RecordItem^.Row[i]);
- RecordItem^.Row[i] := nil;
- end;
- 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 := @MasterChanged;
- BookmarkSize := SizeOf(Pointer);
- FUpdatedItems := TFPList.Create;
- FAddedItems := TFPList.Create;
- FDeletedItems := TFPList.Create;
- inherited Create(AOwner);
- end;
- function TCustomSqliteDataset.CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream;
- var
- FieldOffset: Integer;
- EditItem: PDataRecord;
- begin
- if Field.FieldNo >= 0 then
- begin
- if Mode = bmWrite then
- EditItem := FCacheItem
- else
- EditItem := PPDataRecord(ActiveBuffer)^;
- FieldOffset := Field.FieldNo - 1;
- end
- else
- begin
- EditItem := PPDataRecord(CalcBuffer)^;
- FieldOffset := FieldDefs.Count + FCalcFieldList.IndexOf(Field);
- end;
- if Mode = bmWrite then
- begin
- if not (State in [dsEdit, dsInsert, dsCalcFields]) then
- DatabaseErrorFmt(SNotEditing, [Name], Self);
- StrDispose(EditItem^.Row[FieldOffset]);
- EditItem^.Row[FieldOffset] := nil;
- end;
- Result := TDSStream.Create(Self, Field, FieldOffset, EditItem, Mode = bmWrite);
- end;
- procedure TCustomSqliteDataset.DoBeforeClose;
- begin
- if FSaveOnClose then
- ApplyUpdates;
- inherited DoBeforeClose;
- 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;
- FMasterLink.Destroy;
- //lists created on demand
- FSQLList.Free;
- FIndexFieldList.Free;
- FCalcFieldList.Free;
- // 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
- Result := TField(FIndexFieldList[Value]);
- end;
- function TCustomSqliteDataset.GetSQLList: TStrings;
- begin
- if FSQLList = nil then
- FSQLList := TStringList.Create;
- Result := FSQLList;
- end;
- procedure TCustomSqliteDataset.SetMasterIndexValue;
- var
- i: Integer;
- begin
- for i := 0 to FIndexFieldList.Count - 1 do
- TField(FIndexFieldList[i]).Value := TField(FMasterLink.Fields[i]).Value;
- end;
- procedure TCustomSqliteDataset.SetOptions(const AValue: TSqliteOptions);
- begin
- FOptions := AValue;
- end;
- procedure TCustomSqliteDataset.UpdateCalcFieldList;
- var
- i: Integer;
- AField: TField;
- begin
- if FCalcFieldList = nil then
- FCalcFieldList := TFPList.Create
- else
- FCalcFieldList.Clear;
- for i := 0 to Fields.Count - 1 do
- begin
- AField := Fields[i];
- if AField.FieldKind in [fkCalculated, fkLookup] then
- FCalcFieldList.Add(AField);
- end;
- end;
- procedure TCustomSqliteDataset.DisposeLinkedList;
- var
- TempItem: PDataRecord;
- i: Integer;
- begin
- //Todo: insert debug info
- //Todo: see if FDataAllocated is still necessary
- FDataAllocated := False;
- TempItem := FBeginItem^.Next;
- while TempItem^.Next <> nil do
- begin
- TempItem := TempItem^.Next;
- FreeItem(TempItem^.Previous);
- end;
- //Dispose Deleted Items
- //Directly access list pointer since the index check is already done in the loop
- for i := 0 to FDeletedItems.Count - 1 do
- FreeItem(PDataRecord(FDeletedItems.List^[i]));
- //Dispose FBeginItem.Row
- FreeMem(FBeginItem^.Row, FRowBufferSize);
-
- //Dispose cache item row
- for i:= 0 to FRowCount - 1 do
- StrDispose(FCacheItem^.Row[i]);
- FreeMem(FCacheItem^.Row, FRowBufferSize);
- end;
- procedure TCustomSqliteDataset.FreeRecordBuffer(var Buffer: TRecordBuffer);
- begin
- FreeMem(Buffer);
- end;
- procedure TCustomSqliteDataset.GetBookmarkData(Buffer: TRecordBuffer; Data: Pointer);
- begin
- Pointer(Data^) := PPDataRecord(Buffer)^;
- end;
- function TCustomSqliteDataset.GetBookmarkFlag(Buffer: TRecordBuffer): TBookmarkFlag;
- begin
- Result := PPDataRecord(Buffer)^^.BookmarkFlag;
- end;
- function TCustomSqliteDataset.GetFieldData(Field: TField; Buffer: Pointer;
- NativeFormat: Boolean): Boolean;
- var
- ValError: Word;
- FieldRow: PAnsiChar;
- FieldOffset: Integer;
- begin
- if Field.FieldNo >= 0 then
- FieldOffset := Field.FieldNo - 1
- else
- FieldOffset := FieldDefs.Count + FCalcFieldList.IndexOf(Field);
- if not (State in [dsCalcFields, dsInternalCalc]) then
- FieldRow := PPDataRecord(ActiveBuffer)^^.Row[FieldOffset]
- else
- FieldRow := PPDataRecord(CalcBuffer)^^.Row[FieldOffset];
- Result := FieldRow <> nil;
- if Result and (Buffer <> nil) then //supports GetIsNull
- begin
- case Field.Datatype of
- ftString:
- begin
- Move(FieldRow^, PAnsiChar(Buffer)^, StrLen(FieldRow) + 1);
- end;
- ftInteger, ftAutoInc:
- begin
- Val(String(FieldRow), LongInt(Buffer^), ValError);
- Result := ValError = 0;
- end;
- ftBoolean, ftWord:
- begin
- Val(String(FieldRow), Word(Buffer^), ValError);
- Result := ValError = 0;
- end;
- ftFloat, ftDateTime, ftTime, ftDate, ftCurrency:
- begin
- Val(String(FieldRow), Double(Buffer^), ValError);
- Result := ValError = 0;
- end;
- ftLargeInt:
- begin
- Val(String(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: TRecordBuffer; 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;
- GetCalcFields(Buffer);
- 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
- TempActive := FInternalActiveBuffer;
- //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 := SizeOf(PPDataRecord); //??
- end;
- procedure TCustomSqliteDataset.InternalAddRecord(Buffer: Pointer; DoAppend: Boolean);
- var
- NewItem: PDataRecord;
- begin
- {$ifdef DEBUG_SQLITEDS}
- if PPDataRecord(ActiveBuffer)^ <> FCacheItem then
- DatabaseError('PPDataRecord(ActiveBuffer) <> FCacheItem - Problem', Self);
- {$endif}
- New(NewItem);
- GetMem(NewItem^.Row, FRowBufferSize);
- //if is a detail dataset then set the index value
- if FMasterLink.Active then
- SetMasterIndexValue;
- //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
- //BindFields(False);
- if DefaultFields then
- DestroyFields;
- if FDataAllocated then
- DisposeLinkedList;
- FAddedItems.Clear;
- FUpdatedItems.Clear;
- FDeletedItems.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
- Dec(FRecordCount);
- TempItem := PPDataRecord(ActiveBuffer)^;
- 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(String(TempItem^.Row[FAutoIncFieldNo]), TempInteger, ValError);
- if (ValError = 0) and (TempInteger = (FNextAutoInc - 1)) then
- Dec(FNextAutoInc);
- end;
- // Update item lists
- FUpdatedItems.Remove(TempItem);
- if FAddedItems.Remove(TempItem) = -1 then
- FDeletedItems.Add(TempItem)
- else
- FreeItem(TempItem);
- 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.InternalInitFieldDefs;
- begin
- if FSQL = '' then
- begin
- if FTablename = '' then
- DatabaseError('Tablename not set', Self);
- FEffectiveSQL := 'Select * from ' + FTableName + ';';
- end
- else
- FEffectiveSQL := FSQL;
- if FSqliteHandle = nil then
- GetSqliteHandle;
- RetrieveFieldDefs;
- end;
- procedure TCustomSqliteDataset.InternalInitRecord(Buffer: TRecordBuffer);
- 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;
- begin
- InternalInitFieldDefs;
- if DefaultFields then
- CreateFields;
- BindFields(True);
- if CalcFieldsSize > 0 then
- UpdateCalcFieldList;
- if FIndexFieldNames <> '' then
- UpdateIndexFieldList;
- if FMasterLink.DataSource <> nil then
- UpdateMasterDetailProperties;
- // Get PrimaryKeyNo if available
- if TDefCollection(FieldDefs).Find(FPrimaryKey) <> nil then
- FPrimaryKeyNo := FieldDefs.Find(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(nil, 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: TRecordBuffer);
- begin
- FCurrentItem := PPDataRecord(Buffer)^;
- end;
- function TCustomSqliteDataset.IsCursorOpen: Boolean;
- begin
- Result := FDataAllocated;
- end;
- type
- TLocateCompareFunction = function (Value: PAnsiChar; const Key: String): Boolean;
-
- TLocateFieldInfo = record
- Index: Integer;
- Key: String;
- CompFunction: TLocateCompareFunction;
- end;
- function CompInsensitivePartial(UTF8Value: PAnsiChar; const AnsiKey: String): Boolean;
- var
- AnsiValue: AnsiString;
- begin
- //see comments of CompInsensitive and CompInsensitiveWild functions
- if UTF8Value <> nil then
- begin
- AnsiValue := UTF8Decode(UTF8Value);
- Result := AnsiStrLIComp(PAnsiChar(AnsiValue), PAnsiChar(AnsiKey), Length(AnsiKey)) = 0;
- end
- else
- Result := False;
- end;
- function CompSensitivePartial(UTF8Value: PAnsiChar; const UTF8Key: String): Boolean;
- begin
- if UTF8Value <> nil then
- Result := StrLComp(UTF8Value, PAnsiChar(UTF8Key), Length(UTF8Key)) = 0
- else
- Result := False;
- end;
- function CompInsensitive(UTF8Value: PAnsiChar; const AnsiKey: String): Boolean;
- begin
- //fpc does not provide a function to compare UTF8 directly, so convert the
- //UTF8Value string to ansi through a temporary widestring and compare with the
- //AnsiKey (already encoded in the system ansi encoding).
- //In unix systems where UTF8 is the system ansi encoding this would not be
- //necessary but there's no direct way to check that
- //todo: change this code when fpc has better support for unicode
- if UTF8Value <> nil then
- Result := AnsiCompareText(UTF8Decode(UTF8Value), AnsiKey) = 0
- else
- Result := False;
- end;
- function CompSensitive(UTF8Value: PAnsiChar; const UTF8Key: String): Boolean;
- begin
- if UTF8Value <> nil then
- Result := StrComp(UTF8Value, PAnsiChar(UTF8Key)) = 0
- else
- Result := False;
- end;
- function CompSensitiveWild(UTF8Value: PAnsiChar; const UTF8Key: String): Boolean;
- begin
- if UTF8Value <> nil then
- Result := IsWild(String(UTF8Value), UTF8Key, False)
- else
- Result := False;
- end;
- function CompDouble(UTF8Value: PAnsiChar; const UTF8Key: String): Boolean;
- var e1,e2:double;
- begin
- if UTF8Value <> nil then
- begin
- val(UTF8Value,e1);
- val(UTF8Key,e2);
- result:=e1=e2;
- end
- else
- Result := False;
- end;
- function CompInsensitiveWild(UTF8Value: PAnsiChar; const AnsiKey: String): Boolean;
- begin
- //IsWild does not work with UTF8 encoded strings for case insensitive searches,
- //so convert UTF8Value to the system ansi encoding before passing to IsWild.
- //AnsiKey is already encoded in ansi
- //todo: change this code when fpc has better support for unicode
- if UTF8Value <> nil then
- Result := IsWild(UTF8Decode(UTF8Value), AnsiKey, True)
- else
- Result := False;
- end;
- function TCustomSqliteDataset.FindRecordItem(StartItem: PDataRecord; const KeyFields: string; const KeyValues: Variant; LocateOptions: TLocateOptions; DoResync:Boolean): PDataRecord;
- var
- LocateFields: array of TLocateFieldInfo;
- AFieldList: TList;
- i, AFieldCount: Integer;
- MatchRecord: Boolean;
- TempItem: PDataRecord;
-
- begin
- Result := nil;
- 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 the fields info
- SetLength(LocateFields, AFieldCount);
-
- for i := 0 to AFieldCount - 1 do
- with TField(AFieldList[i]) do
- begin
- if not (DataType in [ftFloat, ftDateTime, ftTime, ftDate]) then
- begin
- //the loPartialKey and loCaseInsensitive is ignored in numeric fields
- if DataType in [ftString, ftMemo] then
- begin
- if loPartialKey in LocateOptions then
- begin
- if loCaseInsensitive in LocateOptions then
- LocateFields[i].CompFunction := @CompInsensitivePartial
- else
- LocateFields[i].CompFunction := @CompSensitivePartial;
- end
- else
- if soWildcardKey in FOptions then
- begin
- if loCaseInsensitive in LocateOptions then
- LocateFields[i].CompFunction := @CompInsensitiveWild
- else
- LocateFields[i].CompFunction := @CompSensitiveWild;
- end
- else
- begin
- if loCaseInsensitive in LocateOptions then
- LocateFields[i].CompFunction := @CompInsensitive
- else
- LocateFields[i].CompFunction := @CompSensitive;
- end;
- end
- else
- LocateFields[i].CompFunction := @CompSensitive;
-
- if VarIsArray(KeyValues) then
- LocateFields[i].Key := VarToStr(KeyValues[i])
- else
- LocateFields[i].Key := VarToStr(KeyValues);
- //store Key encoded as the system ansi encoding
- if loCaseInsensitive in LocateOptions then
- LocateFields[i].Key := UTF8Decode(LocateFields[i].Key);
- end
- else
- begin
- LocateFields[i].CompFunction := @CompDouble;
- //get float types in appropriate format
- if VarIsArray(KeyValues) then
- Str(VarToDateTime(keyvalues[i]), LocateFields[i].Key)
- else
- Str(VarToDateTime(keyvalues), LocateFields[i].Key);
- end;
- LocateFields[i].Index := FieldNo - 1;
- end;
- finally
- AFieldList.Destroy;
- end;
- {$ifdef DEBUG_SQLITEDS}
- WriteLn('##TCustomSqliteDataset.FindRecordItem##');
- WriteLn(' KeyFields: ', KeyFields);
- for i := 0 to AFieldCount - 1 do
- begin
- WriteLn('LocateFields[', i, ']');
- WriteLn(' Key: ', LocateFields[i].Key);
- WriteLn(' Index: ', LocateFields[i].Index);
- end;
- {$endif}
- //Search the list
- TempItem := StartItem;
- while TempItem <> FEndItem do
- begin
- MatchRecord := True;
- for i:= 0 to AFieldCount - 1 do
- begin
- with LocateFields[i] do
- if not CompFunction(TempItem^.Row[Index], Key) then
- begin
- MatchRecord := False;
- break; //for
- end;
- end;
- if MatchRecord then
- begin
- Result := TempItem;
- if DoResync and (TempItem <> PPDataRecord(ActiveBuffer)^) then
- begin
- DoBeforeScroll;
- FCurrentItem := TempItem;
- Resync([]);
- DoAfterScroll;
- end;
- break; //while
- end;
- TempItem := TempItem^.Next;
- end;
- end;
- procedure TCustomSqliteDataset.UpdateMasterDetailProperties;
- var
- i: Integer;
- begin
- if FMasterLink.Active and (FIndexFieldList.Count <> FMasterLink.Fields.Count) then
- DatabaseError('MasterFields count doesn''t match IndexFields count', Self);
- if FieldDefs.Count > 0 then
- begin
- //build the sql template used to filter the dataset
- FSqlFilterTemplate := 'SELECT ';
- for i := 0 to FieldDefs.Count - 2 do
- FSqlFilterTemplate := FSqlFilterTemplate + FieldDefs[i].Name + ',';
- FSqlFilterTemplate := FSqlFilterTemplate + FieldDefs[FieldDefs.Count - 1].Name +
- ' FROM ' + FTableName;
- end;
- //set FEffectiveSQL considering MasterSource active record
- SetDetailFilter;
- end;
- function TCustomSqliteDataset.FieldDefsStored: Boolean;
- begin
- Result := FStoreDefs and (FieldDefs.Count > 0);
- end;
- procedure TCustomSqliteDataset.GetSqliteHandle;
- begin
- if FFileName = '' then
- DatabaseError('Filename not set', Self);
- FSqliteHandle := InternalGetHandle;
- if Assigned(FOnGetHandle) then
- FOnGetHandle(Self);
- end;
- procedure TCustomSqliteDataset.FreeItem(AItem: PDataRecord);
- var
- i: Integer;
- begin
- for i:= 0 to FRowCount - 1 do
- StrDispose(AItem^.Row[i]);
- FreeMem(AItem^.Row, FRowBufferSize);
- Dispose(AItem);
- end;
- function TCustomSqliteDataset.Locate(const KeyFields: String; const KeyValues: Variant; LocateOptions: TLocateOptions): Boolean;
- begin
- CheckBrowseMode;
- Result := FindRecordItem(FBeginItem^.Next, KeyFields, KeyValues, LocateOptions, True) <> nil;
- end;
-
- function TCustomSqliteDataset.LocateNext(const KeyFields: String; const KeyValues: Variant; LocateOptions: TLocateOptions): Boolean;
- begin
- CheckBrowseMode;
- Result := FindRecordItem(PPDataRecord(ActiveBuffer)^^.Next, KeyFields, KeyValues, LocateOptions, True) <> nil;
- end;
-
- function TCustomSqliteDataset.Lookup(const KeyFields: String; const KeyValues: Variant; const ResultFields: String): Variant;
- var
- TempItem: PDataRecord;
- SaveState: TDataSetState;
- begin
- CheckBrowseMode;
- TempItem := FindRecordItem(FBeginItem^.Next, KeyFields, KeyValues, [], False);
- if TempItem <> nil then
- begin
- SaveState := SetTempState(dsInternalCalc);
- try
- CalculateFields(TRecordBuffer(@TempItem));
- Result := FieldByName(ResultFields).Value;
- finally
- RestoreState(SaveState);
- end;
- end
- else
- Result := Null;
- end;
- procedure TCustomSqliteDataset.SetBookmarkData(Buffer: TRecordBuffer; Data: Pointer);
- begin
- //The BookMarkData is the Buffer itself: no need to set nothing;
- end;
- procedure TCustomSqliteDataset.SetBookmarkFlag(Buffer: TRecordBuffer; 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;
- end;
- procedure TCustomSqliteDataset.SetFieldData(Field: TField; Buffer: Pointer;
- NativeFormat: Boolean);
- var
- TempStr: String;
- FieldOffset: Integer;
- EditItem: PDataRecord;
- begin
- if not (State in [dsEdit, dsInsert, dsCalcFields]) then
- DatabaseErrorFmt(SNotEditing, [Name], Self);
- if Field.FieldNo >= 0 then
- begin
- if State in [dsEdit, dsInsert] then
- Field.Validate(Buffer);
- FieldOffset := Field.FieldNo - 1;
- EditItem := FCacheItem;
- end
- else
- begin
- FieldOffset := FieldDefs.Count + FCalcFieldList.IndexOf(Field);
- EditItem := PPDataRecord(CalcBuffer)^;
- end;
- StrDispose(EditItem^.Row[FieldOffset]);
- if Buffer <> nil then
- begin
- case Field.Datatype of
- ftString:
- begin
- EditItem^.Row[FieldOffset] := StrNew(PAnsiChar(Buffer));
- end;
- ftInteger:
- begin
- Str(LongInt(Buffer^), TempStr);
- EditItem^.Row[FieldOffset] := StrAlloc(Length(TempStr) + 1);
- Move(PAnsiChar(TempStr)^, (EditItem^.Row[FieldOffset])^, Length(TempStr) + 1);
- end;
- ftBoolean, ftWord:
- begin
- //ensure that boolean True value is stored as 1
- if Field.DataType = ftBoolean then
- TempStr := IfThen(Boolean(Buffer^), '1', '0')
- else
- Str(Word(Buffer^), TempStr);
- EditItem^.Row[FieldOffset] := StrAlloc(Length(TempStr) + 1);
- Move(PAnsiChar(TempStr)^, (EditItem^.Row[FieldOffset])^, Length(TempStr) + 1);
- end;
- ftFloat, ftDateTime, ftDate, ftTime, ftCurrency:
- begin
- Str(Double(Buffer^), TempStr);
- EditItem^.Row[FieldOffset] := StrAlloc(Length(TempStr) + 1);
- Move(PAnsiChar(TempStr)^, (EditItem^.Row[FieldOffset])^, Length(TempStr) + 1);
- end;
- ftLargeInt:
- begin
- Str(Int64(Buffer^), TempStr);
- EditItem^.Row[FieldOffset] := StrAlloc(Length(TempStr) + 1);
- Move(PAnsiChar(TempStr)^, (EditItem^.Row[FieldOffset])^, Length(TempStr) + 1);
- end;
- end;// case
- end//if
- else
- EditItem^.Row[FieldOffset] := 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;
- if TempItem <> PPDataRecord(ActiveBuffer)^ then
- begin
- DoBeforeScroll;
- FCurrentItem := TempItem;
- Resync([]);
- DoAfterScroll;
- end;
- end;
- // Specific functions
- procedure TCustomSqliteDataset.SetDetailFilter;
- function FieldToSqlStr(AField: TField): String;
- begin
- if not AField.IsNull then
- begin
- case AField.DataType of
- //todo: handle " caracter properly
- ftString, ftMemo:
- Result := '"' + AField.AsString + '"';
- 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 not FMasterLink.Active or (FMasterLink.Dataset.RecordCount = 0) then //Retrieve all data
- FEffectiveSQL := FSqlFilterTemplate
- 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;
- FEffectiveSQL := FSqlFilterTemplate + AFilter;
- end;
- end;
- procedure TCustomSqliteDataset.MasterChanged(Sender: TObject);
- begin
- SetDetailFilter;
- {$ifdef DEBUG_SQLITEDS}
- WriteLn('##TCustomSqliteDataset.MasterChanged##');
- WriteLn(' SQL used to filter detail dataset:');
- WriteLn(' ', FEffectiveSQL);
- {$endif}
- RefetchData;
- end;
- procedure TCustomSqliteDataset.SetMasterFields(const Value: String);
- begin
- FMasterLink.FieldNames := Value;
- if Active and FMasterLink.Active then
- begin
- UpdateIndexFieldList;
- 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.UpdateIndexFieldList;
- begin
- if FIndexFieldList = nil then
- FIndexFieldList := TList.Create
- else
- FIndexFieldList.Clear;
- try
- GetFieldList(FIndexFieldList, FIndexFieldNames);
- except
- on E: Exception do
- begin
- FIndexFieldList.Clear;
- DatabaseError('Error retrieving index fields: ' + E.Message);
- end;
- end;
- end;
- function TCustomSqliteDataset.GetMasterSource: TDataSource;
- begin
- Result := FMasterLink.DataSource;
- end;
- procedure TCustomSqliteDataset.SetFileName(const Value: UTF8String);
- 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.ExecSQL(ASqlList: TStrings);
- begin
- if FSqliteHandle = nil then
- GetSqliteHandle;
- FReturnCode := SqliteExec(PAnsiChar(ASQLList.Text), nil, nil);
- if FReturnCode <> SQLITE_OK then
- DatabaseError(ReturnString, Self);
- end;
- procedure TCustomSqliteDataset.ExecSQLList;
- begin
- ExecSQL(SQLList);
- end;
- function TCustomSqliteDataset.GetSQLValue(Values: PPAnsiChar; FieldIndex: Integer): String;
- begin
- if (State = dsInactive) or (FieldIndex < 0) or (FieldIndex >= FieldDefs.Count) then
- DatabaseError('Error retrieving SQL value: dataset inactive or field out of range', Self);
- Result := FGetSqlStr[FieldIndex](Values[FieldIndex]);
- end;
- procedure TCustomSqliteDataset.ExecSQL;
- begin
- ExecSQL(FSQL);
- end;
- function TCustomSqliteDataset.ApplyUpdates: Boolean;
- var
- iFields, iItems, StatementsCounter: Integer;
- SQLTemp, WhereKeyNameEqual, SQLLine, TemplateStr: String;
- TempItem: PDataRecord;
- begin
- Result := False;
- CheckBrowseMode;
- if not UpdatesPending then
- begin
- Result := True;
- Exit;
- end;
- //A PrimaryKey is only necessary to update or delete records
- if FPrimaryKeyNo <> -1 then
- begin
- WhereKeyNameEqual := ' WHERE ' + FieldDefs[FPrimaryKeyNo].Name + ' = ';
- Result := True;
- end else if (FUpdatedItems.Count + FDeletedItems.Count) = 0 then
- Result := True;
- if not Result then
- Exit;
- FReturnCode := SQLITE_OK;
- StatementsCounter := 0;
- SQLTemp := 'BEGIN;';
- {$ifdef DEBUG_SQLITEDS}
- WriteLn('##TCustomSqliteDataset.ApplyUpdates##');
- if FPrimaryKeyNo = FAutoIncFieldNo then
- WriteLn(' Using an AutoInc field as primary key');
- WriteLn(' PrimaryKey: ', WhereKeyNameEqual);
- WriteLn(' PrimaryKeyNo: ', FPrimaryKeyNo);
- {$endif}
- // Delete Records
- if FDeletedItems.Count > 0 then
- begin
- TemplateStr := 'DELETE FROM ' + FTableName + WhereKeyNameEqual;
- for iItems := 0 to FDeletedItems.Count - 1 do
- begin
- TempItem := PDataRecord(FDeletedItems.List^[iItems]);
- SQLTemp := SQLTemp + (TemplateStr +
- FGetSqlStr[FPrimaryKeyNo](TempItem^.Row[FPrimaryKeyNo]) + ';');
- FreeItem(TempItem);
- Inc(StatementsCounter);
- //ApplyUpdates each 400 statements
- if StatementsCounter = 400 then
- begin
- SQLTemp := SQLTemp + 'COMMIT;';
- FReturnCode := SqliteExec(PAnsiChar(SQLTemp), nil, nil);
- StatementsCounter := 0;
- SQLTemp := 'BEGIN;';
- if FReturnCode <> SQLITE_OK then
- begin
- SqliteExec('ROLLBACK;', nil, nil);
- Break;
- end;
- end;
- end;
- end;
- // Update changed records
- if (FUpdatedItems.Count > 0) and (FReturnCode = SQLITE_OK) then
- begin
- TemplateStr := 'UPDATE ' + FTableName + ' SET ';
- for iItems := 0 to FUpdatedItems.Count - 1 do
- begin
- SQLLine := TemplateStr;
- for iFields := 0 to FieldDefs.Count - 2 do
- begin
- SQLLine := SQLLine + (FieldDefs[iFields].Name + ' = ' +
- FGetSqlStr[iFields](PDataRecord(FUpdatedItems[iItems])^.Row[iFields]) + ',');
- end;
- iFields := FieldDefs.Count - 1;
- SQLLine := SQLLine + (FieldDefs[iFields].Name + ' = ' +
- FGetSqlStr[iFields](PDataRecord(FUpdatedItems[iItems])^.Row[iFields]) +
- WhereKeyNameEqual +
- FGetSqlStr[FPrimaryKeyNo](PDataRecord(FUpdatedItems[iItems])^.Row[FPrimaryKeyNo]) + ';');
- SQLTemp := SQLTemp + SQLLine;
- Inc(StatementsCounter);
- //ApplyUpdates each 400 statements
- if StatementsCounter = 400 then
- begin
- SQLTemp := SQLTemp + 'COMMIT;';
- FReturnCode := SqliteExec(PAnsiChar(SQLTemp), nil, nil);
- StatementsCounter := 0;
- SQLTemp := 'BEGIN;';
- if FReturnCode <> SQLITE_OK then
- begin
- SqliteExec('ROLLBACK;', nil, nil);
- Break;
- end;
- end;
- end;
- end;
- // Add new records
- if (FAddedItems.Count > 0) and (FReturnCode = SQLITE_OK) then
- begin
- // Build TemplateStr
- TemplateStr := 'INSERT INTO ' + FTableName + ' (';
- for iFields := 0 to FieldDefs.Count - 2 do
- TemplateStr := TemplateStr + FieldDefs[iFields].Name + ',';
- TemplateStr := TemplateStr + FieldDefs[FieldDefs.Count - 1].Name + ') VALUES (';
- for iItems := 0 to FAddedItems.Count - 1 do
- begin
- SQLLine := TemplateStr;
- for iFields := 0 to FieldDefs.Count - 2 do
- SQLLine := SQLLine + (FGetSqlStr[iFields](PDataRecord(FAddedItems[iItems])^.Row[iFields]) + ',');
- iFields := FieldDefs.Count - 1;
- SQLLine := SQLLine + (FGetSqlStr[iFields](PDataRecord(FAddedItems[iItems])^.Row[iFields]) + ');' );
- SQLTemp := SQLTemp + SQLLine;
- Inc(StatementsCounter);
- //ApplyUpdates each 400 statements
- if StatementsCounter = 400 then
- begin
- SQLTemp := SQLTemp + 'COMMIT;';
- FReturnCode := SqliteExec(PAnsiChar(SQLTemp), nil, nil);
- StatementsCounter := 0;
- SQLTemp := 'BEGIN;';
- if FReturnCode <> SQLITE_OK then
- begin
- SqliteExec('ROLLBACK;', nil, nil);
- Break;
- end;
- end;
- end;
- end;
- FAddedItems.Clear;
- FUpdatedItems.Clear;
- FDeletedItems.Clear;
- if FReturnCode = SQLITE_OK then
- begin
- SQLTemp := SQLTemp + 'COMMIT;';
- FReturnCode := SqliteExec(PAnsiChar(SQLTemp), nil, nil);
- if FReturnCode <> SQLITE_OK then
- SqliteExec('ROLLBACK;', nil, nil);
- end;
- Result := FReturnCode = SQLITE_OK;
- {$ifdef DEBUG_SQLITEDS}
- WriteLn(' Result: ', Result);
- {$endif}
- end;
- procedure TCustomSqliteDataset.ClearUpdates(RecordStates: TRecordStateSet);
- begin
- if rsUpdated in RecordStates then
- FUpdatedItems.Clear;
- if rsDeleted in RecordStates then
- FDeletedItems.Clear;
- if rsAdded in RecordStates then
- FAddedItems.Clear;
- end;
- function TCustomSqliteDataset.CreateTable: Boolean;
- begin
- Result := CreateTable(FTableName);
- end;
- function TCustomSqliteDataset.CreateTable(const ATableName: String): Boolean;
- var
- SQLTemp: String;
- i, StrSize: Integer;
- begin
- {$ifdef DEBUG_SQLITEDS}
- 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:
- begin
- StrSize := FieldDefs[i].Size;
- if StrSize = 0 then
- StrSize := DefaultStringSize;
- SQLTemp := SQLTemp + ' VARCHAR(' + IntToStr(StrSize) + ')';
- end;
- 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_SQLITEDS}
- WriteLn(' SQL: ',SqlTemp);
- {$endif}
- ExecSQL(SQLTemp);
- Result := FReturnCode = SQLITE_DONE;
- 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(PAnsiChar(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);
- CheckBrowseMode;
- 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;
- //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
- ExecSql('SELECT name FROM SQLITE_MASTER WHERE type = ''table'' AND name LIKE ''' + ATableName + ''';');
- Result := FReturnCode = SQLITE_ROW;
- 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.
|