disqlite3database.pas

来自「DELPHI 访问SQLITE3 数据库的VCL控件」· PAS 代码 · 共 2,333 行 · 第 1/5 页

        if i = 0 then goto NoExtension;
        if p^ = WC_PATH_DELIMITER then goto NoExtension;
        if p^ = WC_DRIVE_DELIMITER then goto NoExtension;
      until False;
      Result := Copy(FileName, 1, i) + Extension;
      Exit;
    end;

  NoExtension:
  Result := FileName + Extension;
end;

function WideDeleteFile(const AFileName: WideString): Boolean;
begin
  if IsUnicode then
    Result := DeleteFileW(PWideChar(AFileName))
  else
    Result := SysUtils.DeleteFile(AFileName);
end;

function WideExtractFileName(const FileName: WideString): WideString;
var
  l, Start: Cardinal;
begin
  l := Length(FileName);
  if l > 0 then
    begin
      Start := l;
      while (Start > 0) and (FileName[Start] <> WC_PATH_DELIMITER) and (FileName[Start] <> WC_COLON) do
        Dec(Start);
      SetString(Result, PWideChar(Pointer(FileName)) + Start, l - Start);
    end
  else
    Result := '';
end;

function WideFileExists(const AFileName: WideString): Boolean;
var
  Code: Cardinal;
begin
  if IsUnicode then
    begin
      Code := GetFileAttributesW(Pointer(AFileName));
      Result := (Code <> $FFFFFFFF) and (Code and FILE_ATTRIBUTE_DIRECTORY = 0);
    end
  else
    Result := FileExists(AFileName);
end;

function WideExpandFileName(const AFileName: WideString): WideString;
var
  Required: Cardinal;
begin
  if IsUnicode then
    begin
      Required := GetFullPathNameW(Pointer(AFileName), 0, nil, PWideChar(nil^));
      SetString(Result, nil, Required - 1);
      GetFullPathNameW(Pointer(AFileName), Required, Pointer(Result), PWideChar(nil^));
      SetLength(Result, DISQLite3Api.StrLen16(PWideChar(Result)));
    end
  else
    Result := ExpandFileName(AFileName);
end;

function YmdToJulianDate(const AYear, AMonth, ADay: Integer): TDIJulianDate;
begin
  Result := DISQLite3Api.YmdToJulianDate(AYear, AMonth, ADay);
end;

function ResolveEncoding(const p: PAnsiChar; const l: Cardinal): TDISQLite3Encoding;
begin
  if (l > 4) and
    ((p[0] = 'U') or (p[0] = 'u')) and
    ((p[1] = 'T') or (p[1] = 't')) and
    ((p[2] = 'F') or (p[2] = 'f')) and
    (p[3] = '-') then
    case p[4] of
      '1':
        if (l = 8) and (p[5] = '6') and ((p[7] = 'E') or (p[7] = 'e')) then
          if (p[6] = 'B') or (p[6] = 'b') then
            begin Result := encUtf16be; Exit; end
          else
            if (p[6] = 'L') or (p[6] = 'l') then
              begin Result := encUtf16le; Exit; end;
      '8':
        if l = 5 then
          begin Result := encUtf8; Exit; end;
    end;
  Result := encUnknown;
end;

function sqlite3_cell16_as_ansistring(const ACell: TDISQLite3Cell16): AnsiString;
var
  l: Integer;
begin
  with ACell do
    case CellType of
      SQLITE_INTEGER:
        Result := IntToStr(CellInteger);
      SQLITE_FLOAT:
        Result := FloatToSqlStr(CellFloat);
      SQLITE_TEXT:
        begin
          l := WideCharToMultiByte(CP_ACP, 0, CellText.p, CellText.l, nil, 0, nil, nil);
          SetLength(Result, l);
          WideCharToMultiByte(CP_ACP, 0, CellText.p, CellText.l, PAnsiChar(Result), l, nil, nil);
        end;
      else
        Result := '';
    end;
end;

function sqlite3_cell16_as_date(const ACell: TDISQLite3Cell16): TDateTime;
begin
  Result := DISQLite3Api.JulianDateToDate(sqlite3_cell16_as_float(ACell));
end;

function sqlite3_cell16_as_datetime(const ACell: TDISQLite3Cell16): TDateTime;
begin
  Result := DISQLite3Api.JulianDateToDateTime(sqlite3_cell16_as_float(ACell));
end;

function sqlite3_cell16_as_float(const ACell: TDISQLite3Cell16): Double;
begin
  with ACell do
    case CellType of
      SQLITE_INTEGER:
        Result := CellInteger;
      SQLITE_FLOAT:
        Result := CellFloat;
      SQLITE_TEXT:
        Result := SqlStrToFloatDef(CellText.p, 0);
      else
        Result := 0;
    end;
end;

function sqlite3_cell16_as_integer(const ACell: TDISQLite3Cell16): Integer;
begin
  with ACell do
    case CellType of
      SQLITE_INTEGER:
        Result := CellInteger;
      SQLITE_FLOAT:
        Result := Trunc(CellFloat);
      SQLITE_TEXT:
        Result := StrToIntDef(CellText.p, 0);
      else
        Result := 0;
    end;
end;

function sqlite3_cell16_as_int64(const ACell: TDISQLite3Cell16): Int64;
begin
  with ACell do
    case CellType of
      SQLITE_INTEGER:
        Result := CellInteger;
      SQLITE_FLOAT:
        Result := Trunc(CellFloat);
      SQLITE_TEXT:
        Result := StrToInt64Def(CellText.p, 0);
      else
        Result := 0;
    end;
end;

function sqlite3_cell16_as_time(const ACell: TDISQLite3Cell16): TDateTime;
begin
  Result := DISQLite3Api.JulianDateToTime(sqlite3_cell16_as_float(ACell));
end;

function sqlite3_cell16_as_widestring(const ACell: TDISQLite3Cell16): WideString;
begin
  with ACell do
    case CellType of
      SQLITE_INTEGER:
        Result := IntToStr(CellInteger);
      SQLITE_FLOAT:
        Result := FloatToSqlStr(CellFloat);
      SQLITE_TEXT:
        SetString(Result, CellText.p, CellText.l);
      else
        Result := '';
    end;
end;

function sqlite3_pragma_database(const ADataBase: AnsiString): AnsiString;
begin
  Result := 'PRAGMA ';
  if sqlite3_database_type(ADataBase) <> dtMain then
    Result := Result + DISQLite3Api.QuotedStr(ADataBase) + '.';
end;

function sqlite3_pragma_database16(const ADataBase: WideString): WideString;
begin
  Result := 'PRAGMA ';
  if sqlite3_database_type16(ADataBase) <> dtMain then
    Result := Result + DISQLite3Api.QuotedStr16(ADataBase) + '.';
end;

function sqlite3_exec_with_callback(
  const ADBHandle: TDISQLite3DatabaseHandle;
  const ASQL: AnsiString;
  const ACallback: TDISQLite3_Callback_ = nil;
  const AUserData: Pointer = nil): Integer;
var
  CallbackResult: Boolean;
  RetriesPrepare: Integer;
  SqlStart, SqlTail: PAnsiChar;
  SqlLength: Integer;
  Stmt: TDISQLite3StatementHandle;
begin
  if Assigned(ADBHandle) then
    begin
      SqlStart := Pointer(ASQL);
      SqlLength := Length(ASQL);
      repeat
        CallbackResult := True;
        RetriesPrepare := 3;
        repeat
          Result := sqlite3_prepare(ADBHandle, SqlStart, SqlLength, @Stmt, @SqlTail);
          if Result = SQLITE_OK then
            begin
              if not Assigned(Stmt) then
                Break;

              Result := sqlite3_step(Stmt);
              if (Result and $FF = SQLITE_ROW) and Assigned(ACallback) then

                repeat
                  CallbackResult := ACallback(Stmt, AUserData);
                  if not CallbackResult then
                    Break;
                  Result := sqlite3_step(Stmt);
                until Result and $FF <> SQLITE_ROW;

              Result := sqlite3_finalize(Stmt);
              if (Result and $FF = SQLITE_SCHEMA) and (RetriesPrepare > 0) then
                begin
                  Dec(RetriesPrepare);
                  Continue;
                end;
              Break;
            end
          else
            Exit;
        until False;

        if not CallbackResult then
          begin
            Result := SQLITE_ABORT;
            Break;
          end;
        Dec(SqlLength, SqlTail - SqlStart);
        if SqlLength = 0 then
          Break;
        SqlStart := SqlTail;
      until False;
    end
  else
    Result := SQLITE_MISUSE;
end;

function sqlite3_exec_with_callback16(
  const ADBHandle: TDISQLite3DatabaseHandle;
  const ASQL: WideString;
  const ACallback: TDISQLite3_Callback_;
  const AUserData: Pointer): Integer;
begin
  Result := sqlite3_exec_with_callback(
    ADBHandle,
    sqlite3_encode_utf8(ASQL),
    ACallback,
    AUserData);
end;

function sqlite3_exec_once(
  const ADb: TDISQLite3DatabaseHandle;
  const ASQL: AnsiString;
  const AParam1: Integer): Integer; overload;
var
  e: Integer;
  Stmt: TDISQLite3StatementHandle;
begin
  if Assigned(ADb) then
    begin
      Result := sqlite3_prepare(ADb, Pointer(ASQL), Length(ASQL), @Stmt, nil);
      if Result = SQLITE_OK then
        begin
          Result := sqlite3_bind_int(Stmt, 0, AParam1);
          if Result = SQLITE_OK then
            begin
              Result := sqlite3_step(Stmt);
              case Result and $FF of
                SQLITE_ROW, SQLITE_DONE:
                  Result := SQLITE_OK;
              end;
            end;
          e := sqlite3_finalize(Stmt);
          if e <> SQLITE_OK then
            Result := e;
        end;
    end
  else
    Result := SQLITE_ERROR;
end;

{$IFNDEF SQLITE_OMIT_UTF16}

function sqlite3_exec_once16(
  const ADb: TDISQLite3DatabaseHandle;
  const ASQL: WideString): Integer;
var
  e: Integer;
  Stmt: TDISQLite3StatementHandle;
begin
  if Assigned(ADb) then
    begin
      Result := sqlite3_prepare16(ADb, Pointer(ASQL), Length(ASQL) * 2, @Stmt, nil);
      if Result = SQLITE_OK then
        begin
          Result := sqlite3_step(Stmt);
          case Result and $FF of
            SQLITE_ROW, SQLITE_DONE:
              Result := SQLITE_OK;
          end;
          e := sqlite3_finalize(Stmt);
          if e <> SQLITE_OK then
            Result := e;
        end;
    end
  else
    Result := SQLITE_ERROR;
end;
{$ENDIF !SQLITE_OMIT_UTF16}

procedure sqlite3_init_cell8(out ACell: TDISQLite3Cell8);
begin
  FillChar(ACell, SizeOf(ACell), 0);
end;

procedure sqlite3_init_cell16(out ACell: TDISQLite3Cell16);
begin
  with ACell do
    begin
      CellType := 0;
      CellInteger := 0;
    end;
end;

procedure sqlite3_finalize_cell8(var ACell: TDISQLite3Cell8);
begin
  with ACell do
    begin

      case CellType of
        SQLITE_BLOB:
          FreeMem(CellBlob.p);
        SQLITE_TEXT:
          FreeMem(CellText.p);
      end;

      CellType := 0;
      CellInteger := 0;
    end;
end;

procedure sqlite3_finalize_cell16(var ACell: TDISQLite3Cell16);
begin
  with ACell do
    begin

      case CellType of
        SQLITE_BLOB:
          FreeMem(CellBlob.p);
        SQLITE_TEXT:
          FreeMem(CellText.p);
      end;

      CellType := 0;
      CellInteger := 0;
    end;
end;

function sqlite3_get_boolean_callback(
  const AStmt: TDISQLite3StatementHandle;
  const AUserData: Pointer): Boolean;
{$IFNDEF COMPILER_6_UP}type PBoolean = ^Boolean; {$ENDIF}
begin
  PBoolean(AUserData)^ := sqlite3_column_int(AStmt, 0) <> 0;
  Result := False;
end;

function sqlite3_get_boolean(
  const ADb: TDISQLite3DatabaseHandle;
  const ASQL: AnsiString;
  out ABoolean: Boolean): Integer;
begin
  Result := sqlite3_exec_with_callback(ADb, ASQL, sqlite3_get_boolean_callback, @ABoolean);
  if Result = SQLITE_ABORT then Result := SQLITE_OK;
end;

function sqlite3_get_boolean16(
  const ADb: TDISQLite3DatabaseHandle;
  const ASQL: WideString;
  out ABoolean: Boolean): Integer;
begin
  Result := sqlite3_exec_with_callback16(ADb, ASQL, sqlite3_get_boolean_callback, @ABoolean);
  if Result = SQLITE_ABORT then Result := SQLITE_OK;
end;

function sqlite3_get_int_callback(
  const AStmt: TDISQLite3StatementHandle;
  const AUserData: Pointer): Boolean;
begin
  PInteger(AUserData)^ := sqlite3_column_int(AStmt, 0);
  Result := False;
end;

function sqlite3_get_int(
  const ADb: TDISQLite3DatabaseHandle;
  const ASQL: WideString;
  out AInteger: Integer): Integer;
begin
  Result := sqlite3_exec_with_callback(ADb, ASQL, sqlite3_get_int_callback, @AInteger);
  if Result = SQLITE_ABORT then Result := SQLITE_OK;
end;

function sqlite3_get_int16(
  const ADb: TDISQLite3DatabaseHandle;
  const ASQL: WideString;
  out AInteger: Integer): Integer;
begin
  Result := sqlite3_exec_with_callback16(ADb, ASQL, sqlite3_get_int_callback, @AInteger);
  if Result = SQLITE_ABORT then Result := SQLITE_OK;
end;

function sqlite3_get_str_callback(
  const AStmt: TDISQLite3StatementHandle;
  const AUserData: Pointer): Boolean;
begin
  PAnsiString(AUserData)^ := sqlite3_column_str(AStmt, 0);
  Result := False;
end;

function sqlite3_get_str(
  const ADb: TDISQLite3DatabaseHandle;
  const ASQL: AnsiString;
  out AValue: AnsiString): Integer;
begin
  Result := sqlite3_exec_with_callback(ADb, ASQL, sqlite3_get_str_callback, @AValue);
  if Result = SQLITE_ABORT then Result := SQLITE_OK;
end;

function sqlite3_get_str16_callback(
  const AStmt: TDISQLite3StatementHandle;
  const AUserData: Pointer): Boolean;
begin
  {$IFDEF SQLITE_OMIT_UTF16}
  PWideString(AUserData)^ := sqlite3_decode_utf8(sqlite3_column_str(AStmt, 0));
  {$ELSE SQLITE_OMIT_UTF16}
  PWideString(AUserData)^ := sqlite3_column_str16(AStmt, 0);
  {$ENDIF SQLITE_OMIT_UTF16}
  Result := False;
end;