00001 {*********************************************************}
00002 { }
00003 { Zeos Database Objects }
00004 { Database Connectivity Functions }
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 ZDbcUtils;
00055
00056 interface
00057
00058 {$I ZDbc.inc}
00059
00060 uses
00061 {$IFNDEF VER130BELOW}
00062 Types,
00063 {$ENDIF}
00064 Classes, SysUtils, Contnrs, ZCompatibility, ZDbcIntfs, ZDbcResultSetMetadata;
00065
00066 {**
00067 Resolves a connection protocol and raises an exception with protocol
00068 is not supported.
00069 @param Url an initial database URL.
00070 @param SuupportedProtocols a driver's supported subprotocols.
00071 }
00072 function ResolveConnectionProtocol(Url: string;
00073 SupportedProtocols: TStringDynArray): string;
00074
00075 {**
00076 Resolves a database URL and fills the database connection parameters.
00077 @param Url an initial database URL.
00078 @param Info an initial info parameters.
00079 @param HostName a name of the database host.
00080 @param Port a port number.
00081 @param Database a database name.
00082 @param UserName a name of the database user.
00083 @param Password a user's password.
00084 @param ResutlInfo a result info parameters.
00085 }
00086 procedure ResolveDatabaseUrl(const Url: string; Info: TStrings;
00087 var HostName: string; var Port: Integer; var Database: string;
00088 var UserName: string; var Password: string; ResultInfo: TStrings);
00089
00090 {**
00091 Checks is the convertion from one type to another type allowed.
00092 @param InitialType an initial data type.
00093 @param ResultType a result data type.
00094 @return <code>True</code> if convertion is allowed
00095 or <code>False</code> otherwise.
00096 }
00097 function CheckConvertion(InitialType: TZSQLType; ResultType: TZSQLType): Boolean;
00098
00099 {**
00100 Defines a name of the column type.
00101 @param ColumnType a type of the column.
00102 @return a name of the specified type.
00103 }
00104 function DefineColumnTypeName(ColumnType: TZSQLType): string;
00105
00106 {**
00107 Raises a copy of the given exception.
00108 @param E an exception to be raised.
00109 }
00110 procedure RaiseSQLException(E: Exception);
00111
00112 {**
00113 Copies column information objects from one object list to another one.
00114 @param FromList the source object list.
00115 @param ToList the destination object list.
00116 }
00117 procedure CopyColumnsInfo(FromList: TObjectList; ToList: TObjectList);
00118
00119 {**
00120 Defines a statement specific parameter.
00121 @param Statement a statement interface reference.
00122 @param ParamName a name of the parameter.
00123 @param Default a parameter default value.
00124 @return a parameter value or default if nothing was found.
00125 }
00126 function DefineStatementParameter(Statement: IZStatement; const ParamName: string;
00127 const Default: string): string;
00128
00129 {**
00130 AnsiQuotedStr or NullText
00131 @param S the string
00132 @param NullText the "NULL"-Text
00133 @param QuoteChar the char that is used for quotation
00134 @return 'null' if S is '', otherwise AnsiQuotedStr(S)
00135 }
00136 function AQSNullText(const Value, NullText: string; QuoteChar: Char = ''''): string;
00137
00138 {**
00139 AnsiQuotedStr or Null
00140 @param S the string
00141 @return 'null' if S is '', otherwise AnsiQuotedStr(S)
00142 }
00143 function AQSNull(const Value: string; QuoteChar: Char = ''''): string;
00144
00145 {**
00146 ToLikeString returns the given string or if the string is empty it returns '%'
00147 @param Value the string
00148 @return given Value or '%'
00149 }
00150 function ToLikeString(const Value: string): string;
00151
00152 implementation
00153
00154 uses ZMessages, ZSysUtils;
00155
00156 {**
00157 Resolves a connection protocol and raises an exception with protocol
00158 is not supported.
00159 @param Url an initial database URL.
00160 @param SupportedProtocols a driver's supported subprotocols.
00161 }
00162 function ResolveConnectionProtocol(Url: string;
00163 SupportedProtocols: TStringDynArray): string;
00164 var
00165 I: Integer;
00166 Protocol: string;
00167 Index: Integer;
00168 begin
00169 Result := '';
00170
00171 Index := FirstDelimiter(':', Url);
00172 if Index > 0 then
00173 Protocol := Copy(Url, Index + 1, Length(Url) - Index)
00174 else Protocol := '';
00175 Index := FirstDelimiter(':', Protocol);
00176 if Index > 1 then
00177 Protocol := Copy(Protocol, 1, Index - 1)
00178 else Protocol := '';
00179
00180 if Protocol = '' then
00181 raise EZSQLException.Create(Format(SIncorrectConnectionURL, [Url]));
00182
00183 for I := Low(SupportedProtocols) to High(SupportedProtocols) do
00184 begin
00185 if SupportedProtocols[I] = Protocol then
00186 begin
00187 Result := Protocol;
00188 Break;
00189 end;
00190 end;
00191
00192 if Result = '' then
00193 raise EZSQLException.Create(Format(SUnsupportedProtocol, [Protocol]));
00194 end;
00195
00196 {**
00197 Resolves a database URL and fills the database connection parameters.
00198 @param Url an initial database URL.
00199 @param Info an initial info parameters.
00200 @param HostName a name of the database host.
00201 @param Port a port number.
00202 @param Database a database name.
00203 @param UserName a name of the database user.
00204 @param Password a user's password.
00205 @param ResutlInfo a result info parameters.
00206 }
00207 procedure ResolveDatabaseUrl(const Url: string; Info: TStrings;
00208 var HostName: string; var Port: Integer; var Database: string;
00209 var UserName: string; var Password: string; ResultInfo: TStrings);
00210 var
00211 Index: Integer;
00212 Temp: string;
00213
00214 procedure RaiseException;
00215 begin
00216 raise EZSQLException.Create(Format(SIncorrectConnectionURL, [Url]));
00217 end;
00218
00219 begin
00220 { Set default values. }
00221 HostName := 'localhost';
00222 Port := 0;
00223 Database := '';
00224 UserName := '';
00225 Password := '';
00226 ResultInfo.Clear;
00227
00228 Temp := Copy(Url, 6, Length(Url) - 5);
00229 Index := FirstDelimiter(':', Temp);
00230 if Index > 0 then
00231 Temp := Copy(Temp, Index + 1, Length(Temp) - Index)
00232 else
00233 RaiseException;
00234
00235 { Retrieves the host name. }
00236 if Pos('//', Temp) = 1 then
00237 begin
00238 Delete(Temp, 1, 2);
00239 Index := FirstDelimiter('/:?', Temp);
00240 if Index = 0 then
00241 RaiseException;
00242
00243 HostName := Copy(Temp, 1, Index - 1);
00244 Delete(Temp, 1, Index - 1);
00245
00246 { Retrieves port }
00247 if Pos(':', Temp) = 1 then
00248 begin
00249 Delete(Temp, 1, 1);
00250 Index := FirstDelimiter('/?', Temp);
00251 if Index = 0 then
00252 RaiseException;
00253
00254 Port := StrToInt(Copy(Temp, 1, Index - 1));
00255 Delete(Temp, 1, Index - 1);
00256 end;
00257
00258 if Pos('/', Temp) <> 1 then
00259 RaiseException;
00260 Delete(Temp, 1, 1);
00261 end;
00262
00263 { Retrieves database }
00264 Index := FirstDelimiter('?', Temp);
00265 if Index > 0 then
00266 begin
00267 Database := Copy(Temp, 1, Index - 1);
00268 Delete(Temp, 1, Index);
00269 PutSplitString(ResultInfo, Temp, ';');
00270 end else
00271 Database := Temp;
00272
00273 if Info <> nil then
00274 ResultInfo.AddStrings(Info);
00275
00276 { Defines user name }
00277 UserName := ResultInfo.Values['UID'];
00278 if UserName = '' then
00279 UserName := ResultInfo.Values['username'];
00280
00281 { Defines user password }
00282 Password := ResultInfo.Values['PWD'];
00283 if Password = '' then
00284 Password := ResultInfo.Values['password'];
00285 end;
00286
00287 {**
00288 Checks is the convertion from one type to another type allowed.
00289 @param InitialType an initial data type.
00290 @param ResultType a result data type.
00291 @return <code>True</code> if convertion is allowed
00292 or <code>False</code> otherwise.
00293 }
00294 function CheckConvertion(InitialType: TZSQLType; ResultType: TZSQLType): Boolean;
00295 begin
00296 case ResultType of
00297 stBoolean, stByte, stShort, stInteger,
00298 stLong, stFloat, stDouble, stBigDecimal:
00299 Result := InitialType in [stBoolean, stByte, stShort, stInteger,
00300 stLong, stFloat, stDouble, stBigDecimal, stString, stUnicodeString];
00301 stString, stUnicodeString:
00302 Result := True;
00303 stBytes:
00304 Result := InitialType in [stString, stUnicodeString, stBytes,
00305 stAsciiStream, stUnicodeStream, stBinaryStream];
00306 stTimestamp:
00307 Result := InitialType in [stString, stUnicodeString, stDate, stTime, stTimestamp];
00308 stDate:
00309 Result := InitialType in [stString, stUnicodeString, stDate, stTimestamp];
00310 stTime:
00311 Result := InitialType in [stString, stUnicodeString, stTime, stTimestamp];
00312 else
00313 Result := (ResultType = InitialType) and (InitialType <> stUnknown);
00314 end;
00315 end;
00316
00317 {**
00318 Defines a name of the column type.
00319 @param ColumnType a type of the column.
00320 @return a name of the specified type.
00321 }
00322 function DefineColumnTypeName(ColumnType: TZSQLType): string;
00323 begin
00324 case ColumnType of
00325 stBoolean:
00326 Result := 'Boolean';
00327 stByte:
00328 Result := 'Byte';
00329 stShort:
00330 Result := 'Short';
00331 stInteger:
00332 Result := 'Integer';
00333 stLong:
00334 Result := 'Long';
00335 stFloat:
00336 Result := 'Float';
00337 stDouble:
00338 Result := 'Double';
00339 stBigDecimal:
00340 Result := 'BigDecimal';
00341 stString:
00342 Result := 'String';
00343 stUnicodeString:
00344 Result := 'UnicodeString';
00345 stBytes:
00346 Result := 'Bytes';
00347 stDate:
00348 Result := 'Date';
00349 stTime:
00350 Result := 'Time';
00351 stTimestamp:
00352 Result := 'Timestamp';
00353 stAsciiStream:
00354 Result := 'AsciiStream';
00355 stUnicodeStream:
00356 Result := 'UnicodeStream';
00357 stBinaryStream:
00358 Result := 'BinaryStream';
00359 else
00360 Result := 'Unknown';
00361 end;
00362 end;
00363
00364 {**
00365 Raises a copy of the given exception.
00366 @param E an exception to be raised.
00367 }
00368 procedure RaiseSQLException(E: Exception);
00369 begin
00370 if E is EZSQLException then begin
00371 raise EZSQLException.CreateClone(EZSQLException(E));
00372 end else begin
00373 raise EZSQLException.Create(E.Message);
00374 end;
00375 end;
00376
00377 {**
00378 Copies column information objects from one object list to another one.
00379 @param FromList the source object list.
00380 @param ToList the destination object list.
00381 }
00382 procedure CopyColumnsInfo(FromList: TObjectList; ToList: TObjectList);
00383 var
00384 I: Integer;
00385 Current: TZColumnInfo;
00386 ColumnInfo: TZColumnInfo;
00387 begin
00388 for I := 0 to FromList.Count - 1 do
00389 begin
00390 Current := TZColumnInfo(FromList[I]);
00391 ColumnInfo := TZColumnInfo.Create;
00392
00393 ColumnInfo.AutoIncrement := Current.AutoIncrement;
00394 ColumnInfo.CaseSensitive := Current.CaseSensitive;
00395 ColumnInfo.Searchable := Current.Searchable;
00396 ColumnInfo.Currency := Current.Currency;
00397 ColumnInfo.Nullable := Current.Nullable;
00398 ColumnInfo.Signed := Current.Signed;
00399 ColumnInfo.ColumnDisplaySize := Current.ColumnDisplaySize;
00400 ColumnInfo.ColumnLabel := Current.ColumnLabel;
00401 ColumnInfo.ColumnName := Current.ColumnName;
00402 ColumnInfo.SchemaName := Current.SchemaName;
00403 ColumnInfo.Precision := Current.Precision;
00404 ColumnInfo.Scale := Current.Scale;
00405 ColumnInfo.TableName := Current.TableName;
00406 ColumnInfo.CatalogName := Current.CatalogName;
00407 ColumnInfo.ColumnType := Current.ColumnType;
00408 ColumnInfo.ReadOnly := Current.ReadOnly;
00409 ColumnInfo.Writable := Current.Writable;
00410 ColumnInfo.DefinitelyWritable := Current.DefinitelyWritable;
00411
00412 ToList.Add(ColumnInfo);
00413 end;
00414 end;
00415
00416 {**
00417 Defines a statement specific parameter.
00418 @param Statement a statement interface reference.
00419 @param ParamName a name of the parameter.
00420 @param Default a parameter default value.
00421 @return a parameter value or default if nothing was found.
00422 }
00423 function DefineStatementParameter(Statement: IZStatement; const ParamName: string;
00424 const Default: string): string;
00425 begin
00426 Result := Statement.GetParameters.Values[ParamName];
00427 if Result = '' then
00428 Result := Statement.GetConnection.GetParameters.Values[ParamName];
00429 if Result = '' then
00430 Result := Default;
00431 end;
00432
00433 {**
00434 AnsiQuotedStr or NullText
00435 @param S the string
00436 @param NullText the "NULL"-Text
00437 @param QuoteChar the char that is used for quotation
00438 @return 'null' if S is '', otherwise AnsiQuotedStr(S)
00439 }
00440 function AQSNullText(const Value, NullText: string; QuoteChar: Char): string;
00441 begin
00442 if Value = '' then
00443 Result := NullText
00444 else
00445 Result := AnsiQuotedStr(Value, QuoteChar);
00446 end;
00447
00448 {**
00449 AnsiQuotedStr or Null
00450 @param S the string
00451 @param QuoteChar the char that is used for quotation
00452 @return 'null' if S is '', otherwise AnsiQuotedStr(S)
00453 }
00454 function AQSNull(const Value: string; QuoteChar: Char): string;
00455 begin
00456 Result := AQSNullText(Value, 'null', QuoteChar);
00457 end;
00458
00459 {**
00460 ToLikeString returns the given string or if the string is empty it returns '%'
00461 @param Value the string
00462 @return given Value or '%'
00463 }
00464 function ToLikeString(const Value: string): string;
00465 begin
00466 if Value = '' then
00467 Result := '%'
00468 else
00469 Result := Value;
00470 end;
00471
00472 end.
00473