paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-12 13:06:18 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ updated to latest version from Luiz Camara

Browse Source 
git-svn-id: trunk@3061 -
This commit is contained in:
joost 2006-03-27 18:14:02 +00:00
parent dfd84c6fd3
commit 9b7d7cb21f
3 changed files with 541 additions and 407 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

448
fcl/db/sqlite/customsqliteds.pas
View File

@ -62,9 +62,6 @@ type
TCustomSqliteDataset = class(TDataSet) TCustomSqliteDataset = class(TDataSet)
private private
FPrimaryKey: String;
FPrimaryKeyNo: Integer;
{$ifdef DEBUGACTIVEBUFFER} {$ifdef DEBUGACTIVEBUFFER}
FFCurrentItem: PDataRecord; FFCurrentItem: PDataRecord;
{$else} {$else}
@ -74,25 +71,30 @@ type
FExpectedAppends: Integer; FExpectedAppends: Integer;
FExpectedDeletes: Integer; FExpectedDeletes: Integer;
FExpectedUpdates: Integer; FExpectedUpdates: Integer;
//FPersistentHandle: Boolean;
FSaveOnClose: Boolean; FSaveOnClose: Boolean;
FSaveOnRefetch: Boolean; FSaveOnRefetch: Boolean;
FSqlMode: Boolean; FAutoIncrementKey: Boolean;
FUpdatedItems: TFPList;
FAddedItems: TFPList;
FDeletedItems: TFPList;
FOrphanItems: TFPList;
FMasterLink: TMasterDataLink; FMasterLink: TMasterDataLink;
FIndexFieldNames: String; FIndexFieldNames: String;
FIndexFieldList: TList; FIndexFieldList: TList;
FSqlList:TStrings;
function GetIndexFields(Value: Integer): TField; function GetIndexFields(Value: Integer): TField;
procedure UpdateIndexFields; procedure UpdateIndexFields;
function FindRecordItem(StartItem: PDataRecord; const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions; DoResync:Boolean):PDataRecord; function FindRecordItem(StartItem: PDataRecord; const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions; DoResync:Boolean):PDataRecord;
protected protected
FPrimaryKey: String;
FPrimaryKeyNo: Integer;
FFileName: String; FFileName: String;
FSql: String; FSql: String;
FTableName: String; FTableName: String;
FSelectSqlStr: String;
FAutoIncFieldNo: Integer; FAutoIncFieldNo: Integer;
FNextAutoInc:Integer; FNextAutoInc:Integer;
FUpdatedItems: TFPList;
FAddedItems: TFPList;
FDeletedItems: TFPList;
FOrphanItems: TFPList;
FSqliteReturnId: Integer; FSqliteReturnId: Integer;
FSqliteHandle: Pointer; FSqliteHandle: Pointer;
FDataAllocated: Boolean; FDataAllocated: Boolean;
@ -103,8 +105,9 @@ type
FEndItem: PDataRecord; FEndItem: PDataRecord;
FCacheItem: PDataRecord; FCacheItem: PDataRecord;
function SqliteExec(AHandle: Pointer; Sql:PChar):Integer;virtual; abstract; function SqliteExec(AHandle: Pointer; Sql:PChar):Integer;virtual; abstract;
procedure SqliteClose(AHandle: Pointer);virtual;abstract; procedure InternalCloseHandle;virtual;abstract;
function GetSqliteHandle: Pointer; virtual; abstract; function InternalGetHandle: Pointer; virtual; abstract;
procedure GetSqliteHandle;
function GetSqliteVersion: String; virtual; abstract; function GetSqliteVersion: String; virtual; abstract;
procedure BuildLinkedList; virtual; abstract; procedure BuildLinkedList; virtual; abstract;
procedure DisposeLinkedList; procedure DisposeLinkedList;
@ -115,6 +118,8 @@ type
function GetMasterFields:String; function GetMasterFields:String;
procedure SetMasterSource(Value: TDataSource); procedure SetMasterSource(Value: TDataSource);
function GetMasterSource:TDataSource; function GetMasterSource:TDataSource;
procedure SetFileName(Value: String);
function GetRowsAffected:Integer; virtual;abstract;
//TDataSet overrides //TDataSet overrides
function AllocRecordBuffer: PChar; override; function AllocRecordBuffer: PChar; override;
function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override; function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override;
@ -141,26 +146,32 @@ type
procedure SetExpectedAppends(AValue:Integer); procedure SetExpectedAppends(AValue:Integer);
procedure SetExpectedUpdates(AValue:Integer); procedure SetExpectedUpdates(AValue:Integer);
procedure SetExpectedDeletes(AValue:Integer); procedure SetExpectedDeletes(AValue:Integer);
procedure SetFieldData(Field: TField; Buffer: Pointer); override; procedure SetFieldData(Field: TField; Buffer: Pointer); override;
procedure SetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean); override;
procedure SetRecNo(Value: Integer); override; procedure SetRecNo(Value: Integer); override;
public public
constructor Create(AOwner: TComponent); override; constructor Create(AOwner: TComponent); override;
destructor Destroy; override; destructor Destroy; override;
function GetFieldData(Field: TField; Buffer: Pointer): Boolean; 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 Locate(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions) : boolean; override;
function LocateNext(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions) : boolean; 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} function Lookup(const KeyFields: string; const KeyValues: Variant; const ResultFields: string): Variant;{$ifndef ver2_0_0}override;{$endif}
// Additional procedures // Additional procedures
function ApplyUpdates: Boolean; virtual; function ApplyUpdates: Boolean;
function CreateTable: Boolean; virtual; function CreateTable: Boolean;
function ExecSQL:Integer; function CreateTable(const ATableName: String): Boolean;
function ExecSQL(const ASql:String):Integer; procedure ExecSQL;
procedure ExecSQL(const ASql:String);
procedure ExecSQLList;
procedure ExecuteDirect(const ASql: String);virtual;abstract;
function QuickQuery(const ASql:String):String;overload; 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):String;overload;
function QuickQuery(const ASql:String;const AStrList: TStrings;FillObjects:Boolean):String;virtual;abstract;overload; function QuickQuery(const ASql:String;const AStrList: TStrings;FillObjects:Boolean):String;virtual;abstract;overload;
procedure RefetchData; procedure RefetchData;
function SqliteReturnString: String; virtual;abstract; function SqliteReturnString: String; virtual;abstract;
function TableExists: Boolean;virtual;abstract; function TableExists: Boolean;overload;
function TableExists(const ATableName:String):Boolean;virtual;abstract;overload;
function UpdatesPending: Boolean; function UpdatesPending: Boolean;
{$ifdef DEBUGACTIVEBUFFER} {$ifdef DEBUGACTIVEBUFFER}
procedure SetCurrentItem(Value:PDataRecord); procedure SetCurrentItem(Value:PDataRecord);
@ -177,17 +188,20 @@ type
property ExpectedUpdates: Integer read FExpectedUpdates write SetExpectedUpdates; property ExpectedUpdates: Integer read FExpectedUpdates write SetExpectedUpdates;
property ExpectedDeletes: Integer read FExpectedDeletes write SetExpectedDeletes; property ExpectedDeletes: Integer read FExpectedDeletes write SetExpectedDeletes;
property IndexFields[Value: Integer]: TField read GetIndexFields; property IndexFields[Value: Integer]: TField read GetIndexFields;
property RowsAffected: Integer read GetRowsAffected;
//property PersistentHandle: boolean read FPersistentHandle write FPersistentHandle;
property SqliteReturnId: Integer read FSqliteReturnId; property SqliteReturnId: Integer read FSqliteReturnId;
property SqliteHandle: Pointer read FSqliteHandle; property SqliteHandle: Pointer read FSqliteHandle;
property SqliteVersion: String read GetSqliteVersion; property SqliteVersion: String read GetSqliteVersion;
property SQLList:TStrings read FSqlList;
published published
property AutoIncrementKey: Boolean read FAutoIncrementKey write FAutoIncrementKey;
property IndexFieldNames: string read FIndexFieldNames write FIndexFieldNames; property IndexFieldNames: string read FIndexFieldNames write FIndexFieldNames;
property FileName: String read FFileName write FFileName; property FileName: String read FFileName write SetFileName;
property PrimaryKey: String read FPrimaryKey write FPrimaryKey; property PrimaryKey: String read FPrimaryKey write FPrimaryKey;
property SaveOnClose: Boolean read FSaveOnClose write FSaveOnClose; property SaveOnClose: Boolean read FSaveOnClose write FSaveOnClose;
property SaveOnRefetch: Boolean read FSaveOnRefetch write FSaveOnRefetch; property SaveOnRefetch: Boolean read FSaveOnRefetch write FSaveOnRefetch;
property SQL: String read FSql write FSql; property SQL: String read FSql write FSql;
property SqlMode: Boolean read FSqlMode write FSqlMode;
property TableName: String read FTableName write FTableName; property TableName: String read FTableName write FTableName;
property MasterSource: TDataSource read GetMasterSource write SetMasterSource; property MasterSource: TDataSource read GetMasterSource write SetMasterSource;
property MasterFields: string read GetMasterFields write SetMasterFields; property MasterFields: string read GetMasterFields write SetMasterFields;
@ -255,31 +269,26 @@ begin
Result:=Count; Result:=Count;
if Count = 0 then if Count = 0 then
Exit; Exit;
//Todo: see how TDbMemo read/write to field and choose best if order //FRowSize is always 0 when FPosition = 0,
if FPosition = 0 then //so there's no need to check FPosition
begin NewRow:=StrAlloc(FRowSize+Count+1);
NewRow:=StrAlloc(Count+1); (NewRow+Count+FRowSize)^:=#0;
(NewRow+Count)^:=#0; if FRowSize > 0 then
Move(Buffer,NewRow^,Count);
end
else
begin
NewRow:=StrAlloc(FRowSize+Count+1);
(NewRow+Count+FRowSize)^:=#0;
Move(FFieldRow^,NewRow^,FRowSize); Move(FFieldRow^,NewRow^,FRowSize);
Move(Buffer,(NewRow+FRowSize)^,Count); Move(Buffer,(NewRow+FRowSize)^,Count);
end;
FActiveItem^.Row[FFieldIndex]:=NewRow; FActiveItem^.Row[FFieldIndex]:=NewRow;
StrDispose(FFieldRow); 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; FFieldRow:=NewRow;
FRowSize:=StrLen(NewRow); FRowSize:=StrLen(NewRow);
Inc(FPosition,Count); Inc(FPosition,Count);
{$ifdef DEBUG}
WriteLn('Writing a BlobStream');
WriteLn('Stream.Size: ',StrLen(NewRow));
WriteLn('Stream Value: ',NewRow);
WriteLn('FPosition:',FPosition);
{$endif}
end; end;
function TDSStream.Read(var Buffer; Count: Longint): Longint; function TDSStream.Read(var Buffer; Count: Longint): Longint;
@ -294,11 +303,11 @@ begin
Inc(FPosition,BytesToMove); Inc(FPosition,BytesToMove);
Result:=BytesToMove; Result:=BytesToMove;
{$ifdef DEBUG} {$ifdef DEBUG}
WriteLn('Reading a BlobStream'); WriteLn('##TDSStream.Read##');
WriteLn('Bytes requested: ',Count); WriteLn(' Bytes requested: ',Count);
WriteLn('Bytes Moved: ',BytesToMove); WriteLn(' Bytes moved: ',BytesToMove);
WriteLn('Stream.Size: ',FRowSize); WriteLn(' Stream.Size: ',FRowSize);
WriteLn('Stream Value: ',FFieldRow); //WriteLn(' Stream Value: ',FFieldRow);
{$endif} {$endif}
end; end;
@ -334,30 +343,40 @@ begin
BookmarkSize := SizeOf(Pointer); BookmarkSize := SizeOf(Pointer);
FBufferSize := SizeOf(PPDataRecord); FBufferSize := SizeOf(PPDataRecord);
FUpdatedItems:= TFPList.Create; FUpdatedItems:= TFPList.Create;
FUpdatedItems.Capacity:=20;
FAddedItems:= TFPList.Create; FAddedItems:= TFPList.Create;
FAddedItems.Capacity:=20;
FOrphanItems:= TFPList.Create; FOrphanItems:= TFPList.Create;
FOrphanItems.Capacity:=20;
FDeletedItems:= TFPList.Create; FDeletedItems:= TFPList.Create;
FDeletedItems.Capacity:=20; FSqlList:=TStringList.Create;
inherited Create(AOwner); inherited Create(AOwner);
end; end;
function TCustomSqliteDataset.CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; function TCustomSqliteDataset.CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream;
var
ActiveItem:PDataRecord;
begin begin
if Mode = bmWrite then
begin
ActiveItem:=PPDataRecord(ActiveBuffer)^;
if (ActiveItem <> FCacheItem) and (FUpdatedItems.IndexOf(ActiveItem) = -1) and (FAddedItems.IndexOf(ActiveItem) = -1) then
FUpdatedItems.Add(ActiveItem);
StrDispose(ActiveItem^.Row[Field.FieldNo - 1]);
ActiveItem^.Row[Field.FieldNo - 1]:=nil;
end;
Result:= TDSStream.Create(PPDataRecord(ActiveBuffer)^,Field.FieldNo - 1); Result:= TDSStream.Create(PPDataRecord(ActiveBuffer)^,Field.FieldNo - 1);
end; end;
destructor TCustomSqliteDataset.Destroy; destructor TCustomSqliteDataset.Destroy;
begin begin
inherited Destroy; inherited Destroy;
if FSqliteHandle <> nil then
InternalCloseHandle;
FUpdatedItems.Destroy; FUpdatedItems.Destroy;
FAddedItems.Destroy; FAddedItems.Destroy;
FDeletedItems.Destroy; FDeletedItems.Destroy;
FOrphanItems.Destroy; FOrphanItems.Destroy;
FMasterLink.Destroy; FMasterLink.Destroy;
FIndexFieldList.Destroy; FIndexFieldList.Destroy;
FSqlList.Destroy;
// dispose special items // dispose special items
Dispose(FBeginItem); Dispose(FBeginItem);
Dispose(FCacheItem); Dispose(FCacheItem);
@ -377,11 +396,14 @@ var
Counter,I:Integer; Counter,I:Integer;
begin begin
//Todo: insert debug info //Todo: insert debug info
//Todo: see if FDataAllocated is still necessary
FDataAllocated:=False; FDataAllocated:=False;
TempItem:=FBeginItem^.Next; TempItem:=FBeginItem^.Next;
//Todo: see if is necessary to check if TempItem is nil (aparently is not)
if TempItem <> nil then if TempItem <> nil then
while TempItem^.Next <> nil do while TempItem^.Next <> nil do
begin begin
//Todo: Add procedure to Dispose and Free a Row ?
for Counter:= 0 to FRowCount - 1 do for Counter:= 0 to FRowCount - 1 do
StrDispose(TempItem^.Row[Counter]); StrDispose(TempItem^.Row[Counter]);
FreeMem(TempItem^.Row,FRowBufferSize); FreeMem(TempItem^.Row,FRowBufferSize);
@ -423,7 +445,8 @@ begin
Result := PPDataRecord(Buffer)^^.BookmarkFlag; Result := PPDataRecord(Buffer)^^.BookmarkFlag;
end; end;
function TCustomSqliteDataset.GetFieldData(Field: TField; Buffer: Pointer): Boolean; function TCustomSqliteDataset.GetFieldData(Field: TField; Buffer: Pointer;
NativeFormat: Boolean): Boolean;
var var
ValError:Word; ValError:Word;
FieldRow:PChar; FieldRow:PChar;
@ -461,6 +484,11 @@ begin
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; function TCustomSqliteDataset.GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult;
begin begin
Result := grOk; Result := grOk;
@ -561,11 +589,13 @@ begin
DestroyFields; DestroyFields;
if FDataAllocated then if FDataAllocated then
DisposeLinkedList; DisposeLinkedList;
if FSqliteHandle <> nil then {
if (FSqliteHandle <> nil) and not FPersistentHandle then
begin begin
SqliteClose(FSqliteHandle); InternalCloseHandle;
FSqliteHandle := nil; FSqliteHandle := nil;
end; end;
}
FAddedItems.Clear; FAddedItems.Clear;
FUpdatedItems.Clear; FUpdatedItems.Clear;
FDeletedItems.Clear; FDeletedItems.Clear;
@ -586,6 +616,9 @@ begin
FUpdatedItems.Remove(TempItem); FUpdatedItems.Remove(TempItem);
if FAddedItems.Remove(TempItem) = -1 then if FAddedItems.Remove(TempItem) = -1 then
FDeletedItems.Add(TempItem); FDeletedItems.Add(TempItem);
//Todo: see if FOrphanItems is necessary:
// in ApplyUpdates a check could be done
// to avoid "delete" the AddedItems
FOrphanItems.Add(TempItem); FOrphanItems.Add(TempItem);
TempItem^.Next^.Previous:=TempItem^.Previous; TempItem^.Next^.Previous:=TempItem^.Previous;
TempItem^.Previous^.Next:=TempItem^.Next; TempItem^.Previous^.Next:=TempItem^.Next;
@ -640,28 +673,38 @@ begin
end; end;
procedure TCustomSqliteDataset.InternalOpen; procedure TCustomSqliteDataset.InternalOpen;
var
i:Integer;
begin begin
FAutoIncFieldNo:=-1;
if not FileExists(FFileName) then
DatabaseError('File "'+ExpandFileName(FFileName)+'" not found',Self);
if (FTablename = '') and not (FSqlMode) then
DatabaseError('Tablename not set',Self);
if MasterSource <> nil then if MasterSource <> nil then
begin begin
//todo: retrieve only necessary fields
FSql := 'Select * from '+FTableName+';'; // forced to obtain all fields FSql := 'Select * from '+FTableName+';'; // forced to obtain all fields
FMasterLink.FieldNames:=FMasterLink.FieldNames; //workaround to fill MasterLinks.Fields FMasterLink.FieldNames:=FMasterLink.FieldNames; //workaround to fill MasterLinks.Fields
//if FMasterLink.Fields.Count = 0 MasterChanged will not be called anyway so ignore it //if FMasterLink.Fields.Count = 0 MasterChanged will not be called anyway so ignore it
end; end;
FSqliteHandle:=GetSqliteHandle;
if FSql = '' then if FSql = '' then
begin
if FTablename = '' then
DatabaseError('Tablename not set',Self);
FSql := 'Select * from '+FTableName+';'; FSql := 'Select * from '+FTableName+';';
end;
if FSqliteHandle = nil then
GetSqliteHandle;
InternalInitFieldDefs; 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;
//writeln(FSelectSqlStr);
if DefaultFields then if DefaultFields then
CreateFields; CreateFields;
BindFields(True); BindFields(True);
UpdateIndexFields; UpdateIndexFields;
@ -708,7 +751,7 @@ var
begin begin
Result:=nil; Result:=nil;
// Now, it allows to search only one field and ignores options // Now, it allows to search only one field and ignores options
AField:=Fields.FieldByName(KeyFields); //FieldByName raises an exeception if field not found AField:=Fields.FieldByName(KeyFields); //FieldByName raises an exception if field not found
AFieldIndex:=AField.FieldNo - 1; AFieldIndex:=AField.FieldNo - 1;
//get float types in appropriate format //get float types in appropriate format
if not (AField.DataType in [ftFloat,ftDateTime,ftTime,ftDate]) then if not (AField.DataType in [ftFloat,ftDateTime,ftTime,ftDate]) then
@ -719,10 +762,10 @@ begin
AValue:=Trim(AValue); AValue:=Trim(AValue);
end; end;
{$ifdef DEBUG} {$ifdef DEBUG}
writeln('=FindRecord='); writeln('##TCustomSqliteDataset.FindRecordItem##');
writeln('keyfields: ',keyfields); writeln(' KeyFields: ',keyfields);
writeln('keyvalues: ',keyvalues); writeln(' KeyValues: ',keyvalues);
writeln('AValue: ',AValue); writeln(' AValue: ',AValue);
{$endif} {$endif}
//Search the list //Search the list
TempItem:=StartItem; TempItem:=StartItem;
@ -745,6 +788,14 @@ begin
end; end;
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; function TCustomSqliteDataset.Locate(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions) : boolean;
begin begin
Result:=FindRecordItem(FBeginItem^.Next,KeyFields,KeyValues,Options,True) <> nil; Result:=FindRecordItem(FBeginItem^.Next,KeyFields,KeyValues,Options,True) <> nil;
@ -792,7 +843,8 @@ begin
FOrphanItems.Capacity:=AValue; FOrphanItems.Capacity:=AValue;
end; end;
procedure TCustomSqliteDataset.SetFieldData(Field: TField; Buffer: Pointer); procedure TCustomSqliteDataset.SetFieldData(Field: TField; Buffer: Pointer;
NativeFormat: Boolean);
var var
TempStr:String; TempStr:String;
ActiveItem:PDataRecord; ActiveItem:PDataRecord;
@ -813,25 +865,27 @@ begin
begin begin
Str(LongInt(Buffer^),TempStr); Str(LongInt(Buffer^),TempStr);
ActiveItem^.Row[Pred(Field.FieldNo)]:=StrAlloc(Length(TempStr)+1); ActiveItem^.Row[Pred(Field.FieldNo)]:=StrAlloc(Length(TempStr)+1);
StrPCopy(ActiveItem^.Row[Pred(Field.FieldNo)],TempStr); Move(PChar(TempStr)^,(ActiveItem^.Row[Pred(Field.FieldNo)])^,Length(TempStr)+1);
end; end;
ftBoolean,ftWord: ftBoolean,ftWord:
begin begin
Str(Word(Buffer^),TempStr); Str(Word(Buffer^),TempStr);
ActiveItem^.Row[Pred(Field.FieldNo)]:=StrAlloc(Length(TempStr)+1); ActiveItem^.Row[Pred(Field.FieldNo)]:=StrAlloc(Length(TempStr)+1);
StrPCopy(ActiveItem^.Row[Pred(Field.FieldNo)],TempStr); Move(PChar(TempStr)^,(ActiveItem^.Row[Pred(Field.FieldNo)])^,Length(TempStr)+1);
end; end;
ftFloat,ftDateTime,ftDate,ftTime,ftCurrency: ftFloat,ftDateTime,ftDate,ftTime,ftCurrency:
begin begin
Str(Double(Buffer^),TempStr); Str(Double(Buffer^),TempStr);
ActiveItem^.Row[Pred(Field.FieldNo)]:=StrAlloc(Length(TempStr)+1); ActiveItem^.Row[Pred(Field.FieldNo)]:=StrAlloc(Length(TempStr));
StrPCopy(ActiveItem^.Row[Pred(Field.FieldNo)],TempStr); //Skips the first space that str returns
//todo: make a custom Str?
Move((PChar(TempStr)+1)^,(ActiveItem^.Row[Pred(Field.FieldNo)])^,Length(TempStr));
end; end;
ftLargeInt: ftLargeInt:
begin begin
Str(Int64(Buffer^),TempStr); Str(Int64(Buffer^),TempStr);
ActiveItem^.Row[Pred(Field.FieldNo)]:=StrAlloc(Length(TempStr)+1); ActiveItem^.Row[Pred(Field.FieldNo)]:=StrAlloc(Length(TempStr)+1);
StrPCopy(ActiveItem^.Row[Pred(Field.FieldNo)],TempStr); Move(PChar(TempStr)^,(ActiveItem^.Row[Pred(Field.FieldNo)])^,Length(TempStr)+1);
end; end;
end;// case end;// case
end//if end//if
@ -841,6 +895,11 @@ begin
DataEvent(deFieldChange, Ptrint(Field)); DataEvent(deFieldChange, Ptrint(Field));
end; end;
procedure TCustomSqliteDataset.SetFieldData(Field: TField; Buffer: Pointer);
begin
SetFieldData(Field, Buffer, False);
end;
procedure TCustomSqliteDataset.SetRecNo(Value: Integer); procedure TCustomSqliteDataset.SetRecNo(Value: Integer);
var var
Counter:Integer; Counter:Integer;
@ -858,7 +917,7 @@ end;
// Specific functions // Specific functions
procedure TCustomSqliteDataset.SetDetailFilter; procedure TCustomSqliteDataset.SetDetailFilter;
function GetSqlStr(AField:TField):String; function FieldToSqlStr(AField:TField):String;
begin begin
case AField.DataType of case AField.DataType of
ftString,ftMemo: Result:='"'+AField.AsString+'"';//todo: handle " caracter properly ftString,ftMemo: Result:='"'+AField.AsString+'"';//todo: handle " caracter properly
@ -879,7 +938,7 @@ begin
AFilter:=' where '; AFilter:=' where ';
for i:= 0 to FMasterLink.Fields.Count - 1 do for i:= 0 to FMasterLink.Fields.Count - 1 do
begin begin
AFilter:=AFilter + IndexFields[i].FieldName +' = '+ GetSqlStr(TField(FMasterLink.Fields[i])); AFilter:=AFilter + IndexFields[i].FieldName +' = '+ FieldToSqlStr(TField(FMasterLink.Fields[i]));
if i <> FMasterLink.Fields.Count - 1 then if i <> FMasterLink.Fields.Count - 1 then
AFilter:= AFilter + ' and '; AFilter:= AFilter + ' and ';
end; end;
@ -891,8 +950,9 @@ procedure TCustomSqliteDataset.MasterChanged(Sender: TObject);
begin begin
SetDetailFilter; SetDetailFilter;
{$ifdef DEBUG} {$ifdef DEBUG}
writeln('Sql used to filter detail dataset:'); writeln('##TCustomSqliteDataset.MasterChanged##');
writeln(FSql); writeln(' SQL used to filter detail dataset:');
writeln(' ',FSql);
{$endif} {$endif}
RefetchData; RefetchData;
end; end;
@ -919,7 +979,6 @@ begin
Result:=FMasterLink.FieldNames; Result:=FMasterLink.FieldNames;
end; end;
procedure TCustomSqliteDataset.UpdateIndexFields; procedure TCustomSqliteDataset.UpdateIndexFields;
begin begin
FIndexFieldList.Clear; FIndexFieldList.Clear;
@ -939,41 +998,62 @@ begin
Result := FMasterLink.DataSource; Result := FMasterLink.DataSource;
end; 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); procedure TCustomSqliteDataset.SetMasterSource(Value: TDataSource);
begin begin
FMasterLink.DataSource := Value; FMasterLink.DataSource := Value;
end; end;
procedure TCustomSqliteDataset.ExecSQL(const ASql:String);
function TCustomSqliteDataset.ExecSQL(const ASql:String):Integer;
var
AHandle: Pointer;
begin begin
Result:=0; if FSqliteHandle = nil then
//Todo check if Filename exists GetSqliteHandle;
if FSqliteHandle <> nil then ExecuteDirect(ASql);
AHandle:=FSqliteHandle
else
if FFileName <> '' then
AHandle := GetSqliteHandle
else
DatabaseError ('ExecSql - FileName not set',Self);
FSqliteReturnId:= SqliteExec(AHandle,PChar(ASql));
//todo: add a way to get the num of changes
//Result:=sqlite_changes(AHandle);
if AHandle <> FSqliteHandle then
SqliteClose(AHandle);
end;
function TCustomSqliteDataset.ExecSQL:Integer;
begin
Result:=ExecSQL(FSql);
end; end;
procedure TCustomSqliteDataset.ExecSQLList;
begin
if FSqliteHandle = nil then
GetSqliteHandle;
SqliteExec(FSqliteHandle,PChar(FSqlList.Text));
end;
procedure TCustomSqliteDataset.ExecSQL;
begin
ExecSQL(FSql);
end;
function GetSqlStr(IsString: boolean; APChar: PChar): String;
begin
if APChar = nil then
begin
Result:='NULL';
Exit;
end;
Result:=StrPas(APChar);
if IsString then
begin
if Pos('''',Result) > 0 then
Result:=AnsiReplaceStr(Result,'''','''''');
Result:=''''+Result+'''';
end;
end;
function TCustomSqliteDataset.ApplyUpdates:Boolean; function TCustomSqliteDataset.ApplyUpdates:Boolean;
var var
CounterFields,CounterItems,StatementsCounter:Integer; CounterFields,CounterItems,StatementsCounter:Integer;
SqlTemp,KeyName,ASqlLine,TemplateStr:String; SqlTemp,WhereKeyNameEqual,ASqlLine,TemplateStr:String;
begin begin
if not UpdatesPending then if not UpdatesPending then
begin begin
@ -981,49 +1061,59 @@ begin
Exit; Exit;
end; end;
Result:=False; Result:=False;
if (FPrimaryKeyNo <> -1) and not FSqlMode then if FPrimaryKeyNo <> -1 then
begin begin
StatementsCounter:=0; StatementsCounter:=0;
KeyName:=Fields[FPrimaryKeyNo].FieldName; WhereKeyNameEqual:=' WHERE '+Fields[FPrimaryKeyNo].FieldName+' = ';
{$ifdef DEBUG} {$ifdef DEBUG}
WriteLn('ApplyUpdates called'); WriteLn('##TCustomSqliteDataset.ApplyUpdates##');
if FPrimaryKeyNo = FAutoIncFieldNo then if FPrimaryKeyNo = FAutoIncFieldNo then
WriteLn('Using an AutoInc field as primary key'); WriteLn(' Using an AutoInc field as primary key');
WriteLn('PrimaryKey: ',KeyName); WriteLn(' PrimaryKey: ',WhereKeyNameEqual);
WriteLn('PrimaryKeyNo: ',FPrimaryKeyNo); WriteLn(' PrimaryKeyNo: ',FPrimaryKeyNo);
{$endif} {$endif}
SqlTemp:='BEGIN TRANSACTION;'; SqlTemp:='BEGIN;';
// Delete Records
if FDeletedItems.Count > 0 then
TemplateStr:='DELETE FROM '+FTableName+WhereKeyNameEqual;
for CounterItems:= 0 to FDeletedItems.Count - 1 do
begin
SqlTemp:=SqlTemp+(TemplateStr+
StrPas(PDataRecord(FDeletedItems[CounterItems])^.Row[FPrimaryKeyNo])+';');
inc(StatementsCounter);
//ApplyUpdates each 400 statements
if StatementsCounter = 400 then
begin
SqlTemp:=SqlTemp+'COMMIT;';
FSqliteReturnId:=SqliteExec(FSqliteHandle,PChar(SqlTemp));
StatementsCounter:=0;
SqlTemp:='BEGIN;';
end;
end;
// Update changed records // Update changed records
if FUpdatedItems.Count > 0 then if FUpdatedItems.Count > 0 then
TemplateStr:='UPDATE '+FTableName+' SET '; TemplateStr:='UPDATE '+FTableName+' SET ';
for CounterItems:= 0 to FUpdatedItems.Count - 1 do for CounterItems:= 0 to FUpdatedItems.Count - 1 do
begin begin
ASqlLine:=TemplateStr; ASqlLine:=TemplateStr;
for CounterFields:= 0 to Fields.Count - 1 do for CounterFields:= 0 to Fields.Count - 2 do
begin begin
if PDataRecord(FUpdatedItems[CounterItems])^.Row[CounterFields] <> nil then ASqlLine:=ASqlLine + (Fields[CounterFields].FieldName +' = '+
begin GetSqlStr((Fields[CounterFields].DataType in [ftString,ftMemo]),
ASqlLine:=ASqlLine + Fields[CounterFields].FieldName +' = '; PDataRecord(FUpdatedItems[CounterItems])^.Row[CounterFields])+',');
if not (Fields[CounterFields].DataType in [ftString,ftMemo]) then
ASqlLine:=ASqlLine+StrPas(PDataRecord(FUpdatedItems[CounterItems])^.Row[CounterFields])+ ','
else
ASqlLine:=ASqlLine+''''+
AnsiReplaceStr(StrPas(PDataRecord(FUpdatedItems[CounterItems])^.Row[CounterFields]),'''','''''')+''',';
end
else
ASqlLine:=ASqlLine + Fields[CounterFields].FieldName +' = NULL,';
end; end;
//Todo: see if system.delete trunks AnsiString ASqlLine:=ASqlLine + (Fields[Fields.Count - 1].FieldName +' = '+
system.delete(ASqlLine,Length(ASqlLine),1); GetSqlStr((Fields[Fields.Count - 1].DataType in [ftString,ftMemo]),PDataRecord(FUpdatedItems[CounterItems])^.Row[Fields.Count - 1])+
SqlTemp:=SqlTemp + ASqlLine+' WHERE '+KeyName+' = '+StrPas(PDataRecord(FUpdatedItems[CounterItems])^.Row[FPrimaryKeyNo])+';'; WhereKeyNameEqual+StrPas(PDataRecord(FUpdatedItems[CounterItems])^.Row[FPrimaryKeyNo])+';');
SqlTemp:=SqlTemp + ASqlLine;
inc(StatementsCounter); inc(StatementsCounter);
//ApplyUpdates each 400 statements //ApplyUpdates each 400 statements
if StatementsCounter = 400 then if StatementsCounter = 400 then
begin begin
SqlTemp:=SqlTemp+'END TRANSACTION;'; SqlTemp:=SqlTemp+'COMMIT;';
FSqliteReturnId:=SqliteExec(FSqliteHandle,PChar(SqlTemp)); FSqliteReturnId:=SqliteExec(FSqliteHandle,PChar(SqlTemp));
StatementsCounter:=0; StatementsCounter:=0;
SqlTemp:='BEGIN TRANSACTION;'; SqlTemp:='BEGIN;';
end; end;
end; end;
// Add new records // Add new records
@ -1042,53 +1132,27 @@ begin
for CounterItems:= 0 to FAddedItems.Count - 1 do for CounterItems:= 0 to FAddedItems.Count - 1 do
begin begin
ASqlLine:=TemplateStr; ASqlLine:=TemplateStr;
for CounterFields:= 0 to Fields.Count - 1 do for CounterFields:= 0 to Fields.Count - 2 do
begin begin
if PDataRecord(FAddedItems[CounterItems])^.Row[CounterFields] <> nil then ASqlLine:=ASqlLine + (GetSqlStr((Fields[CounterFields].DataType in [ftString,ftMemo]),
begin PDataRecord(FAddedItems[CounterItems])^.Row[CounterFields])+',');
if not (Fields[CounterFields].DataType in [ftString,ftMemo]) then
ASqlLine:=ASqlLine+StrPas(PDataRecord(FAddedItems[CounterItems])^.Row[CounterFields])
else
ASqlLine:=ASqlLine+''''+
AnsiReplaceStr(StrPas(PDataRecord(FAddedItems[CounterItems])^.Row[CounterFields]),'''','''''')+'''';
end
else
ASqlLine:=ASqlLine + 'NULL';
//Todo: see if delete ASqline is faster
if CounterFields <> Fields.Count - 1 then
ASqlLine:=ASqlLine+',';
end; end;
SqlTemp:=SqlTemp+ASqlLine+');'; ASqlLine:=ASqlLine + (GetSqlStr((Fields[Fields.Count -1].DataType in [ftString,ftMemo]),
PDataRecord(FAddedItems[CounterItems])^.Row[Fields.Count - 1])+');');
SqlTemp:=SqlTemp + ASqlLine;
inc(StatementsCounter); inc(StatementsCounter);
//ApplyUpdates each 400 statements //ApplyUpdates each 400 statements
if StatementsCounter = 400 then if StatementsCounter = 400 then
begin begin
SqlTemp:=SqlTemp+'END TRANSACTION;'; SqlTemp:=SqlTemp+'COMMIT;';
FSqliteReturnId:=SqliteExec(FSqliteHandle,PChar(SqlTemp)); FSqliteReturnId:=SqliteExec(FSqliteHandle,PChar(SqlTemp));
StatementsCounter:=0; StatementsCounter:=0;
SqlTemp:='BEGIN TRANSACTION;'; SqlTemp:='BEGIN;';
end; end;
end; end;
// Delete Items SqlTemp:=SqlTemp+'COMMIT;';
if FDeletedItems.Count > 0 then
TemplateStr:='DELETE FROM '+FTableName+ ' WHERE '+KeyName+' = ';
for CounterItems:= 0 to FDeletedItems.Count - 1 do
begin
SqlTemp:=SqlTemp+TemplateStr+
StrPas(PDataRecord(FDeletedItems[CounterItems])^.Row[FPrimaryKeyNo])+';';
inc(StatementsCounter);
//ApplyUpdates each 400 statements
if StatementsCounter = 400 then
begin
SqlTemp:=SqlTemp+'END TRANSACTION;';
FSqliteReturnId:=SqliteExec(FSqliteHandle,PChar(SqlTemp));
StatementsCounter:=0;
SqlTemp:='BEGIN TRANSACTION;';
end;
end;
SqlTemp:=SqlTemp+'END TRANSACTION;';
{$ifdef DEBUG} {$ifdef DEBUG}
writeln('ApplyUpdates Sql: ',SqlTemp); writeln(' SQL: ',SqlTemp);
{$endif} {$endif}
FAddedItems.Clear; FAddedItems.Clear;
FUpdatedItems.Clear; FUpdatedItems.Clear;
@ -1097,37 +1161,45 @@ begin
Result:= FSqliteReturnId = SQLITE_OK; Result:= FSqliteReturnId = SQLITE_OK;
end; end;
{$ifdef DEBUG} {$ifdef DEBUG}
writeln('ApplyUpdates Result: ',Result); writeln(' Result: ',Result);
{$endif} {$endif}
end; end;
function TCustomSqliteDataset.CreateTable: Boolean; function TCustomSqliteDataset.CreateTable: Boolean;
begin
Result:=CreateTable(FTableName);
end;
function TCustomSqliteDataset.CreateTable(const ATableName: String): Boolean;
var var
SqlTemp:String; SqlTemp:String;
Counter:Integer; i:Integer;
begin begin
{$ifdef DEBUG} {$ifdef DEBUG}
if FTableName = '' then writeln('##TCustomSqliteDataset.CreateTable##');
WriteLn('CreateTable : TableName Not Set'); if ATableName = '' then
if FieldDefs.Count = 0 then WriteLn(' TableName Not Set');
WriteLn('CreateTable : FieldDefs Not Initialized'); if FieldDefs.Count = 0 then
WriteLn(' FieldDefs Not Initialized');
{$endif} {$endif}
if (FTableName <> '') and (FieldDefs.Count > 0) then if (ATableName <> '') and (FieldDefs.Count > 0) then
begin begin
FSqliteHandle:= GetSqliteHandle; if FSqliteHandle = nil then
SqlTemp:='CREATE TABLE '+FTableName+' ('; GetSqliteHandle;
for Counter := 0 to FieldDefs.Count-1 do SqlTemp:='CREATE TABLE '+ATableName+' (';
for i := 0 to FieldDefs.Count-1 do
begin begin
SqlTemp:=SqlTemp + FieldDefs[Counter].Name; //todo: add index to autoinc field
case FieldDefs[Counter].DataType of SqlTemp:=SqlTemp + FieldDefs[i].Name;
case FieldDefs[i].DataType of
ftInteger: ftInteger:
SqlTemp:=SqlTemp + ' INTEGER'; SqlTemp:=SqlTemp + ' INTEGER';
ftString: ftString:
SqlTemp:=SqlTemp + ' VARCHAR'; SqlTemp:=SqlTemp + ' VARCHAR';
ftBoolean: ftBoolean:
SqlTemp:=SqlTemp + ' BOOLEAN'; SqlTemp:=SqlTemp + ' BOOL_INT';
ftFloat: ftFloat:
SqlTemp:=SqlTemp + ' FLOAT'; SqlTemp:=SqlTemp + ' FLOAT';
ftWord: ftWord:
SqlTemp:=SqlTemp + ' WORD'; SqlTemp:=SqlTemp + ' WORD';
ftDateTime: ftDateTime:
@ -1135,33 +1207,33 @@ begin
ftDate: ftDate:
SqlTemp:=SqlTemp + ' DATE'; SqlTemp:=SqlTemp + ' DATE';
ftTime: ftTime:
SqlTemp:=SqlTemp + ' TIME'; SqlTemp:=SqlTemp + ' TIME';
ftLargeInt: ftLargeInt:
SqlTemp:=SqlTemp + ' LARGEINT'; SqlTemp:=SqlTemp + ' LARGEINT';
ftCurrency: ftCurrency:
SqlTemp:=SqlTemp + ' CURRENCY'; SqlTemp:=SqlTemp + ' CURRENCY';
ftAutoInc: ftAutoInc:
SqlTemp:=SqlTemp + ' AUTOINC'; SqlTemp:=SqlTemp + ' AUTOINC_INT';
ftMemo: ftMemo:
SqlTemp:=SqlTemp + ' MEMO'; SqlTemp:=SqlTemp + ' TEXT';
else else
DatabaseError('Field type "'+FieldTypeNames[FieldDefs[Counter].DataType]+'" not supported',Self); DatabaseError('Field type "'+FieldTypeNames[FieldDefs[i].DataType]+'" not supported',Self);
end; end;
if Counter <> FieldDefs.Count - 1 then if UpperCase(FieldDefs[i].Name) = UpperCase(FPrimaryKey) then
SqlTemp:=SqlTemp+ ' , '; SqlTemp:=SqlTemp + ' PRIMARY KEY';
if i <> FieldDefs.Count - 1 then
SqlTemp:=SqlTemp+ ' , ';
end; end;
SqlTemp:=SqlTemp+');'; SqlTemp:=SqlTemp+');';
{$ifdef DEBUG} {$ifdef DEBUG}
writeln('CreateTable Sql: ',SqlTemp); writeln(' SQL: ',SqlTemp);
{$endif} {$endif}
FSqliteReturnId:=SqliteExec(FSqliteHandle,PChar(SqlTemp)); FSqliteReturnId:=SqliteExec(FSqliteHandle,PChar(SqlTemp));
Result:= FSqliteReturnId = SQLITE_OK; Result:= FSqliteReturnId = SQLITE_OK;
SqliteClose(FSqliteHandle);
FSqliteHandle:=nil;
end end
else else
Result:=False; Result:=False;
end; end;
procedure TCustomSqliteDataset.RefetchData; procedure TCustomSqliteDataset.RefetchData;
var var
@ -1182,8 +1254,12 @@ begin
for i := 0 to BufferCount - 1 do for i := 0 to BufferCount - 1 do
PPDataRecord(Buffers[i])^:=FBeginItem; PPDataRecord(Buffers[i])^:=FBeginItem;
Resync([]); Resync([]);
end; end;
function TCustomSqliteDataset.TableExists: Boolean;
begin
Result:=TableExists(FTableName);
end;
function TCustomSqliteDataset.UpdatesPending: Boolean; function TCustomSqliteDataset.UpdatesPending: Boolean;
begin begin

277
fcl/db/sqlite/sqlite3ds.pas
View File

@ -36,15 +36,18 @@ type
TSqlite3Dataset = class (TCustomSqliteDataset) TSqlite3Dataset = class (TCustomSqliteDataset)
private private
function SqliteExec(AHandle: Pointer; ASql:PChar):Integer;override; function SqliteExec(AHandle: Pointer; ASql:PChar):Integer;override;
function GetSqliteHandle: Pointer; override; function InternalGetHandle: Pointer; override;
function GetSqliteVersion: String; override; function GetSqliteVersion: String; override;
procedure SqliteClose(AHandle: Pointer);override; procedure InternalCloseHandle;override;
procedure BuildLinkedList; override; procedure BuildLinkedList; override;
protected protected
procedure InternalCancel;override;
procedure InternalInitFieldDefs; override; procedure InternalInitFieldDefs; override;
function GetRowsAffected:Integer; override;
public public
procedure ExecuteDirect(const ASql: String);override;
function SqliteReturnString: String; override; function SqliteReturnString: String; override;
function TableExists: Boolean;override; function TableExists(const ATableName:String): Boolean;override;
function QuickQuery(const ASql:String;const AStrList: TStrings;FillObjects:Boolean):String;override; function QuickQuery(const ASql:String;const AStrList: TStrings;FillObjects:Boolean):String;override;
end; end;
@ -75,14 +78,15 @@ begin
Result:=sqlite3_exec(AHandle, ASql, nil, nil, nil); Result:=sqlite3_exec(AHandle, ASql, nil, nil, nil);
end; end;
procedure TSqlite3Dataset.SqliteClose(AHandle: Pointer); procedure TSqlite3Dataset.InternalCloseHandle;
begin begin
sqlite3_close(AHandle); sqlite3_close(FSqliteHandle);
FSqliteHandle:=nil;
//todo:handle return data //todo:handle return data
end; end;
function TSqlite3Dataset.GetSqliteHandle: Pointer; function TSqlite3Dataset.InternalGetHandle: Pointer;
begin begin
FSqliteReturnId:=sqlite3_open(PChar(FFileName),@Result); FSqliteReturnId:=sqlite3_open(PChar(FFileName),@Result);
end; end;
@ -91,35 +95,47 @@ procedure TSqlite3Dataset.InternalInitFieldDefs;
var var
vm:Pointer; vm:Pointer;
ColumnStr:String; ColumnStr:String;
Counter,FieldSize:Integer; i,FieldSize:Integer;
AType:TFieldType; AType:TFieldType;
begin begin
{$ifdef DEBUG}
WriteLn('##TSqlite3Dataset.InternalInitFieldDefs##');
{$endif}
FAutoIncFieldNo:=-1;
FieldDefs.Clear; FieldDefs.Clear;
sqlite3_prepare(FSqliteHandle,PChar(FSql),-1,@vm,nil); sqlite3_prepare(FSqliteHandle,PChar(FSql),-1,@vm,nil);
sqlite3_step(vm); sqlite3_step(vm);
for Counter:= 0 to sqlite3_column_count(vm) - 1 do for i:= 0 to sqlite3_column_count(vm) - 1 do
begin begin
ColumnStr:= UpperCase(StrPas(sqlite3_column_decltype(vm,Counter))); ColumnStr:= UpperCase(StrPas(sqlite3_column_decltype(vm,i)));
if (ColumnStr = 'INTEGER') then if (ColumnStr = 'INTEGER') or (ColumnStr = 'INT') then
begin begin
AType:= ftInteger; if AutoIncrementKey and (UpperCase(StrPas(sqlite3_column_name(vm,i))) = UpperCase(PrimaryKey)) then
begin
AType:= ftAutoInc;
FAutoIncFieldNo:=i;
end
else
AType:= ftInteger;
FieldSize:=SizeOf(LongInt); FieldSize:=SizeOf(LongInt);
end else if (ColumnStr = 'VARCHAR') then end else if Pos('VARCHAR',ColumnStr) = 1 then
begin begin
AType:= ftString; AType:= ftString;
FieldSize:=10;//?? FieldSize:=0;
end else if (ColumnStr = 'BOOLEAN') then end else if Pos('BOOL',ColumnStr) = 1 then
begin begin
AType:= ftBoolean; AType:= ftBoolean;
FieldSize:=SizeOf(Boolean); FieldSize:=SizeOf(WordBool);
end else if (ColumnStr = 'FLOAT') then end else if Pos('AUTOINC',ColumnStr) = 1 then
begin
AType:= ftAutoInc;
FieldSize:=SizeOf(LongInt);
if FAutoIncFieldNo = -1 then
FAutoIncFieldNo:= i;
end else if (Pos('FLOAT',ColumnStr)=1) or (Pos('NUMERIC',ColumnStr)=1) then
begin begin
AType:= ftFloat; AType:= ftFloat;
FieldSize:=SizeOf(Double); FieldSize:=SizeOf(Double);
end else if (ColumnStr = 'WORD') then
begin
AType:= ftWord;
FieldSize:=SizeOf(Word);
end else if (ColumnStr = 'DATETIME') then end else if (ColumnStr = 'DATETIME') then
begin begin
AType:= ftDateTime; AType:= ftDateTime;
@ -132,41 +148,55 @@ begin
begin begin
AType:= ftLargeInt; AType:= ftLargeInt;
FieldSize:=SizeOf(Int64); FieldSize:=SizeOf(Int64);
end else if (ColumnStr = 'CURRENCY') then
begin
AType:= ftCurrency;
FieldSize:=SizeOf(Double);
end else if (ColumnStr = 'TIME') then end else if (ColumnStr = 'TIME') then
begin begin
AType:= ftTime; AType:= ftTime;
FieldSize:=SizeOf(TDateTime); FieldSize:=SizeOf(TDateTime);
end else if (ColumnStr = 'MEMO') then end else if (ColumnStr = 'TEXT') then
begin begin
AType:= ftMemo; AType:= ftMemo;
FieldSize:=10;//?? FieldSize:=0;
end else if (ColumnStr = 'AUTOINC') then end else if (ColumnStr = 'CURRENCY') then
begin begin
AType:= ftAutoInc; AType:= ftCurrency;
FieldSize:=SizeOf(Integer); FieldSize:=SizeOf(Double);
if FAutoIncFieldNo = -1 then end else if (ColumnStr = 'WORD') then
FAutoIncFieldNo:= Counter; begin
AType:= ftWord;
FieldSize:=SizeOf(Word);
end else end else
begin begin
DatabaseError('Field type "'+ColumnStr+'" not recognized',Self); DatabaseError('Field type "'+ColumnStr+'" not recognized',Self);
end; end;
FieldDefs.Add(StrPas(sqlite3_column_name(vm,Counter)), AType, FieldSize, False); FieldDefs.Add(StrPas(sqlite3_column_name(vm,i)), AType, FieldSize, False);
{$ifdef DEBUG} {$ifdef DEBUG}
writeln('Field Name: ',sqlite3_column_name(vm,Counter)); writeln(' Field[',i,'] Name: ',sqlite3_column_name(vm,i));
writeln('Field Type: ',sqlite3_column_decltype(vm,Counter)); writeln(' Field[',i,'] Type: ',sqlite3_column_decltype(vm,i));
{$endif} {$endif}
end; end;
sqlite3_finalize(vm); sqlite3_finalize(vm);
FRowBufferSize:=(SizeOf(PPChar)*FieldDefs.Count); FRowBufferSize:=(SizeOf(PPChar)*FieldDefs.Count);
{$ifdef DEBUG} {$ifdef DEBUG}
writeln('FieldDefs.Count: ',FieldDefs.Count); writeln(' FieldDefs.Count: ',FieldDefs.Count);
{$endif} {$endif}
end; end;
function TSqlite3Dataset.GetRowsAffected: Integer;
begin
Result:=sqlite3_changes(FSqliteHandle);
end;
procedure TSqlite3Dataset.ExecuteDirect(const ASql: String);
var
vm:Pointer;
begin
FSqliteReturnId:=sqlite3_prepare(FSqliteHandle,Pchar(ASql),-1,@vm,nil);
if FSqliteReturnId <> SQLITE_OK then
DatabaseError(SqliteReturnString,Self);
FSqliteReturnId:=sqlite3_step(vm);
sqlite3_finalize(vm);
end;
procedure TSqlite3Dataset.BuildLinkedList; procedure TSqlite3Dataset.BuildLinkedList;
var var
TempItem:PDataRecord; TempItem:PDataRecord;
@ -180,12 +210,7 @@ begin
FSqliteReturnId:=sqlite3_prepare(FSqliteHandle,Pchar(FSql),-1,@vm,nil); FSqliteReturnId:=sqlite3_prepare(FSqliteHandle,Pchar(FSql),-1,@vm,nil);
if FSqliteReturnId <> SQLITE_OK then if FSqliteReturnId <> SQLITE_OK then
case FSqliteReturnId of DatabaseError(SqliteReturnString,Self);
SQLITE_ERROR:
DatabaseError('Invalid SQL',Self);
else
DatabaseError('Error returned by sqlite while retrieving data: '+SqliteReturnString,Self);
end;
FDataAllocated:=True; FDataAllocated:=True;
@ -200,7 +225,7 @@ begin
TempItem^.Next^.Previous:=TempItem; TempItem^.Next^.Previous:=TempItem;
TempItem:=TempItem^.Next; TempItem:=TempItem^.Next;
GetMem(TempItem^.Row,FRowBufferSize); GetMem(TempItem^.Row,FRowBufferSize);
For Counter := 0 to FRowCount - 1 do for Counter := 0 to FRowCount - 1 do
TempItem^.Row[Counter]:=StrNew(sqlite3_column_text(vm,Counter)); TempItem^.Row[Counter]:=StrNew(sqlite3_column_text(vm,Counter));
FSqliteReturnId:=sqlite3_step(vm); FSqliteReturnId:=sqlite3_step(vm);
end; end;
@ -210,92 +235,128 @@ begin
TempItem^.Next:=FEndItem; TempItem^.Next:=FEndItem;
FEndItem^.Previous:=TempItem; FEndItem^.Previous:=TempItem;
// Alloc item used in append/insert // Alloc temporary item used in append/insert
GetMem(FCacheItem^.Row,FRowBufferSize); GetMem(FCacheItem^.Row,FRowBufferSize);
for Counter := 0 to FRowCount - 1 do for Counter := 0 to FRowCount - 1 do
FCacheItem^.Row[Counter]:=nil; FCacheItem^.Row[Counter]:=nil;
// Fill FBeginItem.Row with nil -> necessary for avoid exceptions in empty datasets // Fill FBeginItem.Row with nil -> necessary for avoid exceptions in empty datasets
GetMem(FBeginItem^.Row,FRowBufferSize); GetMem(FBeginItem^.Row,FRowBufferSize);
//Todo: see if is better to nullif using FillDWord
for Counter := 0 to FRowCount - 1 do for Counter := 0 to FRowCount - 1 do
FBeginItem^.Row[Counter]:=nil; FBeginItem^.Row[Counter]:=nil;
end; end;
function TSqlite3Dataset.TableExists: Boolean; procedure TSqlite3Dataset.InternalCancel;
{
var var
AHandle,vm:Pointer; vm:Pointer;
i:Integer;
ActiveItem:PDataRecord;
ASql:String;
}
begin begin
{
//WriteLn('InternalCancel called');
if FPrimaryKeyNo <> - 1 then //requires a primarykey
begin
ActiveItem:=PPDataRecord(ActiveBuffer)^;
if ActiveItem = FBeginItem then //Dataset is empty
Exit;
for i:= 0 to FRowCount -1 do
StrDispose(ActiveItem^.Row[i]);
if FAddedItems.IndexOf(ActiveItem) <> -1 then //the record is not in the database
begin
for i:= 0 to FRowCount - 1 do
begin
ActiveItem^.Row[i]:=nil;
//DataEvent(deFieldChange, Ptrint(Fields[i]));
end;
Exit;
end;
ASql:=FSelectSqlStr+' Where '+Fields[FPrimaryKeyNo].FieldName+
' = '+StrPas(ActiveItem^.Row[FPrimaryKeyNo]);
//writeln(Asql);
sqlite3_prepare(FSqliteHandle,PChar(ASql),-1,@vm,nil);
if sqlite3_step(vm) = SQLITE_ROW then
begin
for i:= 0 to FRowCount - 1 do
begin
ActiveItem^.Row[i]:=StrNew(sqlite3_column_text(vm,i));
//DataEvent(deFieldChange, Ptrint(Fields[i]));
end;
end;
sqlite3_finalize(vm);
end;
}
end;
function TSqlite3Dataset.TableExists(const ATableName:String): Boolean;
var
vm:Pointer;
begin
{$ifdef DEBUG}
writeln('##TSqlite3Dataset.TableExists##');
{$endif}
Result:=False; Result:=False;
if not (FTableName = '') and FileExists(FFileName) then if not (ATableName = '') and FileExists(FFileName) then
begin begin
if FSqliteHandle = nil then if FSqliteHandle = nil then
begin GetSqliteHandle;
{$ifdef DEBUG} FSqliteReturnId:=sqlite3_prepare(FSqliteHandle,
writeln('TableExists - FSqliteHandle=nil : Opening a file'); Pchar('SELECT name FROM SQLITE_MASTER WHERE type = ''table'' AND name LIKE '''+ ATableName+ ''';'),
{$endif}
AHandle:=GetSqliteHandle;
end
else
begin
{$ifdef DEBUG}
writeln('TableExists - FSqliteHandle<>nil : Using FSqliteHandle');
{$endif}
AHandle:=FSqliteHandle;
end;
FSqliteReturnId:=sqlite3_prepare(AHandle,
Pchar('SELECT name FROM SQLITE_MASTER WHERE type = ''table'' AND name LIKE '''+ FTableName+ ''';'),
-1,@vm,nil); -1,@vm,nil);
{$ifdef DEBUG} {$ifdef DEBUG}
WriteLn('TableExists.sqlite3_prepare - SqliteReturnString:',SqliteReturnString); WriteLn(' sqlite3_prepare - SqliteReturnString:',SqliteReturnString);
{$endif} {$endif}
FSqliteReturnId:=sqlite3_step(vm); FSqliteReturnId:=sqlite3_step(vm);
{$ifdef DEBUG} {$ifdef DEBUG}
WriteLn('TableExists.sqlite3_step - SqliteReturnString:',SqliteReturnString); WriteLn(' sqlite3_step - SqliteReturnString:',SqliteReturnString);
{$endif} {$endif}
Result:=FSqliteReturnId = SQLITE_ROW; Result:=FSqliteReturnId = SQLITE_ROW;
sqlite3_finalize(vm); sqlite3_finalize(vm);
if (FSqliteHandle = nil) then
sqlite3_close(AHandle);
end; end;
{$ifdef DEBUG} {$ifdef DEBUG}
WriteLn('TableExists ('+FTableName+') Result:',Result); WriteLn(' Table '+ATableName+' exists: ',Result);
{$endif} {$endif}
end; end;
function TSqlite3Dataset.SqliteReturnString: String; function TSqlite3Dataset.SqliteReturnString: String;
begin begin
case FSqliteReturnId of case FSqliteReturnId of
SQLITE_OK : Result := 'SQLITE_OK '; SQLITE_OK : Result := 'SQLITE_OK';
SQLITE_ERROR : Result := 'SQLITE_ERROR '; SQLITE_ERROR : Result := 'SQLITE_ERROR';
SQLITE_INTERNAL : Result := 'SQLITE_INTERNAL '; SQLITE_INTERNAL : Result := 'SQLITE_INTERNAL';
SQLITE_PERM : Result := 'SQLITE_PERM '; SQLITE_PERM : Result := 'SQLITE_PERM';
SQLITE_ABORT : Result := 'SQLITE_ABORT '; SQLITE_ABORT : Result := 'SQLITE_ABORT';
SQLITE_BUSY : Result := 'SQLITE_BUSY '; SQLITE_BUSY : Result := 'SQLITE_BUSY';
SQLITE_LOCKED : Result := 'SQLITE_LOCKED '; SQLITE_LOCKED : Result := 'SQLITE_LOCKED';
SQLITE_NOMEM : Result := 'SQLITE_NOMEM '; SQLITE_NOMEM : Result := 'SQLITE_NOMEM';
SQLITE_READONLY : Result := 'SQLITE_READONLY '; SQLITE_READONLY : Result := 'SQLITE_READONLY';
SQLITE_INTERRUPT : Result := 'SQLITE_INTERRUPT '; SQLITE_INTERRUPT : Result := 'SQLITE_INTERRUPT';
SQLITE_IOERR : Result := 'SQLITE_IOERR '; SQLITE_IOERR : Result := 'SQLITE_IOERR';
SQLITE_CORRUPT : Result := 'SQLITE_CORRUPT '; SQLITE_CORRUPT : Result := 'SQLITE_CORRUPT';
SQLITE_NOTFOUND : Result := 'SQLITE_NOTFOUND '; SQLITE_NOTFOUND : Result := 'SQLITE_NOTFOUND';
SQLITE_FULL : Result := 'SQLITE_FULL '; SQLITE_FULL : Result := 'SQLITE_FULL';
SQLITE_CANTOPEN : Result := 'SQLITE_CANTOPEN '; SQLITE_CANTOPEN : Result := 'SQLITE_CANTOPEN';
SQLITE_PROTOCOL : Result := 'SQLITE_PROTOCOL '; SQLITE_PROTOCOL : Result := 'SQLITE_PROTOCOL';
SQLITE_EMPTY : Result := 'SQLITE_EMPTY '; SQLITE_EMPTY : Result := 'SQLITE_EMPTY';
SQLITE_SCHEMA : Result := 'SQLITE_SCHEMA '; SQLITE_SCHEMA : Result := 'SQLITE_SCHEMA';
SQLITE_TOOBIG : Result := 'SQLITE_TOOBIG '; SQLITE_TOOBIG : Result := 'SQLITE_TOOBIG';
SQLITE_CONSTRAINT : Result := 'SQLITE_CONSTRAINT '; SQLITE_CONSTRAINT : Result := 'SQLITE_CONSTRAINT';
SQLITE_MISMATCH : Result := 'SQLITE_MISMATCH '; SQLITE_MISMATCH : Result := 'SQLITE_MISMATCH';
SQLITE_MISUSE : Result := 'SQLITE_MISUSE '; SQLITE_MISUSE : Result := 'SQLITE_MISUSE';
SQLITE_NOLFS : Result := 'SQLITE_NOLFS '; SQLITE_NOLFS : Result := 'SQLITE_NOLFS';
SQLITE_AUTH : Result := 'SQLITE_AUTH '; SQLITE_AUTH : Result := 'SQLITE_AUTH';
SQLITE_FORMAT : Result := 'SQLITE_FORMAT '; SQLITE_FORMAT : Result := 'SQLITE_FORMAT';
SQLITE_RANGE : Result := 'SQLITE_RANGE '; SQLITE_RANGE : Result := 'SQLITE_RANGE';
SQLITE_ROW : Result := 'SQLITE_ROW '; SQLITE_ROW : Result := 'SQLITE_ROW';
SQLITE_NOTADB : Result := 'SQLITE_NOTADB '; SQLITE_NOTADB : Result := 'SQLITE_NOTADB';
SQLITE_DONE : Result := 'SQLITE_DONE '; SQLITE_DONE : Result := 'SQLITE_DONE';
else else
Result:='Unknow Return Value'; Result:='Unknow Return Value';
end; end;
Result:=Result+' - '+sqlite3_errmsg(FSqliteHandle);
end; end;
function TSqlite3Dataset.GetSqliteVersion: String; function TSqlite3Dataset.GetSqliteVersion: String;
@ -305,7 +366,7 @@ end;
function TSqlite3Dataset.QuickQuery(const ASql:String;const AStrList: TStrings;FillObjects:Boolean):String; function TSqlite3Dataset.QuickQuery(const ASql:String;const AStrList: TStrings;FillObjects:Boolean):String;
var var
vm,AHandle:Pointer; vm:Pointer;
procedure FillStrings; procedure FillStrings;
begin begin
@ -324,20 +385,12 @@ var
end; end;
end; end;
begin begin
if FSqliteHandle <> nil then if FSqliteHandle = nil then
AHandle:=FSqliteHandle GetSqliteHandle;
else
if FileExists(FFileName) then
AHandle:=GetSqliteHandle
else
DatabaseError('File "'+FFileName+'" not Exists',Self);
Result:=''; Result:='';
// It's up to the caller clear or not the list FSqliteReturnId:=sqlite3_prepare(FSqliteHandle,Pchar(ASql),-1,@vm,nil);
//if AStrList <> nil then
// AStrList.Clear;
FSqliteReturnId:=sqlite3_prepare(AHandle,Pchar(ASql),-1,@vm,nil);
if FSqliteReturnId <> SQLITE_OK then if FSqliteReturnId <> SQLITE_OK then
DatabaseError('Error returned by sqlite in QuickQuery: '+SqliteReturnString,Self); DatabaseError(SqliteReturnString,Self);
FSqliteReturnId:=sqlite3_step(vm); FSqliteReturnId:=sqlite3_step(vm);
if (FSqliteReturnId = SQLITE_ROW) and (sqlite3_column_count(vm) > 0) then if (FSqliteReturnId = SQLITE_ROW) and (sqlite3_column_count(vm) > 0) then
@ -352,8 +405,6 @@ begin
end; end;
end; end;
sqlite3_finalize(vm); sqlite3_finalize(vm);
if FSqliteHandle = nil then
sqlite3_close(AHandle);
end; end;
end. end.

223
fcl/db/sqlite/sqliteds.pas
View File

@ -36,16 +36,18 @@ type
TSqliteDataset = class (TCustomSqliteDataset) TSqliteDataset = class (TCustomSqliteDataset)
private private
function SqliteExec(AHandle: Pointer; ASql:PChar):Integer;override; function SqliteExec(AHandle: Pointer; ASql:PChar):Integer;override;
function GetSqliteHandle: Pointer; override; function InternalGetHandle: Pointer; override;
function GetSqliteEncoding: String; function GetSqliteEncoding: String;
function GetSqliteVersion: String; override; function GetSqliteVersion: String; override;
procedure SqliteClose(AHandle: Pointer);override; procedure InternalCloseHandle;override;
procedure BuildLinkedList; override; procedure BuildLinkedList; override;
protected protected
procedure InternalInitFieldDefs; override; procedure InternalInitFieldDefs; override;
function GetRowsAffected:Integer; override;
public public
procedure ExecuteDirect(const ASql: String);override;
function SqliteReturnString: String; override; function SqliteReturnString: String; override;
function TableExists: Boolean;override; function TableExists(const ATableName:String): Boolean;override;
function QuickQuery(const ASql:String;const AStrList: TStrings;FillObjects:Boolean):String;override; function QuickQuery(const ASql:String;const AStrList: TStrings;FillObjects:Boolean):String;override;
property SqliteEncoding: String read GetSqliteEncoding; property SqliteEncoding: String read GetSqliteEncoding;
end; end;
@ -58,6 +60,8 @@ uses
var var
DummyAutoIncFieldNo:Integer; DummyAutoIncFieldNo:Integer;
//function sqlite_last_statement_changes(dbhandle:Pointer):longint;cdecl;external 'sqlite' name 'sqlite_last_statement_changes';
function GetAutoIncValue(NextValue: Pointer; Columns: Integer; ColumnValues: PPChar; ColumnNames: PPChar): integer; cdecl; function GetAutoIncValue(NextValue: Pointer; Columns: Integer; ColumnValues: PPChar; ColumnNames: PPChar): integer; cdecl;
var var
CodeError, TempInt: Integer; CodeError, TempInt: Integer;
@ -76,7 +80,7 @@ end;
function GetFieldDefs(TheDataset: Pointer; Columns: Integer; ColumnValues: PPChar; ColumnNames: PPChar): integer; cdecl; function GetFieldDefs(TheDataset: Pointer; Columns: Integer; ColumnValues: PPChar; ColumnNames: PPChar): integer; cdecl;
var var
FieldSize:Word; FieldSize:Word;
Counter:Integer; i:Integer;
AType:TFieldType; AType:TFieldType;
ColumnStr:String; ColumnStr:String;
begin begin
@ -84,30 +88,39 @@ begin
// regardless of what is in Create Table, but returns // regardless of what is in Create Table, but returns
// exactly what is in Create Table statement // exactly what is in Create Table statement
// here is a trick to get the datatype. // here is a trick to get the datatype.
// If the field contains another type, there will be problems // If the field contains another type, may have problems
for Counter:= 0 to Columns - 1 do for i:= 0 to Columns - 1 do
begin begin
ColumnStr:= UpperCase(StrPas(ColumnNames[Counter + Columns])); ColumnStr:= UpperCase(StrPas(ColumnNames[i + Columns]));
if (ColumnStr = 'INTEGER') then if (ColumnStr = 'INTEGER') or (ColumnStr = 'INT') then
begin begin
AType:= ftInteger; if TCustomSqliteDataset(TheDataset).AutoIncrementKey and
(UpperCase(StrPas(ColumnNames[i])) = UpperCase(TCustomSqliteDataset(TheDataset).PrimaryKey)) then
begin
AType:= ftAutoInc;
DummyAutoIncFieldNo:=i;
end
else
AType:= ftInteger;
FieldSize:=SizeOf(LongInt); FieldSize:=SizeOf(LongInt);
end else if (ColumnStr = 'VARCHAR') then end else if Pos('VARCHAR',ColumnStr) = 1 then
begin begin
AType:= ftString; AType:= ftString;
FieldSize:=10;//?? FieldSize:=0;
end else if (ColumnStr = 'BOOLEAN') then end else if Pos('BOOL',ColumnStr) = 1 then
begin begin
AType:= ftBoolean; AType:= ftBoolean;
FieldSize:=SizeOf(Boolean); FieldSize:=SizeOf(WordBool);
end else if (ColumnStr = 'FLOAT') then end else if Pos('AUTOINC',ColumnStr) = 1 then
begin
AType:= ftAutoInc;
FieldSize:=SizeOf(LongInt);
if DummyAutoIncFieldNo = -1 then
DummyAutoIncFieldNo:= i;
end else if (Pos('FLOAT',ColumnStr)=1) or (Pos('NUMERIC',ColumnStr)=1) then
begin begin
AType:= ftFloat; AType:= ftFloat;
FieldSize:=SizeOf(Double); FieldSize:=SizeOf(Double);
end else if (ColumnStr = 'WORD') then
begin
AType:= ftWord;
FieldSize:=SizeOf(Word);
end else if (ColumnStr = 'DATETIME') then end else if (ColumnStr = 'DATETIME') then
begin begin
AType:= ftDateTime; AType:= ftDateTime;
@ -124,27 +137,26 @@ begin
begin begin
AType:= ftLargeInt; AType:= ftLargeInt;
FieldSize:=SizeOf(LargeInt); FieldSize:=SizeOf(LargeInt);
end else if (ColumnStr = 'TEXT') then
begin
AType:= ftMemo;
FieldSize:=0;
end else if (ColumnStr = 'CURRENCY') then end else if (ColumnStr = 'CURRENCY') then
begin begin
AType:= ftCurrency; AType:= ftCurrency;
FieldSize:=SizeOf(Double); FieldSize:=SizeOf(Double);
end else if (ColumnStr = 'MEMO') then end else if (ColumnStr = 'WORD') then
begin begin
AType:= ftMemo; AType:= ftWord;
FieldSize:=10;//?? FieldSize:=SizeOf(Word);
end else if (ColumnStr = 'AUTOINC') then
begin
AType:= ftAutoInc;
FieldSize:=SizeOf(Integer);
if DummyAutoIncFieldNo = -1 then
DummyAutoIncFieldNo:= Counter;
end else end else
begin begin
DatabaseError('Field type "'+ColumnStr+'" not recognized',TDataset(TheDataset)); AType:=ftString;
FieldSize:=0;
end; end;
TDataset(TheDataset).FieldDefs.Add(StrPas(ColumnNames[Counter]), AType, FieldSize, False); TDataset(TheDataset).FieldDefs.Add(StrPas(ColumnNames[i]), AType, FieldSize, False);
end; end;
result:=-1; Result:=-1;
end; end;
@ -155,20 +167,19 @@ begin
Result:=sqlite_exec(AHandle, ASql, nil, nil, nil); Result:=sqlite_exec(AHandle, ASql, nil, nil, nil);
end; end;
procedure TSqliteDataset.SqliteClose(AHandle: Pointer); procedure TSqliteDataset.InternalCloseHandle;
begin begin
sqlite_close(AHandle); sqlite_close(FSqliteHandle);
FSqliteHandle:=nil;
end; end;
function TSqliteDataset.InternalGetHandle: Pointer;
function TSqliteDataset.GetSqliteHandle: Pointer;
begin begin
Result:=sqlite_open(PChar(FFileName),0,nil); Result:=sqlite_open(PChar(FFileName),0,nil);
end; end;
procedure TSqliteDataset.InternalInitFieldDefs; procedure TSqliteDataset.InternalInitFieldDefs;
begin begin
FieldDefs.Clear; FieldDefs.Clear;
sqlite_exec(FSqliteHandle,PChar('PRAGMA empty_result_callbacks = ON;PRAGMA show_datatypes = ON;'),nil,nil,nil); sqlite_exec(FSqliteHandle,PChar('PRAGMA empty_result_callbacks = ON;PRAGMA show_datatypes = ON;'),nil,nil,nil);
DummyAutoIncFieldNo:=-1; DummyAutoIncFieldNo:=-1;
@ -181,6 +192,27 @@ begin
FRowBufferSize:=(SizeOf(PPChar)*FieldDefs.Count); FRowBufferSize:=(SizeOf(PPChar)*FieldDefs.Count);
end; end;
function TSqliteDataset.GetRowsAffected: Integer;
begin
Result:=sqlite_changes(FSqliteHandle);
//Result:=sqlite_last_statement_changes(FSqliteHandle);
end;
procedure TSqliteDataset.ExecuteDirect(const ASql: String);
var
vm:Pointer;
ColumnNames,ColumnValues:PPChar;
ColCount:Integer;
begin
FSqliteReturnId:=sqlite_compile(FSqliteHandle,Pchar(ASql),nil,@vm,nil);
if FSqliteReturnId <> SQLITE_OK then
DatabaseError(SqliteReturnString,Self);
FSqliteReturnId:=sqlite_step(vm,@ColCount,@ColumnValues,@ColumnNames);
sqlite_finalize(vm, nil);
end;
procedure TSqliteDataset.BuildLinkedList; procedure TSqliteDataset.BuildLinkedList;
var var
TempItem:PDataRecord; TempItem:PDataRecord;
@ -195,12 +227,7 @@ begin
FSqliteReturnId:=sqlite_compile(FSqliteHandle,Pchar(FSql),nil,@vm,nil); FSqliteReturnId:=sqlite_compile(FSqliteHandle,Pchar(FSql),nil,@vm,nil);
if FSqliteReturnId <> SQLITE_OK then if FSqliteReturnId <> SQLITE_OK then
case FSqliteReturnId of DatabaseError(SqliteReturnString,Self);
SQLITE_ERROR:
DatabaseError('Invalid SQL',Self);
else
DatabaseError('Error returned by sqlite while retrieving data: '+SqliteReturnString,Self);
end;
FDataAllocated:=True; FDataAllocated:=True;
@ -214,7 +241,7 @@ begin
TempItem^.Next^.Previous:=TempItem; TempItem^.Next^.Previous:=TempItem;
TempItem:=TempItem^.Next; TempItem:=TempItem^.Next;
GetMem(TempItem^.Row,FRowBufferSize); GetMem(TempItem^.Row,FRowBufferSize);
For Counter := 0 to FRowCount - 1 do for Counter := 0 to FRowCount - 1 do
TempItem^.Row[Counter]:=StrNew(ColumnValues[Counter]); TempItem^.Row[Counter]:=StrNew(ColumnValues[Counter]);
FSqliteReturnId:=sqlite_step(vm,@FRowCount,@ColumnValues,@ColumnNames); FSqliteReturnId:=sqlite_step(vm,@FRowCount,@ColumnValues,@ColumnNames);
end; end;
@ -234,83 +261,73 @@ begin
FBeginItem^.Row[Counter]:=nil; FBeginItem^.Row[Counter]:=nil;
end; end;
function TSqliteDataset.TableExists: Boolean; function TSqliteDataset.TableExists(const ATableName:String): Boolean;
var var
AHandle,vm:Pointer; vm:Pointer;
ColumnNames,ColumnValues:PPChar; ColumnNames,ColumnValues:PPChar;
AInt:Integer; AInt:Integer;
begin begin
{$ifdef DEBUG}
WriteLn('##TSqliteDataset.TableExists##');
{$endif}
Result:=False; Result:=False;
if not (FTableName = '') and FileExists(FFileName) then if not (ATableName = '') and FileExists(FFileName) then
begin begin
if FSqliteHandle = nil then if FSqliteHandle = nil then
begin GetSqliteHandle;
{$ifdef DEBUG} FSqliteReturnId:=sqlite_compile(FSqliteHandle,
writeln('TableExists - FSqliteHandle=nil : Opening a file'); Pchar('SELECT name FROM SQLITE_MASTER WHERE type = ''table'' AND name LIKE '''+ ATableName+ ''';'),
{$endif}
AHandle:=GetSqliteHandle;
end
else
begin
{$ifdef DEBUG}
writeln('TableExists - FSqliteHandle<>nil : Using FSqliteHandle');
{$endif}
AHandle:=FSqliteHandle;
end;
FSqliteReturnId:=sqlite_compile(AHandle,
Pchar('SELECT name FROM SQLITE_MASTER WHERE type = ''table'' AND name LIKE '''+ FTableName+ ''';'),
nil,@vm,nil); nil,@vm,nil);
{$ifdef DEBUG} {$ifdef DEBUG}
WriteLn('TableExists.sqlite_compile - SqliteReturnString:',SqliteReturnString); WriteLn(' sqlite_compile - SqliteReturnString:',SqliteReturnString);
{$endif} {$endif}
FSqliteReturnId:=sqlite_step(vm,@AInt,@ColumnValues,@ColumnNames); FSqliteReturnId:=sqlite_step(vm,@AInt,@ColumnValues,@ColumnNames);
{$ifdef DEBUG} {$ifdef DEBUG}
WriteLn('TableExists.sqlite_step - SqliteReturnString:',SqliteReturnString); WriteLn(' sqlite_step - SqliteReturnString:',SqliteReturnString);
{$endif} {$endif}
Result:=FSqliteReturnId = SQLITE_ROW; Result:=FSqliteReturnId = SQLITE_ROW;
sqlite_finalize(vm, nil); sqlite_finalize(vm, nil);
if FSqliteHandle = nil then
SqliteClose(AHandle);
end; end;
{$ifdef DEBUG} {$ifdef DEBUG}
WriteLn('TableExists ('+FTableName+') Result:',Result); WriteLn(' Table '+ATableName+' exists:',Result);
{$endif} {$endif}
end; end;
function TSqliteDataset.SqliteReturnString: String; function TSqliteDataset.SqliteReturnString: String;
begin begin
case FSqliteReturnId of case FSqliteReturnId of
SQLITE_OK : Result := 'SQLITE_OK '; SQLITE_OK : Result := 'SQLITE_OK';
SQLITE_ERROR : Result := 'SQLITE_ERROR '; SQLITE_ERROR : Result := 'SQLITE_ERROR';
SQLITE_INTERNAL : Result := 'SQLITE_INTERNAL '; SQLITE_INTERNAL : Result := 'SQLITE_INTERNAL';
SQLITE_PERM : Result := 'SQLITE_PERM '; SQLITE_PERM : Result := 'SQLITE_PERM';
SQLITE_ABORT : Result := 'SQLITE_ABORT '; SQLITE_ABORT : Result := 'SQLITE_ABORT';
SQLITE_BUSY : Result := 'SQLITE_BUSY '; SQLITE_BUSY : Result := 'SQLITE_BUSY';
SQLITE_LOCKED : Result := 'SQLITE_LOCKED '; SQLITE_LOCKED : Result := 'SQLITE_LOCKED';
SQLITE_NOMEM : Result := 'SQLITE_NOMEM '; SQLITE_NOMEM : Result := 'SQLITE_NOMEM';
SQLITE_READONLY : Result := 'SQLITE_READONLY '; SQLITE_READONLY : Result := 'SQLITE_READONLY';
SQLITE_INTERRUPT : Result := 'SQLITE_INTERRUPT '; SQLITE_INTERRUPT : Result := 'SQLITE_INTERRUPT';
SQLITE_IOERR : Result := 'SQLITE_IOERR '; SQLITE_IOERR : Result := 'SQLITE_IOERR';
SQLITE_CORRUPT : Result := 'SQLITE_CORRUPT '; SQLITE_CORRUPT : Result := 'SQLITE_CORRUPT';
SQLITE_NOTFOUND : Result := 'SQLITE_NOTFOUND '; SQLITE_NOTFOUND : Result := 'SQLITE_NOTFOUND';
SQLITE_FULL : Result := 'SQLITE_FULL '; SQLITE_FULL : Result := 'SQLITE_FULL';
SQLITE_CANTOPEN : Result := 'SQLITE_CANTOPEN '; SQLITE_CANTOPEN : Result := 'SQLITE_CANTOPEN';
SQLITE_PROTOCOL : Result := 'SQLITE_PROTOCOL '; SQLITE_PROTOCOL : Result := 'SQLITE_PROTOCOL';
SQLITE_EMPTY : Result := 'SQLITE_EMPTY '; SQLITE_EMPTY : Result := 'SQLITE_EMPTY';
SQLITE_SCHEMA : Result := 'SQLITE_SCHEMA '; SQLITE_SCHEMA : Result := 'SQLITE_SCHEMA';
SQLITE_TOOBIG : Result := 'SQLITE_TOOBIG '; SQLITE_TOOBIG : Result := 'SQLITE_TOOBIG';
SQLITE_CONSTRAINT : Result := 'SQLITE_CONSTRAINT '; SQLITE_CONSTRAINT : Result := 'SQLITE_CONSTRAINT';
SQLITE_MISMATCH : Result := 'SQLITE_MISMATCH '; SQLITE_MISMATCH : Result := 'SQLITE_MISMATCH';
SQLITE_MISUSE : Result := 'SQLITE_MISUSE '; SQLITE_MISUSE : Result := 'SQLITE_MISUSE';
SQLITE_NOLFS : Result := 'SQLITE_NOLFS '; SQLITE_NOLFS : Result := 'SQLITE_NOLFS';
SQLITE_AUTH : Result := 'SQLITE_AUTH '; SQLITE_AUTH : Result := 'SQLITE_AUTH';
SQLITE_FORMAT : Result := 'SQLITE_FORMAT '; SQLITE_FORMAT : Result := 'SQLITE_FORMAT';
SQLITE_RANGE : Result := 'SQLITE_RANGE '; SQLITE_RANGE : Result := 'SQLITE_RANGE';
SQLITE_ROW : Result := 'SQLITE_ROW '; SQLITE_ROW : begin Result := 'SQLITE_ROW - not an error'; Exit; end;
SQLITE_DONE : Result := 'SQLITE_DONE '; SQLITE_DONE : begin Result := 'SQLITE_DONE - not an error'; Exit; end;
else else
Result:='Unknow Return Value'; Result:='Unknow Return Value';
end; end;
Result:=Result+' - '+sqlite_error_string(FSqliteReturnId);
end; end;
function TSqliteDataset.GetSqliteEncoding: String; function TSqliteDataset.GetSqliteEncoding: String;
@ -325,7 +342,7 @@ end;
function TSqliteDataset.QuickQuery(const ASql:String;const AStrList: TStrings;FillObjects:Boolean):String; function TSqliteDataset.QuickQuery(const ASql:String;const AStrList: TStrings;FillObjects:Boolean):String;
var var
vm,AHandle:Pointer; vm:Pointer;
ColumnNames,ColumnValues:PPChar; ColumnNames,ColumnValues:PPChar;
ColCount:Integer; ColCount:Integer;
@ -347,20 +364,12 @@ var
end; end;
end; end;
begin begin
if FSqliteHandle <> nil then if FSqliteHandle = nil then
AHandle:=FSqliteHandle GetSqliteHandle;
else
if FileExists(FFileName) then
AHandle:=GetSqliteHandle
else
DatabaseError('File '+FFileName+' not Exists',Self);
Result:=''; Result:='';
// It's up to the caller clear or not the list FSqliteReturnId:=sqlite_compile(FSqliteHandle,Pchar(ASql),nil,@vm,nil);
//if AStrList <> nil then
// AStrList.Clear;
FSqliteReturnId:=sqlite_compile(AHandle,Pchar(ASql),nil,@vm,nil);
if FSqliteReturnId <> SQLITE_OK then if FSqliteReturnId <> SQLITE_OK then
DatabaseError('Error returned by sqlite in QuickQuery: '+SqliteReturnString,Self); DatabaseError(SqliteReturnString,Self);
FSqliteReturnId:=sqlite_step(vm,@ColCount,@ColumnValues,@ColumnNames); FSqliteReturnId:=sqlite_step(vm,@ColCount,@ColumnValues,@ColumnNames);
if (FSqliteReturnId = SQLITE_ROW) and (ColCount > 0) then if (FSqliteReturnId = SQLITE_ROW) and (ColCount > 0) then
@ -375,8 +384,6 @@ begin
end; end;
end; end;
sqlite_finalize(vm, nil); sqlite_finalize(vm, nil);
if FSqliteHandle = nil then
sqlite_close(AHandle);
end; end;
end. end.