00001 {*********************************************************}
00002 { }
00003 { Zeos Database Objects }
00004 { ADO Specific Utilities }
00005 { }
00006 { Originally written by Janos Fegyverneki }
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 ZDbcAdoUtils;
00055
00056 interface
00057
00058 {$I ZDbc.inc}
00059
00060 uses Windows, Classes, SysUtils, ActiveX, ZDbcIntfs;
00061
00062 {**
00063 Converts an ADO native types into string related.
00064 @param FieldType dblibc native field type.
00065 @return a string data type name.
00066 }
00067 function ConvertAdoToTypeName(FieldType: SmallInt): string;
00068
00069 {**
00070 Converts a Ado native types into ZDBC SQL types.
00071 @param FieldType dblibc native field type.
00072 @return a SQL undepended type.
00073 }
00074 function ConvertAdoToSqlType(FieldType: SmallInt): TZSQLType;
00075
00076 {**
00077 Converts a Zeos type into ADO types.
00078 @param FieldType zeos field type.
00079 @return a ADO datatype.
00080 }
00081 function ConvertSqlTypeToAdo(FieldType: TZSQLType): Integer;
00082
00083 {**
00084 Converts a Variant type into ADO types.
00085 @param VT Variant datatype.
00086 @return a ADO datatype.
00087 }
00088 {$IFDEF VER130BELOW}
00089 function ConvertVariantToAdo(VT: Integer): Integer;
00090 {$ELSE}
00091 function ConvertVariantToAdo(VT: TVarType): Integer;
00092 {$ENDIF}
00093
00094 {**
00095 Converts a TZResultSetType type into ADO cursor type.
00096 @param ResultSetType.
00097 @return a ADO cursor type.
00098 }
00099 function ConvertResultSetTypeToAdo(ResultSetType: TZResultSetType): Integer;
00100
00101 {**
00102 Converts a TZResultSetConcurrency type into ADO lock type.
00103 @param ResultSetConcurrency.
00104 @return a ADO lock type.
00105 }
00106 function ConvertResultSetConcurrencyToAdo(ResultSetConcurrency: TZResultSetConcurrency): Integer;
00107
00108 {**
00109 Converts a OLEDB schema guid into ADO schema ID usable with OpenSchema.
00110 @param OleDBSchema schema guid.
00111 @return a ADO schema id.
00112 }
00113 function ConvertOleDBToAdoSchema(OleDBSchema: TGUID): Integer;
00114
00115 {**
00116 Brings up the ADO connection string builder dialog.
00117 }
00118 function PromptDataSource(Handle: THandle; InitialString: WideString): WideString;
00119
00120 var
00121 {**
00122 Required to free memory allocated by oledb
00123 }
00124 ZAdoMalloc: IMalloc;
00125
00126 implementation
00127
00128 uses
00129 ComObj, OleDB, ZCompatibility, ZSysUtils, ZPlainAdo;
00130
00131 {**
00132 Converts an ADO native types into string related.
00133 @param FieldType dblibc native field type.
00134 @return a string data type name.
00135 }
00136 function ConvertAdoToTypeName(FieldType: SmallInt): string;
00137 begin
00138 case FieldType of
00139 adChar : Result := 'Char';
00140 adVarChar : Result := 'VarChar';
00141 adBSTR : Result := 'BSTR';
00142 adWChar : Result := 'WChar';
00143 adVarWChar : Result := 'VarWChar';
00144 adBoolean : Result := 'Boolean';
00145 adTinyInt : Result := 'TinyInt';
00146 adUnsignedTinyInt : Result := 'UnsignedTinyInt';
00147 adSmallInt : Result := 'SmallInt';
00148 adUnsignedSmallInt : Result := 'UnsignedSmallInt';
00149 adInteger : Result := 'Integer';
00150 adUnsignedInt : Result := 'UnsignedInt';
00151 adBigInt : Result := 'BigInt';
00152 adUnsignedBigInt : Result := 'UnsignedBigInt';
00153 adSingle : Result := 'Single';
00154 adDouble : Result := 'Double';
00155 adDecimal : Result := 'Decimal';
00156 adNumeric : Result := 'Numeric';
00157 adVarNumeric : Result := 'VarNumeric';
00158 adCurrency : Result := 'Currency';
00159 adDBDate : Result := 'DBDate';
00160 adDBTime : Result := 'DBTime';
00161 adDate : Result := 'Date';
00162 adDBTimeStamp : Result := 'DBTimeStamp';
00163 adFileTime : Result := 'FileTime';
00164 adLongVarChar : Result := 'LongVarChar';
00165 adLongVarWChar : Result := 'LongVarWChar';
00166 adBinary : Result := 'Binary';
00167 adVarBinary : Result := 'VarBinary';
00168 adLongVarBinary : Result := 'LongVarBinary';
00169 adGUID : Result := 'GUID';
00170 adEmpty : Result := 'Empty';
00171 adError : Result := 'Error';
00172 adArray : Result := 'Array';
00173 adChapter : Result := 'Chapter';
00174 adIDispatch : Result := 'IDispatch';
00175 adIUnknown : Result := 'IUnknown';
00176 adPropVariant : Result := 'PropVariant';
00177 adUserDefined : Result := 'UserDefined';
00178 adVariant : Result := 'Variant';
00179 else
00180 Result := 'Unknown';
00181 end;
00182 end;
00183
00184 {**
00185 Converts a Ado native types into ZDBC SQL types.
00186 @param FieldType dblibc native field type.
00187 @return a SQL undepended type.
00188 }
00189 function ConvertAdoToSqlType(FieldType: SmallInt): TZSQLType;
00190 begin
00191 case FieldType of
00192 adChar, adVarChar, adBSTR: Result := stString;
00193 adWChar, adVarWChar: Result := stUnicodeString;
00194 adBoolean: Result := stBoolean;
00195
00196
00197 adTinyInt, adUnsignedTinyInt: Result := stShort;
00198 adSmallInt, adUnsignedSmallInt: Result := stShort;
00199 adInteger, adUnsignedInt: Result := stInteger;
00200 adBigInt, adUnsignedBigInt: Result := stLong;
00201 adSingle: Result := stDouble;
00202 adDouble: Result := stDouble;
00203 adDecimal: Result := stBigDecimal;
00204 adNumeric, adVarNumeric: Result := stBigDecimal;
00205 adCurrency: Result := stBigDecimal;
00206 adDBDate: Result := stDate;
00207 adDBTime: Result := stTime;
00208 adDate : Result := stDate;
00209 adDBTimeStamp, adFileTime: Result := stTimestamp;
00210 adLongVarChar: Result := stAsciiStream;
00211 adLongVarWChar: Result := stUnicodeStream;
00212 adBinary, adVarBinary, adLongVarBinary: Result := stBinaryStream;
00213 adGUID: Result := stString;
00214
00215 adEmpty, adError, AdArray, adChapter, adIDispatch, adIUnknown,
00216 adPropVariant, adUserDefined, adVariant: Result := stString;
00217 else
00218 Result := stString;
00219 end;
00220 end;
00221
00222 {**
00223 Converts a Zeos type into ADO types.
00224 @param FieldType zeos field type.
00225 @return a ADO datatype.
00226 }
00227 function ConvertSqlTypeToAdo(FieldType: TZSQLType): Integer;
00228 begin
00229 case FieldType of
00230 stString: Result := adVarChar;
00231 stUnicodeString: Result := adVarWChar;
00232 stBoolean: Result := adBoolean;
00233 stByte: Result := adTinyInt;
00234 stShort: Result := adSmallInt;
00235 stInteger: Result := adInteger;
00236 stLong: Result := adBigInt;
00237 stBigDecimal: Result := adDecimal;
00238 stFloat: Result := adSingle;
00239 stDouble: Result := adDouble;
00240 stDate: Result := adDBDate;
00241 stTime: Result := adDBTime;
00242 stTimestamp: Result := adDBTimeStamp;
00243 stBytes: Result := adVarBinary;
00244 stAsciiStream: Result := adLongVarChar;
00245 stUnicodeStream: Result := adLongVarWChar;
00246 stBinaryStream: Result := adLongVarBinary;
00247 else
00248 Result := adEmpty;
00249 end;
00250 end;
00251
00252 {**
00253 Converts a Variant type into ADO types.
00254 @param VT Variant datatype.
00255 @return a ADO datatype.
00256 }
00257 {$IFDEF VER130BELOW}
00258 function ConvertVariantToAdo(VT: Integer): Integer;
00259 {$ELSE}
00260 function ConvertVariantToAdo(VT: TVarType): Integer;
00261 {$ENDIF}
00262 begin
00263 case VT and varTypeMask of
00264 varEmpty: Result := adEmpty;
00265 varNull: Result := adVarChar;
00266 varSmallint: Result := adSmallInt;
00267 varInteger: Result := adInteger;
00268 varSingle: Result := adSingle;
00269 varDouble: Result := adDouble;
00270 varCurrency: Result := adCurrency;
00271 varDate: Result := adDate;
00272 varOleStr: Result := adVarWChar;
00273 varDispatch: Result := adIDispatch;
00274 varError: Result := adError;
00275 varBoolean: Result := adBoolean;
00276 varVariant: Result := adVariant;
00277 varUnknown: Result := adIUnknown;
00278 {$IFNDEF VER130BELOW}
00279 varShortInt: Result := adTinyInt;
00280 {$ENDIF}
00281 varByte: if (VT and varArray) <> 0 then Result := adLongVarBinary else Result := adUnsignedTinyInt;
00282 {$IFNDEF VER130BELOW}
00283 varWord: Result := adUnsignedSmallInt;
00284 varLongWord: Result := adUnsignedInt;
00285 varInt64: Result := adBigInt;
00286 {$ENDIF}
00287 varStrArg: Result := adWChar;
00288 varString: Result := adVarChar;
00289 varAny: Result := adEmpty;
00290 else
00291 Result := adEmpty;
00292 end;
00293 end;
00294
00295
00296 {**
00297 Converts a TZResultSetType type into ADO cursor type.
00298 @param ResultSetType.
00299 @return a ADO cursor type.
00300 }
00301 function ConvertResultSetTypeToAdo(ResultSetType: TZResultSetType): Integer;
00302 begin
00303 case ResultSetType of
00304 rtForwardOnly: Result := adOpenForwardOnly;
00305 rtScrollInsensitive: Result := adOpenStatic;
00306 rtScrollSensitive: Result := adOpenDynamic;
00307 else
00308 Result := -1;
00309 end
00310 end;
00311
00312 {**
00313 Converts a TZResultSetConcurrency type into ADO lock type.
00314 @param ResultSetConcurrency.
00315 @return a ADO lock type.
00316 }
00317 function ConvertResultSetConcurrencyToAdo(ResultSetConcurrency: TZResultSetConcurrency): Integer;
00318 begin
00319 case ResultSetConcurrency of
00320 rcReadOnly: Result := adLockReadOnly;
00321 rcUpdatable: Result := adLockOptimistic;
00322 else
00323 Result := -1;
00324 end
00325 end;
00326
00327 {**
00328 Converts a OLEDB schema guid into ADO schema ID usable with OpenSchema.
00329 @param OleDBSchema schema guid.
00330 @return a ADO schema id.
00331 }
00332 function ConvertOleDBToAdoSchema(OleDBSchema: TGUID): Integer;
00333 begin
00334 Result := -1;
00335 if IsEqualGuid(OleDBSchema, DBSCHEMA_ASSERTIONS) then Result := 0;
00336 if IsEqualGuid(OleDBSchema, DBSCHEMA_CATALOGS) then Result := 1;
00337 if IsEqualGuid(OleDBSchema, DBSCHEMA_CHARACTER_SETS) then Result := 2;
00338 if IsEqualGuid(OleDBSchema, DBSCHEMA_COLLATIONS) then Result := 3;
00339 if IsEqualGuid(OleDBSchema, DBSCHEMA_COLUMNS) then Result := 4;
00340 if IsEqualGuid(OleDBSchema, DBSCHEMA_CHECK_CONSTRAINTS) then Result := 5;
00341 if IsEqualGuid(OleDBSchema, DBSCHEMA_CONSTRAINT_COLUMN_USAGE) then Result := 6;
00342 if IsEqualGuid(OleDBSchema, DBSCHEMA_CONSTRAINT_TABLE_USAGE) then Result := 7;
00343 if IsEqualGuid(OleDBSchema, DBSCHEMA_KEY_COLUMN_USAGE) then Result := 8;
00344 if IsEqualGuid(OleDBSchema, DBSCHEMA_REFERENTIAL_CONSTRAINTS) then Result := 9;
00345 if IsEqualGuid(OleDBSchema, DBSCHEMA_TABLE_CONSTRAINTS) then Result := 10;
00346 if IsEqualGuid(OleDBSchema, DBSCHEMA_COLUMN_DOMAIN_USAGE) then Result := 11;
00347 if IsEqualGuid(OleDBSchema, DBSCHEMA_INDEXES) then Result := 12;
00348 if IsEqualGuid(OleDBSchema, DBSCHEMA_COLUMN_PRIVILEGES) then Result := 13;
00349 if IsEqualGuid(OleDBSchema, DBSCHEMA_TABLE_PRIVILEGES) then Result := 14;
00350 if IsEqualGuid(OleDBSchema, DBSCHEMA_USAGE_PRIVILEGES) then Result := 15;
00351 if IsEqualGuid(OleDBSchema, DBSCHEMA_PROCEDURES) then Result := 16;
00352 if IsEqualGuid(OleDBSchema, DBSCHEMA_SCHEMATA) then Result := 17;
00353 if IsEqualGuid(OleDBSchema, DBSCHEMA_SQL_LANGUAGES) then Result := 18;
00354 if IsEqualGuid(OleDBSchema, DBSCHEMA_STATISTICS) then Result := 19;
00355 if IsEqualGuid(OleDBSchema, DBSCHEMA_TABLES) then Result := 20;
00356 if IsEqualGuid(OleDBSchema, DBSCHEMA_TRANSLATIONS) then Result := 21;
00357 if IsEqualGuid(OleDBSchema, DBSCHEMA_PROVIDER_TYPES) then Result := 22;
00358 if IsEqualGuid(OleDBSchema, DBSCHEMA_VIEWS) then Result := 23;
00359 if IsEqualGuid(OleDBSchema, DBSCHEMA_VIEW_COLUMN_USAGE) then Result := 24;
00360 if IsEqualGuid(OleDBSchema, DBSCHEMA_VIEW_TABLE_USAGE) then Result := 25;
00361 if IsEqualGuid(OleDBSchema, DBSCHEMA_PROCEDURE_PARAMETERS) then Result := 26;
00362 if IsEqualGuid(OleDBSchema, DBSCHEMA_FOREIGN_KEYS) then Result := 27;
00363 if IsEqualGuid(OleDBSchema, DBSCHEMA_PRIMARY_KEYS) then Result := 28;
00364 if IsEqualGuid(OleDBSchema, DBSCHEMA_PROCEDURE_COLUMNS) then Result := 29;
00365 if IsEqualGuid(OleDBSchema, MDSCHEMA_CUBES) then Result := 32;
00366 if IsEqualGuid(OleDBSchema, MDSCHEMA_DIMENSIONS) then Result := 33;
00367 if IsEqualGuid(OleDBSchema, MDSCHEMA_HIERARCHIES) then Result := 34;
00368 if IsEqualGuid(OleDBSchema, MDSCHEMA_LEVELS) then Result := 35;
00369 if IsEqualGuid(OleDBSchema, MDSCHEMA_MEASURES) then Result := 36;
00370 if IsEqualGuid(OleDBSchema, MDSCHEMA_PROPERTIES) then Result := 37;
00371 if IsEqualGuid(OleDBSchema, MDSCHEMA_MEMBERS) then Result := 38;
00372 if IsEqualGuid(OleDBSchema, DBPROPSET_TRUSTEE) then Result := 39;
00373 end;
00374
00375 {**
00376 Brings up the ADO connection string builder dialog.
00377 }
00378 function PromptDataSource(Handle: THandle; InitialString: WideString): WideString;
00379 var
00380 DataInit: IDataInitialize;
00381 DBPrompt: IDBPromptInitialize;
00382 DataSource: IUnknown;
00383 InitStr: PWideChar;
00384 begin
00385 Result := InitialString;
00386 DataInit := CreateComObject(CLSID_DataLinks) as IDataInitialize;
00387 if InitialString <> '' then
00388 DataInit.GetDataSource(nil, CLSCTX_INPROC_SERVER,
00389 PWideChar(InitialString), IUnknown, DataSource);
00390 DBPrompt := CreateComObject(CLSID_DataLinks) as IDBPromptInitialize;
00391 if Succeeded(DBPrompt.PromptDataSource(nil, Handle,
00392 DBPROMPTOPTIONS_PROPERTYSHEET, 0, nil, nil, IUnknown, DataSource)) then
00393 begin
00394 InitStr := nil;
00395 DataInit.GetInitializationString(DataSource, True, InitStr);
00396 Result := InitStr;
00397 end;
00398 end;
00399
00400 initialization
00401 OleCheck(CoGetMalloc(1, ZAdoMalloc));
00402 finalization
00403 ZAdoMalloc := nil;
00404 end.
00405
00406