sqlite.pas

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

  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 LoadLibs: Boolean;
begin
  Result := False;
  DLLHandle := LoadLibrary(SQLITEDLL);
  if DLLHandle <> 0 then
  begin
    @SQLite_Open := GetProcAddress(DLLHandle, 'sqlite_open');
    if not Assigned(@SQLite_Open) then exit;
    @SQLite_Close := GetProcAddress(DLLHandle, 'sqlite_close');
    if not Assigned(@SQLite_Close) then exit;
    @SQLite_Exec := GetProcAddress(DLLHandle, 'sqlite_exec');
    if not Assigned(@SQLite_Exec) then exit;
    @SQLite_Version := GetProcAddress(DLLHandle, 'sqlite_libversion');
    if not Assigned(@SQLite_Version) then exit;
    @SQLite_Encoding := GetProcAddress(DLLHandle, 'sqlite_libencoding');
    if not Assigned(@SQLite_Encoding) then exit;
    @SQLite_ErrorString := GetProcAddress(DLLHandle, 'sqlite_error_string');
    if not Assigned(@SQLite_ErrorString) then exit;
    @SQLite_GetTable := GetProcAddress(DLLHandle, 'sqlite_get_table');
    if not Assigned(@SQLite_GetTable) then exit;
    @SQLite_FreeTable := GetProcAddress(DLLHandle, 'sqlite_free_table');
    if not Assigned(@SQLite_FreeTable) then exit;
    @SQLite_FreeMem := GetProcAddress(DLLHandle, 'sqlite_freemem');
    if not Assigned(@SQLite_FreeMem) then exit;
    @SQLite_Complete := GetProcAddress(DLLHandle, 'sqlite_complete');
    if not Assigned(@SQLite_Complete) then exit;
    @SQLite_LastInsertRow := GetProcAddress(DLLHandle, 'sqlite_last_insert_rowid');
    if not Assigned(@SQLite_LastInsertRow) then exit;
    @SQLite_Cancel := GetProcAddress(DLLHandle, 'sqlite_interrupt');
    if not Assigned(@SQLite_Cancel) then exit;
    @SQLite_BusyTimeout := GetProcAddress(DLLHandle, 'sqlite_busy_timeout');
    if not Assigned(@SQLite_BusyTimeout) then exit;
    @SQLite_BusyHandler := GetProcAddress(DLLHandle, 'sqlite_busy_handler');
    if not Assigned(@SQLite_BusyHandler) then exit;
    @SQLite_Changes := GetProcAddress(DLLHandle, 'sqlite_changes');
    if not Assigned(@SQLite_Changes) then exit;
    Result := True;
  end;
end;

function SystemErrorMsg(ErrNo: Integer = -1): String;
var
  buf: PChar;
  size: Integer;
  MsgLen: Integer;
begin
  size := 256;
  GetMem(buf, size);
  If ErrNo = - 1 then
    ErrNo := GetLastError;
  MsgLen := FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, nil, ErrNo, 0, buf, size, nil);
  if MsgLen = 0 then
    Result := 'ERROR'
  else
    Result := buf;
end;

function BusyCallback(Sender: TObject; ObjectName: PChar; BusyCount: integer): integer; cdecl;
var
  sObjName: String;
  bCancel: Boolean;
begin
  Result := -1;
  with Sender as TSQLite do
  begin
    if Assigned(fOnBusy) then
    begin
      bCancel := False;
      sObjName := ObjectName;
      fOnBusy(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;

constructor TSQLite.Create(DBFileName: String);
var
  fPMsg: PChar;
begin
  inherited Create;
  fError := SQLITE_ERROR;
  fIsOpen := False;
  fLstName := TStringList.Create;
  fLstVal := TStringList.Create;
  fOnData := nil;
  fOnBusy := nil;
  fOnQueryComplete := nil;
  fChangeCount := 0;
  if LibsLoaded then
  begin
    fSQLite := SQLite_Open(PChar(DBFileName), 1, fPMsg);
    SQLite_FreeMem(fPMsg);
    if fSQLite <> nil then
    begin
      fVersion := SQLite_Version;
      fEncoding := SQLite_Encoding;
      fIsOpen := True;
      fError := SQLITE_OK;
    end;
  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;
  inherited Destroy;
end;

function TSQLite.Query(Sql: String; Table: TStrings = nil): boolean;
//var
//  fPMsg: PChar;
begin
  fError := SQLITE_ERROR;
  if fIsOpen then
  begin
    fPMsg := nil;
    fBusy := True;
    fTable := Table;
    if fTable <> nil then
      fTable.Clear;
    fError := SQLite_Exec(fSQLite, PChar(Sql), @ExecCallback, Self, fPMsg);
    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
    SQLite_Cancel(fSQLite);
    fBusy := false;
    Result := True;
  end;
end;

procedure TSQLite.SetBusyTimeout(Timeout: Integer);
begin
  fBusyTimeout := Timeout;
  if fIsOpen then
  begin
    SQLite_BusyTimeout(fSQLite, fBusyTimeout);
    if fBusyTimeout > 0 then
      SQLite_BusyHandler(fSQLite, @BusyCallback, Self)
    else
      SQLite_BusyHandler(fSQLite, nil, nil);
  end;
end;

function TSQLite.LastInsertRow: integer;
begin
  if fIsOpen then
    Result := SQLite_LastInsertRow(fSQLite)
  else
    Result := -1;
end;

function TSQLite.ErrorMessage(ErrNo: Integer): string;
begin
  if LibsLoaded then
  begin
    if ErrNo = 0 then
      Result := MsgNoError
    else
      Result := SQLite_ErrorString(ErrNo);
  end else
    MessageBox(GetActiveWindow(), 'Library "sqlite.dll" not found.', 'Error loading DLL', MB_OK or MB_ICONHAND or MB_SETFOREGROUND);
end;

function TSQLite.IsComplete(Sql: String): boolean;
begin
  Result := SQLite_Complete(PChar(Sql));
end;

function TSQLite.DatabaseDetails(Table: TStrings): boolean;
begin
  Result := Query('SELECT * FROM SQLITE_MASTER;', Table);
end;

initialization
  LibsLoaded := LoadLibs;
  MsgNoError := SystemErrorMsg(0);

finalization
  if DLLHandle <> 0 then
    FreeLibrary(DLLHandle);

end.