disqlite3database.pas

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

    property SQLiteVersion: WideString read GetSQLiteVersion write SetSQLiteVersion stored False;

    property AfterConnect: TNotifyEvent read FAfterConnect write FAfterConnect;

    property AfterCreateDatabase: TNotifyEvent read FAfterCreateDatabase write FAfterCreateDatabase;

    property AfterDisconnect: TNotifyEvent read FAfterDisconnect write FAfterDisconnect;

    property BeforeConnect: TNotifyEvent read FBeforeConnect write FBeforeConnect;

    property BeforeCreateDatabase: TNotifyEvent read FBeforeCreateDatabase write FBeforeCreateDatabase;

    property BeforeDisconnect: TNotifyEvent read FBeforeDisconnect write FBeforeDisconnect;

    property InitDatabase: TNotifyEvent read FInitDatabase write FInitDatabase;

  end;

  TDISQLite3_Callback_ = function(
    const AStmt: TDISQLite3StatementHandle;
    const AUserData: Pointer): Boolean;

procedure DatabaseError(
  const AResStrRec: PResStringRec;
  const AObject: TObject = nil);

procedure DatabaseErrorFmt(
  const AResStrRec: PResStringRec;
  const AArgs: array of const;
  const AObject: TObject = nil);

function DateToJulianDate(
  const ADate: TDateTime): TDIJulianDate; {$IFDEF SUPPORTS_DEPRECATED}deprecated; {$ENDIF}

function DateTimeToJulianDate(
  const ADateTime: TDateTime): TDIJulianDate; {$IFDEF SUPPORTS_DEPRECATED}deprecated; {$ENDIF}

function HmsToJulianDate(
  const AHour, AMinute, ASecond: Integer): TDIJulianDate; {$IFDEF SUPPORTS_DEPRECATED}deprecated; {$ENDIF}

function JulianDateToDate(
  const AJulianDate: TDIJulianDate): TDateTime; {$IFDEF SUPPORTS_DEPRECATED}deprecated; {$ENDIF}

procedure JulianDateToHms(
  const AJulianDate: TDIJulianDate;
  out AHour, AMinute, ASecond: Integer); {$IFDEF SUPPORTS_DEPRECATED}deprecated; {$ENDIF}

function JulianDateToTime(
  const AJulianDate: TDIJulianDate): TDateTime; {$IFDEF SUPPORTS_DEPRECATED}deprecated; {$ENDIF}

procedure JulianDateToYmd(
  const AJulianDate: TDIJulianDate;
  out AYear, AMonth, ADay: Integer); {$IFDEF SUPPORTS_DEPRECATED}deprecated; {$ENDIF}

function JulianDateToDateTime(
  const AJulianDate: TDIJulianDate): TDateTime; {$IFDEF SUPPORTS_DEPRECATED}deprecated; {$ENDIF}

function sqlite3_cell16_as_ansistring(const ACell: TDISQLite3Cell16): AnsiString;

function sqlite3_cell16_as_date(const ACell: TDISQLite3Cell16): TDateTime;

function sqlite3_cell16_as_datetime(const ACell: TDISQLite3Cell16): TDateTime;

function sqlite3_cell16_as_float(const ACell: TDISQLite3Cell16): Double;

function sqlite3_cell16_as_integer(const ACell: TDISQLite3Cell16): Integer;

function sqlite3_cell16_as_int64(const ACell: TDISQLite3Cell16): Int64;

function sqlite3_cell16_as_time(const ACell: TDISQLite3Cell16): TDateTime;

function sqlite3_cell16_as_widestring(const ACell: TDISQLite3Cell16): WideString;

function sqlite3_exec_with_callback(
  const ADBHandle: TDISQLite3DatabaseHandle;
  const ASQL: AnsiString;
  const ACallback: TDISQLite3_Callback_ = nil;
  const AUserData: Pointer = nil): Integer;

function sqlite3_exec_with_callback16(
  const ADBHandle: TDISQLite3DatabaseHandle;
  const ASQL: WideString;
  const ACallback: TDISQLite3_Callback_;
  const AUserData: Pointer): Integer;

function sqlite3_get_boolean(
  const ADb: TDISQLite3DatabaseHandle;
  const ASQL: AnsiString;
  out ABoolean: Boolean): Integer;

function sqlite3_get_boolean16(
  const ADb: TDISQLite3DatabaseHandle;
  const ASQL: WideString;
  out ABoolean: Boolean): Integer;

function sqlite3_get_int(
  const ADb: TDISQLite3DatabaseHandle;
  const ASQL: WideString;
  out AInteger: Integer): Integer;

function sqlite3_get_int16(
  const ADb: TDISQLite3DatabaseHandle;
  const ASQL: WideString;
  out AInteger: Integer): Integer;

function sqlite3_get_str(
  const ADb: TDISQLite3DatabaseHandle;
  const ASQL: AnsiString;
  out AValue: AnsiString): Integer;

function sqlite3_get_str16(
  const ADb: TDISQLite3DatabaseHandle;
  const ASQL: WideString;
  out AValue: WideString): Integer;

procedure sqlite3_init_cell8(
  out ACell: TDISQLite3Cell8);

procedure sqlite3_init_cell16(
  out ACell: TDISQLite3Cell16);

function sqlite3_integrity_check(
  const ADb: TDISQLite3DatabaseHandle;
  const ADatabaseName: AnsiString = ''): Integer;

{$IFNDEF SQLITE_OMIT_UTF16}
function sqlite3_integrity_check16(
  const ADb: TDISQLite3DatabaseHandle;
  const ADatabaseName: WideString = ''): Integer;
{$ENDIF !SQLITE_OMIT_UTF16}

procedure sqlite3_finalize_cell8(
  var ACell: TDISQLite3Cell8);

procedure sqlite3_finalize_cell16(
  var ACell: TDISQLite3Cell16);

function sqlite3_pragma_database16(
  const ADataBase: WideString): WideString;

function sqlite3_pragma_get_encoding(
  const ADb: TDISQLite3DatabaseHandle;
  out AEncoding: AnsiString;
  const ADatabaseName: AnsiString = ''): Integer;

function StrCmp(l, r: PAnsiChar): Integer;

function TimeToJulianDate(const ATime: TDateTime): TDIJulianDate; {$IFDEF SUPPORTS_DEPRECATED}deprecated; {$ENDIF}

type

  TDITextLineBreakStyle = (tlbsLF, tlbsCRLF, tlbsCR);

function WideAdjustLineBreaks(const s: WideString; const Style: TDITextLineBreakStyle = tlbsCRLF): WideString;

function WideStrCmp(l, r: PWideChar): Integer;

function YmdToJulianDate(const AYear, AMonth, ADay: Integer): TDIJulianDate; {$IFDEF SUPPORTS_DEPRECATED}deprecated; {$ENDIF}

const

  SQLITE3_AFFINITY_TO_TYPE: array[TDISQLite3Affinity] of Integer = (
    SQLITE_INTEGER,
    SQLITE_TEXT,
    SQLITE_BLOB,
    SQLITE_FLOAT,
    SQLITE_FLOAT);

resourcestring

  SDatabaseClosed = 'Cannot perform this operation on a closed database';
  SDatabaseNameMissing = 'Database name missing';
  SDatabaseOpen = 'Cannot perform this operation on an open database';
  SEmptySQLStatement = 'Empty SQL Statement';
  SMissingDatabase = 'Missing dabatase';
  SMissingDataSet = 'Missing dataset';
  SStatementClosed = 'Cannot perform this operation on a closed statement';
  SStatementOpen = 'Cannot perform this operation on an open statement';

implementation

uses
  Windows, {$IFDEF COMPILER_6_UP}RTLConsts{$ELSE}Consts{$ENDIF}, SysUtils;

const
  BOOLEAN_TO_ANSICHAR: array[Boolean] of AnsiChar = ('0', '1');
  BOOLEAN_TO_WIDECHAR: array[Boolean] of WideChar = ('0', '1');

  WC_SPACE = WideChar(#$0020);

  WC_FULL_STOP = WideChar(#$002E);

  WC_SOLIDUS = WideChar(#$002F);

  WC_COLON = WideChar(#$003A);

  WC_REVERSE_SOLIDUS = WideChar(#$005C);

  WC_REPLACEMENT_CHARACTER = WideChar(#$FFFD);

  WC_DRIVE_DELIMITER: WideChar = WideChar(WC_COLON);

  WC_DOS_PATH_DELIMITER = WC_REVERSE_SOLIDUS;
  WC_UNIX_PATH_DELIMITER = WC_SOLIDUS;
  WC_PATH_DELIMITER =
    {$IFDEF MSWINDOWS}WC_DOS_PATH_DELIMITER{$ENDIF}
  {$IFDEF CLR}WC_DOS_PATH_DELIMITER{$ENDIF}
  {$IFDEF LINUX}WC_UNIX_PATH_DELIMITER{$ENDIF};

  WideLineSeparator = WideChar($2028);

var
  IsUnicode: Boolean;

function DateToJulianDate(const ADate: TDateTime): TDIJulianDate;
begin
  Result := DISQLite3Api.DateToJulianDate(ADate);
end;

function DateTimeToJulianDate(const ADateTime: TDateTime): TDIJulianDate;
begin
  Result := DISQLite3Api.DateTimeToJulianDate(ADateTime);
end;

function HmsToJulianDate(const AHour, AMinute, ASecond: Integer): TDIJulianDate;
begin
  Result := DISQLite3Api.HmsToJulianDate(AHour, AMinute, ASecond);
end;

function JulianDateToDate(const AJulianDate: TDIJulianDate): TDateTime;
begin
  Result := DISQLite3Api.JulianDateToDate(AJulianDate);
end;

function JulianDateToDateTime(const AJulianDate: TDIJulianDate): TDateTime;
begin
  Result := DISQLite3Api.JulianDateToDateTime(AJulianDate);
end;

function JulianDateToTime(const AJulianDate: TDIJulianDate): TDateTime;
begin
  Result := DISQLite3Api.JulianDateToTime(AJulianDate);
end;

procedure JulianDateToHms(const AJulianDate: TDIJulianDate; out AHour, AMinute, ASecond: Integer);
begin
  DISQLite3Api.JulianDateToHms(AJulianDate, AHour, AMinute, ASecond);
end;

procedure JulianDateToYmd(const AJulianDate: TDIJulianDate; out AYear, AMonth, ADay: Integer);
begin
  DISQLite3Api.JulianDateToYmd(AJulianDate, AYear, AMonth, ADay);
end;

function StrCmp(l, r: PAnsiChar): Integer;
begin
  if l = r then
    Result := 0
  else
    if not Assigned(l) then
      Result := -1
    else
      if not Assigned(r) then
        Result := 1
      else
        begin
          repeat
            if l[0] = r[0] then
              begin
                if l[0] = #0 then Break;
                if l[1] = r[1] then
                  begin
                    if l[1] = #0 then Break;
                    if l[2] = r[2] then
                      begin
                        if l[2] = #0 then Break;
                        if l[3] = r[3] then
                          begin
                            if l[3] = #0 then Break;
                            Inc(l, 4); Inc(r, 4);
                          end
                        else
                          begin
                            Result := Ord(l[3]) - Ord(r[3]);
                            Exit;
                          end;
                      end
                    else
                      begin
                        Result := Ord(l[2]) - Ord(r[2]);
                        Exit;
                      end;
                  end
                else
                  begin
                    Result := Ord(l[1]) - Ord(r[1]);
                    Exit;
                  end;
              end
            else
              begin
                Result := Ord(l[0]) - Ord(r[0]);
                Exit;
              end;
          until False;
          Result := 0;
        end;
end;

function TimeToJulianDate(const ATime: TDateTime): TDIJulianDate;
begin
  Result := DISQLite3Api.TimeToJulianDate(ATime);
end;

function WideAdjustLineBreaksLength(
  const s: WideString;
  const Style: TDITextLineBreakStyle = tlbsCRLF): Cardinal;
var
  l: Cardinal;
  Source: PWideChar;
begin
  Source := Pointer(s);
  Result := Length(s);
  l := Result;
  while l > 0 do
    begin
      case Source^ of
        #10, WideLineSeparator:
          if Style = tlbsCRLF then
            Inc(Result);
        #13:
          if Style = tlbsCRLF then
            if Source[1] = #10 then
              Inc(Source)
            else
              Inc(Result)
          else
            if Source[1] = #10 then
              Dec(Result);
      end;
      Inc(Source); Dec(l);
    end;
end;

function WideAdjustLineBreaks(
  const s: WideString;
  const Style: TDITextLineBreakStyle = tlbsCRLF): WideString;
var
  Source, SourceEnd, Dest: PWideChar;
  DestLen: Integer;
begin
  Source := Pointer(s);
  SourceEnd := Source + Length(s);
  DestLen := WideAdjustLineBreaksLength(s, Style);
  SetString(Result, nil, DestLen);
  Dest := Pointer(Result);
  while Source < SourceEnd do begin
      case Source^ of
        #10, WideLineSeparator:
          begin
            if Style in [tlbsCRLF, tlbsCR] then
              begin
                Dest^ := #13;
                Inc(Dest);
              end;
            if Style in [tlbsCRLF, tlbsLF] then
              begin
                Dest^ := #10;
                Inc(Dest);
              end;
            Inc(Source);
          end;
        #13:
          begin
            if Style in [tlbsCRLF, tlbsCR] then
              begin
                Dest^ := #13;
                Inc(Dest);
              end;
            if Style in [tlbsCRLF, tlbsLF] then
              begin
                Dest^ := #10;
                Inc(Dest);
              end;
            Inc(Source);
            if Source^ = #10 then Inc(Source);
          end;
        else
          Dest^ := Source^;
          Inc(Dest);
          Inc(Source);
      end;
    end;
end;

function WideStrCmp(l, r: PWideChar): Integer;
begin
  if l = r then
    Result := 0
  else
    if not Assigned(l) then
      Result := -1
    else
      if not Assigned(r) then
        Result := 1
      else
        begin
          repeat
            if l[0] = r[0] then
              begin
                if l[0] = #0 then Break;
                if l[1] = r[1] then
                  begin
                    if l[1] = #0 then Break;
                    if l[2] = r[2] then
                      begin
                        if l[2] = #0 then Break;
                        if l[3] = r[3] then
                          begin
                            if l[3] = #0 then Break;
                            Inc(l, 4); Inc(r, 4);
                          end
                        else
                          begin
                            Result := Ord(l[3]) - Ord(r[3]);
                            Exit;
                          end;
                      end
                    else
                      begin
                        Result := Ord(l[2]) - Ord(r[2]);
                        Exit;
                      end;
                  end
                else
                  begin
                    Result := Ord(l[1]) - Ord(r[1]);
                    Exit;
                  end;
              end
            else
              begin
                Result := Ord(l[0]) - Ord(r[0]);
                Exit;
              end;
          until False;
          Result := 0;
        end;
end;

function WideChangeFileExt(const FileName, Extension: WideString): WideString;
label
  NoExtension;
var
  p: PWideChar;
  i, l: Cardinal;
begin
  l := Length(FileName);
  if l > 0 then
    begin
      i := l;
      p := Pointer(FileName);
      Inc(p, i);
      repeat
        Dec(i);
        Dec(p);
        if p^ = WC_FULL_STOP then Break;