00001 {*********************************************************}
00002 { }
00003 { Zeos Database Objects }
00004 { ADO Statement Classes }
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 ZDbcAdoStatement;
00055
00056 interface
00057
00058 {$I ZDbc.inc}
00059
00060 uses
00061 {$IFNDEF UNIX}
00062 {$IFNDEF VER130BELOW}
00063 Types,
00064 {$ENDIF}
00065 {$ENDIF}
00066 Classes, SysUtils, ZCompatibility, ZClasses, ZSysUtils, ZCollections,
00067 ZDbcIntfs, ZPlainDriver, ZDbcStatement, ZDbcAdo, ZPlainAdoDriver, ZPlainAdo,
00068 ZVariant;
00069
00070 type
00071 {** Implements Generic ADO Statement. }
00072 TZAdoStatement = class(TZAbstractCallableStatement)
00073 protected
00074 AdoRecordSet: ZPlainAdo.RecordSet;
00075 FPlainDriver: IZPlainDriver;
00076 function GetCurrentResult(RC: Integer): Boolean; virtual;
00077 function IsSelect(const SQL: string): Boolean;
00078 public
00079 constructor Create(PlainDriver: IZPlainDriver; Connection: IZConnection; SQL: string; Info: TStrings);
00080 destructor Destroy; override;
00081 procedure Close; override;
00082
00083 function ExecuteQuery(const SQL: string): IZResultSet; override;
00084 function ExecuteUpdate(const SQL: string): Integer; override;
00085 function Execute(const SQL: string): Boolean; override;
00086 function GetMoreResults: Boolean; override;
00087 end;
00088
00089 {** Implements Prepared ADO Statement. }
00090 TZAdoPreparedStatement = class(TZAdoStatement)
00091 protected
00092 FAdoCommand: ZPlainAdo.Command;
00093 procedure SetInParamCount(NewParamCount: Integer); override;
00094 procedure SetInParam(ParameterIndex: Integer; SQLType: TZSQLType;
00095 const Value: TZVariant); override;
00096 public
00097 constructor Create(PlainDriver: IZPlainDriver; Connection: IZConnection; SQL: string; Info: TStrings);
00098 destructor Destroy; override;
00099 procedure Close; override;
00100 procedure ClearParameters; override;
00101
00102 function ExecuteQueryPrepared: IZResultSet; override;
00103 function ExecuteUpdatePrepared: Integer; override;
00104 function ExecutePrepared: Boolean; override;
00105 end;
00106
00107 {** Implements Prepared ADO Statement. }
00108 TZAdoCallableStatement = class(TZAdoPreparedStatement)
00109 protected
00110 FOutParamIndexes: TIntegerDynArray;
00111 function GetOutParam(ParameterIndex: Integer): TZVariant; override;
00112 public
00113 constructor Create(PlainDriver: IZPlainDriver; Connection: IZConnection;
00114 SQL: string; Info: TStrings);
00115 end;
00116
00117 implementation
00118
00119 uses
00120 {$IFNDEF VER130BELOW}
00121 Variants,
00122 {$ENDIF}
00123 OleDB, ActiveX, ComObj,
00124 ZDbcLogging, ZDbcCachedResultSet,
00125 ZDbcAdoResultSet, ZDbcAdoUtils;
00126
00127 constructor TZAdoStatement.Create(PlainDriver: IZPlainDriver; Connection: IZConnection; SQL: string;
00128 Info: TStrings);
00129 begin
00130 inherited Create(Connection, SQL, Info);
00131 FPlainDriver := PlainDriver;
00132 end;
00133
00134 destructor TZAdoStatement.Destroy;
00135 begin
00136 inherited;
00137 end;
00138
00139 procedure TZAdoStatement.Close;
00140 begin
00141 inherited;
00142 AdoRecordSet := nil;
00143 end;
00144
00145 function TZAdoStatement.IsSelect(const SQL: string): Boolean;
00146 begin
00147 Result := Uppercase(Copy(TrimLeft(Sql), 1, 6)) = 'SELECT';
00148 end;
00149
00150 function TZAdoStatement.ExecuteQuery(const SQL: string): IZResultSet;
00151 begin
00152 Result := nil;
00153 LastResultSet := nil;
00154 LastUpdateCount := -1;
00155 if not Execute(Sql) then
00156 while (not GetMoreResults) and (LastUpdateCount > -1) do ;
00157 Result := LastResultSet
00158 end;
00159
00160 function TZAdoStatement.ExecuteUpdate(const SQL: string): Integer;
00161 begin
00162 Result := -1;
00163 LastResultSet := nil;
00164 LastUpdateCount := -1;
00165 if Execute(Sql) then
00166 Result := LastUpdateCount;
00167 end;
00168
00169 function TZAdoStatement.Execute(const SQL: string): Boolean;
00170 var
00171 RC: OleVariant;
00172 begin
00173 try
00174 LastResultSet := nil;
00175 LastUpdateCount := -1;
00176 Self.SQL := sql;
00177 if IsSelect(SQL) then
00178 begin
00179 AdoRecordSet := CoRecordSet.Create;
00180 AdoRecordSet.MaxRecords := MaxRows;
00181 AdoRecordSet.Open(SQL, (Connection as IZAdoConnection).GetAdoConnection,
00182 adOpenStatic, adLockOptimistic, adAsyncFetch);
00183 end
00184 else
00185 AdoRecordSet := (Connection as IZAdoConnection).GetAdoConnection.Execute(SQL, RC, adExecuteNoRecords);
00186 Result := GetCurrentResult(RC);
00187 DriverManager.LogMessage(lcExecute, FPlainDriver.GetProtocol, SQL);
00188 except
00189 on E: Exception do
00190 begin
00191 DriverManager.LogError(lcExecute, FPlainDriver.GetProtocol, SQL, 0, E.Message);
00192 raise;
00193 end;
00194 end
00195 end;
00196
00197 function TZAdoStatement.GetCurrentResult(RC: Integer): Boolean;
00198 var
00199 NativeResultSet: IZResultSet;
00200 begin
00201 Result := False;
00202 if Assigned(AdoRecordset) then
00203 begin
00204 if (AdoRecordSet.State and adStateOpen) = adStateOpen then
00205 begin
00206 Result := True;
00207 NativeResultSet := TZAdoResultSet.Create(Self, SQL, AdoRecordSet);
00208 if ResultSetConcurrency = rcUpdatable then
00209 LastResultSet := TZCachedResultSet.Create(NativeResultSet, SQL, TZAdoCachedResolver.Create((Connection as IZAdoConnection).GetAdoConnection, Self, NativeResultSet.GetMetaData))
00210 else LastResultSet := NativeResultSet;
00211 end else
00212 LastUpdateCount := RC;
00213 end;
00214 end;
00215
00216 function TZAdoStatement.GetMoreResults: Boolean;
00217 var
00218 RC: OleVariant;
00219 begin
00220 Result := False;
00221 LastResultSet := nil;
00222 LastUpdateCount := -1;
00223 if Assigned(AdoRecordSet) then
00224 begin
00225 AdoRecordSet := AdoRecordSet.NextRecordset(RC);
00226 Result := GetCurrentResult(RC);
00227 end;
00228 end;
00229
00230 constructor TZAdoPreparedStatement.Create(PlainDriver: IZPlainDriver;
00231 Connection: IZConnection; SQL: string; Info: TStrings);
00232 begin
00233 FAdoCommand := CoCommand.Create;
00234 FAdoCommand.CommandText := SQL;
00235 inherited Create(PlainDriver, Connection, SQL, Info);
00236 FAdoCommand._Set_ActiveConnection((Connection as IZAdoConnection).GetAdoConnection);
00237 FAdoCommand.Prepared := True;
00238 end;
00239
00240 destructor TZAdoPreparedStatement.Destroy;
00241 begin
00242 inherited;
00243 end;
00244
00245 procedure TZAdoPreparedStatement.Close;
00246 begin
00247 inherited;
00248 FAdoCommand := nil;
00249 end;
00250
00251 procedure TZAdoPreparedStatement.ClearParameters;
00252 begin
00253 end;
00254
00255 {**
00256 Sets a new parameter count and initializes the buffers.
00257 @param NewParamCount a new parameters count.
00258 }
00259 procedure TZAdoPreparedStatement.SetInParamCount(NewParamCount: Integer);
00260 begin
00261 inherited;
00262 InParamCount := NewParamCount;
00263 end;
00264
00265 {**
00266 Sets a variant value into specified parameter.
00267 @param ParameterIndex a index of the parameter.
00268 @param SqlType a parameter SQL type.
00269 @paran Value a new parameter value.
00270 }
00271 procedure TZAdoPreparedStatement.SetInParam(ParameterIndex: Integer;
00272 SQLType: TZSQLType; const Value: TZVariant);
00273 var
00274 S: Integer;
00275 HR: HResult;
00276 T: Integer;
00277 PC: Integer;
00278 P: ZPlainAdo.Parameter;
00279 B: IZBlob;
00280 V: Variant;
00281 OleDBCommand: IUnknown;
00282 OleDBCmdParams: ICommandWithParameters;
00283 OleDBCmdPrepare: ICommandPrepare;
00284 OleDBPC: Cardinal;
00285 ParamInfo: PDBParamInfo;
00286 NamesBuffer: PPOleStr;
00287 RetValue: TZVariant;
00288 begin
00289 PC := 0;
00290 if FAdoCommand.CommandType = adCmdStoredProc then
00291 begin
00292 try
00293
00294 PC := FAdoCommand.Parameters.Count;
00295 except
00296 end;
00297 end
00298 else
00299 begin
00300 OleDBCommand := (FAdoCommand as ADOCommandConstruction).OLEDBCommand;
00301 OleDBCommand.QueryInterface(ICommandWithParameters, OleDBCmdParams);
00302 ParamInfo := nil;
00303 NamesBuffer := nil;
00304 if Assigned(OleDBCmdParams) then
00305 begin
00306 HR := OleDBCmdParams.GetParameterInfo(OleDBPC, ParamInfo, NamesBuffer);
00307
00308 if HR = DB_E_NOTPREPARED then
00309 begin
00310 OleDBCommand.QueryInterface(ICommandPrepare, OleDBCmdPrepare);
00311 if Assigned(OleDBCmdPrepare) then
00312 begin
00313 OleDBCmdPrepare.Prepare(0);
00314 OleDBCmdParams.GetParameterInfo(OleDBPC, ParamInfo, NamesBuffer);
00315 end
00316 end;
00317 if Assigned(ParamInfo) then ZAdoMalloc.Free(ParamInfo);
00318 if Assigned(NamesBuffer) then ZAdoMalloc.Free(NamesBuffer);
00319 PC := OleDBPC;
00320 end;
00321 end;
00322
00323 RetValue:= Value;
00324 if (SQLType in [stAsciiStream, stUnicodeStream, stBinaryStream]) then
00325 begin
00326 B := DefVarManager.GetAsInterface(Value) as IZBlob;
00327 case SQLType of
00328 stAsciiStream:
00329 begin
00330 if Assigned(B) then
00331 DefVarManager.SetAsString(RetValue, B.GetString);
00332 SQLType := stString;
00333 end;
00334 stUnicodeStream:
00335 begin
00336 if Assigned(B) then
00337 DefVarManager.SetAsUnicodeString(RetValue, B.GetUnicodeString);
00338 SQLType := stUnicodeString;
00339 end;
00340 stBinaryStream:
00341 begin
00342 if Assigned(B) then
00343 DefVarManager.SetAsString(RetValue, BytesToStr(B.GetBytes));
00344 SQLType := stBytes;
00345 end;
00346 end;
00347 end;
00348
00349 case RetValue.VType of
00350 vtNull: V := Null;
00351 vtBoolean: V := SoftVarManager.GetAsBoolean(RetValue);
00352 vtInteger: V := Integer(SoftVarManager.GetAsInteger(RetValue));
00353 vtFloat: V := SoftVarManager.GetAsFloat(RetValue);
00354 vtString: V := SoftVarManager.GetAsString(RetValue);
00355 vtUnicodeString: V := SoftVarManager.GetAsUnicodeString(RetValue);
00356 vtDateTime: V := SoftVarManager.GetAsDateTime(RetValue);
00357 end;
00358
00359 S := 0;
00360 if SQLType = stString then
00361 begin
00362 S := Length(VarToStr(V));
00363 if S = 0 then
00364 begin
00365 S := 1;
00366
00367
00368 end;
00369 end;
00370
00371 if SQLType = stUnicodeString then
00372 begin
00373 S := Length(VarToWideStr(V));
00374 if S = 0 then
00375 begin
00376 S := 1;
00377
00378
00379 end;
00380 end;
00381
00382 if SQLType = stBytes then
00383 begin
00384 V := StrToBytes(VarToStr(V));
00385 if (VarType(V) and varArray) <> 0 then
00386 S := VarArrayHighBound(V, 1) + 1;
00387 if S = 0 then V := Null;
00388 end;
00389
00390 if VarIsNull(V) then
00391 T := ConvertSqlTypeToAdo(SQLType)
00392 else
00393 T := ConvertVariantToAdo(VarType(V));
00394
00395 if ParameterIndex <= PC then
00396 begin
00397 P := FAdoCommand.Parameters.Item[ParameterIndex - 1];
00398 FAdoCommand.Parameters.Item[ParameterIndex - 1].Type_ := T;
00399 FAdoCommand.Parameters.Item[ParameterIndex - 1].Size := S;
00400 FAdoCommand.Parameters.Item[ParameterIndex - 1].Value := V;
00401 end
00402 else
00403 begin
00404 FAdoCommand.Parameters.Append(FAdoCommand.CreateParameter(
00405 'P' + IntToStr(ParameterIndex), T, adParamInput, S, V));
00406 end;
00407 end;
00408
00409 {**
00410 Executes the SQL query in this <code>PreparedStatement</code> object
00411 and returns the result set generated by the query.
00412
00413 @return a <code>ResultSet</code> object that contains the data produced by the
00414 query; never <code>null</code>
00415 }
00416 function TZAdoPreparedStatement.ExecuteQueryPrepared: IZResultSet;
00417 begin
00418 if not ExecutePrepared then
00419 while (not GetMoreResults) and (LastUpdateCount > -1) do ;
00420 Result := LastResultSet;
00421 end;
00422
00423 {**
00424 Executes the SQL INSERT, UPDATE or DELETE statement
00425 in this <code>PreparedStatement</code> object.
00426 In addition,
00427 SQL statements that return nothing, such as SQL DDL statements,
00428 can be executed.
00429
00430 @return either the row count for INSERT, UPDATE or DELETE statements;
00431 or 0 for SQL statements that return nothing
00432 }
00433 function TZAdoPreparedStatement.ExecuteUpdatePrepared: Integer;
00434 begin
00435 ExecutePrepared;
00436 Result := LastUpdateCount;
00437 end;
00438
00439 {**
00440 Executes any kind of SQL statement.
00441 Some prepared statements return multiple results; the <code>execute</code>
00442 method handles these complex statements as well as the simpler
00443 form of statements handled by the methods <code>executeQuery</code>
00444 and <code>executeUpdate</code>.
00445 @see Statement#execute
00446 }
00447 function TZAdoPreparedStatement.ExecutePrepared: Boolean;
00448 var
00449 RC: OleVariant;
00450 begin
00451 LastResultSet := nil;
00452 LastUpdateCount := -1;
00453
00454 try
00455 if IsSelect(SQL) then
00456 begin
00457 AdoRecordSet := CoRecordSet.Create;
00458 AdoRecordSet.MaxRecords := MaxRows;
00459 AdoRecordSet._Set_ActiveConnection(FAdoCommand.Get_ActiveConnection);
00460 AdoRecordSet.Open(FAdoCommand, EmptyParam, adOpenForwardOnly, adLockOptimistic, adAsyncFetch);
00461 end
00462 else
00463 AdoRecordSet := FAdoCommand.Execute(RC, EmptyParam, -1{adExecuteNoRecords});
00464 Result := GetCurrentResult(RC);
00465 DriverManager.LogMessage(lcExecute, FPlainDriver.GetProtocol, SQL);
00466 except
00467 on E: Exception do
00468 begin
00469 DriverManager.LogError(lcExecute, FPlainDriver.GetProtocol, SQL, 0, E.Message);
00470 raise;
00471 end;
00472 end
00473 end;
00474
00475 constructor TZAdoCallableStatement.Create(PlainDriver: IZPlainDriver;
00476 Connection: IZConnection; SQL: string; Info: TStrings);
00477 begin
00478 inherited Create(PlainDriver, Connection, SQL, Info);
00479 FAdoCommand.CommandType := adCmdStoredProc;
00480 end;
00481
00482 function TZAdoCallableStatement.GetOutParam(ParameterIndex: Integer): TZVariant;
00483 var
00484 Temp: Variant;
00485 begin
00486 if ParameterIndex > OutParamCount then
00487 Result := NullVariant
00488 else begin
00489 Temp := FAdoCommand.Parameters.Item[ParameterIndex - 1].Value;
00490
00491
00492 case VarType(Temp) of
00493 varString, varOleStr:
00494 DefVarManager.SetAsString(Result, Temp);
00495 varSmallInt, varInteger:
00496 DefVarManager.SetAsInteger(Result, Integer(Temp));
00497 {$IFNDEF VER130BELOW}
00498 varShortInt, varInt64:
00499 DefVarManager.SetAsInteger(Result, Temp);
00500 {$ENDIF}
00501 varDate:
00502 DefVarManager.SetAsDateTime(Result, Temp);
00503 varSingle, varDouble:
00504 DefVarManager.SetAsFloat(Result, Temp);
00505 else
00506 DefVarManager.SetNull(Result);
00507 end;
00508 end;
00509
00510 LastWasNull := DefVarManager.IsNull(Result);
00511 end;
00512
00513 end.
00514
00515
00516
00517
00518
00519
00520
00521
00522
00523
00524
00525
00526
00527
00528
00529
00530
00531
00532
00533
00534
00535
00536
00537
00538
00539
00540
00541
00542
00543
00544
00545
00546
00547
00548
00549
00550
00551
00552
00553
00554
00555
00556
00557
00558
00559
00560
00561
00562
00563
00564
00565
00566
00567
00568