sqlite.pas

delphi sqlite示例,对于学习sqlite的新手很有帮助

unit SQLite;
{
simple class interface for SQLite. Hacked in by Ben Hochstrasser ([e-mail])
Thanks to Roger Reghin ([e-mail]) for his idea to ValueList. 

use it like this:

procedure TForm1.OnSQLBusy(Sender: TObject; ObjectName: String; BusyCount: integer; var Cancel: Boolean);
procedure TForm1.OnSQLData(Sender: TObject; Columns: Integer; ColumnNames, ColumnValues: String);
procedure TForm1.OnSQLComplete(Sender: TObject);

procedure TForm1.Button1Click(Sender: TObject);
var
  MySQL: TSQLite;
  SQL: String;
begin
  MySQL := TSQLite.Create('test.db');
  MySQL.OnData := OnSQLData;
  MySQL.BusyTimeout := 1000;
  MySQL.OnBusy := OnSQLBusy;
  MySQL.OnQueryComplete := OnSQLComplete;
  SQL := 'CREATE TABLE Test(Name varchar(32), Vorname varchar(32));';
  MySQL.Query(sql, nil);
  SQL := 'INSERT INTO Test VALUES(''Hochstrasser'', ''Benedikt'');';
  if MySQL.IsComplete(sql) then
    MySQL.Query(sql, nil);
  SQL := 'SELECT * FROM Test;';
  MySQL.Query(sql, ListBox1.Items);
  MySQL.DatabaseDetails(Memo1.Lines);
  SQL := 'DROP TABLE Test;';
  MySQL.Query(sql, nil);
  MySQL.Free;
end;

You may also add this to your form if you would like to see the results in a ListView

Procedure TStringsToListView(LstIn: TStrings; LstOut: TListView);
var
  n: integer;
  lTmp: TStringList;
begin
  lTmp := TStringList.Create;
  lTmp.CommaText := LstIn.Strings[0];
  LstOut.Items.Clear;
  LstOut.Columns.Clear;
  for n := 0 to lTmp.Count - 1 do
    with LstOut.Columns.Add do
    begin
      Caption := lTmp.Strings[n];
      AutoSize := True;
      Width := -1;
    end;
  for n := 1 to LstIn.Count - 1 do
  begin
    lTmp.CommaText := LstIn.Strings[n];
    with LstOut.Items.Add do
    begin
      Caption := lTmp.Strings[0];
      lTmp.Delete(0);
      SubItems.Text := lTmp.Text;
    end;
  end;
  lTmp.Free;
end;

There is a similar function for a StringGrid:

Procedure TStringsToStringGrid(LstIn: TStrings; LstOut: TStringGrid);
var
  n: integer;
  i: integer;
  lTmp: TStringList;
begin
  if (LstIn <> nil) and (LstOut <> nil) then
  begin
    lTmp := TStringList.Create;
    lTmp.CommaText := LstIn.Strings[0];
    lstOut.ColCount := Ltmp.Count;
    lstout.RowCount := 1;
    lstout.FixedCols := 1;
    lstout.Rows[0] := ltmp;
    i := 1;
    for n := 1 to LstIn.Count - 1 do
    begin
      inc(i);
      lTmp.CommaText := LstIn.Strings[n];
      lstOut.RowCount := i;
      lstOut.Rows[i-1] := ltmp;
    end;
    lstOut.FixedRows := 1;
    lTmp.Free;
  end;
end;

Three utility functions have been added: Pas2SQLStr, SQL2PasStr, ValueList.

  Pas2SQLStr will convert a Pascal-Style String to an SQL-Style String
    Pas2SQLStr('my mother'''s car') -> "my mother''s car"
  SQL2PasStr will convert an SQL-Style string to a Pascal-Style String
    SQL2PasStr('"my mother''s car") -> 'my mother's car'
  ValueList will Convert ColumnNames, ColumnValues Strings to a Name-Value Pair StringList
    ValueList('ID,Name','1001,FooBar') > ID=1001,Name=Foobar

}

interface

uses Windows, Classes;

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;
    procedure SetBusyTimeout(Timeout: integer);
  public
    constructor Create(DBFileName: String);
    destructor Destroy; override;
    function Query(Sql: String; Table: TStrings = nil): 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;
  end;
  function Pas2SQLStr(const PasString: string): string;
  function SQL2PasStr(const SQLString: string): string;
  function QuoteStr(const s: string; QuoteChar: Char = #39): string;
  function UnQuoteStr(const s: string; QuoteChar: Char = #39): string;
  procedure ValueList(const ColumnNames, ColumnValues: String; NameValuePairs: TStrings);

implementation

const
  SQLITE_OK         =  0;   // Successful result
  SQLITE_ERROR      =  1;   // SQL error or missing database
  SQLITE_INTERNAL   =  2;   // An internal logic error in SQLite
  SQLITE_PERM       =  3;   // Access permission denied
  SQLITE_ABORT      =  4;   // Callback routine requested an abort
  SQLITE_BUSY       =  5;   // The database file is locked
  SQLITE_LOCKED     =  6;   // A table in the database is locked
  SQLITE_NOMEM      =  7;   // A malloc() failed
  SQLITE_READONLY   =  8;   // Attempt to write a readonly database
  SQLITE_INTERRUPT  =  9;   // Operation terminated by sqlite_interrupt()
  SQLITE_IOERR      = 10;   // Some kind of disk I/O error occurred
  SQLITE_CORRUPT    = 11;   // The database disk image is malformed
  SQLITE_NOTFOUND   = 12;   // (Internal Only) Table or record not found
  SQLITE_FULL       = 13;   // Insertion failed because database is full
  SQLITE_CANTOPEN   = 14;   // Unable to open the database file
  SQLITE_PROTOCOL   = 15;   // Database lock protocol error
  SQLITE_EMPTY      = 16;   // (Internal Only) Database table is empty
  SQLITE_SCHEMA     = 17;   // The database schema changed
  SQLITE_TOOBIG     = 18;   // Too much data for one row of a table
  SQLITE_CONSTRAINT = 19;   // Abort due to contraint violation
  SQLITE_MISMATCH   = 20;   // Data type mismatch
  SQLITEDLL: PChar  = 'sqlite.dll';
  DblQuote: Char    = '"';
  SngQuote: Char    = #39;
  Crlf: String      = #13#10;
  Tab: Char         = #9;

var
  SQLite_Open: function(dbname: PChar; mode: Integer; var ErrMsg: PChar): Pointer; cdecl;
  SQLite_Close: procedure(db: Pointer); cdecl;
  SQLite_Exec: function(db: Pointer; SQLStatement: PChar; CallbackPtr: Pointer; Sender: TObject; var ErrMsg: PChar): integer; cdecl;
  SQLite_Version: function(): PChar; cdecl;
  SQLite_Encoding: function(): PChar; cdecl;
  SQLite_ErrorString: function(ErrNo: Integer): PChar; cdecl;
  SQLite_GetTable: function(db: Pointer; SQLStatement: PChar; var ResultPtr: Pointer; var RowCount: Cardinal; var ColCount: Cardinal; var ErrMsg: PChar): integer; cdecl;
  SQLite_FreeTable: procedure(Table: PChar); cdecl;
  SQLite_FreeMem: procedure(P: PChar); cdecl;
  SQLite_Complete: function(P: PChar): boolean; cdecl;
  SQLite_LastInsertRow: function(db: Pointer): integer; cdecl;
  SQLite_Cancel: procedure(db: Pointer); cdecl;
  SQLite_BusyHandler: procedure(db: Pointer; CallbackPtr: Pointer; Sender: TObject); cdecl;
  SQLite_BusyTimeout: procedure(db: Pointer; TimeOut: integer); cdecl;
  SQLite_Changes: function(db: Pointer): integer; cdecl;
  LibsLoaded: Boolean;
  DLLHandle: THandle;
  MsgNoError: String;

function QuoteStr(const s: string; QuoteChar: Char = #39): string;
begin
  Result := Concat(QuoteChar, s, QuoteChar);
end;

function UnQuoteStr(const s: string; QuoteChar: Char = #39): 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);
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);
end;

procedure ValueList(const ColumnNames, ColumnValues: String; NameValuePairs: TStrings);
var
  n: integer;
  lstName, lstValue: TStringList;
begin
  if NameValuePairs <> nil then