On Wed, Aug 06, 2003 at 07:18:33PM +0200, Jilani Khaldi wrote:
> Hi All,
> could someone point me where to find the sqlite.pas for FP to use with
> Linux Linux?
Excellent someone else that wishes to use sqlite with FPC :)
I'll attach all relevant sources... However a TDataset class still needs
to be written (although not 100% necessary). I can't write it though, no
knowledge of Datasets...
cheers
James
> Any hint or examples is welcome.
> jilani
>
> _______________________________________________
> fpc-pascal maillist - [EMAIL PROTECTED]
> http://lists.freepascal.org/mailman/listinfo/fpc-pascal
--
-
-Zero Defect Software Engineers Group - ZDSEG
-
-You need only two tools. WD-40 and duct tape.
-If it doesn't move and it should, use WD-40.
-If it moves and shouldn't, use the tape.
{$mode objfpc}
unit sqlite;
interface
{
Automatically converted by H2Pas 0.99.15 from sqlite.h
The following command line parameters were used:
-S
-D
-p
-l
sqlite
sqlite.h
}
const
External_library='sqlite'; {Setup as you need}
{ Pointers to basic pascal types, inserted by h2pas conversion program.}
Type
PLongint = ^Longint;
PSmallInt = ^SmallInt;
PByte = ^Byte;
PWord = ^Word;
PDWord = ^DWord;
PDouble = ^Double;
PPPchar = ^ppchar;
{$PACKRECORDS C}
const
_SQLITE_VERSION = '2.8.3';
SQLITE_ISO8859 = 1;
{$ifndef win32}
var
sqlite_version : pchar;cvar;external;
sqlite_encoding : pchar;cvar;external;
{$endif}
const
SQLITE_OK = 0;
SQLITE_ERROR = 1;
SQLITE_INTERNAL = 2;
SQLITE_PERM = 3;
SQLITE_ABORT = 4;
SQLITE_BUSY = 5;
SQLITE_LOCKED = 6;
SQLITE_NOMEM = 7;
SQLITE_READONLY = 8;
SQLITE_INTERRUPT = 9;
SQLITE_IOERR = 10;
SQLITE_CORRUPT = 11;
SQLITE_NOTFOUND = 12;
SQLITE_FULL = 13;
SQLITE_CANTOPEN = 14;
SQLITE_PROTOCOL = 15;
SQLITE_EMPTY = 16;
SQLITE_SCHEMA = 17;
SQLITE_TOOBIG = 18;
SQLITE_CONSTRAINT = 19;
SQLITE_MISMATCH = 20;
SQLITE_MISUSE = 21;
SQLITE_NOLFS = 22;
SQLITE_AUTH = 23;
SQLITE_FORMAT = 24;
SQLITE_ROW = 100;
SQLITE_DONE = 101;
SQLITE_COPY = 0;
SQLITE_CREATE_INDEX = 1;
SQLITE_CREATE_TABLE = 2;
SQLITE_CREATE_TEMP_INDEX = 3;
SQLITE_CREATE_TEMP_TABLE = 4;
SQLITE_CREATE_TEMP_TRIGGER = 5;
SQLITE_CREATE_TEMP_VIEW = 6;
SQLITE_CREATE_TRIGGER = 7;
SQLITE_CREATE_VIEW = 8;
SQLITE_DELETE = 9;
SQLITE_DROP_INDEX = 10;
SQLITE_DROP_TABLE = 11;
SQLITE_DROP_TEMP_INDEX = 12;
SQLITE_DROP_TEMP_TABLE = 13;
SQLITE_DROP_TEMP_TRIGGER = 14;
SQLITE_DROP_TEMP_VIEW = 15;
SQLITE_DROP_TRIGGER = 16;
SQLITE_DROP_VIEW = 17;
SQLITE_INSERT = 18;
SQLITE_PRAGMA = 19;
SQLITE_READ = 20;
SQLITE_SELECT = 21;
SQLITE_TRANSACTION = 22;
SQLITE_UPDATE = 23;
SQLITE_DENY = 1;
SQLITE_IGNORE = 2;
SQLITE_NUMERIC = -1;
SQLITE_TEXT = -2;
SQLITE_ARGS = -3;
Type
Psqlite = Pointer;
Psqlite_vm = Pointer;
PPsqlite_vm = ^Psqlite_vm;
Psqlite_func = Pointer;
// Procedural types used in functions.
sqlite_callback = function (_para1:pointer; _para2:longint; _para3:PPchar; _para4:PPchar):longint;{$ifdef win32}cdecl{$else}cdecl{$endif};
sqlite_trace_func = procedure (_para1:pointer; _para2:Pchar);{$ifdef win32}cdecl{$else}cdecl{$endif};
sqlite_create_func = procedure (_para1:Psqlite_func; _para2:longint; _para3:PPchar);{$ifdef win32}cdecl{$else}cdecl{$endif};
sqlite_handler = function (_para1:pointer; _para2:Pchar; _para3:longint):longint;{$ifdef win32}cdecl{$else}cdecl{$endif};
sqlite_step_func = procedure (_para1:Psqlite_func; _para2:longint; _para3:PPchar) ;{$ifdef win32}cdecl{$else}cdecl{$endif};
sqlite_finalize_func = procedure (_para1:Psqlite_func);{$ifdef win32}cdecl{$else}cdecl{$endif};
sqlite_authorize_func = function (_para1:pointer; _para2:longint; _para3, _para4,_para5,_para6:Pchar):longint;{$ifdef win32}cdecl{$else}cdecl{$endif};
function sqlite_create_function(_para1:Psqlite; zName:Pchar; nArg:longint; xFunc:sqlite_create_func; pUserData:pointer):longint;{$ifdef win32}cdecl{$else}cdecl{$endif};external External_library name 'sqlite_create_function';
function sqlite_open(filename:Pchar; mode:longint; errmsg:PPchar):Psqlite;{$ifdef win32}cdecl{$else}cdecl{$endif};external External_library name 'sqlite_open';
procedure sqlite_close(_para1:Psqlite);{$ifdef win32}cdecl{$else}cdecl{$endif};external External_library name 'sqlite_close';
function sqlite_exec(_para1:Psqlite; sql:Pchar; _para3:sqlite_callback; _para4:pointer; errmsg:PPchar):longint;{$ifdef win32}cdecl{$else}cdecl{$endif};external External_library name 'sqlite_exec';
function sqlite_last_insert_rowid(_para1:Psqlite):longint;{$ifdef win32}cdecl{$else}cdecl{$endif};external External_library name 'sqlite_last_insert_rowid';
function sqlite_changes(_para1:Psqlite):longint;{$ifdef win32}cdecl{$else}cdecl{$endif};external External_library name 'sqlite_changes';
function sqlite_error_string(_para1:longint):Pchar;{$ifdef win32}cdecl{$else}cdecl{$endif};external External_library name 'sqlite_error_string';
procedure do_sqlite_interrupt(_para1:Psqlite);{$ifdef win32}cdecl{$else}cdecl{$endif};external External_library name 'sqlite_interrupt';
function sqlite_complete(sql:Pchar):longint;{$ifdef win32}cdecl{$else}cdecl{$endif};external External_library name 'sqlite_complete';
procedure sqlite_busy_handler(_para1:Psqlite; _para2:sqlite_handler; _para3:pointer);{$ifdef win32}cdecl{$else}cdecl{$endif};external External_library name 'sqlite_busy_handler';
procedure sqlite_busy_timeout(_para1:Psqlite; ms:longint);{$ifdef win32}cdecl{$else}cdecl{$endif};external External_library name 'sqlite_busy_timeout';
function sqlite_get_table(_para1:Psqlite; sql:Pchar; resultp:PPPchar; nrow:Plongint; ncolumn:Plongint;
errmsg:PPchar):longint;{$ifdef win32}cdecl{$else}cdecl{$endif};external External_library name 'sqlite_get_table';
procedure sqlite_free_table(result:PPchar);{$ifdef win32}cdecl{$else}cdecl{$endif};external External_library name 'sqlite_free_table';
function sqlite_exec_printf(_para1:Psqlite; sqlFormat:Pchar; _para3:sqlite_callback; _para4:pointer; errmsg:PPchar;
args:array of const):longint;{$ifdef win32}cdecl{$else}cdecl{$endif};external External_library name 'sqlite_exec_printf';
function sqlite_exec_printf(_para1:Psqlite; sqlFormat:Pchar; _para3:sqlite_callback; _para4:pointer; errmsg:PPchar):longint;{$ifdef win32}cdecl{$else}cdecl{$endif};external External_library name 'sqlite_exec_printf';
function sqlite_exec_vprintf(_para1:Psqlite; sqlFormat:Pchar; _para3:sqlite_callback; _para4:pointer; errmsg:PPchar;
ap:array of const):longint;{$ifdef win32}cdecl{$else}cdecl{$endif};external External_library name 'sqlite_exec_vprintf';
function sqlite_get_table_printf(_para1:Psqlite; sqlFormat:Pchar; resultp:PPPchar; nrow:Plongint; ncolumn:Plongint;
errmsg:PPchar; args:array of const):longint;{$ifdef win32}cdecl{$else}cdecl{$endif};external External_library name 'sqlite_get_table_printf';
function sqlite_get_table_printf(_para1:Psqlite; sqlFormat:Pchar; resultp:PPPchar; nrow:Plongint; ncolumn:Plongint;
errmsg:PPchar):longint;{$ifdef win32}cdecl{$else}cdecl{$endif};external External_library name 'sqlite_get_table_printf';
function sqlite_get_table_vprintf(_para1:Psqlite; sqlFormat:Pchar; resultp:PPPchar; nrow:Plongint; ncolumn:Plongint;
errmsg:PPchar; ap:array of const):longint;{$ifdef win32}cdecl{$else}cdecl{$endif};external External_library name 'sqlite_get_table_vprintf';
function sqlite_mprintf(_para1:Pchar; args:array of const):Pchar;{$ifdef win32}cdecl{$else}cdecl{$endif};external External_library name 'sqlite_mprintf';
function sqlite_mprintf(_para1:Pchar):Pchar;{$ifdef win32}cdecl{$else}cdecl{$endif};external External_library name 'sqlite_mprintf';
procedure sqlite_freemem(p:pointer);{$ifdef win32}cdecl{$else}cdecl{$endif};external External_library name 'sqlite_freemem';
function sqlite_libversion:Pchar;{$ifdef win32}cdecl{$else}cdecl{$endif};external External_library name 'sqlite_libversion';
function sqlite_libencoding:Pchar;{$ifdef win32}cdecl{$else}cdecl{$endif};external External_library name 'sqlite_libencoding';
function sqlite_create_aggregate(_para1:Psqlite; zName:Pchar; nArg:longint; xStep:sqlite_step_func ; xFinalize:sqlite_finalize_func;
pUserData:pointer):longint;{$ifdef win32}cdecl{$else}cdecl{$endif};external External_library name 'sqlite_create_aggregate';
function sqlite_function_type(db:Psqlite; zName:Pchar; datatype:longint):longint;{$ifdef win32}cdecl{$else}cdecl{$endif};external External_library name 'sqlite_function_type';
function sqlite_set_result_string(_para1:Psqlite_func; _para2:Pchar; _para3:longint):Pchar;{$ifdef win32}cdecl{$else}cdecl{$endif};external External_library name 'sqlite_set_result_string';
procedure sqlite_set_result_int(_para1:Psqlite_func; _para2:longint);{$ifdef win32}cdecl{$else}cdecl{$endif};external External_library name 'sqlite_set_result_int';
procedure sqlite_set_result_double(_para1:Psqlite_func; _para2:double);{$ifdef win32}cdecl{$else}cdecl{$endif};external External_library name 'sqlite_set_result_double';
procedure sqlite_set_result_error(_para1:Psqlite_func; _para2:Pchar; _para3:longint);{$ifdef win32}cdecl{$else}cdecl{$endif};external External_library name 'sqlite_set_result_error';
function sqlite_user_data(_para1:Psqlite_func):pointer;{$ifdef win32}cdecl{$else}cdecl{$endif};external External_library name 'sqlite_user_data';
function sqlite_aggregate_context(_para1:Psqlite_func; nBytes:longint):pointer;{$ifdef win32}cdecl{$else}cdecl{$endif};external External_library name 'sqlite_aggregate_context';
function sqlite_aggregate_count(_para1:Psqlite_func):longint;{$ifdef win32}cdecl{$else}cdecl{$endif};external External_library name 'sqlite_aggregate_count';
function sqlite_set_authorizer(_para1:Psqlite; xAuth:sqlite_authorize_func ; pUserData:pointer):longint;{$ifdef win32}cdecl{$else}cdecl{$endif};external External_library name 'sqlite_set_authorizer';
function sqlite_trace(_para1:Psqlite; xTrace:sqlite_trace_func; _para3:pointer):pointer;{$ifdef win32}cdecl{$else}cdecl{$endif};external External_library name 'sqlite_trace';
function sqlite_compile(db:Psqlite; zSql:Pchar; pzTail:PPchar; ppVm:PPsqlite_vm; pzErrmsg:PPchar):longint;{$ifdef win32}cdecl{$else}cdecl{$endif};external External_library name 'sqlite_compile';
function sqlite_step(pVm:Psqlite_vm; pN:Plongint; pazValue:PPPchar; pazColName:PPPchar):longint;{$ifdef win32}cdecl{$else}cdecl{$endif};external External_library name 'sqlite_step';
function sqlite_finalize(_para1:Psqlite_vm; pzErrMsg:PPchar):longint;{$ifdef win32}cdecl{$else}cdecl{$endif};external External_library name 'sqlite_finalize';
implementation
end.
{$mode objfpc}
{$h+}
unit SQLitedb;
interface
uses Classes,strings,sqlite;
type
TSQLiteExecCallback = function(Sender: TObject; Columns: Integer; ColumnValues: Pointer; ColumnNames: Pointer): integer of object; cdecl;
TSQLiteBusyCallback = function(Sender: TObject; ObjectName: PChar; BusyCount: integer): integer of object; cdecl;
TOnData = Procedure(Sender: TObject; Columns: Integer; ColumnNames, ColumnValues: String) of object;
TOnBusy = Procedure(Sender: TObject; ObjectName: String; BusyCount: integer; var Cancel: Boolean) of object;
TOnQueryComplete = Procedure(Sender: TObject) of object;
TSQLite = class(TObject)
private
fSQLite: Pointer;
fMsg: String;
fIsOpen: Boolean;
fBusy: Boolean;
fError: Integer;
fVersion: String;
fEncoding: String;
fTable: TStrings;
fLstName: TStringList;
fLstVal: TStringList;
fOnData: TOnData;
fOnBusy: TOnBusy;
fOnQueryComplete: TOnQueryComplete;
fBusyTimeout: integer;
fPMsg: PChar;
fChangeCount: integer;
fNb_Champ : Integer;
fList_FieldName : TStringList;
fList_Field : TList;
procedure SetBusyTimeout(Timeout: integer);
public
constructor Create(DBFileName: String);
destructor Destroy; override;
function Query(Sql: String; Table: TStrings ): boolean;
function ErrorMessage(ErrNo: Integer): string;
function IsComplete(Sql: String): boolean;
function LastInsertRow: integer;
function Cancel: boolean;
function DatabaseDetails(Table: TStrings): boolean;
property LastErrorMessage: string read fMsg;
property LastError: Integer read fError;
property Version: String read fVersion;
property Encoding: String read fEncoding;
property OnData: TOnData read fOnData write fOnData;
property OnBusy: TOnBusy read fOnBusy write fOnBusy;
property OnQueryComplete: TOnQueryComplete read fOnQueryComplete write fOnQueryComplete;
property BusyTimeout: Integer read fBusyTimeout write SetBusyTimeout;
property ChangeCount: Integer read fChangeCount;
property List_FieldName: TStringList read fList_FieldName write fList_FieldName;
property List_Field: TList read fList_Field write fList_Field;
property Nb_Champ: integer read fNb_Champ write fNb_Champ;
procedure SQLOnData(Sender: TObject; Columns: Integer; ColumnNames, ColumnValues: String);
end;
(*
function Pas2SQLStr(const PasString: string): string;
function SQL2PasStr(const SQLString: string): string;
function QuoteStr(const s: string; QuoteChar: Char ): string;
function UnQuoteStr(const s: string; QuoteChar: Char ): string;
*)
procedure ValueList(const ColumnNames, ColumnValues: String; NameValuePairs: TStrings);
implementation
(*
Const
DblQuote: Char = '"';
SngQuote: Char = #39;
Crlf: String = #13#10;
Tab: Char = #9;
*)
var
MsgNoError: String;
(*
function QuoteStr(const s: string; QuoteChar: Char ): string;
begin
Result := Concat(QuoteChar, s, QuoteChar);
end;
function UnQuoteStr(const s: string; QuoteChar: Char ): string;
begin
Result := s;
if length(Result) > 1 then
begin
if Result[1] = QuoteChar then
Delete(Result, 1, 1);
if Result[Length(Result)] = QuoteChar then
Delete(Result, Length(Result), 1);
end;
end;
function Pas2SQLStr(const PasString: string): string;
var
n: integer;
begin
Result := SQL2PasStr(PasString);
n := Length(Result);
while n > 0 do
begin
if Result[n] = SngQuote then
Insert(SngQuote, Result, n);
dec(n);
end;
Result := QuoteStr(Result,#39);
end;
function SQL2PasStr(const SQLString: string): string;
const
DblSngQuote: String = #39#39;
var
p: integer;
begin
Result := SQLString;
p := pos(DblSngQuote, Result);
while p > 0 do
begin
Delete(Result, p, 1);
p := pos(DblSngQuote, Result);
end;
Result := UnQuoteStr(Result,#39);
end;
*)
procedure ValueList(const ColumnNames, ColumnValues: String; NameValuePairs: TStrings);
var
n: integer;
lstName, lstValue: TStringList;
begin
if NameValuePairs <> nil then
begin
lstName := TStringList.Create;
lstValue := TStringList.Create;
lstName.CommaText := ColumnNames;
lstValue.CommaText := ColumnValues;
NameValuePairs.Clear;
if lstName.Count = LstValue.Count then
if lstName.Count > 0 then
for n := 0 to lstName.Count - 1 do
NameValuePairs.Append(Concat(lstName.Strings[n], '=', lstValue.Strings[n]));
lstValue.Free;
lstName.Free;
end;
end;
function BusyCallback(Sender: pointer; ObjectName: PChar; BusyCount: integer): integer; cdecl;
var
sObjName: String;
bCancel: Boolean;
begin
Result := -1;
with TObject(Sender) as TSQLite do
begin
if Assigned(fOnBusy) then
begin
bCancel := False;
sObjName := ObjectName;
fOnBusy(Tobject(Sender), sObjName, BusyCount, bCancel);
if bCancel then
Result := 0;
end;
end;
end;
function ExecCallback(Sender: TObject; Columns: Integer; ColumnValues: Pointer; ColumnNames: Pointer): integer; cdecl;
var
PVal, PName: ^PChar;
n: integer;
sVal, sName: String;
begin
Result := 0;
with Sender as TSQLite do
begin
if (Assigned(fOnData) or Assigned(fTable)) then
begin
fLstName.Clear;
fLstVal.Clear;
if Columns > 0 then
begin
PName := ColumnNames;
PVal := ColumnValues;
for n := 0 to Columns - 1 do
begin
fLstName.Append(PName^);
fLstVal.Append(PVal^);
inc(PName);
inc(PVal);
end;
end;
sVal := fLstVal.CommaText;
sName := fLstName.CommaText;
if Assigned(fOnData) then
fOnData(Sender, Columns, sName, sVal);
if Assigned(fTable) then
begin
if fTable.Count = 0 then
fTable.Append(sName);
fTable.Append(sVal);
end;
end;
end;
end;
procedure TSQLite.SQLOnData(Sender: TObject; Columns: Integer; ColumnNames, ColumnValues: String);
Var i : Integer;
InterS,val : String;
Field : TStringList;
function Pos1(a: String ; s : char) : integer;
var i,j : Integer;
begin
j:=-1;
for i:=1 to length(a) Do
begin
if a[i] = s then
begin
j:=i;
break;
end;
end;
result:=j;
end;
begin
If Nb_Champ = -1 Then
Begin // Put the fields name in List_FieldName
Nb_Champ:=Columns;
InterS:=ColumnNames;
While (Pos1(InterS,',') > 0) do
begin
val:=copy(InterS,1,Pos1(InterS,',')-1);
InterS:=copy(InterS,Pos1(InterS,',')+1,length(InterS));
List_FieldName.add(val);
end;
if length(InterS) > 0 then List_FieldName.add(InterS);
end;
// Put the list of TStringList of value
Field :=TStringList.Create;
InterS:=ColumnValues;
While (Pos1(InterS,',') > 0) do
begin
val:=copy(InterS,1,Pos1(InterS,',')-1);
InterS:=copy(InterS,Pos1(InterS,',')+1,length(InterS));
Field.add(val);
end;
if length(InterS) > 0 then Field.add(InterS);
List_Field.add(Field);
end;
constructor TSQLite.Create(DBFileName: String);
var
fPMsg1: PChar;
name : pchar;
begin
inherited Create;
List_FieldName := TStringList.Create;
List_Field := TList.Create;
fError := SQLITE_ERROR;
fIsOpen := False;
fLstName := TStringList.Create;
fLstVal := TStringList.Create;
fOnData := nil;
fOnBusy := nil;
fOnQueryComplete := nil;
fChangeCount := 0;
name:=StrAlloc (length(DBFileName)+1);
strpcopy(name,DBFileName);
OnData:[EMAIL PROTECTED];
fSQLite := SQLite_Open(name, 1, @fPMsg);
SQLite_FreeMem(fPMsg);
if fSQLite <> nil then
begin
//fVersion := String(SQLite_Version);
//fEncoding := SQLite_Encoding;
fIsOpen := True;
fError := SQLITE_OK;
end;
fMsg := ErrorMessage(fError);
end;
destructor TSQLite.Destroy;
begin
if fIsOpen then
SQLite_Close(fSQLite);
fIsOpen := False;
fLstName.Free;
fLstVal.Free;
fSQLite := nil;
fOnData := nil;
fOnBusy := nil;
fOnQueryComplete := nil;
fLstName := nil;
fLstVal := nil;
List_FieldName.destroy;
List_Field.destroy;
inherited Destroy;
end;
function TSQLite.Query(Sql: String; Table: TStrings ): boolean;
//var
// fPMsg: PChar;
var Psql : pchar;
begin
fError := SQLITE_ERROR;
if fIsOpen then
begin
fPMsg := nil;
fBusy := True;
fTable := Table;
if fTable <> nil then
fTable.Clear;
Psql:=StrAlloc (length(Sql)+1);
strpcopy(Psql,Sql);
List_FieldName.clear;
List_Field.clear;
Nb_Champ:=-1;
fError := SQLite_Exec(fSQLite, Psql, @ExecCallback, Self, @fPMsg);
strdispose(Psql);
SQLite_FreeMem(fPMsg);
fChangeCount := SQLite_Changes(fSQLite);
fTable := nil;
fBusy := False;
if Assigned(fOnQueryComplete) then
fOnQueryComplete(Self);
end;
fMsg := ErrorMessage(fError);
Result := (fError <> SQLITE_OK);
end;
function TSQLite.Cancel: boolean;
begin
Result := False;
if fBusy and fIsOpen then
begin
do_SQLite_interrupt(fSQLite);
fBusy := false;
Result := True;
end;
end;
procedure TSQLite.SetBusyTimeout(Timeout: Integer);
begin
fBusyTimeout := Timeout;
if fIsOpen then
begin
SQLite_Busy_Timeout(fSQLite, fBusyTimeout);
if fBusyTimeout > 0 then
SQLite_Busy_Handler(fSQLite, @BusyCallback, Self)
else
SQLite_Busy_Handler(fSQLite, nil, nil);
end;
end;
function TSQLite.LastInsertRow: integer;
begin
if fIsOpen then
Result := SQLite_Last_Insert_RowID(fSQLite)
else
Result := -1;
end;
function TSQLite.ErrorMessage(ErrNo: Integer): string;
begin
exit;
if ErrNo = 0 then
Result := MsgNoError
else
Result := SQLite_Error_String(ErrNo);
end;
function TSQLite.IsComplete(Sql: String): boolean;
var Psql : pchar;
begin
Psql:=StrAlloc (length(Sql)+1);
strpcopy(Psql,Sql);
Writeln('Testing: ',psql);
Result := SQLite_Complete(Psql)<>0;
strdispose(Psql);
end;
function TSQLite.DatabaseDetails(Table: TStrings): boolean;
begin
Result := Query('SELECT * FROM SQLITE_MASTER;', Table);
end;
initialization
finalization
end.
