zeoslib  UNKNOWN
 All Files
ZDbcSqLiteUtils.pas
Go to the documentation of this file.
1 {*********************************************************}
2 { }
3 { Zeos Database Objects }
4 { SQLite Database Connectivity Classes }
5 { }
6 { Originally written by Sergey Seroukhov }
7 { }
8 {*********************************************************}
9 
10 {@********************************************************}
11 { Copyright (c) 1999-2012 Zeos Development Group }
12 { }
13 { License Agreement: }
14 { }
15 { This library is distributed in the hope that it will be }
16 { useful, but WITHOUT ANY WARRANTY; without even the }
17 { implied warranty of MERCHANTABILITY or FITNESS FOR }
18 { A PARTICULAR PURPOSE. See the GNU Lesser General }
19 { Public License for more details. }
20 { }
21 { The source code of the ZEOS Libraries and packages are }
22 { distributed under the Library GNU General Public }
23 { License (see the file COPYING / COPYING.ZEOS) }
24 { with the following modification: }
25 { As a special exception, the copyright holders of this }
26 { library give you permission to link this library with }
27 { independent modules to produce an executable, }
28 { regardless of the license terms of these independent }
29 { modules, and to copy and distribute the resulting }
30 { executable under terms of your choice, provided that }
31 { you also meet, for each linked independent module, }
32 { the terms and conditions of the license of that module. }
33 { An independent module is a module which is not derived }
34 { from or based on this library. If you modify this }
35 { library, you may extend this exception to your version }
36 { of the library, but you are not obligated to do so. }
37 { If you do not wish to do so, delete this exception }
38 { statement from your version. }
39 { }
40 { }
41 { The project web site is located on: }
42 { http://zeos.firmos.at (FORUM) }
43 { http://sourceforge.net/p/zeoslib/tickets/ (BUGTRACKER)}
44 { svn://svn.code.sf.net/p/zeoslib/code-0/trunk (SVN) }
45 { }
46 { http://www.sourceforge.net/projects/zeoslib. }
47 { }
48 { }
49 { Zeos Development Group. }
50 {********************************************************@}
51 
52 unit ZDbcSqLiteUtils;
53 
54 interface
55 
56 {$I ZDbc.inc}
57 
58 uses
59  Classes, SysUtils, ZSysUtils, ZDbcIntfs, ZPlainSqLiteDriver, ZDbcLogging, ZCompatibility;
60 
61 {**
62  Convert string SQLite field type to SQLType
63  @param string field type value
64  @param Precision the column precision or size
65  @param Decimals the column position after decimal point
66  @result the SQLType field type value
67 }
68 function ConvertSQLiteTypeToSQLType(TypeName: string; var Precision: Integer;
69  var Decimals: Integer; const CtrlsCPType: TZControlsCodePage): TZSQLType;
70 
71 {**
72  Checks for possible sql errors.
73  @param PlainDriver a SQLite plain driver.
74  @param ErrorCode an error code.
75  @param ErrorMessage an error message.
76  @param LogCategory a logging category.
77  @param LogMessage a logging message.
78 }
79 procedure CheckSQLiteError(PlainDriver: IZSQLitePlainDriver;
80  Handle: PSqlite;
81  ErrorCode: Integer; ErrorMessage: PAnsiChar;
82  LogCategory: TZLoggingCategory; LogMessage: string);
83 
84 {**
85  Converts an string into escape PostgreSQL format.
86  @param Value a regular string.
87  @return a string in PostgreSQL escape format.
88 }
89 function EncodeString(Buffer: PAnsiChar; Len: Integer): RawByteString; overload;
90 function EncodeString(Value: RawByteString): RawByteString; overload;
91 
92 {**
93  Converts an string from escape PostgreSQL format.
94  @param Value a string in PostgreSQL escape format.
95  @return a regular string.
96 }
97 function DecodeString(Value: ansistring): ansistring;
98 
99 {**
100  Decodes a SQLite Version Value and Encodes it to a Zeos SQL Version format:
101  (major_version * 1,000,000) + (minor_version * 1,000) + sub_version
102  into separated major, minor and subversion values
103  @param SQLiteVersion an integer containing the Full Version to decode.
104  @return Encoded Zeos SQL Version Value.
105 }
106 function ConvertSQLiteVersionToSQLVersion( const SQLiteVersion: PAnsiChar ): Integer;
107 
108 
109 implementation
110 
111 uses ZMessages{$IFDEF WITH_UNITANSISTRINGS}, AnsiStrings{$ENDIF};
112 
113 {**
114  Convert string SQLite field type to SQLType
115  @param string field type value
116  @param Precision the column precision or size
117  @param Decimals the column position after decimal point
118  @result the SQLType field type value
119 }
120 function ConvertSQLiteTypeToSQLType(TypeName: string; var Precision: Integer;
121  var Decimals: Integer; const CtrlsCPType: TZControlsCodePage): TZSQLType;
122 var
123  P1, P2: Integer;
124  Temp: string;
125 begin
126  TypeName := UpperCase(TypeName);
127  Result := stString;
128  Precision := 0;
129  Decimals := 0;
130 
131  P1 := Pos('(', TypeName);
132  P2 := Pos(')', TypeName);
133  if (P1 > 0) and (P2 > 0) then
134  begin
135  Temp := Copy(TypeName, P1 + 1, P2 - P1 - 1);
136  TypeName := Copy(TypeName, 1, P1 - 1);
137  P1 := Pos(',', Temp);
138  if P1 > 0 then
139  begin
140  Precision := StrToIntDef(Copy(Temp, 1, P1 - 1), 0);
141  Decimals := StrToIntDef(Copy(Temp, P1 + 1, Length(Temp) - P1), 0);
142  end
143  else
144  Precision := StrToIntDef(Temp, 0);
145  end;
146 
147  if StartsWith(TypeName, 'BOOL') then
148  Result := stBoolean
149  else if TypeName = 'TINYINT' then
150  Result := stShort
151  else if TypeName = 'SMALLINT' then
152  Result := stShort
153  else if TypeName = 'MEDIUMINT' then
154  Result := stInteger
155  else if TypeName = {$IFDEF UNICODE}RawByteString{$ENDIF}('INTEGER') then
156  Result := stLong //http://www.sqlite.org/autoinc.html
157  else if StartsWith(TypeName, {$IFDEF UNICODE}RawByteString{$ENDIF}('INT')) then
158  Result := stInteger
159  else if TypeName = 'BIGINT' then
160  Result := stLong
161  else if StartsWith(TypeName, 'REAL') then
162  Result := stDouble
163  else if StartsWith(TypeName, 'FLOAT') then
164  Result := stDouble
165  else if (TypeName = 'NUMERIC') or (TypeName = 'DECIMAL')
166  or (TypeName = 'NUMBER') then
167  begin
168  { if Decimals = 0 then
169  Result := stInteger
170  else} Result := stDouble;
171  end
172  else if StartsWith(TypeName, 'DOUB') then
173  Result := stDouble
174  else if TypeName = 'MONEY' then
175  Result := stBigDecimal
176  else if StartsWith(TypeName, 'CHAR') then
177  Result := stString
178  else if TypeName = 'VARCHAR' then
179  Result := stString
180  else if TypeName = 'VARBINARY' then
181  Result := stBytes
182  else if TypeName = 'BINARY' then
183  Result := stBytes
184  else if TypeName = 'DATE' then
185  Result := stDate
186  else if TypeName = 'TIME' then
187  Result := stTime
188  else if TypeName = 'TIMESTAMP' then
189  Result := stTimestamp
190  else if TypeName = 'DATETIME' then
191  Result := stTimestamp
192  else if Pos('BLOB', TypeName) > 0 then
193  Result := stBinaryStream
194  else if Pos('CLOB', TypeName) > 0 then
195  Result := stAsciiStream
196  else if Pos('TEXT', TypeName) > 0 then
197  Result := stAsciiStream;
198 
199  if (Result = stInteger) and (Precision <> 0) then
200  begin
201  if Precision <= 2 then
202  Result := stByte
203  else if Precision <= 4 then
204  Result := stShort
205  else if Precision <= 9 then
206  Result := stInteger
207  else
208  Result := stLong;
209  end;
210 
211  if ( CtrlsCPType = cCP_UTF16 ) then
212  case Result of
213  stString: Result := stUnicodeString;
214  stAsciiStream: Result := stUnicodeStream;
215  end;
216 
217  if (Result = stString) then
218  if (Precision = 0) then
219  Precision := 255 *{$IFDEF UNICODE}2{$ELSE}4{$ENDIF}//UTF8 assumes 4Byte/Char
220  else
221  Precision := Precision*{$IFDEF UNICODE}2{$ELSE}4{$ENDIF};//UTF8 assumes 4Byte/Char
222 
223  if (Result = stUnicodeString) then
224  if (Precision = 0) then
225  Precision := 255 * 2 //UTF8 assumes 4Byte/Char -> 2 * UnicodeChar
226  else
227  Precision := Precision * 2;//UTF8 assumes 4Byte/Char
228 
229 end;
230 
231 {**
232  Checks for possible sql errors.
233  @param PlainDriver a SQLite plain driver.
234  @param ErrorCode an error code.
235  @param ErrorMessage an error message.
236  @param LogCategory a logging category.
237  @param LogMessage a logging message.
238 }
239 procedure CheckSQLiteError(PlainDriver: IZSQLitePlainDriver;
240  Handle: PSqlite;
241  ErrorCode: Integer; ErrorMessage: PAnsiChar;
242  LogCategory: TZLoggingCategory; LogMessage: string);
243 var
244  Error: string;
245 begin
246  if ErrorMessage <> nil then
247  begin
248  {$IFDEF UNICODE}
249  Error := trim(UTF8ToUnicodeString(ErrorMessage));
250  {$ELSE}
251  {$IFNDEF FPC}
252  Error := Trim(UTF8ToAnsi(StrPas(ErrorMessage)));
253  {$ELSE}
254  Error := Trim(StrPas(ErrorMessage));
255  {$ENDIF}
256  {$ENDIF}
257  PlainDriver.FreeMem(ErrorMessage);
258  end
259  else
260  Error := '';
261  if not (ErrorCode in [SQLITE_OK, SQLITE_ROW, SQLITE_DONE]) then
262  begin
263  if Error = '' then
264  Error := PlainDriver.ErrorString(Handle, ErrorCode);
265  DriverManager.LogError(LogCategory, PlainDriver.GetProtocol, LogMessage,
266  ErrorCode, Error);
267  raise EZSQLException.CreateWithCode(ErrorCode, Format(SSQLError1, [Error]));
268  end;
269 end;
270 
271 
272 function NewEncodeString(Buffer: PAnsiChar; Len: Integer): RawByteString; overload;
273 var
274  I: Integer;
275  ihx : integer;
276  shx : ansistring;
277 begin
278  SetLength( Result,3 + Len * 2 );
279  Result[1] := 'x'; // set x
280  Result[2] := ''''; // set Open Quote
281  ihx := 3; // set 1st hex location
282  for I := 1 to Len do
283  begin
284  shx := AnsiString(IntToHex( ord(Buffer^),2 )); // eg. '3E'
285  result[ihx] := shx[1]; Inc( ihx,1 ); // copy '3'
286  result[ihx] := shx[2]; Inc( ihx,1 ); // copy 'E'
287  Inc( Buffer,1 ); // next byte source location
288  end;
289  result[ihx] := ''''; // set Close Quote
290 end;
291 
292 function NewEncodeString(Value: RawByteString): RawByteString; overload;
293 begin
294  Result := NewEncodeString(PAnsiChar(Value), Length(Value));
295 end;
296 
297 function NewDecodeString(Value:ansistring):ansistring;
298 var
299  i : integer;
300  srcbuffer : PAnsichar;
301 begin
302  value := copy(value,3,length(value)-4);
303  value := {$IFDEF WITH_UNITANSISTRINGS}AnsiStrings.{$ENDIF}AnsiLowercase(value);
304  i := length(value) div 2;
305  srcbuffer := PAnsiChar(value);
306  setlength(result,i);
307  HexToBin(PAnsiChar(srcbuffer),PAnsiChar(result),i);
308 end;
309 
310 {**
311  Converts an string into escape PostgreSQL format.
312  @param Value a regular string.
313  @return a string in PostgreSQL escape format.
314 }
315 
316 function EncodeString(Buffer: PAnsiChar; Len: Integer): RawByteString; overload;
317 begin
318  result := NewEncodeString(Buffer, Len);
319 end;
320 
321 function EncodeString(Value: RawByteString): RawByteString; overload;
322 begin
323  result := NewEncodeString(Value);
324 end;
325 
326 {**
327  Converts an string from escape PostgreSQL format.
328  @param Value a string in PostgreSQL escape format.
329  @return a regular string.
330 }
331 function DecodeString(Value: ansistring): ansistring;
332 var
333  SrcLength, DestLength: Integer;
334  SrcBuffer, DestBuffer: PAnsiChar;
335 begin
336  if pos('x''',String(value))= 1 then
337  result := NewDecodeString(value)
338  else
339  begin
340  SrcLength := Length(Value);
341  SrcBuffer := PAnsiChar(Value);
342  SetLength(Result, SrcLength);
343  DestLength := 0;
344  DestBuffer := PAnsiChar(Result);
345 
346  while SrcLength > 0 do
347  begin
348  if SrcBuffer^ = '%' then
349  begin
350  Inc(SrcBuffer);
351  if SrcBuffer^ <> '0' then
352  DestBuffer^ := SrcBuffer^
353  else
354  DestBuffer^ := #0;
355  Inc(SrcBuffer);
356  Dec(SrcLength, 2);
357  end
358  else
359  begin
360  DestBuffer^ := SrcBuffer^;
361  Inc(SrcBuffer);
362  Dec(SrcLength);
363  end;
364  Inc(DestBuffer);
365  Inc(DestLength);
366  end;
367  SetLength(Result, DestLength);
368  end;
369 end;
370 
371 {**
372  Decodes a SQLite Version Value and Encodes it to a Zeos SQL Version format:
373  (major_version * 1,000,000) + (minor_version * 1,000) + sub_version
374  into separated major, minor and subversion values
375  @param SQLiteVersion an integer containing the Full Version to decode.
376  @return Encoded Zeos SQL Version Value.
377 }
378 function ConvertSQLiteVersionToSQLVersion( const SQLiteVersion: PAnsiChar ): Integer;
379 var
380  MajorVersion, MinorVersion, SubVersion: Integer;
381  s:string;
382 begin
383  s:=String(SQLiteVersion);
384  MajorVersion:=StrToIntDef(copy(s,1,pos('.',s)-1),0);
385  delete(s,1,pos('.',s));
386  MinorVersion:=StrToIntDef(copy(s,1,pos('.',s)-1),0);
387  delete(s,1,pos('.',s));
388  SubVersion:=StrToIntDef(s,0);
389  Result := EncodeSQLVersioning(MajorVersion,MinorVersion,SubVersion);
390 end;
391 
392 end.
393