00001 {*********************************************************}
00002 { }
00003 { Zeos Database Objects }
00004 { SQLite Database Connectivity Classes }
00005 { }
00006 { Originally written by Sergey Seroukhov }
00007 { }
00008 {*********************************************************}
00009
00010 {@********************************************************}
00011 { Copyright (c) 1999-2006 Zeos Development Group }
00012 { }
00013 { License Agreement: }
00014 { }
00015 { This library is distributed in the hope that it will be }
00016 { useful, but WITHOUT ANY WARRANTY; without even the }
00017 { implied warranty of MERCHANTABILITY or FITNESS FOR }
00018 { A PARTICULAR PURPOSE. See the GNU Lesser General }
00019 { Public License for more details. }
00020 { }
00021 { The source code of the ZEOS Libraries and packages are }
00022 { distributed under the Library GNU General Public }
00023 { License (see the file COPYING / COPYING.ZEOS) }
00024 { with the following modification: }
00025 { As a special exception, the copyright holders of this }
00026 { library give you permission to link this library with }
00027 { independent modules to produce an executable, }
00028 { regardless of the license terms of these independent }
00029 { modules, and to copy and distribute the resulting }
00030 { executable under terms of your choice, provided that }
00031 { you also meet, for each linked independent module, }
00032 { the terms and conditions of the license of that module. }
00033 { An independent module is a module which is not derived }
00034 { from or based on this library. If you modify this }
00035 { library, you may extend this exception to your version }
00036 { of the library, but you are not obligated to do so. }
00037 { If you do not wish to do so, delete this exception }
00038 { statement from your version. }
00039 { }
00040 { }
00041 { The project web site is located on: }
00042 { http:
00043 { http:
00044 { svn:
00045 { }
00046 { http:
00047 { http:
00048 { }
00049 { }
00050 { }
00051 { Zeos Development Group. }
00052 {********************************************************@}
00053
00054 unit ZDbcSqLiteUtils;
00055
00056 interface
00057
00058 {$I ZDbc.inc}
00059
00060 uses
00061 Classes, SysUtils, ZSysUtils, ZDbcIntfs, ZPlainSqLiteDriver, ZDbcLogging;
00062
00063 {**
00064 Convert string SQLite field type to SQLType
00065 @param string field type value
00066 @param Precision the column precision or size
00067 @param Decimals the column position after decimal point
00068 @result the SQLType field type value
00069 }
00070 function ConvertSQLiteTypeToSQLType(TypeName: string; var Precision: Integer;
00071 var Decimals: Integer): TZSQLType;
00072
00073 {**
00074 Checks for possible sql errors.
00075 @param PlainDriver a SQLite plain driver.
00076 @param ErrorCode an error code.
00077 @param ErrorMessage an error message.
00078 @param LogCategory a logging category.
00079 @param LogMessage a logging message.
00080 }
00081 procedure CheckSQLiteError(PlainDriver: IZSQLitePlainDriver;
00082 ErrorCode: Integer; ErrorMessage: PChar;
00083 LogCategory: TZLoggingCategory; LogMessage: string);
00084
00085 {**
00086 Converts an string into escape PostgreSQL format.
00087 @param Value a regular string.
00088 @return a string in PostgreSQL escape format.
00089 }
00090 function EncodeString(Value: string): string;
00091
00092 {**
00093 Converts an string from escape PostgreSQL format.
00094 @param Value a string in PostgreSQL escape format.
00095 @return a regular string.
00096 }
00097 function DecodeString(Value: string): string;
00098
00099 implementation
00100
00101 uses ZMessages;
00102
00103 {**
00104 Convert string SQLite field type to SQLType
00105 @param string field type value
00106 @param Precision the column precision or size
00107 @param Decimals the column position after decimal point
00108 @result the SQLType field type value
00109 }
00110 function ConvertSQLiteTypeToSQLType(TypeName: string; var Precision: Integer;
00111 var Decimals: Integer): TZSQLType;
00112 var
00113 P1, P2: Integer;
00114 Temp: string;
00115 begin
00116 TypeName := UpperCase(TypeName);
00117 Result := stString;
00118 Precision := 0;
00119 Decimals := 0;
00120
00121 P1 := Pos('(', TypeName);
00122 P2 := Pos(')', TypeName);
00123 if (P1 > 0) and (P2 > 0) then
00124 begin
00125 Temp := Copy(TypeName, P1 + 1, P2 - P1 - 1);
00126 TypeName := Copy(TypeName, 1, P1 - 1);
00127 P1 := Pos(',', Temp);
00128 if P1 > 0 then
00129 begin
00130 Precision := StrToIntDef(Copy(Temp, 1, P1 - 1), 0);
00131 Decimals := StrToIntDef(Copy(Temp, P1 + 1, Length(Temp) - P1), 0);
00132 end else
00133 Precision := StrToIntDef(Temp, 0);
00134 end;
00135
00136 if StartsWith(TypeName, 'BOOL') then
00137 Result := stBoolean
00138 else if TypeName = 'TINYINT' then
00139 Result := stByte
00140 else if TypeName = 'SMALLINT' then
00141 Result := stShort
00142 else if TypeName = 'MEDIUMINT' then
00143 Result := stInteger
00144 else if StartsWith(TypeName, 'INT') then
00145 Result := stInteger
00146 else if TypeName = 'BIGINT' then
00147 Result := stLong
00148 else if StartsWith(TypeName, 'REAL') then
00149 Result := stDouble
00150 else if StartsWith(TypeName, 'FLOAT') then
00151 Result := stDouble
00152 else if (TypeName = 'NUMERIC') or (TypeName = 'DECIMAL')
00153 or (TypeName = 'NUMBER') then
00154 begin
00155 { if Decimals = 0 then
00156 Result := stInteger
00157 else} Result := stDouble;
00158 end
00159 else if StartsWith(TypeName, 'DOUB') then
00160 Result := stDouble
00161 else if TypeName = 'MONEY' then
00162 Result := stBigDecimal
00163 else if StartsWith(TypeName, 'CHAR') then
00164 Result := stString
00165 else if TypeName = 'VARCHAR' then
00166 Result := stString
00167 else if TypeName = 'VARBINARY' then
00168 Result := stBytes
00169 else if TypeName = 'BINARY' then
00170 Result := stBytes
00171 else if TypeName = 'DATE' then
00172 Result := stDate
00173 else if TypeName = 'TIME' then
00174 Result := stTime
00175 else if TypeName = 'TIMESTAMP' then
00176 Result := stTimestamp
00177 else if TypeName = 'DATETIME' then
00178 Result := stTimestamp
00179 else if Pos('BLOB', TypeName) > 0 then
00180 Result := stBinaryStream
00181 else if Pos('CLOB', TypeName) > 0 then
00182 Result := stAsciiStream
00183 else if Pos('TEXT', TypeName) > 0 then
00184 Result := stAsciiStream;
00185
00186
00187 if (Result = stInteger) and (Precision <> 0) then
00188 begin
00189 if Precision <= 2 then
00190 Result := stByte
00191 else if Precision <= 4 then
00192 Result := stShort
00193 else if Precision <= 9 then
00194 Result := stInteger
00195 else Result := stLong;
00196 end;
00197
00198 if (Result = stString) and (Precision = 0) then
00199 Precision := 255;
00200 end;
00201
00202 {**
00203 Checks for possible sql errors.
00204 @param PlainDriver a SQLite plain driver.
00205 @param ErrorCode an error code.
00206 @param ErrorMessage an error message.
00207 @param LogCategory a logging category.
00208 @param LogMessage a logging message.
00209 }
00210 procedure CheckSQLiteError(PlainDriver: IZSQLitePlainDriver;
00211 ErrorCode: Integer; ErrorMessage: PChar;
00212 LogCategory: TZLoggingCategory; LogMessage: string);
00213 var
00214 Error: string;
00215 begin
00216 if ErrorMessage <> nil then
00217 begin
00218 Error := Trim(StrPas(ErrorMessage));
00219 PlainDriver.FreeMem(ErrorMessage);
00220 end else
00221 Error := '';
00222 if not (ErrorCode in [SQLITE_OK, SQLITE_ROW, SQLITE_DONE]) then
00223 begin
00224 if Error = '' then
00225 Error := StrPas(PlainDriver.ErrorString(ErrorCode));
00226
00227 DriverManager.LogError(LogCategory, PlainDriver.GetProtocol, LogMessage,
00228 ErrorCode, Error);
00229 raise EZSQLException.CreateWithCode(ErrorCode, Format(SSQLError1, [Error]));
00230 end;
00231 end;
00232
00233 {**
00234 Converts an string into escape PostgreSQL format.
00235 @param Value a regular string.
00236 @return a string in PostgreSQL escape format.
00237 }
00238 function EncodeString(Value: string): string;
00239 var
00240 I: Integer;
00241 SrcLength, DestLength: Integer;
00242 SrcBuffer, DestBuffer: PChar;
00243 begin
00244 SrcLength := Length(Value);
00245 SrcBuffer := PChar(Value);
00246 DestLength := 2;
00247 for I := 1 to SrcLength do
00248 begin
00249 if SrcBuffer^ in [#0, '''', '%'] then
00250 Inc(DestLength, 2)
00251 else Inc(DestLength);
00252 Inc(SrcBuffer);
00253 end;
00254
00255 SrcBuffer := PChar(Value);
00256 SetLength(Result, DestLength);
00257 DestBuffer := PChar(Result);
00258 DestBuffer^ := '''';
00259 Inc(DestBuffer);
00260
00261 for I := 1 to SrcLength do
00262 begin
00263 if SrcBuffer^ = #0 then
00264 begin
00265 DestBuffer[0] := '%';
00266 DestBuffer[1] := '0';
00267 Inc(DestBuffer, 2);
00268 end
00269 else if SrcBuffer^ = '%' then
00270 begin
00271 DestBuffer[0] := '%';
00272 DestBuffer[1] := '%';
00273 Inc(DestBuffer, 2);
00274 end
00275 else if SrcBuffer^ = '''' then
00276 begin
00277 DestBuffer[0] := '''';
00278 DestBuffer[1] := '''';
00279 Inc(DestBuffer, 2);
00280 end
00281 else
00282 begin
00283 DestBuffer^ := SrcBuffer^;
00284 Inc(DestBuffer);
00285 end;
00286 Inc(SrcBuffer);
00287 end;
00288 DestBuffer^ := '''';
00289 end;
00290
00291 {**
00292 Converts an string from escape PostgreSQL format.
00293 @param Value a string in PostgreSQL escape format.
00294 @return a regular string.
00295 }
00296 function DecodeString(Value: string): string;
00297 var
00298 SrcLength, DestLength: Integer;
00299 SrcBuffer, DestBuffer: PChar;
00300 begin
00301 SrcLength := Length(Value);
00302 SrcBuffer := PChar(Value);
00303 SetLength(Result, SrcLength);
00304 DestLength := 0;
00305 DestBuffer := PChar(Result);
00306
00307 while SrcLength > 0 do
00308 begin
00309 if SrcBuffer^ = '%' then
00310 begin
00311 Inc(SrcBuffer);
00312 if SrcBuffer^ <> '0' then
00313 DestBuffer^ := SrcBuffer^
00314 else DestBuffer^ := #0;
00315 Inc(SrcBuffer);
00316 Dec(SrcLength, 2);
00317 end
00318 else
00319 begin
00320 DestBuffer^ := SrcBuffer^;
00321 Inc(SrcBuffer);
00322 Dec(SrcLength);
00323 end;
00324 Inc(DestBuffer);
00325 Inc(DestLength);
00326 end;
00327 SetLength(Result, DestLength);
00328 end;
00329
00330 end.