mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-08 06:21:15 +02:00
fcl-db: sqldb: introduce connection CodePage (derived from connection CharSet) and supporting routines, which performs f.e. codepage aware parameter binding using connection codepage (charset)
git-svn-id: trunk@34099 -
This commit is contained in:
lacak
parent
d2c53d48e9
commit
ad96eb037d
@ -46,35 +46,34 @@ uses
|
||||
|
||||
type
|
||||
|
||||
TServerInfo = record
|
||||
ServerVersion: string;
|
||||
ServerVersionString: string;
|
||||
UserName: string;
|
||||
end;
|
||||
|
||||
TClientCharset = (ccNone, ccUTF8, ccISO88591, ccUnknown);
|
||||
|
||||
{ TMSSQLConnection }
|
||||
|
||||
TMSSQLConnection = class(TSQLConnection)
|
||||
private
|
||||
FDBLogin: PLOGINREC;
|
||||
FDBProc : PDBPROCESS;
|
||||
Ftds : integer; // TDS protocol version
|
||||
Fstatus : STATUS; // current result/rows fetch status
|
||||
FServerInfo: TServerInfo;
|
||||
type
|
||||
TServerInfo = record
|
||||
ServerVersion: string;
|
||||
ServerVersionString: string;
|
||||
UserName: string;
|
||||
end;
|
||||
var
|
||||
FDBLogin: PLOGINREC;
|
||||
FDBProc : PDBPROCESS;
|
||||
Ftds : integer; // TDS protocol version
|
||||
Fstatus : STATUS; // current result/rows fetch status
|
||||
FServerInfo: TServerInfo;
|
||||
function CheckError(const Ret: RETCODE): RETCODE;
|
||||
procedure Execute(const cmd: string); overload;
|
||||
procedure ExecuteDirectSQL(const Query: string);
|
||||
procedure GetParameters(cursor: TSQLCursor; AParams: TParams);
|
||||
function TranslateFldType(SQLDataType: integer): TFieldType;
|
||||
function ClientCharset: TClientCharset;
|
||||
function AutoCommit: boolean;
|
||||
function IsSybase: boolean;
|
||||
protected
|
||||
// Overrides from TSQLConnection
|
||||
function GetHandle:pointer; override;
|
||||
function GetAsSQLText(Param : TParam) : string; overload; override;
|
||||
function GetConnectionCharSet: string; override;
|
||||
// - Connect/disconnect
|
||||
procedure DoInternalConnect; override;
|
||||
procedure DoInternalDisconnect; override;
|
||||
@ -201,10 +200,10 @@ const
|
||||
|
||||
|
||||
var
|
||||
DBErrorStr, DBMsgStr: string;
|
||||
DBErrorStr, DBMsgStr: AnsiString;
|
||||
DBErrorNo, DBMsgNo: integer;
|
||||
|
||||
function DBErrHandler(dbproc: PDBPROCESS; severity, dberr, oserr:INT; dberrstr, oserrstr:PChar):INT; cdecl;
|
||||
function DBErrHandler(dbproc: PDBPROCESS; severity, dberr, oserr:INT; dberrstr, oserrstr:PAnsiChar):INT; cdecl;
|
||||
begin
|
||||
DBErrorStr:=DBErrorStr+LineEnding+dberrstr;
|
||||
DBErrorNo :=dberr;
|
||||
@ -212,7 +211,7 @@ begin
|
||||
// for server messages with severity greater than 10 error handler is also called
|
||||
end;
|
||||
|
||||
function DBMsgHandler(dbproc: PDBPROCESS; msgno: DBINT; msgstate, severity:INT; msgtext, srvname, procname:PChar; line:DBUSMALLINT):INT; cdecl;
|
||||
function DBMsgHandler(dbproc: PDBPROCESS; msgno: DBINT; msgstate, severity:INT; msgtext, srvname, procname:PAnsiChar; line:DBUSMALLINT):INT; cdecl;
|
||||
begin
|
||||
DBMsgStr:=DBMsgStr+LineEnding+msgtext;
|
||||
DBMsgNo :=msgno;
|
||||
@ -375,13 +374,7 @@ begin
|
||||
//if IsBinary(Param.AsString) then
|
||||
// Result := '0x' + StrToHex(Param.AsString)
|
||||
//else
|
||||
begin
|
||||
Result := QuotedStr(Param.AsString);
|
||||
if (Ftds >= DBTDS_70) then
|
||||
Result := 'N' + Result
|
||||
else if (Ftds = 0) and (ClientCharset = ccUTF8) then //hack: Microsoft DB-Lib used
|
||||
Result := UTF8Decode(Result);
|
||||
end;
|
||||
Result := 'N' + inherited GetAsSQLText(Param);
|
||||
ftBlob, ftBytes, ftVarBytes:
|
||||
Result := '0x' + StrToHex(Param.AsString);
|
||||
else
|
||||
@ -391,6 +384,14 @@ begin
|
||||
Result:=inherited GetAsSQLText(Param);
|
||||
end;
|
||||
|
||||
function TMSSQLConnection.GetConnectionCharSet: string;
|
||||
begin
|
||||
if CharSet = '' then
|
||||
Result := 'utf-8'
|
||||
else
|
||||
Result := CharSet;
|
||||
end;
|
||||
|
||||
procedure TMSSQLConnection.DoInternalConnect;
|
||||
const
|
||||
DBVERSION: array[boolean] of BYTE = (DBVER60, DBVERSION_100);
|
||||
@ -425,22 +426,22 @@ begin
|
||||
dbsetlsecure(FDBLogin)
|
||||
else
|
||||
begin
|
||||
dbsetlname(FDBLogin, PChar(UserName), DBSETUSER);
|
||||
dbsetlname(FDBLogin, PChar(Password), DBSETPWD);
|
||||
dbsetlname(FDBLogin, PAnsiChar(UserName), DBSETUSER);
|
||||
dbsetlname(FDBLogin, PAnsiChar(Password), DBSETPWD);
|
||||
end;
|
||||
|
||||
if CharSet = '' then
|
||||
dbsetlcharset(FDBLogin, 'UTF-8')
|
||||
else
|
||||
dbsetlcharset(FDBLogin, PChar(CharSet));
|
||||
dbsetlcharset(FDBLogin, PAnsiChar(CharSet));
|
||||
|
||||
if Params.IndexOfName(SAppName) <> -1 then
|
||||
dbsetlname(FDBLogin, PChar(Params.Values[SAppName]), DBSETAPP);
|
||||
dbsetlname(FDBLogin, PAnsiChar(Params.Values[SAppName]), DBSETAPP);
|
||||
|
||||
//dbsetlname(FDBLogin, PChar(TIMEOUT_IGNORE), DBSET_LOGINTIME);
|
||||
//dbsetlname(FDBLogin, PAnsiChar(TIMEOUT_IGNORE), DBSET_LOGINTIME);
|
||||
dbsetlogintime(10);
|
||||
|
||||
FDBProc := dbopen(FDBLogin, PChar(HostName));
|
||||
FDBProc := dbopen(FDBLogin, PAnsiChar(HostName));
|
||||
if FDBProc=nil then CheckError(FAIL);
|
||||
|
||||
Ftds := dbtds(FDBProc);
|
||||
@ -465,7 +466,7 @@ begin
|
||||
Execute(IMPLICIT_TRANSACTIONS_OFF[IsSybase]); //set connection to autocommit mode - default
|
||||
|
||||
if DatabaseName <> '' then
|
||||
CheckError( dbuse(FDBProc, PChar(DatabaseName)) );
|
||||
CheckError( dbuse(FDBProc, PAnsiChar(DatabaseName)) );
|
||||
|
||||
with TDBLibCursor.Create(Self) do
|
||||
begin
|
||||
@ -562,27 +563,6 @@ begin
|
||||
Result := StrToBoolDef(Params.Values[SAutoCommit], False);
|
||||
end;
|
||||
|
||||
function TMSSQLConnection.ClientCharset: TClientCharset;
|
||||
begin
|
||||
{$IF (FPC_VERSION>=2) AND (FPC_RELEASE>4)}
|
||||
case CharSet of
|
||||
'' : Result := ccNone;
|
||||
'UTF-8' : Result := ccUTF8;
|
||||
'ISO-8859-1' : Result := ccISO88591;
|
||||
else Result := ccUnknown;
|
||||
end;
|
||||
{$ELSE}
|
||||
if CharSet = '' then
|
||||
Result := ccNone
|
||||
else if CharSet = 'UTF-8' then
|
||||
Result := ccUTF8
|
||||
else if CharSet = 'ISO-8859-1' then
|
||||
Result := ccISO88591
|
||||
else
|
||||
Result := ccUnknown;
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
procedure TMSSQLConnection.PrepareStatement(cursor: TSQLCursor;
|
||||
ATransaction: TSQLTransaction; buf: string; AParams: TParams);
|
||||
begin
|
||||
@ -599,7 +579,7 @@ procedure TMSSQLConnection.Execute(const cmd: string);
|
||||
begin
|
||||
DBErrorStr:='';
|
||||
DBMsgStr :='';
|
||||
CheckError( dbcmd(FDBProc, PChar(cmd)) );
|
||||
CheckError( dbcmd(FDBProc, PAnsiChar(cmd)) );
|
||||
CheckError( dbsqlexec(FDBProc) );
|
||||
CheckError( dbresults(FDBProc) );
|
||||
end;
|
||||
@ -731,7 +711,6 @@ begin
|
||||
FieldSize := col.MaxLength;
|
||||
if FieldSize >= $3FFFFFFF then // varchar(max)
|
||||
FieldType := ftMemo;
|
||||
|
||||
end;
|
||||
ftBytes, ftVarBytes:
|
||||
begin
|
||||
@ -753,15 +732,8 @@ begin
|
||||
FieldType := ftAutoInc;
|
||||
end;
|
||||
|
||||
with FieldDefs.Add(FieldDefs.MakeNameUnique(FieldName), FieldType, FieldSize, (col.Null=0) and (not col.Identity), i) do
|
||||
begin
|
||||
// identity, timestamp and calculated column are not updatable
|
||||
if col.Updatable = 0 then Attributes := Attributes + [faReadonly];
|
||||
case FieldType of
|
||||
ftBCD,
|
||||
ftFmtBCD: Precision := col.Precision;
|
||||
end;
|
||||
end;
|
||||
// identity, timestamp and calculated column are not updatable
|
||||
AddFieldDef(FieldDefs, i, FieldName, FieldType, FieldSize, col.Precision, True, (col.Null=0) and (not col.Identity), col.Updatable=0);
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -787,7 +759,7 @@ var i: integer;
|
||||
dbdt: DBDATETIME;
|
||||
dbdr: DBDATEREC;
|
||||
dbdta: DBDATETIMEALL;
|
||||
bcdstr: array[0..MaxFmtBCDFractionSize+2] of char;
|
||||
bcdstr: array[0..MaxFmtBCDFractionSize+2] of AnsiChar;
|
||||
begin
|
||||
CreateBlob:=false;
|
||||
i:=FieldDef.FieldNo;
|
||||
@ -803,7 +775,10 @@ begin
|
||||
destlen:=FieldDef.Size;
|
||||
case FieldDef.DataType of
|
||||
ftString, ftFixedChar:
|
||||
begin
|
||||
desttype:=SQLCHAR;
|
||||
destlen:=FieldDef.Size*FieldDef.CharSize;
|
||||
end;
|
||||
ftBytes:
|
||||
desttype:=SQLBINARY;
|
||||
ftVarBytes:
|
||||
@ -893,12 +868,7 @@ begin
|
||||
|
||||
case FieldDef.DataType of
|
||||
ftString, ftFixedChar:
|
||||
begin
|
||||
PChar(dest + datalen)^ := #0; //strings must be null-terminated
|
||||
if ((Ftds = 0) and (ClientCharset = ccUTF8)) {hack: MS DB-Lib used} or
|
||||
(ClientCharset = ccISO88591) {hack: FreeTDS} then
|
||||
StrPLCopy(PChar(dest), UTF8Encode(PChar(dest)), destlen);
|
||||
end;
|
||||
PAnsiChar(dest + datalen)^ := #0; //strings must be null-terminated
|
||||
ftDate, ftTime, ftDateTime:
|
||||
if desttype = SYBMSDATETIME2 then
|
||||
PDateTime(buffer)^ := dbdatetimeallcrack(@dbdta)
|
||||
|
||||
@ -190,6 +190,7 @@ type
|
||||
FUserName : string;
|
||||
FHostName : string;
|
||||
FCharSet : string;
|
||||
FCodePage : TSystemCodePage;
|
||||
FRole : String;
|
||||
FStatements : TFPList;
|
||||
FLogEvents: TDBEventTypes;
|
||||
@ -218,9 +219,12 @@ type
|
||||
procedure ApplyRecUpdate(Query : TCustomSQLQuery; UpdateKind : TUpdateKind); virtual;
|
||||
function RefreshLastInsertID(Query : TCustomSQLQuery; Field : TField): Boolean; virtual;
|
||||
procedure GetDBInfo(const ASchemaType : TSchemaType; const ASchemaObjectName, AReturnField : string; AList: TStrings);
|
||||
function GetConnectionCharSet: string; virtual;
|
||||
procedure SetTransaction(Value : TSQLTransaction); virtual;
|
||||
procedure DoConnect; override;
|
||||
procedure DoInternalConnect; override;
|
||||
procedure DoInternalDisconnect; override;
|
||||
function GetAsString(Param: TParam): RawByteString;
|
||||
function GetAsSQLText(Field : TField) : string; overload; virtual;
|
||||
function GetAsSQLText(Param : TParam) : string; overload; virtual;
|
||||
function GetHandle : pointer; virtual;
|
||||
@ -229,6 +233,7 @@ type
|
||||
Procedure Log(EventType : TDBEventType; Const Msg : String); virtual;
|
||||
Procedure RegisterStatement(S : TCustomSQLStatement);
|
||||
Procedure UnRegisterStatement(S : TCustomSQLStatement);
|
||||
|
||||
Function AllocateCursorHandle : TSQLCursor; virtual; abstract;
|
||||
Procedure DeAllocateCursorHandle(var cursor : TSQLCursor); virtual; abstract;
|
||||
function StrToStatementType(s : string) : TStatementType; virtual;
|
||||
@ -237,7 +242,8 @@ type
|
||||
procedure Execute(cursor: TSQLCursor;atransaction:tSQLtransaction; AParams : TParams); virtual; abstract;
|
||||
function RowsAffected(cursor: TSQLCursor): TRowsCount; virtual;
|
||||
function Fetch(cursor : TSQLCursor) : boolean; virtual; abstract;
|
||||
procedure AddFieldDefs(cursor: TSQLCursor; FieldDefs : TfieldDefs); virtual; abstract;
|
||||
procedure AddFieldDefs(cursor: TSQLCursor; FieldDefs : TFieldDefs); virtual; abstract;
|
||||
function AddFieldDef(AFieldDefs: TFieldDefs; AFieldNo: Longint; const AName: string; ADataType: TFieldType; ASize, APrecision: Integer; AByteSize, ARequired, AReadOnly: Boolean): TFieldDef;
|
||||
function LoadField(cursor : TSQLCursor; FieldDef : TFieldDef; buffer : pointer; out CreateBlob : boolean) : boolean; virtual; abstract;
|
||||
procedure LoadBlobIntoBuffer(FieldDef: TFieldDef;ABlobBuf: PBufBlobField; cursor: TSQLCursor; ATransaction : TSQLTransaction); virtual; abstract;
|
||||
procedure FreeFldBuffers(cursor : TSQLCursor); virtual;
|
||||
@ -697,8 +703,8 @@ type
|
||||
Property DataBase : TDatabase Read FDatabase Write SetDatabase;
|
||||
Property Transaction : TDBTransaction Read FTransaction Write SetTransaction;
|
||||
property OnDirective: TSQLScriptDirectiveEvent read FOnDirective write FOnDirective;
|
||||
Property UseDollarString;
|
||||
Property DollarStrings;
|
||||
Property UseDollarString;
|
||||
Property DollarStrings;
|
||||
property Directives;
|
||||
property Defines;
|
||||
property Script;
|
||||
@ -1213,16 +1219,40 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure TSQLConnection.UpdateIndexDefs(IndexDefs : TIndexDefs; TableName : string);
|
||||
begin
|
||||
// Empty abstract
|
||||
end;
|
||||
|
||||
procedure TSQLConnection.DoConnect;
|
||||
var ConnectionCharSet: string;
|
||||
begin
|
||||
inherited;
|
||||
|
||||
// map connection CharSet to corresponding local CodePage
|
||||
// do not set FCodePage to CP_ACP if FCodePage = DefaultSystemCodePage
|
||||
// aliases listed here are commonly used, but not recognized by CodePageNameToCodePage()
|
||||
ConnectionCharSet := LowerCase(GetConnectionCharSet);
|
||||
case ConnectionCharSet of
|
||||
'utf8','utf-8':
|
||||
FCodePage := CP_UTF8;
|
||||
'win1250','cp1250':
|
||||
FCodePage := 1250;
|
||||
'win1252','cp1252','latin1','iso8859_1':
|
||||
FCodePage := 1252;
|
||||
else
|
||||
begin
|
||||
FCodePage := CodePageNameToCodePage(ConnectionCharSet);
|
||||
if FCodePage = CP_NONE then
|
||||
FCodePage := CP_ACP;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TSQLConnection.DoInternalConnect;
|
||||
begin
|
||||
if (DatabaseName = '') and not(sqSupportEmptyDatabaseName in FConnOptions) then
|
||||
DatabaseError(SErrNoDatabaseName,self);
|
||||
DatabaseError(SErrNoDatabaseName,Self);
|
||||
end;
|
||||
|
||||
procedure TSQLConnection.DoInternalDisconnect;
|
||||
@ -1366,11 +1396,43 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TSQLConnection.GetConnectionCharSet: string;
|
||||
begin
|
||||
// default implementation returns user supplied FCharSet
|
||||
// (can be overriden by descendants, which are able retrieve current connection charset using client API)
|
||||
Result := FCharSet;
|
||||
end;
|
||||
|
||||
function TSQLConnection.RowsAffected(cursor: TSQLCursor): TRowsCount;
|
||||
begin
|
||||
Result := -1;
|
||||
end;
|
||||
|
||||
function TSQLConnection.AddFieldDef(AFieldDefs: TFieldDefs; AFieldNo: Longint;
|
||||
const AName: string; ADataType: TFieldType; ASize, APrecision: Integer;
|
||||
AByteSize, ARequired, AReadOnly: Boolean): TFieldDef;
|
||||
var
|
||||
ACodePage: TSystemCodePage;
|
||||
begin
|
||||
// helper function used by descendants
|
||||
if ADataType in [ftString, ftFixedChar, ftMemo] then
|
||||
begin
|
||||
ACodePage := FCodePage;
|
||||
// if ASize of character data is passed as "byte length",
|
||||
// translate it to "character length" as expected by TFieldDef
|
||||
if AByteSize and (ACodePage = CP_UTF8) then
|
||||
ASize := ASize div 4;
|
||||
end
|
||||
else
|
||||
ACodePage := 0;
|
||||
Result := AFieldDefs.Add(AFieldDefs.MakeNameUnique(AName), ADataType, ASize, ARequired, AFieldNo, ACodePage);
|
||||
if AReadOnly then
|
||||
Result.Attributes := Result.Attributes + [faReadOnly];
|
||||
case ADataType of
|
||||
ftBCD, ftFmtBCD:
|
||||
Result.Precision := APrecision;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TSQLConnection.GetTableNames(List: TStrings; SystemTables: Boolean);
|
||||
begin
|
||||
@ -1623,6 +1685,20 @@ begin
|
||||
until CurrentP^=#0;
|
||||
end;
|
||||
|
||||
function TSQLConnection.GetAsString(Param: TParam): RawByteString;
|
||||
begin
|
||||
// converts parameter value to connection charset
|
||||
if FCodePage = CP_UTF8 then
|
||||
Result := Param.AsUTF8String
|
||||
else if FCodePage in [DefaultSystemCodePage, CP_ACP] then
|
||||
Result := Param.AsAnsiString
|
||||
else
|
||||
begin
|
||||
Result := Param.AsAnsiString;
|
||||
SetCodePage(Result, FCodePage, True);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TSQLConnection.GetAsSQLText(Field : TField) : string;
|
||||
begin
|
||||
if (not assigned(Field)) or Field.IsNull then Result := 'Null'
|
||||
@ -1643,14 +1719,14 @@ begin
|
||||
ftGuid,
|
||||
ftMemo,
|
||||
ftFixedChar,
|
||||
ftString : Result := QuotedStr(Param.AsString);
|
||||
ftString : Result := QuotedStr(GetAsString(Param));
|
||||
ftDate : Result := '''' + FormatDateTime('yyyy-mm-dd',Param.AsDateTime,FSQLFormatSettings) + '''';
|
||||
ftTime : Result := QuotedStr(TimeIntervalToString(Param.AsDateTime));
|
||||
ftDateTime : Result := '''' + FormatDateTime('yyyy-mm-dd hh:nn:ss.zzz', Param.AsDateTime, FSQLFormatSettings) + '''';
|
||||
ftCurrency,
|
||||
ftBcd : Result := CurrToStr(Param.AsCurrency, FSQLFormatSettings);
|
||||
ftFloat : Result := FloatToStr(Param.AsFloat, FSQLFormatSettings);
|
||||
ftFMTBcd : Result := stringreplace(Param.AsString, DefaultFormatSettings.DecimalSeparator, FSQLFormatSettings.DecimalSeparator, []);
|
||||
ftFMTBcd : Result := StringReplace(Param.AsString, DefaultFormatSettings.DecimalSeparator, FSQLFormatSettings.DecimalSeparator, []);
|
||||
else
|
||||
Result := Param.AsString;
|
||||
end; {case}
|
||||
|
||||
@ -53,7 +53,8 @@ type
|
||||
procedure DoInternalConnect; override;
|
||||
procedure DoInternalDisconnect; override;
|
||||
function GetHandle : pointer; override;
|
||||
|
||||
function GetConnectionCharSet: string; override;
|
||||
|
||||
Function AllocateCursorHandle : TSQLCursor; override;
|
||||
Procedure DeAllocateCursorHandle(var cursor : TSQLCursor); override;
|
||||
Function AllocateTransactionHandle : TSQLHandle; override;
|
||||
@ -148,7 +149,7 @@ type
|
||||
|
||||
procedure freebindstring(astring: pointer); cdecl;
|
||||
begin
|
||||
StrDispose(AString);
|
||||
StrDispose(astring);
|
||||
end;
|
||||
|
||||
procedure TSQLite3Cursor.checkerror(const aerror: integer);
|
||||
@ -158,8 +159,7 @@ end;
|
||||
|
||||
Procedure TSQLite3Cursor.bindparams(AParams : TParams);
|
||||
|
||||
Function PCharStr(Const S : String) : PChar;
|
||||
|
||||
Function PAllocStr(Const S : RawByteString) : PAnsiChar;
|
||||
begin
|
||||
Result:=StrAlloc(Length(S)+1);
|
||||
If (Result<>Nil) then
|
||||
@ -168,9 +168,10 @@ Procedure TSQLite3Cursor.bindparams(AParams : TParams);
|
||||
|
||||
Var
|
||||
I : Integer;
|
||||
P : TParam;
|
||||
str1: string;
|
||||
wstr1: widestring;
|
||||
P : TParam;
|
||||
astr: AnsiString;
|
||||
ustr: UTF8String;
|
||||
wstr: WideString;
|
||||
|
||||
begin
|
||||
for I:=1 to high(fparambinding)+1 do
|
||||
@ -194,25 +195,27 @@ begin
|
||||
ftTime: checkerror(sqlite3_bind_double(fstatement, I, P.AsFloat - JulianEpoch));
|
||||
ftFMTBcd:
|
||||
begin
|
||||
str1:=BCDToStr(P.AsFMTBCD, Fconnection.FSQLFormatSettings);
|
||||
checkerror(sqlite3_bind_text(fstatement, I, PChar(str1), length(str1), sqlite3_destructor_type(SQLITE_TRANSIENT)));
|
||||
astr:=BCDToStr(P.AsFMTBCD, Fconnection.FSQLFormatSettings);
|
||||
checkerror(sqlite3_bind_text(fstatement, I, PAnsiChar(astr), length(astr), sqlite3_destructor_type(SQLITE_TRANSIENT)));
|
||||
end;
|
||||
ftString,
|
||||
ftFixedChar,
|
||||
ftMemo: begin // According to SQLite documentation, CLOB's (ftMemo) have the Text affinity
|
||||
str1:= p.asstring;
|
||||
checkerror(sqlite3_bind_text(fstatement,I,pcharstr(str1), length(str1),@freebindstring));
|
||||
ustr:= P.AsUTF8String;
|
||||
checkerror(sqlite3_bind_text(fstatement,I, PAllocStr(ustr), length(ustr), @freebindstring));
|
||||
end;
|
||||
ftBytes,
|
||||
ftVarBytes,
|
||||
ftBlob: begin
|
||||
str1:= P.asstring;
|
||||
checkerror(sqlite3_bind_blob(fstatement,I,pcharstr(str1), length(str1),@freebindstring));
|
||||
astr:= P.AsAnsiString;
|
||||
checkerror(sqlite3_bind_blob(fstatement,I, PAllocStr(astr), length(astr), @freebindstring));
|
||||
end;
|
||||
ftWideString, ftFixedWideChar, ftWideMemo:
|
||||
ftWideString,
|
||||
ftFixedWideChar,
|
||||
ftWideMemo:
|
||||
begin
|
||||
wstr1:=P.AsWideString;
|
||||
checkerror(sqlite3_bind_text16(fstatement,I, PWideChar(wstr1), length(wstr1)*sizeof(WideChar), sqlite3_destructor_type(SQLITE_TRANSIENT)));
|
||||
wstr:=P.AsWideString;
|
||||
checkerror(sqlite3_bind_text16(fstatement,I, PWideChar(wstr), length(wstr)*sizeof(WideChar), sqlite3_destructor_type(SQLITE_TRANSIENT)));
|
||||
end
|
||||
else
|
||||
DatabaseErrorFmt(SUnsupportedParameter, [Fieldtypenames[P.DataType], Self]);
|
||||
@ -240,21 +243,8 @@ end;
|
||||
|
||||
Procedure TSQLite3Cursor.Execute;
|
||||
|
||||
var
|
||||
wo1: word;
|
||||
|
||||
begin
|
||||
{$ifdef i386}
|
||||
wo1:= get8087cw;
|
||||
set8087cw(wo1 or $1f); //mask exceptions, Sqlite3 has overflow
|
||||
Try // Why do people always forget this ??
|
||||
{$endif}
|
||||
fstate:= sqlite3_step(fstatement);
|
||||
{$ifdef i386}
|
||||
finally
|
||||
set8087cw(wo1); //restore
|
||||
end;
|
||||
{$endif}
|
||||
fstate:= sqlite3_step(fstatement);
|
||||
if (fstate<=sqliteerrormax) then
|
||||
checkerror(sqlite3_reset(fstatement));
|
||||
FSelectable :=sqlite3_column_count(fstatement)>0;
|
||||
@ -296,7 +286,7 @@ var
|
||||
|
||||
begin
|
||||
st:=TSQLite3Cursor(cursor).fstatement;
|
||||
fnum:= FieldDef.fieldno - 1;
|
||||
fnum:= FieldDef.FieldNo - 1;
|
||||
|
||||
case FieldDef.DataType of
|
||||
ftWideMemo:
|
||||
@ -510,7 +500,7 @@ begin
|
||||
end;
|
||||
ftUnknown : DatabaseErrorFmt('Unknown or unsupported data type %s of column %s', [FD, FN]);
|
||||
end; // Case
|
||||
FieldDefs.Add(FieldDefs.MakeNameUnique(FN),ft1,size1,false,i+1);
|
||||
FieldDefs.Add(FieldDefs.MakeNameUnique(FN), ft1, size1, false, i+1, CP_UTF8);
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -666,8 +656,8 @@ begin
|
||||
ftFixedChar,
|
||||
ftString: begin
|
||||
int1:= sqlite3_column_bytes(st,fnum);
|
||||
if int1>FieldDef.Size then
|
||||
int1:=FieldDef.Size;
|
||||
if int1>FieldDef.Size*FieldDef.CharSize then
|
||||
int1:=FieldDef.Size*FieldDef.CharSize;
|
||||
if int1 > 0 then
|
||||
move(sqlite3_column_text(st,fnum)^,buffer^,int1);
|
||||
PAnsiChar(buffer + int1)^ := #0;
|
||||
@ -799,6 +789,11 @@ begin
|
||||
result:= fhandle;
|
||||
end;
|
||||
|
||||
function TSQLite3Connection.GetConnectionCharSet: string;
|
||||
begin
|
||||
Result:='utf8';
|
||||
end;
|
||||
|
||||
procedure TSQLite3Connection.checkerror(const aerror: integer);
|
||||
|
||||
Var
|
||||
|
||||
Loading…
Reference in New Issue
Block a user