← Back to branch summary

~ubuntu-branches/ubuntu/feisty/fpc/feisty

« back to all changes in this revision

Viewing changes to fcl/db/sqlite/sqlitedataset.pas

  • Committer: Bazaar Package Importer
  • Author(s): Torsten Werner
  • Date: 2007-01-27 20:08:50 UTC
  • mfrom: (1.2.3 upstream)
  • Revision ID: james.westby@ubuntu.com-20070127200850-9mrptaqqjsx9nwa7
Tags: 2.0.4-5
* Fixed Build-Depends.
* Add myself to Uploaders in debian/control.
* Make sure that the sources are really patched before building them.
* Build unit 'libc' on powerpc too.

Show diffs side-by-side

added added

removed removed

Lines of Context:
fcl/db/sqlite/sqlitedataset.pas
1
 
{$mode objfpc}
2
 
{$h+}
3
 
unit SQLiteDataset;
4
 
{
5
 
Improved class sqLite,copyright(c) 2002-2003 Marcin Krzetowski
6
 
metal4@box43.gnet.pl
7
 
http://www.a-i.prv.pl
8
 
simple class interface for SQLite. Hacked in by Ben Hochstrasser (bhoc@surfeu.ch)
9
 
Thanks to Roger Reghin (RReghin@scelectric.ca) for his idea to ValueList.
10
 
 
11
 
}
12
 
 
13
 
interface
14
 
 
15
 
uses
16
 
  Classes,db,sysutils,Contnrs;
17
 
 
18
 
type
19
 
  PRecInfo = ^TRecInfo;
20
 
  TRecInfo = record
21
 
    Index: Integer;
22
 
    Bookmark: Longint;
23
 
    BookmarkFlag: TBookmarkFlag;
24
 
  end;
25
 
 
26
 
type
27
 
        pBinBookMark = ^tBinBookMark;
28
 
        tBinBookmark = record
29
 
        RecPtr : Int64;
30
 
end;
31
 
 
32
 
 
33
 
type
34
 
  TSQLiteExecCallback = function(Sender: TObject; Columns: Integer; ColumnValues: Pointer; ColumnNames: Pointer): integer of object; cdecl;
35
 
  TSQLiteBusyCallback = function(Sender: TObject; ObjectName: PChar; BusyCount: integer): integer of object; cdecl;
36
 
  TOnData = Procedure(Sender: TObject; Columns: Integer; ColumnNames, ColumnValues: String) of object;
37
 
  TOnBusy = Procedure(Sender: TObject; ObjectName: String; BusyCount: integer; var Cancel: Boolean) of object;
38
 
  TOnQueryComplete = Procedure(Sender: TObject) of object;
39
 
 
40
 
 
41
 
Type
42
 
        tSqliteField = class(tObject)
43
 
protected
44
 
        FOwner : tObject;
45
 
        data : string;
46
 
        fFieldKind: tFieldKind;
47
 
        fFieldType: tFieldType;
48
 
{        tIntegerType : Integer;
49
 
        tLongIntegerType : int64;
50
 
        tDateTimeType : tDateTime;}
51
 
//        procedure SetName(const Value: string);
52
 
        procedure SetFieldKind(const Value: tFieldKind);
53
 
        procedure SetFieldType(const Value: tFieldType);
54
 
public
55
 
 
56
 
        constructor create(aOwner : tObject);
57
 
        destructor destroy; override;
58
 
        procedure SetData(pt : pChar; NativeFormat : boolean);
59
 
        function GetData(Buffer: Pointer; NativeFormat : Boolean) : boolean;
60
 
        function GetData(Buffer: Pointer{=True}) : boolean;
61
 
//        property FieldName : string read fName write SetName;
62
 
        property FieldKind : tFieldKind read fFieldKind write SetFieldKind;
63
 
        property FieldType : tFieldType read fFieldType write SetFieldType;
64
 
 
65
 
 
66
 
end;
67
 
 
68
 
tSqliteRows = class (tObject)
69
 
private
70
 
        function getItem(index: integer): tSqliteField;
71
 
        procedure SetItem(index: integer; const Value: tSqliteField);
72
 
        function checkIndex(index : integer) : boolean;
73
 
 
74
 
 
75
 
public
76
 
        BookmarkFlag : tBookmarkFlag;
77
 
        Bookmark : LongInt;
78
 
        DataPointer : Pointer;
79
 
        constructor Create(fieldCount : integer);
80
 
        destructor destroy; override;
81
 
        procedure Push(item : tSqliteField);
82
 
        function Pop : tSqliteField;
83
 
        property Items[index : integer] : tSqliteField read getItem write SetItem;
84
 
        procedure Clear;
85
 
        procedure ClearCalcFields;
86
 
        function add(pt : Pchar; ptName : pCHar) : boolean;
87
 
 
88
 
 
89
 
protected
90
 
        fbuffercount : integer;
91
 
        fBuffer : ^tSqliteField;
92
 
        internalCount : integer;
93
 
        procedure clearBuffer;
94
 
end;
95
 
 
96
 
 
97
 
  TSQLite = class(TDataSet)
98
 
  private
99
 
    maxLengthInit : boolean;
100
 
    maxiL : pinteger;
101
 
    maxilcount : integer;
102
 
    fDoExceptions : boolean;
103
 
    fDoSQL : boolean;
104
 
    fIsCancel: boolean;
105
 
    fSQLite: Pointer;
106
 
    fMsg: String;
107
 
    fIsOpen: Boolean;
108
 
    fBusy: Boolean;
109
 
    fError: Integer;
110
 
    fVersion: String;
111
 
    fEncoding: String;
112
 
    fTable: tStrings;
113
 
    fLstName: TStringList;
114
 
    fLstVal: TStringList;
115
 
//    fbuffer : tObjectList;
116
 
    fOnData: TOnData;
117
 
    fOnBusy: TOnBusy;
118
 
    fOnQueryComplete: TOnQueryComplete;
119
 
    fBusyTimeout: integer;
120
 
    fPMsg: PChar;
121
 
    fChangeCount: integer;
122
 
    fSQL: tStringlist;
123
 
    fonwer : tComponent;
124
 
    fDataBaseName : string;
125
 
    fDataBase: string;
126
 
    fTableName: string;
127
 
    factive : boolean;
128
 
    procedure SetBusyTimeout(Timeout: integer);
129
 
    procedure SetDataBase(DBFileName: String);
130
 
    procedure setTableName(const Value: string);
131
 
    function getIsCancel: boolean;
132
 
    procedure clearBuffer;
133
 
  protected
134
 
    fCalcFieldsOfs,fRecordSize : integer;
135
 
    fBookMarkOfs,fRecordBufferSize : integer;
136
 
    fCurrentRecord : int64;
137
 
    fRecordCount : int64;
138
 
    fCursorOpen : boolean;
139
 
    fFieldOffset : tList;
140
 
  //  procedure internalInsert; override;
141
 
    function getActive: boolean;
142
 
   // procedure setActive(Value: boolean); override;
143
 
    function getRecNo : integer; override;
144
 
    function getBookmarkFlag(Buffer : pChar) : tBookMarkFlag; override;
145
 
    procedure InitBufferPointers;
146
 
    procedure GetBookmarkData(Buffer : pChar; Data : Pointer); override;
147
 
    procedure SetBookMarkData(Buffer : pChar; Data : Pointer); override;
148
 
    procedure InternalGotoBookmark(ABookMark : Pointer) ; override;
149
 
    function FieldDefsStored : boolean;
150
 
    procedure ClearCalcFields(Buffer : pChar); override;
151
 
    procedure OpenCursor(InfoQuery : Boolean); override;
152
 
    function getRecordCount : integer; override;
153
 
    procedure SetRecNo (value : integer); override;
154
 
    function getRecord(Buffer : pChar; GetMode : tGetMode; DoCheck : Boolean): tGetResult; override;
155
 
    procedure InternalInitFieldDefs; override;
156
 
    procedure InternalOpen; override;
157
 
    procedure InternalClose; override;
158
 
    procedure InternalAddRecord(Buffer : Pointer; DoAppend : boolean); override;
159
 
    procedure InternalDelete; override;
160
 
    procedure InternalFirst; override;
161
 
    procedure InternalHandleException; override;
162
 
    procedure InternalInitRecord(Buffer : pChar); override;
163
 
    procedure InternalLast;override;
164
 
    procedure InternalPost;override;
165
 
    procedure InternalSetToRecord (Buffer : pChar); override;
166
 
    function isCursorOpen : Boolean; override;
167
 
    procedure SetBookmarkFlag(Buffer : pChar; value : tBookmarkFlag); override;
168
 
    procedure SetFieldData(Field : tField; Buffer : Pointer); override;
169
 
    function allocRecordBuffer : pChar; override;
170
 
    procedure FreeRecordBuffer(var Buffer : pChar); override;
171
 
    function getRecordSize : Word; override;
172
 
    function getCanModify : boolean; override;
173
 
  public
174
 
      fbuffer : tObjectList; //po zakonczeniu debuggowania usunac
175
 
    constructor create(Aowner : tComponent); override;
176
 
    destructor Destroy; override;
177
 
    function getFieldData(Field : tField; Buffer : Pointer) : boolean; override;
178
 
    function Query(ASql: String{table= nil}) : Boolean;
179
 
    Function Query(ASQL: String; Table: TStrings): boolean;
180
 
    function ExecSQL : boolean;
181
 
    function ErrorMessage(ErrNo: Integer): string;
182
 
    function IsComplete(ASql: String): boolean;
183
 
    function LastInsertRow: integer;
184
 
    procedure Cancel; override;
185
 
    function DatabaseDetails(Table: TStrings): boolean;
186
 
    function CreateTable : boolean;
187
 
    procedure countMaxiLength(pt: pChar;index : int64);
188
 
    procedure InitMaxLength(length : integer);
189
 
  published
190
 
    property LastErrorMessage: string read fMsg;
191
 
    property LastError: Integer read fError;
192
 
    property Version: String read fVersion;
193
 
    property Encoding: String read fEncoding;
194
 
    property OnData: TOnData read fOnData write fOnData;
195
 
    property OnBusy: TOnBusy read fOnBusy write fOnBusy;
196
 
    property OnQueryComplete: TOnQueryComplete read fOnQueryComplete write fOnQueryComplete;
197
 
    property BusyTimeout: Integer read fBusyTimeout write SetBusyTimeout;
198
 
    property ChangeCount: Integer read fChangeCount;
199
 
    property SQL : tStringlist  read fSQL write fSQL;
200
 
//    property Fields : tstringlist read fFields;
201
 
    property DataBase : string read fDataBase write SetDataBase;
202
 
    property TableName : string read fTableName write setTableName;
203
 
    property Active : boolean read getActive write setActive;
204
 
    property isCancel : boolean read getIsCancel;
205
 
    property DoExceptions : boolean read fDoExceptions write fDoExceptions  stored true default true;
206
 
  end;
207
 
  function Pas2SQLStr(const PasString: string): string;
208
 
  function SQL2PasStr(const SQLString: string): string;
209
 
  function QuoteStr(const s: string; QuoteChar: Char): string;
210
 
  function UnQuoteStr(const s: string; QuoteChar: Char): string;
211
 
  function QuoteStr(const s: string{; QuoteChar: Char = #39}): string;
212
 
  function UnQuoteStr(const s: string{; QuoteChar: Char = #39}): string;
213
 
  procedure ValueList(const ColumnNames, ColumnValues: String; NameValuePairs: TStrings);
214
 
 
215
 
 
216
 
  procedure Register;
217
 
 
218
 
implementation
219
 
 
220
 
{$ifndef dynload}
221
 
uses sqlite;
222
 
{$else}
223
 
uses dynlibs;
224
 
 
225
 
function GetProcAddress(S : String) : Pointer;
226
 
 
227
 
begin
228
 
 
229
 
end;
230
 
{$endif}
231
 
const
232
 
  SQLITE_OK         =  0;   // Successful result
233
 
  SQLITE_ERROR      =  1;   // SQL error or missing database
234
 
  SQLITE_INTERNAL   =  2;   // An internal logic error in SQLite
235
 
  SQLITE_PERM       =  3;   // Access permission denied
236
 
  SQLITE_ABORT      =  4;   // Callback routine requested an abort
237
 
  SQLITE_BUSY       =  5;   // The database file is locked
238
 
  SQLITE_LOCKED     =  6;   // A table in the database is locked
239
 
  SQLITE_NOMEM      =  7;   // A malloc() failed
240
 
  SQLITE_READONLY   =  8;   // Attempt to write a readonly database
241
 
  SQLITE_INTERRUPT  =  9;   // Operation terminated by sqlite_interrupt()
242
 
  SQLITE_IOERR      = 10;   // Some kind of disk I/O error occurred
243
 
  SQLITE_CORRUPT    = 11;   // The database disk image is malformed
244
 
  SQLITE_NOTFOUND   = 12;   // (Internal Only) Table or record not found
245
 
  SQLITE_FULL       = 13;   // Insertion failed because database is full
246
 
  SQLITE_CANTOPEN   = 14;   // Unable to open the database file
247
 
  SQLITE_PROTOCOL   = 15;   // Database lock protocol error
248
 
  SQLITE_EMPTY      = 16;   // (Internal Only) Database table is empty
249
 
  SQLITE_SCHEMA     = 17;   // The database schema changed
250
 
  SQLITE_TOOBIG     = 18;   // Too much data for one row of a table
251
 
  SQLITE_CONSTRAINT = 19;   // Abort due to contraint violation
252
 
  SQLITE_MISMATCH   = 20;   // Data type mismatch
253
 
  SQLITEDLL: PChar  = 'sqlite.dll';
254
 
  DblQuote: Char    = '"';
255
 
  SngQuote: Char    = #39;
256
 
  Crlf: String      = #13#10;
257
 
  Tab: Char         = #9;
258
 
  _DO_EXCEPTIONS = 1; //Handle or not exceptions in dataset
259
 
 
260
 
{$ifdef dynload}
261
 
var
262
 
  SQLite_Open: function(dbname: PChar; mode: Integer; var ErrMsg: PChar): Pointer; cdecl;
263
 
  SQLite_Close: procedure(db: Pointer); cdecl;
264
 
  SQLite_Exec: function(db: Pointer; SQLStatement: PChar; CallbackPtr: Pointer; Sender: TObject; var ErrMsg: PChar): integer; cdecl;
265
 
  SQLite_Version: function(): PChar; cdecl;
266
 
  SQLite_Encoding: function(): PChar; cdecl;
267
 
  SQLite_ErrorString: function(ErrNo: Integer): PChar; cdecl;
268
 
  SQLite_GetTable: function(db: Pointer; SQLStatement: PChar; var ResultPtr: Pointer; var RowCount: Cardinal; var ColCount: Cardinal; var ErrMsg: PChar): integer; cdecl;
269
 
  SQLite_FreeTable: procedure(Table: PChar); cdecl;
270
 
  SQLite_FreeMem: procedure(P: PChar); cdecl;
271
 
  SQLite_Complete: function(P: PChar): boolean; cdecl;
272
 
  SQLite_LastInsertRow: function(db: Pointer): integer; cdecl;
273
 
  SQLite_Cancel: procedure(db: Pointer); cdecl;
274
 
  SQLite_BusyHandler: procedure(db: Pointer; CallbackPtr: Pointer; Sender: TObject); cdecl;
275
 
  SQLite_BusyTimeout: procedure(db: Pointer; TimeOut: integer); cdecl;
276
 
  SQLite_Changes: function(db: Pointer): integer; cdecl;
277
 
  LibsLoaded: Boolean;
278
 
  DLLHandle: THandle;
279
 
{$endif}
280
 
 
281
 
Var
282
 
  MsgNoError: String;
283
 
 
284
 
function QuoteStr(const s: string): string;
285
 
begin
286
 
  Result := QuoteStr(S,#39);
287
 
end;
288
 
 
289
 
function QuoteStr(const s: string; QuoteChar: Char): string;
290
 
begin
291
 
  Result := Concat(QuoteChar, s, QuoteChar);
292
 
end;
293
 
 
294
 
function UnQuoteStr(const s: string): string;
295
 
begin
296
 
  Result := UnQuoteStr(s,#39);
297
 
end;
298
 
 
299
 
function UnQuoteStr(const s: string; QuoteChar: Char): string;
300
 
begin
301
 
  Result := s;
302
 
  if length(Result) > 1 then
303
 
  begin
304
 
    if Result[1] = QuoteChar then
305
 
      Delete(Result, 1, 1);
306
 
    if Result[Length(Result)] = QuoteChar then
307
 
      Delete(Result, Length(Result), 1);
308
 
  end;
309
 
end;
310
 
 
311
 
function Pas2SQLStr(const PasString: string): string;
312
 
var
313
 
  n: integer;
314
 
begin
315
 
  Result := SQL2PasStr(PasString);
316
 
  n := Length(Result);
317
 
  while n > 0 do
318
 
  begin
319
 
    if Result[n] = SngQuote then
320
 
      Insert(SngQuote, Result, n);
321
 
    dec(n);
322
 
  end;
323
 
  Result := QuoteStr(Result);
324
 
end;
325
 
 
326
 
function SQL2PasStr(const SQLString: string): string;
327
 
const
328
 
  DblSngQuote: String = #39#39;
329
 
var
330
 
  p: integer;
331
 
begin
332
 
  Result := SQLString;
333
 
  p := pos(DblSngQuote, Result);
334
 
  while p > 0 do
335
 
  begin
336
 
    Delete(Result, p, 1);
337
 
    p := pos(DblSngQuote, Result);
338
 
  end;
339
 
  Result := UnQuoteStr(Result);
340
 
end;
341
 
 
342
 
procedure ValueList(const ColumnNames, ColumnValues: String; NameValuePairs: TStrings);
343
 
var
344
 
  n: integer;
345
 
  lstName, lstValue: TStringList;
346
 
begin
347
 
  if NameValuePairs <> nil then
348
 
  begin
349
 
    lstName := TStringList.Create;
350
 
    lstValue := TStringList.Create;
351
 
    lstName.CommaText := ColumnNames;
352
 
    lstValue.CommaText := ColumnValues;
353
 
    NameValuePairs.Clear;
354
 
    if lstName.Count = LstValue.Count then
355
 
      if lstName.Count > 0 then
356
 
        for n := 0 to lstName.Count - 1 do
357
 
          NameValuePairs.Append(Concat(lstName.Strings[n], '=', lstValue.Strings[n]));
358
 
    lstValue.Free;
359
 
    lstName.Free;
360
 
  end;
361
 
end;
362
 
 
363
 
{$ifdef dynload}
364
 
function LoadLibs: Boolean;
365
 
begin
366
 
  Result := False;
367
 
  DLLHandle := LoadLibrary(SQLITEDLL);
368
 
  if DLLHandle <> 0 then
369
 
  begin
370
 
    @SQLite_Open := GetProcAddress(DLLHandle, 'sqlite_open');
371
 
    if not Assigned(@SQLite_Open) then exit;
372
 
    @SQLite_Close := GetProcAddress(DLLHandle, 'sqlite_close');
373
 
    if not Assigned(@SQLite_Close) then exit;
374
 
    @SQLite_Exec := GetProcAddress(DLLHandle, 'sqlite_exec');
375
 
    if not Assigned(@SQLite_Exec) then exit;
376
 
    @SQLite_Version := GetProcAddress(DLLHandle, 'sqlite_libversion');
377
 
    if not Assigned(@SQLite_Version) then exit;
378
 
    @SQLite_Encoding := GetProcAddress(DLLHandle, 'sqlite_libencoding');
379
 
    if not Assigned(@SQLite_Encoding) then exit;
380
 
    @SQLite_ErrorString := GetProcAddress(DLLHandle, 'sqlite_error_string');
381
 
    if not Assigned(@SQLite_ErrorString) then exit;
382
 
    @SQLite_GetTable := GetProcAddress(DLLHandle, 'sqlite_get_table');
383
 
    if not Assigned(@SQLite_GetTable) then exit;
384
 
    @SQLite_FreeTable := GetProcAddress(DLLHandle, 'sqlite_free_table');
385
 
    if not Assigned(@SQLite_FreeTable) then exit;
386
 
    @SQLite_FreeMem := GetProcAddress(DLLHandle, 'sqlite_freemem');
387
 
    if not Assigned(@SQLite_FreeMem) then exit;
388
 
    @SQLite_Complete := GetProcAddress(DLLHandle, 'sqlite_complete');
389
 
    if not Assigned(@SQLite_Complete) then exit;
390
 
    @SQLite_LastInsertRow := GetProcAddress(DLLHandle, 'sqlite_last_insert_rowid');
391
 
    if not Assigned(@SQLite_LastInsertRow) then exit;
392
 
    @SQLite_Cancel := GetProcAddress(DLLHandle, 'sqlite_interrupt');
393
 
    if not Assigned(@SQLite_Cancel) then exit;
394
 
    @SQLite_BusyTimeout := GetProcAddress(DLLHandle, 'sqlite_busy_timeout');
395
 
    if not Assigned(@SQLite_BusyTimeout) then exit;
396
 
    @SQLite_BusyHandler := GetProcAddress(DLLHandle, 'sqlite_busy_handler');
397
 
    if not Assigned(@SQLite_BusyHandler) then exit;
398
 
    @SQLite_Changes := GetProcAddress(DLLHandle, 'sqlite_changes');
399
 
    if not Assigned(@SQLite_Changes) then exit;
400
 
    Result := True;
401
 
  end;
402
 
end;
403
 
{$endif}
404
 
 
405
 
function SystemErrorMsg(ErrNo: Integer): String;
406
 
var
407
 
  buf: PChar;
408
 
  size: Integer;
409
 
  MsgLen: Integer;
410
 
begin
411
 
{  msglen:=0;
412
 
  size := 256;
413
 
  GetMem(buf, size);
414
 
 
415
 
  If ErrNo = - 1 then
416
 
    ErrNo := GetLastError;
417
 
  MsgLen := FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, nil, ErrNo, 0, buf, size, nil);
418
 
 
419
 
  if MsgLen = 0 then
420
 
    Result := 'ERROR'
421
 
  else
422
 
    Result := buf;
423
 
}
424
 
  Result := ('SystemErrorMsg Not Implemented');
425
 
end;
426
 
 
427
 
function SystemErrorMsg: String;
428
 
 
429
 
begin
430
 
  SystemErrorMsg(-1);
431
 
end;
432
 
 
433
 
function BusyCallback(Sender: Pointer; ObjectName: PChar; BusyCount: integer): integer; cdecl;
434
 
var
435
 
  sObjName: String;
436
 
  bCancel: Boolean;
437
 
begin
438
 
  Result := -1;
439
 
  with TSQLite(Sender) do
440
 
  begin
441
 
    if Assigned(fOnBusy) then
442
 
    begin
443
 
      bCancel := False;
444
 
      sObjName := ObjectName;
445
 
      fOnBusy(Tsqlite(Sender), sObjName, BusyCount, bCancel);
446
 
      if bCancel then
447
 
        Result := 0;
448
 
    end;
449
 
  end;
450
 
end;
451
 
 
452
 
function ExecCallback(Sender: TObject; Columns: Integer; ColumnValues: Pointer; ColumnNames: Pointer): integer; cdecl;
453
 
var
454
 
  PVal, PName: ^PChar;
455
 
  n: integer;
456
 
  sVal, sName: String;
457
 
begin
458
 
  Result := 0;
459
 
  with Sender as TSQLite do
460
 
  begin
461
 
    if (Assigned(fOnData) or Assigned(fTable)) then
462
 
    begin
463
 
      fLstName.Clear;
464
 
      fLstVal.Clear;
465
 
      if Columns > 0 then
466
 
      begin
467
 
        PName := ColumnNames;
468
 
        PVal := ColumnValues;
469
 
        for n := 0 to Columns - 1 do
470
 
        begin
471
 
          fLstName.Append(PName^);
472
 
          fLstVal.Append(PVal^);
473
 
          if Assigned(fTable) then
474
 
          begin
475
 
                fTable.Append(PVal^);
476
 
          end;
477
 
          inc(PName);
478
 
          inc(PVal);
479
 
        end;
480
 
      end;
481
 
      sVal := fLstVal.CommaText;
482
 
      sName := fLstName.CommaText;
483
 
      if Assigned(fOnData) then
484
 
        fOnData(Sender, Columns, sName, sVal);
485
 
 
486
 
    end;
487
 
//    InternalOpen;
488
 
  end;
489
 
end;
490
 
 
491
 
function ExecCallback2(Sender: TObject; Columns: Integer; ColumnValues: Pointer; ColumnNames: Pointer): integer; cdecl;
492
 
var
493
 
  PVal, PName: ^PChar;
494
 
  n: integer;
495
 
  sVal, sName: String;
496
 
  t : tSqliteRows;
497
 
  p : pointer;
498
 
  temp : LongInt;
499
 
 
500
 
begin
501
 
  Result := 0;
502
 
  with Sender as TSQLite do begin
503
 
    if (Assigned(fOnData) or assigned(fBuffer)) then begin
504
 
    fLstName.Clear;
505
 
//      fLstVal.Clear;
506
 
      if Columns > 0 then begin
507
 
        PName := ColumnNames;
508
 
        PVal := ColumnValues;
509
 
        fBuffer.Add(tSqliteRows.Create(Columns));
510
 
        temp:=fBuffer.count-1;
511
 
        initMaxLength(columns);
512
 
        for n := 0 to Columns - 1 do begin
513
 
                fLstName.Append(PName^);
514
 
                if Assigned(fBuffer) then begin
515
 
                        p:=fBuffer.Items[temp];
516
 
                        t:=tSqliteRows(p);
517
 
                        if t=nil then continue;
518
 
                        t.Add(PVAL^,PNAME^);
519
 
 
520
 
                end;
521
 
                countMaxiLength(PVAL^,n);
522
 
          inc(PName);
523
 
          inc(PVal);
524
 
        end;
525
 
        // at last we add the bookmark info
526
 
        t.Bookmark:=temp;
527
 
      end;
528
 
      if Assigned(fOnData) then begin
529
 
              sVal := fLstVal.CommaText;
530
 
              sName := fLstName.CommaText;
531
 
              fOnData(Sender, Columns, sName, sVal);
532
 
      end;
533
 
 
534
 
    end;
535
 
//    InternalOpen;
536
 
  end;
537
 
end;
538
 
 
539
 
procedure  TSQLite.SetDataBase(DBFileName: String);
540
 
var
541
 
  afPMsg: PChar;
542
 
begin
543
 
 
544
 
  fError := SQLITE_ERROR;
545
 
  fIsOpen := False;
546
 
  fOnData := nil;
547
 
  fOnBusy := nil;
548
 
  fOnQueryComplete := nil;
549
 
  fChangeCount := 0;
550
 
{$ifdef dynload}
551
 
  if LibsLoaded then
552
 
    begin
553
 
{$endif}
554
 
    fSQLite := SQLite_Open(PChar(DBFileName), 1, @afPMsg);
555
 
    SQLite_FreeMem(afPMsg);
556
 
    if fSQLite <> nil then
557
 
    begin
558
 
      {$ifndef fpc}
559
 
      fVersion := strpas(SQLite_Version);
560
 
      fEncoding := strpas(SQLite_Encoding);
561
 
      {$endif}
562
 
      fIsOpen := True;
563
 
      fError := SQLITE_OK;
564
 
    end;
565
 
{$ifdef dynload}
566
 
  end;
567
 
{$endif}
568
 
  fMsg := ErrorMessage(fError);
569
 
end;
570
 
 
571
 
destructor TSQLite.Destroy;
572
 
begin
573
 
try
574
 
if assigned(fSQl) then begin
575
 
        fsql.free;
576
 
        fsql:=nil;
577
 
end;
578
 
  if fIsOpen then
579
 
    SQLite_Close(fSQLite);
580
 
  fIsOpen := False;
581
 
if assigned(fLstName) then begin
582
 
  fLstName.Free;
583
 
  fLstName:=nil;
584
 
end;
585
 
if assigned(fLstVal) then begin
586
 
  fLstVal.Free;
587
 
  fLstVal:=nil;
588
 
end;
589
 
  fSQLite := nil;
590
 
  fOnData := nil;
591
 
  fOnBusy := nil;
592
 
  fOnQueryComplete := nil;
593
 
  fLstName := nil;
594
 
  fLstVal := nil;
595
 
if assigned(fBuffer) then begin
596
 
        clearBuffer;
597
 
        fBuffer.Free;
598
 
        fBuffer:=nil;
599
 
end;
600
 
except
601
 
end;
602
 
  inherited Destroy;
603
 
end;
604
 
 
605
 
function TSQLite.Query(ASql: String): boolean;
606
 
 
607
 
begin
608
 
  Result:=Query(ASql,Nil);
609
 
end;
610
 
 
611
 
function TSQLite.Query(ASql: String; Table: TStrings): boolean;
612
 
//var
613
 
//  fPMsg: PChar;
614
 
begin
615
 
  maxLengthInit:=false;
616
 
  fError := SQLITE_ERROR;
617
 
  if fIsOpen then
618
 
  begin
619
 
    fPMsg := nil;
620
 
    fBusy := True;
621
 
    fTable := Table;
622
 
    if fTable <> nil then
623
 
      fTable.Clear;
624
 
    fError := SQLite_Exec(fSQLite, PChar(ASql), @ExecCallback, Self, @fPMsg);
625
 
    SQLite_FreeMem(fPMsg);
626
 
    fChangeCount := SQLite_Changes(fSQLite);
627
 
    fTable := nil;
628
 
    fBusy := False;
629
 
    if Assigned(fOnQueryComplete) then
630
 
      fOnQueryComplete(Self);
631
 
  end;
632
 
  fMsg := ErrorMessage(fError);
633
 
  Result := not (fError <> SQLITE_OK);//function should return true, if execution of query ends ok..
634
 
  if result and not active then
635
 
        factive:=true;
636
 
  fDoSql:=true;
637
 
end;
638
 
 
639
 
 
640
 
procedure TSQLite.SetBusyTimeout(Timeout: Integer);
641
 
begin
642
 
  fBusyTimeout := Timeout;
643
 
  if fIsOpen then
644
 
  begin
645
 
    SQLite_Busy_Timeout(fSQLite, fBusyTimeout);
646
 
    if fBusyTimeout > 0 then
647
 
      SQLite_Busy_Handler(fSQLite, @BusyCallback, Self)
648
 
    else
649
 
      SQLite_Busy_Handler(fSQLite, nil, nil);
650
 
  end;
651
 
end;
652
 
 
653
 
function TSQLite.LastInsertRow: integer;
654
 
begin
655
 
  if fIsOpen then
656
 
    Result := SQLite_Last_Insert_Rowid(fSQLite)
657
 
  else
658
 
    Result := -1;
659
 
end;
660
 
 
661
 
function TSQLite.ErrorMessage(ErrNo: Integer): string;
662
 
begin
663
 
{$ifdef dynload}
664
 
  if LibsLoaded then
665
 
  begin
666
 
{$endif}
667
 
    if ErrNo = 0 then
668
 
      Result := MsgNoError
669
 
    else
670
 
      Result := SQLite_Error_String(ErrNo);
671
 
{$ifdef dynload}
672
 
  end else
673
 
    Raise exception.Create('Library "sqlite.dll" not found.');
674
 
{$endif}
675
 
end;
676
 
 
677
 
function TSQLite.IsComplete(ASql: String): boolean;
678
 
begin
679
 
  Result := SQLite_Complete(PChar(ASql))=0;
680
 
end;
681
 
 
682
 
function TSQLite.DatabaseDetails(Table: TStrings): boolean;
683
 
begin
684
 
  Result := Query('SELECT * FROM SQLITE_MASTER;', Table);
685
 
end;
686
 
 
687
 
function TSQLite.ExecSQL: boolean;
688
 
var i : integer;
689
 
 
690
 
begin
691
 
  result:=false;
692
 
  maxLengthInit:=false;
693
 
  fError := SQLITE_ERROR;
694
 
  if fIsOpen then
695
 
  begin
696
 
    fPMsg := nil;
697
 
    fBusy := True;
698
 
 
699
 
    if fTable <> nil then
700
 
      fTable.Clear;
701
 
    for i:=0 to fsql.Count-1 do begin
702
 
    fError := SQLite_Exec(fSQLite, PChar(fSql[i]), @ExecCallback2, Self, @fPMsg);
703
 
    SQLite_FreeMem(fPMsg);
704
 
    end;
705
 
    fChangeCount := SQLite_Changes(fSQLite);
706
 
    fTable := nil;
707
 
    fBusy := False;
708
 
    if Assigned(fOnQueryComplete) then
709
 
      fOnQueryComplete(Self);
710
 
  end;
711
 
  fMsg := ErrorMessage(fError);
712
 
  Result :=not (fError <> SQLITE_OK);
713
 
  if result and not active then
714
 
        factive:=true;
715
 
  fDoSQl:=true;
716
 
end;
717
 
 
718
 
constructor TSQLite.Create(Aowner: tComponent);
719
 
begin
720
 
inherited create(Aowner);
721
 
fLstName := TStringList.Create;
722
 
fLstVal := TStringList.Create;
723
 
fDoSql:=false;
724
 
fsql:=tStringList.Create;
725
 
fOnwer:=owner;
726
 
fBuffer:=tObjectList.Create(true);
727
 
if length(fDataBase)>1 then
728
 
        setDataBase(fDataBase);
729
 
end;
730
 
 
731
 
procedure TSQLite.setTableName(const Value: string);
732
 
begin
733
 
if (not active) and (length(value)>0) then begin
734
 
  fTableName := Value;
735
 
  sql.Clear;
736
 
  sql.add('select rowid,* from '+tableName+';');
737
 
end;
738
 
end;
739
 
 
740
 
function TSQLite.getActive: boolean;
741
 
begin
742
 
result:=fActive;
743
 
end;
744
 
 
745
 
{
746
 
procedure TSQLite.setActive(Value: boolean);
747
 
begin
748
 
  if value then
749
 
    begin
750
 
    //switch for  active=true;
751
 
    if active then
752
 
      active:=false;
753
 
    end
754
 
  else
755
 
    begin
756
 
    fDoSQL:=value;
757
 
    end;
758
 
  inherited setActive(value);
759
 
end;
760
 
}
761
 
 
762
 
function TSQLite.getRecNo: integer;
763
 
begin
764
 
result:=self.fCurrentRecord;
765
 
end;
766
 
 
767
 
procedure TSQLite.Cancel;
768
 
begin
769
 
  inherited;
770
 
  fIsCancel := False;
771
 
  if fBusy and fIsOpen then
772
 
  begin
773
 
    do_SQLite_interrupt(fSQLite);
774
 
    fBusy := false;
775
 
    fIsCancel := True;
776
 
  end;
777
 
 
778
 
end;
779
 
 
780
 
function TSQLite.getIsCancel: boolean;
781
 
begin
782
 
 
783
 
end;
784
 
 
785
 
function TSQLite.getBookmarkFlag(Buffer: pChar): tBookMarkFlag;
786
 
begin
787
 
result:= pRecInfo(Buffer)^.BookmarkFlag;
788
 
end;
789
 
 
790
 
procedure TSQLite.InitBufferPointers;
791
 
begin
792
 
fCalcFieldsOfs :=fRecordSize;
793
 
//fRecInfoOfs :=fCalcFieldsOfs + CalcFieldsSize;
794
 
//fBookMarkOfs := fRecInfoOfs+SizeOf(tRecInfo);
795
 
fRecordBufferSize :=fBookmarkOfs + BookmarkSize;
796
 
end;
797
 
 
798
 
procedure TSQLite.GetBookmarkData(Buffer: pChar; Data: Pointer);
799
 
begin
800
 
Move(Buffer[fBookMarkOfs],Data^,SizeOf(tBinBookMark));
801
 
//implementacja jest watpliwa
802
 
end;
803
 
 
804
 
procedure TSQLite.SetBookMarkData(Buffer: pChar; Data: Pointer);
805
 
begin
806
 
Move(Data^,Buffer[fBookMarkOfs],SizeOf(tbinBookMark));
807
 
 
808
 
end;
809
 
 
810
 
procedure TSQLite.InternalGotoBookmark(ABookMark: Pointer);
811
 
begin
812
 
with pBinBookMark(ABookMark)^ do begin
813
 
    fCurrentRecord :=RecPtr;
814
 
end;
815
 
end;
816
 
 
817
 
function TSQLite.FieldDefsStored: boolean;
818
 
begin
819
 
 
820
 
end;
821
 
 
822
 
procedure TSQLite.ClearCalcFields(Buffer: pChar);
823
 
var p : pointer;
824
 
t : tSQliteRows;
825
 
begin
826
 
inherited;
827
 
p:=buffer;
828
 
if p<>nil then begin
829
 
try
830
 
        t:=tSQliteRows(p);
831
 
        t.clearCalcFields;
832
 
except
833
 
end;
834
 
end;
835
 
end;
836
 
 
837
 
function TSQLite.getRecordCount: integer;
838
 
begin
839
 
result :=fRecordCount;
840
 
end;
841
 
 
842
 
procedure TSQLite.OpenCursor(InfoQuery: Boolean);
843
 
begin
844
 
  inherited;
845
 
 
846
 
end;
847
 
 
848
 
procedure TSQLite.SetRecNo(value: integer);
849
 
begin
850
 
  inherited;
851
 
 
852
 
end;
853
 
 
854
 
function TSQLite.CreateTable: boolean;
855
 
begin
856
 
 
857
 
end;
858
 
 
859
 
function TSQLite.getRecord(Buffer: pChar; GetMode: tGetMode;
860
 
  DoCheck: Boolean): tGetResult;
861
 
begin
862
 
if fRecordCount<1 then
863
 
        result:=grEof
864
 
else begin
865
 
        result:=grOk;
866
 
        Case GetMode of
867
 
                gmNext :
868
 
                        if fCurrentRecord>= (fRecordCount-1) then
869
 
                                result:=grEof
870
 
                        else
871
 
                                Inc(fCurrentRecord);
872
 
                gmPrior :
873
 
                        if (fCurrentRecord <=0) then
874
 
                                result:=grBof
875
 
                        else
876
 
                                Dec(fCurrentRecord);
877
 
                gmCurrent :
878
 
                        if (fCurrentRecord >= fRecordCount) or (fCurrentRecord <0) then
879
 
                                result:=grError;
880
 
        end;
881
 
end;
882
 
if result=grOk then begin
883
 
        self.fRecordBufferSize:=sizeOf(fBuffer[fCurrentRecord]);
884
 
        self.fRecordSize:=self.fRecordBufferSize;
885
 
       // Buffer:=fBuffer.List[fcurrentRecord];
886
 
        //read data from psyh buffer sqlite..;)
887
 
        GetCalcFields(Buffer);
888
 
 {       with fBuffer.Items[fCurrentRecord] as tSqliteRows do begin
889
 
                BookmarkFlag := bfCurrent;
890
 
        end;}
891
 
    with PRecInfo(Buffer)^ do
892
 
    begin
893
 
      Index := fCurrentRecord;
894
 
      BookmarkFlag := bfCurrent;
895
 
      Bookmark := Integer (fCurrentRecord);
896
 
    end;
897
 
 
898
 
 
899
 
 
900
 
end;
901
 
if result=grError then begin
902
 
        if DoCheck and DoExceptions then
903
 
                raise edataBaseError.Create('Invalid Record');
904
 
end;
905
 
end;
906
 
 
907
 
procedure TSQLite.InternalInitFieldDefs;
908
 
var i : integer;
909
 
begin
910
 
FieldDefs.Clear;
911
 
for i:=0 to fLstname.Count-1 do begin
912
 
        FieldDefs.Add(fLstName[i],ftString,MaxiL[i],false);
913
 
end;
914
 
end;
915
 
 
916
 
procedure TSQLite.InternalOpen;
917
 
begin
918
 
if fBUffer<>nil then begin
919
 
        clearBuffer;
920
 
 
921
 
end;
922
 
if (length(tableName)>0) and (fSQL.Count<1) then begin
923
 
        fsql.add('select rowid,* from '+fTableName);
924
 
end;
925
 
if not fDoSQL then
926
 
        fActive:=execSQL;
927
 
InternalInitFieldDefs;
928
 
{
929
 
if ((fLstName.count-1)>0) and (fBuffer<>nil) then
930
 
        fRecordCount:=(fBuffer.Count-1) div (fLstName.Count-1)
931
 
else
932
 
        fRecordCount:=0;
933
 
}
934
 
if  (fBuffer<>nil) then
935
 
        fRecordCount:=(fBuffer.Count-1)
936
 
else
937
 
        fRecordCount:=0;
938
 
if DefaultFields then
939
 
        CreateFields;
940
 
BindFields(true);
941
 
FisOpen:=true;
942
 
  FRecordSize := sizeof (TRecInfo);
943
 
  FCurrentRecord := -1;
944
 
  BookmarkSize := sizeOf (Integer);
945
 
end;
946
 
 
947
 
procedure TSQLite.InternalClose;
948
 
begin
949
 
clearBuffer;
950
 
end;
951
 
 
952
 
function TSQLite.allocRecordBuffer: pChar;
953
 
var p : pointer;
954
 
begin
955
 
//now is time to calculate currentRecordSize...
956
 
  GetMem(Result,GetRecordSize);
957
 
  FillChar(Result^,GetRecordSize,0);
958
 
end;
959
 
 
960
 
procedure TSQLite.FreeRecordBuffer(var Buffer: pChar);
961
 
begin
962
 
//FreeMem(Buffer,sizeOf(Buffer));
963
 
FreeMem(Buffer,GetRecordSize);
964
 
end;
965
 
 
966
 
function TSQLite.getRecordSize: Word;
967
 
begin
968
 
 
969
 
  Result:=sizeof(TRecInfo);
970
 
 
971
 
end;
972
 
 
973
 
procedure TSQLite.InternalAddRecord(Buffer: Pointer; DoAppend: boolean);
974
 
begin
975
 
 
976
 
end;
977
 
 
978
 
procedure TSQLite.InternalDelete;
979
 
begin
980
 
 
981
 
end;
982
 
 
983
 
procedure TSQLite.InternalFirst;
984
 
begin
985
 
  self.fCurrentRecord:=0;
986
 
end;
987
 
 
988
 
procedure TSQLite.InternalHandleException;
989
 
begin
990
 
{
991
 
  if _DO_EXCEPTIONS=1 then
992
 
        Application.HandleException(Self)
993
 
}
994
 
end;
995
 
 
996
 
procedure TSQLite.InternalInitRecord(Buffer: pChar);
997
 
begin
998
 
 
999
 
end;
1000
 
 
1001
 
procedure TSQLite.InternalLast;
1002
 
begin
1003
 
  fCurrentRecord:=fRecordCount;
1004
 
end;
1005
 
 
1006
 
procedure TSQLite.InternalPost;
1007
 
begin
1008
 
end;
1009
 
 
1010
 
procedure TSQLite.InternalSetToRecord(Buffer: pChar);
1011
 
 
1012
 
begin
1013
 
 
1014
 
end;
1015
 
 
1016
 
function TSQLite.isCursorOpen: Boolean;
1017
 
begin
1018
 
 
1019
 
end;
1020
 
 
1021
 
 
1022
 
procedure TSQLite.SetFieldData(Field: tField; Buffer: Pointer);
1023
 
// var aa : string;
1024
 
begin
1025
 
// Does NOthing ??
1026
 
// aa:=Field.NewValue;
1027
 
//  inherited;
1028
 
 
1029
 
end;
1030
 
 
1031
 
procedure TSQLite.SetBookmarkFlag(Buffer: pChar; value: tBookmarkFlag);
1032
 
begin
1033
 
//  inherited;
1034
 
 
1035
 
end;
1036
 
 
1037
 
function TSQLite.getFieldData(Field: tField; Buffer: Pointer): boolean;
1038
 
var i,k : integer;
1039
 
p : tSqliteField;
1040
 
r : tSqliteRows;
1041
 
pt : pointer;
1042
 
begin
1043
 
 
1044
 
result:=false;
1045
 
k:=fieldDefs.Count-1;
1046
 
self.fLstName.Count;
1047
 
r:=fBuffer[PRecInfo(ActiveBuffer)^.Index] as tSqliteRows;
1048
 
if r=nil then exit;
1049
 
for i:=0 to k do begin
1050
 
                if lowercase(fLstName[i])=lowercase(field.FieldName) then begin
1051
 
                        p:=r.items[i];
1052
 
                        if p = nil then break;
1053
 
                        p.GetData(Buffer,true);
1054
 
                        result:=true;
1055
 
                        break;
1056
 
                end;
1057
 
end;
1058
 
end;
1059
 
 
1060
 
{ tSqliteRows }
1061
 
 
1062
 
procedure tSqliteRows.Push(item: tSqliteField);
1063
 
begin
1064
 
if internalcount<fBuffercount then begin
1065
 
        fBuffer[internalCount]:=item;
1066
 
        inc(internalCount);
1067
 
end;
1068
 
end;
1069
 
 
1070
 
constructor tSqliteRows.Create(fieldCount: integer);
1071
 
begin
1072
 
 
1073
 
inherited create;
1074
 
 
1075
 
if fieldCount<=0 then
1076
 
        fieldCount:=1;
1077
 
 fbuffercount:=fieldcount+1;
1078
 
getmem(fBuffer,fbuffercount*sizeof(pointer));
1079
 
end;
1080
 
 
1081
 
destructor tSqliteRows.destroy;
1082
 
 
1083
 
 
1084
 
begin
1085
 
 
1086
 
  clearBuffer;
1087
 
  inherited;
1088
 
end;
1089
 
 
1090
 
function tSqliteRows.Pop: tSqliteField;
1091
 
begin
1092
 
result:=nil;
1093
 
if (internalCount>0) and (internalCount<fBuffercount) then begin
1094
 
        result:=fBuffer[internalCount];
1095
 
        Dec(internalCount);
1096
 
end;
1097
 
end;
1098
 
 
1099
 
function tSqliteRows.getItem(index: integer): tSqliteField;
1100
 
begin
1101
 
result:=nil;
1102
 
if checkIndex(index) then
1103
 
        result:=fBuffer[Index];
1104
 
end;
1105
 
 
1106
 
procedure tSqliteRows.SetItem(index: integer; const Value: tSqliteField);
1107
 
begin
1108
 
if checkIndex(index) then
1109
 
        fBuffer[index]:=Value;
1110
 
end;
1111
 
 
1112
 
function tSqliteRows.checkIndex(index : integer): boolean;
1113
 
begin
1114
 
result:=false;
1115
 
if (index>=0) and (index<internalCount) then
1116
 
        result:=true;
1117
 
end;
1118
 
 
1119
 
procedure tSqliteRows.clearBuffer;
1120
 
var i : integer;
1121
 
begin
1122
 
if internalcount>0 then begin
1123
 
for i:=0 to internalCount -1  do begin
1124
 
        if fBuffer[i]<>nil then begin
1125
 
                fBuffer[i].Free;
1126
 
                fBuffer[i]:=nil;
1127
 
        try
1128
 
        except
1129
 
                continue;
1130
 
        end;
1131
 
        end;
1132
 
end;
1133
 
fbuffercount:=0;
1134
 
FreeMem(fBuffer);
1135
 
end;
1136
 
 
1137
 
end;
1138
 
 
1139
 
procedure tSqliteRows.Clear;
1140
 
begin
1141
 
clearBuffer;
1142
 
internalCount:=0;
1143
 
end;
1144
 
 
1145
 
procedure tSqliteRows.ClearCalcFields;
1146
 
begin
1147
 
 
1148
 
end;
1149
 
 
1150
 
function tSqliteRows.Add(pt: pChar;ptName : pChar):boolean;
1151
 
var tmp : int64;
1152
 
begin
1153
 
Push(tSqliteField.Create(nil));
1154
 
tmp:=internalCount-1;
1155
 
items[tmp].FieldKind:=fkData;
1156
 
items[tmp].SetFieldType(ftString);
1157
 
items[tmp].SetData(pt,true);
1158
 
end;
1159
 
 
1160
 
 
1161
 
procedure tSqlite.countMaxiLength(pt: pChar; index : int64);
1162
 
begin
1163
 
if length(pt)>maxil[index] then
1164
 
        maxiL[index]:=length(pt);
1165
 
end;
1166
 
 
1167
 
{ tSqliteField }
1168
 
 
1169
 
constructor tSqliteField.create(aOwner: tObject);
1170
 
begin
1171
 
 
1172
 
inherited create;
1173
 
fOwner:=aOwner;
1174
 
end;
1175
 
 
1176
 
destructor tSqliteField.destroy;
1177
 
begin
1178
 
 
1179
 
  inherited;
1180
 
end;
1181
 
 
1182
 
function tSqliteField.GetData(Buffer: Pointer) : boolean;
1183
 
 
1184
 
begin
1185
 
  Result:=GetData(Buffer,True);
1186
 
end ;
1187
 
 
1188
 
function tSqliteField.GetData(Buffer: Pointer;
1189
 
  NativeFormat: Boolean): boolean;
1190
 
  var
1191
 
 l,tIntegerType : integer;
1192
 
 tDateTimeType : tDateTime;
1193
 
begin
1194
 
try
1195
 
result:=false;
1196
 
 
1197
 
if not nativeFormat then begin
1198
 
        Move(data,Buffer^,sizeOf(data));
1199
 
        result:=true;
1200
 
end else begin
1201
 
        case self.fieldType of
1202
 
        ftInteger : begin
1203
 
                        tIntegerType:=StrToInt(data);
1204
 
                        Move(tIntegerType,Buffer^,sizeOf(data));
1205
 
                end;
1206
 
        ftDateTime  : begin
1207
 
                        tDateTimeType:=StrToDate(data);
1208
 
                        Move(tDateTimeType,Buffer^,sizeOf(data));
1209
 
                end;
1210
 
        ftString : begin
1211
 
                  //      L:=length(data);
1212
 
                  //      Move(data,Buffer^,l);
1213
 
                      StrCopy (Buffer, pchar(data));
1214
 
                end;
1215
 
        else
1216
 
                        Move(data,Buffer^,sizeOf(data));
1217
 
        end;
1218
 
        result:=true;
1219
 
end;
1220
 
except
1221
 
        Buffer:=nil;
1222
 
end;
1223
 
end;
1224
 
 
1225
 
procedure tSqliteField.SetData(pt: pChar; NativeFormat: boolean);
1226
 
begin
1227
 
data:=pt;
1228
 
end;
1229
 
 
1230
 
procedure tSqliteField.SetFieldKind(const Value: tFieldKind);
1231
 
begin
1232
 
  fFieldKind := Value;
1233
 
end;
1234
 
 
1235
 
procedure tSqliteField.SetFieldType(const Value: tFieldType);
1236
 
begin
1237
 
  fFieldType := Value;
1238
 
end;
1239
 
{
1240
 
procedure tSqliteField.SetName(const Value: string);
1241
 
begin
1242
 
  fName := Value;
1243
 
end;
1244
 
 }
1245
 
function TSQLite.getCanModify: boolean;
1246
 
begin
1247
 
result:=false;
1248
 
exit;//temporary
1249
 
if length(fTableName)>0 then
1250
 
        result:=true;
1251
 
end;
1252
 
 
1253
 
procedure TSQLite.InitMaxLength(length: integer);
1254
 
begin
1255
 
if not maxLengthInit and (length>0) then begin
1256
 
        maxLengthInit:=true;
1257
 
        maxilcount:=length;
1258
 
        getmem(maxiL,maxilcount*sizeof(integer));
1259
 
end;
1260
 
end;
1261
 
 
1262
 
procedure TSQLite.clearBuffer;
1263
 
 
1264
 
begin
1265
 
if assigned(fBuffer) then begin
1266
 
        if fBuffer.count>0 then begin
1267
 
                fBuffer.pack;
1268
 
                fBuffer.clear;
1269
 
        end;
1270
 
end;
1271
 
if assigned(fLstVal) then begin
1272
 
        fLstVal.Clear;
1273
 
end;
1274
 
if assigned(fLstName) then begin
1275
 
        fLstName.Clear;
1276
 
end;
1277
 
end;
1278
 
 
1279
 
{
1280
 
procedure TSQLite.internalInsert;
1281
 
begin
1282
 
  inherited;
1283
 
 if not getCanModify then exit;
1284
 
end;
1285
 
}
1286
 
 
1287
 
procedure Register;
1288
 
begin
1289
 
  RegisterComponents('MK', [tSqlite]);
1290
 
end;
1291
 
 
1292
 
initialization
1293
 
{$ifdef dynload}
1294
 
  LibsLoaded := LoadLibs;
1295
 
{$endif}
1296
 
{$ifdef fpc}
1297
 
  MsgNoError := SystemErrorMsg(0);
1298
 
{$else}
1299
 
  MsgNoError := 'The operation completed successfully';
1300
 
{$endif}
1301
 
 
1302
 
finalization
1303
 
{$ifdef dynload}
1304
 
  if DLLHandle <> 0 then
1305
 
    FreeLibrary(DLLHandle);
1306
 
{$endif}
1307
 
 
1308
 
 
1309
 
 
1310
 
end.
1311