00001 {*********************************************************}
00002 { }
00003 { Zeos Database Objects }
00004 { DBLib Statement common functionality }
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 ZDbcDbLibStatement;
00055
00056 interface
00057
00058 {$I ZDbc.inc}
00059
00060 uses Classes, SysUtils, ZCompatibility, ZClasses, ZSysUtils, ZCollections,
00061 ZDbcIntfs, ZDbcStatement, ZDbcDbLib, ZPlainDbLibDriver;
00062
00063 type
00064 {** Implements Generic DBLib Statement. }
00065 TZDBLibStatement = class(TZAbstractStatement)
00066 protected
00067 FSQL: string;
00068 FDBLibConnection: IZDBLibConnection;
00069 FPlainDriver: IZDBLibPlainDriver;
00070 FHandle: PDBPROCESS;
00071 FResults: IZCollection;
00072 FRetrievedResultSet: IZResultSet;
00073 FRetrievedUpdateCount: Integer;
00074
00075 procedure InternalExecuteStatement(SQL: string); virtual;
00076 procedure FetchResults; virtual;
00077
00078 public
00079 constructor Create(Connection: IZConnection; Info: TStrings);
00080 destructor Destroy; override;
00081
00082 function GetMoreResults: Boolean; override;
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 end;
00087
00088 {** Implements Prepared SQL Statement. With emulation}
00089 TZDBLibPreparedStatementEmulated = class(TZEmulatedPreparedStatement)
00090 protected
00091 function GetEscapeString(Value: string): string;
00092 function PrepareSQLParam(ParamIndex: Integer): string; override;
00093 function CreateExecStatement: IZStatement; override;
00094 public
00095 constructor Create(Connection: IZConnection; SQL: string; Info: TStrings);
00096 function GetMetaData: IZResultSetMetaData; override;
00097 end;
00098
00099 TZDBLibCallableStatement = class(TZAbstractCallableStatement)
00100 private
00101 FSQL: string;
00102 FDBLibConnection: IZDBLibConnection;
00103 FPlainDriver: IZDBLibPlainDriver;
00104 FHandle: PDBPROCESS;
00105 FResults: IZCollection;
00106 FLastRowsAffected: Integer;
00107 FRetrievedResultSet: IZResultSet;
00108 FRetrievedUpdateCount: Integer;
00109
00110 procedure FetchResults; virtual;
00111 procedure FetchRowCount; virtual;
00112
00113 protected
00114 procedure SetInParamCount(NewParamCount: Integer); override;
00115
00116 public
00117 constructor Create(Connection: IZConnection; ProcName: string; Info: TStrings);
00118
00119 procedure RegisterOutParameter(ParameterIndex: Integer;
00120 SqlType: Integer); override;
00121 function GetMoreResults: Boolean; override;
00122 function ExecuteQueryPrepared: IZResultSet; override;
00123 function ExecuteUpdatePrepared: Integer; override;
00124 function ExecutePrepared: Boolean; override;
00125
00126 end;
00127
00128 type
00129 {** Interface for storing counter. }
00130 IZUpdateCount = interface(IZInterface)
00131 ['{03219BB4-E07F-4A50-80CD-291FEA629697}']
00132 procedure SetCount(Value: Integer);
00133 function GetCount: Integer;
00134 end;
00135
00136 TZUpdateCount = class(TInterfacedObject, IZUpdateCount)
00137 private
00138 FCount: Integer;
00139 public
00140 constructor Create(ACount: Integer);
00141 procedure SetCount(Value: Integer); virtual;
00142 function GetCount: Integer; virtual;
00143 property Count: Integer read GetCount write SetCount;
00144 end;
00145
00146 implementation
00147
00148 uses
00149 ZDbcLogging, ZDbcCachedResultSet, ZDbcDbLibUtils, ZDbcDbLibResultSet,
00150 ZVariant;
00151
00152 constructor TZUpdateCount.Create(ACount: Integer);
00153 begin
00154 inherited Create;
00155 FCount := ACount;
00156 end;
00157
00158 procedure TZUpdateCount.SetCount(Value: Integer);
00159 begin
00160 FCount := Value;
00161 end;
00162
00163 function TZUpdateCount.GetCount: Integer;
00164 begin
00165 Result := FCount;
00166 end;
00167
00168 { TZDBLibStatement }
00169
00170 {**
00171 Constructs this object and assignes the main properties.
00172 @param Connection a database connection object.
00173 @param Info a statement parameters.
00174 }
00175 constructor TZDBLibStatement.Create(Connection: IZConnection; Info: TStrings);
00176 begin
00177 inherited Create(Connection, Info);
00178 Connection.QueryInterface(IZDBLibConnection, FDBLibConnection);
00179 if Assigned(FDBLibConnection) then
00180 FPLainDriver := FDBLibConnection.GetPlainDriver;
00181 FHandle := FDBLibConnection.GetConnectionHandle;
00182 ResultSetType := rtScrollInsensitive;
00183 FResults := TZCollection.Create;
00184 end;
00185
00186 destructor TZDBLibStatement.Destroy;
00187 begin
00188 FResults.Clear;
00189 inherited Destroy;
00190 end;
00191
00192 {**
00193 Executes a Statement.
00194 Used internally to execute statements.
00195
00196 @param Handle a DBLib connection handle.
00197 @sql string containing the statements to execute
00198 }
00199 procedure TZDBLibStatement.InternalExecuteStatement(SQL: string);
00200 begin
00201 FHandle := FDBLibConnection.GetConnectionHandle;
00202 FPlainDriver := FDBLibConnection.GetPlainDriver;
00203 if FPlainDriver.dbcancel(FHandle) <> DBSUCCEED then
00204 FDBLibConnection.CheckDBLibError(lcExecute, SQL);
00205
00206 if FPlainDriver.GetProtocol = 'mssql' then
00207 SQL := StringReplace(Sql, '\'#13, '\\'#13, [rfReplaceAll]);
00208
00209 if FPlainDriver.GetProtocol = 'sybase' then
00210 SQL := StringReplace(Sql, ' AND NULL IS NULL', '', [rfReplaceAll]);
00211 if FPlainDriver.dbcmd(FHandle, PChar(SQL)) <> DBSUCCEED then
00212 FDBLibConnection.CheckDBLibError(lcExecute, SQL);
00213 if FPlainDriver.dbsqlexec(FHandle) <> DBSUCCEED then
00214 FDBLibConnection.CheckDBLibError(lcExecute, SQL);
00215 DriverManager.LogMessage(lcExecute, FPlainDriver.GetProtocol, SQL);
00216 end;
00217
00218 {**
00219 Moves to a <code>Statement</code> object's next result. It returns
00220 <code>true</code> if this result is a <code>ResultSet</code> object.
00221 This method also implicitly closes any current <code>ResultSet</code>
00222 object obtained with the method <code>getResultSet</code>.
00223
00224 <P>There are no more results when the following is true:
00225 <PRE>
00226 <code>(!getMoreResults() && (getUpdateCount() == -1)</code>
00227 </PRE>
00228
00229 @return <code>true</code> if the next result is a <code>ResultSet</code> object;
00230 <code>false</code> if it is an update count or there are no more results
00231 @see #execute
00232 }
00233 function TZDBLibStatement.GetMoreResults: Boolean;
00234 var
00235 ResultSet: IZResultSet;
00236 UpdateCount: IZUpdateCount;
00237 begin
00238 Result := False;
00239 FRetrievedResultSet := nil;
00240 FRetrievedUpdateCount := -1;
00241 if FResults.Count > 0 then
00242 begin
00243 try
00244 Result := FResults.Items[0].QueryInterface(IZResultSet, ResultSet) = 0;
00245 if Result then
00246 begin
00247 FRetrievedResultSet := ResultSet;
00248 FRetrievedUpdateCount := 0;
00249 end
00250 else
00251 begin
00252 if FResults.Items[0].QueryInterface(IZUpdateCount, UpdateCount) = 0 then
00253 FRetrievedUpdateCount := UpdateCount.GetCount;
00254 end;
00255 FResults.Delete(0);
00256 finally
00257 ResultSet := nil;
00258 UpdateCount := nil;
00259 end;
00260 end;
00261 end;
00262
00263 {**
00264 Fetches all results and creates a cachedresultset object for each resultset
00265 and a ZUpdateCount object for each count value.
00266 }
00267 procedure TZDBLibStatement.FetchResults;
00268 var
00269 NativeResultSet: TZDBLibResultSet;
00270 CachedResultSet: TZCachedResultSet;
00271 RowsAffected: Integer;
00272 begin
00273 FResults.Clear;
00274 //Sybase does not seem to return dbCount at all, so a workaround is made
00275 RowsAffected := -2;
00276 while FPlainDriver.dbresults(FHandle) = DBSUCCEED do
00277 begin
00278 if FPlainDriver.dbcmdrow(FHandle) = DBSUCCEED then
00279 begin
00280 NativeResultSet := TZDBLibResultSet.Create(Self, FSQL);
00281 NativeResultSet.SetConcurrency(rcReadOnly);
00282 CachedResultSet := TZCachedResultSet.Create(NativeResultSet, FSQL, TZDBLibCachedResolver.Create(Self, NativeResultSet.GetMetaData));
00283 CachedResultSet.SetType(rtScrollInsensitive);//!!!Cached resultsets are allways this
00284 CachedResultSet.Last; CachedResultSet.BeforeFirst; //!!!Just to invoke fetchall
00285 CachedResultSet.SetConcurrency(GetResultSetConcurrency);
00286 FResults.Add(CachedResultSet);
00287 end
00288 else
00289 begin
00290 RowsAffected := FPlainDriver.dbCount(FHandle);
00291 if RowsAffected > -1 then
00292 FResults.Add(TZUpdateCount.Create(RowsAffected));
00293 end;
00294 FPlainDriver.dbCanQuery(FHandle);
00295 end;
00296 FDBLibConnection.CheckDBLibError(lcOther, 'FETCHRESULTS');
00297 if RowsAffected = -1 then
00298 begin
00299 FDBLibConnection.InternalExecuteStatement('select @@rowcount');
00300 try
00301 FPlainDriver.dbresults(FHandle);
00302 NativeResultSet := TZDBLibResultSet.Create(Self, 'select @@rowcount');
00303 try
00304 if NativeResultset.Next then
00305 RowsAffected := NativeResultSet.GetInt(1);
00306 finally
00307 NativeResultSet.Close;
00308 end;
00309 FResults.Add(TZUpdateCount.Create(RowsAffected));
00310 finally
00311 FPlainDriver.dbCancel(FHandle);
00312 end;
00313 FDBLibConnection.CheckDBLibError(lcOther, 'FETCHRESULTS');
00314 end;
00315 end;
00316
00317 {**
00318 Executes an SQL statement that returns a single <code>ResultSet</code> object.
00319 @param sql typically this is a static SQL <code>SELECT</code> statement
00320 @return a <code>ResultSet</code> object that contains the data produced by the
00321 given query; never <code>null</code>
00322 }
00323 function TZDBLibStatement.ExecuteQuery(const SQL: string): IZResultSet;
00324 begin
00325 Result := nil;
00326 FSQL := SQL;
00327 try
00328 InternalExecuteStatement(SQL);
00329 FetchResults;
00330 repeat
00331 if GetMoreResults then
00332 Result := FRetrievedResultSet
00333 else if FRetrievedUpdateCount = -1 then
00334 Break;
00335 until False;
00336 finally
00337 FRetrievedResultSet := nil;
00338 end;
00339 end;
00340
00341 {**
00342 Executes an SQL <code>INSERT</code>, <code>UPDATE</code> or
00343 <code>DELETE</code> statement. In addition,
00344 SQL statements that return nothing, such as SQL DDL statements,
00345 can be executed.
00346
00347 @param sql an SQL <code>INSERT</code>, <code>UPDATE</code> or
00348 <code>DELETE</code> statement or an SQL statement that returns nothing
00349 @return either the row count for <code>INSERT</code>, <code>UPDATE</code>
00350 or <code>DELETE</code> statements, or 0 for SQL statements that return nothing
00351 }
00352 function TZDBLibStatement.ExecuteUpdate(const SQL: string): Integer;
00353 begin
00354 FSQL := SQL;
00355 InternalExecuteStatement(SQL);
00356 FetchResults;
00357 GetMoreResults;
00358 Result := FRetrievedUpdateCount;
00359 FRetrievedResultSet := nil;
00360 end;
00361
00362 {**
00363 Executes an SQL statement that may return multiple results.
00364 Under some (uncommon) situations a single SQL statement may return
00365 multiple result sets and/or update counts. Normally you can ignore
00366 this unless you are (1) executing a stored procedure that you know may
00367 return multiple results or (2) you are dynamically executing an
00368 unknown SQL string. The methods <code>execute</code>,
00369 <code>getMoreResults</code>, <code>getResultSet</code>,
00370 and <code>getUpdateCount</code> let you navigate through multiple results.
00371
00372 The <code>execute</code> method executes an SQL statement and indicates the
00373 form of the first result. You can then use the methods
00374 <code>getResultSet</code> or <code>getUpdateCount</code>
00375 to retrieve the result, and <code>getMoreResults</code> to
00376 move to any subsequent result(s).
00377
00378 @param sql any SQL statement
00379 @return <code>true</code> if the next result is a <code>ResultSet</code> object;
00380 <code>false</code> if it is an update count or there are no more results
00381 }
00382 function TZDBLibStatement.Execute(const SQL: string): Boolean;
00383 begin
00384 FSQL := SQL;
00385 InternalExecuteStatement(SQL);
00386 FetchResults;
00387 Result := GetMoreResults;
00388 LastResultSet := FRetrievedResultSet;
00389 LastUpdateCount := FRetrievedUpdateCount;
00390 FRetrievedResultSet := nil;
00391 end;
00392
00393 { TZDBLibPreparedStatementEmulated }
00394
00395 {**
00396 Constructs this object and assignes the main properties.
00397 @param Connection a database connection object.
00398 @param Info a statement parameters.
00399 @param Handle a connection handle pointer.
00400 }
00401 constructor TZDBLibPreparedStatementEmulated.Create(Connection: IZConnection;
00402 SQL: string; Info: TStrings);
00403 begin
00404 inherited Create(Connection, SQL, Info);
00405 ResultSetType := rtScrollInsensitive;
00406 end;
00407
00408 {**
00409 Converts an string into escape DBLib format.
00410 @param Value a regular string.
00411 @return a string in DBLib escape format.
00412 }
00413 function TZDBLibPreparedStatementEmulated.GetEscapeString(Value: string): string;
00414 begin
00415 Result := AnsiQuotedStr(Value, '''');
00416 end;
00417
00418 {**
00419 Prepares an SQL parameter for the query.
00420 @param ParameterIndex the first parameter is 1, the second is 2, ...
00421 @return a string representation of the parameter.
00422 }
00423 function TZDBLibPreparedStatementEmulated.PrepareSQLParam(
00424 ParamIndex: Integer): string;
00425 begin
00426 if InParamCount <= ParamIndex then
00427 Result := 'NULL'
00428 else
00429 begin
00430 Result := PrepareSQLParameter(InParamValues[ParamIndex],
00431 InParamTypes[ParamIndex]);
00432 end;
00433 end;
00434
00435 {**
00436 Gets the number, types and properties of a <code>ResultSet</code>
00437 object's columns.
00438 @return the description of a <code>ResultSet</code> object's columns
00439 }
00440 function TZDBLibPreparedStatementEmulated.GetMetaData: IZResultSetMetaData;
00441 begin
00442 Result := nil;
00443 end;
00444
00445 {**
00446 Creates a temporary statement which executes queries.
00447 @param Info a statement parameters.
00448 @return a created statement object.
00449 }
00450 function TZDBLibPreparedStatementEmulated.CreateExecStatement: IZStatement;
00451 begin
00452 Result := TZDBLibStatement.Create(Connection, Info);
00453 end;
00454
00455 constructor TZDBLibCallableStatement.Create(Connection: IZConnection;
00456 ProcName: string; Info: TStrings);
00457 begin
00458 inherited Create(Connection, ProcName, Info);
00459 Connection.QueryInterface(IZDBLibConnection, FDBLibConnection);
00460 if Assigned(FDBLibConnection) then
00461 FPLainDriver := FDBLibConnection.GetPlainDriver;
00462 FHandle := FDBLibConnection.GetConnectionHandle;
00463 ResultSetType := rtScrollInsensitive;
00464 FResults := TZCollection.Create;
00465 end;
00466
00467 procedure TZDBLibCallableStatement.FetchResults;
00468 var
00469 NativeResultSet: TZDBLibResultSet;
00470 CachedResultSet: TZCachedResultSet;
00471 begin
00472
00473 FLastRowsAffected := -2;
00474 while FPlainDriver.dbresults(FHandle) = DBSUCCEED do
00475 begin
00476 if FPlainDriver.dbcmdrow(FHandle) = DBSUCCEED then
00477 begin
00478 NativeResultSet := TZDBLibResultSet.Create(Self, FSQL);
00479 NativeResultSet.SetConcurrency(rcReadOnly);
00480 CachedResultSet := TZCachedResultSet.Create(NativeResultSet, FSQL, TZDBLibCachedResolver.Create(Self, NativeResultSet.GetMetaData));
00481 CachedResultSet.SetType(rtScrollInsensitive);
00482 CachedResultSet.Last; CachedResultSet.BeforeFirst;
00483 CachedResultSet.SetConcurrency(GetResultSetConcurrency);
00484 FResults.Add(CachedResultSet);
00485 end
00486 else
00487 begin
00488 FLastRowsAffected := FPlainDriver.dbCount(FHandle);
00489 if FLastRowsAffected > -1 then
00490 FResults.Add(TZUpdateCount.Create(FLastRowsAffected));
00491 end;
00492 end;
00493 FDBLibConnection.CheckDBLibError(lcOther, 'FETCHRESULTS');
00494 end;
00495
00496 procedure TZDBLibCallableStatement.FetchRowCount;
00497 var
00498 NativeResultSet: TZDBLibResultSet;
00499 begin
00500
00501 if FLastRowsAffected = -1 then
00502 begin
00503 FDBLibConnection.InternalExecuteStatement('select @@rowcount');
00504 try
00505 FPlainDriver.dbresults(FHandle);
00506 NativeResultSet := TZDBLibResultSet.Create(Self, 'select @@rowcount');
00507 try
00508 if NativeResultset.Next then
00509 FLastRowsAffected := NativeResultSet.GetInt(1);
00510 finally
00511 NativeResultset.Close;
00512 end;
00513 FResults.Add(TZUpdateCount.Create(FLastRowsAffected));
00514 finally
00515 FPlainDriver.dbCancel(FHandle);
00516 end;
00517 FDBLibConnection.CheckDBLibError(lcOther, 'FETCHRESULTS');
00518 end;
00519 end;
00520
00521 {**
00522 Moves to a <code>Statement</code> object's next result. It returns
00523 <code>true</code> if this result is a <code>ResultSet</code> object.
00524 This method also implicitly closes any current <code>ResultSet</code>
00525 object obtained with the method <code>getResultSet</code>.
00526
00527 <P>There are no more results when the following is true:
00528 <PRE>
00529 <code>(!getMoreResults() && (getUpdateCount() == -1)</code>
00530 </PRE>
00531
00532 @return <code>true</code> if the next result is a <code>ResultSet</code> object;
00533 <code>false</code> if it is an update count or there are no more results
00534 @see #execute
00535 }
00536 function TZDBLibCallableStatement.GetMoreResults: Boolean;
00537 var
00538 ResultSet: IZResultSet;
00539 UpdateCount: IZUpdateCount;
00540 begin
00541 Result := False;
00542 FRetrievedResultSet := nil;
00543 FRetrievedUpdateCount := -1;
00544 if FResults.Count > 0 then
00545 begin
00546 try
00547 Result := FResults.Items[0].QueryInterface(IZResultSet, ResultSet) = 0;
00548 if Result then
00549 begin
00550 FRetrievedResultSet := ResultSet;
00551 FRetrievedUpdateCount := 0;
00552 end
00553 else
00554 if FResults.Items[0].QueryInterface(IZUpdateCount, UpdateCount) = 0 then
00555 FRetrievedUpdateCount := UpdateCount.GetCount;
00556 FResults.Delete(0);
00557 finally
00558 ResultSet := nil;
00559 UpdateCount := nil;
00560 end;
00561 end;
00562 end;
00563
00564 function TZDBLibCallableStatement.ExecuteQueryPrepared: IZResultSet;
00565 begin
00566 if not ExecutePrepared then
00567 while not GetMoreResults and (FRetrievedUpdateCount <> -1) do;
00568 Result := FRetrievedResultSet;
00569 FRetrievedResultSet := nil;
00570 end;
00571
00572 function TZDBLibCallableStatement.ExecuteUpdatePrepared: Integer;
00573 begin
00574 if ExecutePrepared then
00575 while GetMoreResults and (FRetrievedUpdateCount = -1) do;
00576 Result := FRetrievedUpdateCount;
00577 FRetrievedResultSet := nil;
00578 end;
00579
00580 procedure TZDBLibCallableStatement.RegisterOutParameter(ParameterIndex: Integer;
00581 SqlType: Integer);
00582 begin
00583 SetOutParamCount(ParameterIndex);
00584 OutParamTypes[ParameterIndex - 1] := TZSqlType(SqlType);
00585
00586 //Count inparams must equal count outparams to correct set paramters
00587 if InParamCount < ParameterIndex then
00588 SetInParamCount(ParameterIndex);
00589 end;
00590
00591 function TZDBLibCallableStatement.ExecutePrepared: Boolean;
00592 var
00593 S: string;
00594 I, ParamIndex, DatLen: Integer;
00595 RetParam: Byte;
00596 DatBoolean: Boolean;
00597 DatByte: Byte;
00598 DatShort: SmallInt;
00599 DatInteger: Integer;
00600 DatFloat: Single;
00601 DatDouble: Double;
00602 DatString: string;
00603 DatMoney: Currency;
00604 DatDBDATETIME: DBDATETIME;
00605 DatBytes: TByteDynArray;
00606 Temp: TZVariant;
00607 ParamType: TZSQLType;
00608 begin
00609 FHandle := FDBLibConnection.GetConnectionHandle;
00610 S := Trim(Sql);
00611 if FPLainDriver.dbRPCInit(FHandle, PChar(S), 0) <> DBSUCCEED then
00612 FDBLibConnection.CheckDBLibError(lcOther, 'EXECUTEPREPARED:dbRPCInit');
00613
00614 for I := 1 to InParamCount - 1 do//The 0 parameter is the return value
00615 begin
00616 RetParam := 0;
00617 if OutParamTypes[I] <> stUnknown then
00618 RetParam := DBRPCRETURN;
00619
00620 ParamType := InParamTypes[I];
00621 if ParamType = stUnknown then
00622 ParamType := OutParamTypes[I];
00623
00624 if DefVarManager.IsNull(InParamValues[I]) and (InParamTypes[I] <> stUnknown) then
00625 begin
00626 FPlainDriver.dbRpcParam(FHandle, nil, RetParam,
00627 ConvertSqlTypeToDBLibType(InParamTypes[I]), -1, 0, nil)
00628 end
00629 else
00630 begin
00631 case ParamType of
00632 stBoolean:
00633 begin
00634 DatBoolean := SoftVarManager.GetAsBoolean(InParamValues[I]);
00635 FPlainDriver.dbRpcParam(FHandle, nil, RetParam,
00636 SQLINT1, -1, -1, @DatBoolean);
00637 end;
00638 stByte:
00639 begin
00640 DatByte := Byte(SoftVarManager.GetAsInteger(InParamValues[I]));
00641 FPlainDriver.dbRpcParam(FHandle, nil, RetParam,
00642 SQLINT1, -1, -1, @DatByte);
00643 end;
00644 stShort:
00645 begin
00646 DatShort := SmallInt(SoftVarManager.GetAsInteger(InParamValues[I]));
00647 FPlainDriver.dbRpcParam(FHandle, nil, RetParam,
00648 SQLINT2, -1, -1, @DatShort);
00649 end;
00650 stInteger, stLong:
00651 begin
00652 DatInteger := Integer(SoftVarManager.GetAsInteger(InParamValues[I]));
00653 FPlainDriver.dbRpcParam(FHandle, nil, RetParam,
00654 SQLINT4, -1, -1, @DatInteger);
00655 end;
00656 stFloat:
00657 begin
00658 DatFloat := SoftVarManager.GetAsFloat(InParamValues[I]);
00659 FPlainDriver.dbRpcParam(FHandle, nil, RetParam,
00660 SQLFLT4, -1, -1, @DatFloat);
00661 end;
00662 stDouble, stBigDecimal:
00663 begin
00664 DatDouble := SoftVarManager.GetAsFloat(InParamValues[I]);
00665 FPlainDriver.dbRpcParam(FHandle, nil, RetParam,
00666 SQLFLT8, -1, -1, @DatDouble);
00667 end;
00668 stString:
00669 begin
00670 DatString := SoftVarManager.GetAsString(InParamValues[I]);
00671 if DatString = ''then
00672 DatLen := 1
00673 else
00674 DatLen := Length(DatString);
00675 FPlainDriver.dbRpcParam(FHandle, nil, RetParam,
00676 SQLCHAR, MaxInt, DatLen, PChar(DatString));
00677 end;
00678 stDate:
00679 begin
00680 DatString := FormatDateTime('yyyymmdd',
00681 SoftVarManager.GetAsDateTime(InParamValues[I]));
00682 FPlainDriver.dbRpcParam(FHandle, nil, RetParam,
00683 SQLCHAR, MaxInt, Length(DatString), PChar(DatString));
00684 end;
00685 stTime:
00686 begin
00687 DatString := FormatDateTime('hh":"mm":"ss":"zzz',
00688 SoftVarManager.GetAsDateTime(InParamValues[I]));
00689 FPlainDriver.dbRpcParam(FHandle, nil, RetParam,
00690 SQLCHAR, MaxInt, Length(DatString), PChar(DatString));
00691 end;
00692 stTimeStamp:
00693 begin
00694 DatString := FormatDateTime('yyyymmdd hh":"mm":"ss":"zzz',
00695 SoftVarManager.GetAsDateTime(InParamValues[I]));
00696 FPlainDriver.dbRpcParam(FHandle, nil, RetParam,
00697 SQLCHAR, MaxInt, Length(DatString), PChar(DatString));
00698 end;
00699 // stBytes,
00700 // stUnicodeString,
00701 // stAsciiStream,
00702 // stUnicodeStream,
00703 // stBinaryStream
00704 else
00705 FPlainDriver.dbRpcParam(FHandle, nil, 0, SQLCHAR, 0, 0, nil);
00706 end;
00707 end;
00708 end;
00709
00710 if FPLainDriver.dbRpcExec(FHandle) <> DBSUCCEED then
00711 FDBLibConnection.CheckDBLibError(lcOther, 'EXECUTEPREPARED:dbRPCExec');
00712 FetchResults;
00713 Result := GetMoreResults;
00714
00715 if FPLainDriver.dbHasRetStat(FHandle) then
00716 DefVarManager.SetAsInteger(Temp, FPlainDriver.dbRetStatus(FHandle))
00717 else Temp := NullVariant;
00718 OutParamValues[0] := Temp; //set function RETURN_VALUE
00719
00720 ParamIndex := 1;
00721 for I := 1 to OutParamCount - 1 do
00722 begin
00723 if OutParamTypes[I] = stUnknown then
00724 Continue;
00725 if FPlainDriver.dbRetData(FHandle, ParamIndex) = nil then
00726 Temp := NullVariant
00727 else
00728 begin
00729 case FPLainDriver.dbRetType(FHandle, ParamIndex) of
00730 SQLCHAR, SQLBINARY:
00731 begin
00732 DatLen := FPLainDriver.dbRetLen(FHandle, ParamIndex);
00733 SetLength(DatBytes, DatLen);
00734 Move(PChar(FPLainDriver.dbRetData(FHandle, ParamIndex))^,
00735 DatBytes[0], Length(DatBytes));
00736 DefVarManager.SetAsString(Temp, BytesToStr(DatBytes));
00737 end;
00738 SQLINT1:
00739 DefVarManager.SetAsInteger(Temp,
00740 PByte(FPlainDriver.dbRetData(FHandle, ParamIndex))^);
00741 SQLINT2:
00742 DefVarManager.SetAsInteger(Temp,
00743 PSmallInt(FPLainDriver.dbRetData(FHandle, ParamIndex))^);
00744 SQLINT4:
00745 DefVarManager.SetAsInteger(Temp,
00746 PInteger(FPLainDriver.dbRetData(FHandle, ParamIndex))^);
00747 SQLFLT4:
00748 DefVarManager.SetAsFloat(Temp,
00749 PSingle(FPLainDriver.dbRetData(FHandle, ParamIndex))^);
00750 SQLFLT8:
00751 DefVarManager.SetAsFloat(Temp,
00752 PDouble(FPLainDriver.dbRetData(FHandle, ParamIndex))^);
00753 SQLMONEY4:
00754 begin
00755 FPlainDriver.dbConvert(FHandle, SQLMONEY4,
00756 FPlainDriver.dbRetData(FHandle, ParamIndex), 4, SQLMONEY,
00757 @DatMoney, 8);
00758 DefVarManager.SetAsFloat(Temp, DatMoney);
00759 end;
00760 SQLMONEY:
00761 DefVarManager.SetAsFloat(Temp,
00762 PCurrency(FPLainDriver.dbRetData(FHandle, ParamIndex))^);
00763 SQLDECIMAL:
00764 begin
00765 FPLainDriver.dbConvert(FHandle, SQLDECIMAL,
00766 FPLainDriver.dbRetData(FHandle, ParamIndex),
00767 FPLainDriver.dbRetLen(FHandle, ParamIndex),
00768 SQLFLT8, @DatDouble, 8);
00769 DefVarManager.SetAsFloat(Temp, DatDouble);
00770 end;
00771 SQLNUMERIC:
00772 begin
00773 FPLainDriver.dbConvert(FHandle, SQLNUMERIC,
00774 FPLainDriver.dbRetData(FHandle, ParamIndex),
00775 FPLainDriver.dbRetLen(FHandle, ParamIndex),
00776 SQLFLT8, @DatDouble, 8);
00777 DefVarManager.SetAsFloat(Temp, DatDouble);
00778 end;
00779 SQLDATETIM4:
00780 begin
00781 FPLainDriver.dbConvert(FHandle, SQLDATETIM4,
00782 FPLainDriver.dbRetData(FHandle, ParamIndex), 4,
00783 SQLDATETIME, @DatDBDATETIME, 8);
00784 DefVarManager.SetAsDateTime(Temp,
00785 DatDBDATETIME.dtdays + 2 + (DatDBDATETIME.dttime / 25920000));
00786 end;
00787 SQLDATETIME:
00788 begin
00789 DatDBDATETIME := PDBDATETIME(
00790 FPLainDriver.dbRetData(FHandle, ParamIndex))^;
00791 DefVarManager.SetAsDateTime(Temp,
00792 DatDBDATETIME.dtdays + 2 + (DatDBDATETIME.dttime / 25920000));
00793 end;
00794 else
00795 Temp := NullVariant;
00796 end;
00797 end;
00798 OutParamValues[I] := Temp;
00799 Inc(ParamIndex);
00800 end;
00801
00802 //Workaround for sybase. the dbCount does not work, so a select @@rowcount is
00803 //made but this cleared the returned output parameters, so this is moved here
00804 //after reading the output parameters
00805 FetchRowCount;
00806
00807 DriverManager.LogMessage(lcExecute, FPlainDriver.GetProtocol,
00808 Format('EXEC %s', [SQL]));
00809 end;
00810
00811 procedure TZDBLibCallableStatement.SetInParamCount(NewParamCount: Integer);
00812 begin
00813 inherited SetInParamCount(NewParamCount);
00814
00815 if OutParamCount < NewParamCount then
00816 SetOutParamCount(NewParamCount);
00817 end;
00818
00819 end.
00820