00001 {*********************************************************}
00002 { }
00003 { Zeos Database Objects }
00004 { Unidatabase SQLProcessor component }
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 ZSqlProcessor;
00055
00056 interface
00057
00058 {$I ZComponent.inc}
00059
00060 uses ZCompatibility, Classes, SysUtils, DB, ZDbcIntfs, ZConnection,
00061 ZScriptParser, ZSqlStrings{$IFNDEF VER130BELOW}, Types{$ENDIF};
00062
00063 type
00064
00065 {** Forward definition of TZSQLProcessor. }
00066 TZSQLProcessor = class;
00067
00068 {** Defines an error handle action. }
00069 TZErrorHandleAction = (eaFail, eaAbort, eaSkip, eaRetry);
00070
00071 {** Defines an Processor notification event. }
00072 TZProcessorNotifyEvent = procedure(Processor: TZSQLProcessor;
00073 StatementIndex: Integer) of object;
00074
00075 {** Defines an Processor error handling event. }
00076 TZProcessorErrorEvent = procedure(Processor: TZSQLProcessor;
00077 StatementIndex: Integer; E: Exception;
00078 var ErrorHandleAction: TZErrorHandleAction) of object;
00079
00080 {**
00081 Implements a unidatabase component which parses and executes SQL Scripts.
00082 }
00083 TZSQLProcessor = class (TComponent)
00084 private
00085 FParams: TParams;
00086 FScript: TZSQLStrings;
00087 FScriptParser: TZSQLScriptParser;
00088 FConnection: TZConnection;
00089 FBeforeExecute: TZProcessorNotifyEvent;
00090 FAfterExecute: TZProcessorNotifyEvent;
00091 FOnError: TZProcessorErrorEvent;
00092
00093 procedure SetParams(Value: TParams);
00094 function GetScript: TStrings;
00095 procedure SetScript(Value: TStrings);
00096 function GetStatementCount: Integer;
00097 function GetStatement(Index: Integer): string;
00098 procedure SetConnection(Value: TZConnection);
00099 function GetDelimiterType: TZDelimiterType;
00100 procedure SetDelimiterType(Value: TZDelimiterType);
00101 function GetDelimiter: string;
00102 procedure SetDelimiter(const Value: string);
00103 function GetCleanupStatements: Boolean;
00104 procedure SetCleanupStatements(const Value: Boolean);
00105
00106 function GetParamCheck: Boolean;
00107 procedure SetParamCheck(Value: Boolean);
00108 procedure UpdateSQLStrings(Sender: TObject);
00109 protected
00110 procedure CheckConnected;
00111 function DoOnError(StatementIndex: Integer; E: Exception):
00112 TZErrorHandleAction;
00113 procedure DoBeforeExecute(StatementIndex: Integer);
00114 procedure DoAfterExecute(StatementIndex: Integer);
00115
00116 function CreateStatement(const SQL: string; Properties: TStrings):
00117 IZPreparedStatement; virtual;
00118 procedure SetStatementParams(Statement: IZPreparedStatement;
00119 const ParamNames: TStringDynArray; Params: TParams); virtual;
00120 public
00121 constructor Create(AOwner: TComponent); override;
00122 destructor Destroy; override;
00123
00124 procedure LoadFromStream(Stream: TStream);
00125 procedure LoadFromFile(const FileName: string);
00126
00127 procedure Execute;
00128 procedure Parse;
00129 procedure Clear;
00130
00131 function ParamByName(const Value: string): TParam;
00132
00133 property StatementCount: Integer read GetStatementCount;
00134 property Statements[Index: Integer]: string read GetStatement;
00135 published
00136 property ParamCheck: Boolean read GetParamCheck write SetParamCheck
00137 default True;
00138 property Params: TParams read FParams write SetParams;
00139 property Script: TStrings read GetScript write SetScript;
00140 property Connection: TZConnection read FConnection write SetConnection;
00141 property DelimiterType: TZDelimiterType read GetDelimiterType
00142 write SetDelimiterType default dtDefault;
00143 property Delimiter: string read GetDelimiter write SetDelimiter;
00144 property CleanupStatements: Boolean read GetCleanupStatements
00145 write SetCleanupStatements default False;
00146 property OnError: TZProcessorErrorEvent read FOnError write FOnError;
00147 property AfterExecute: TZProcessorNotifyEvent read FAfterExecute write FAfterExecute;
00148 property BeforeExecute: TZProcessorNotifyEvent read FBeforeExecute write FBeforeExecute;
00149 end;
00150
00151 implementation
00152
00153 uses ZMessages, ZSysUtils, ZDbcUtils, ZAbstractRODataset, ZDatasetUtils;
00154
00155 { TZSQLProcessor }
00156
00157 {**
00158 Creates this Processor component and assignes the main properties.
00159 @param AOwner an owner component.
00160 }
00161 constructor TZSQLProcessor.Create(AOwner: TComponent);
00162 begin
00163 inherited Create(AOwner);
00164
00165 FParams := TParams.Create(Self);
00166 FScript := TZSQLStrings.Create;
00167 FScript.Dataset := Self;
00168 FScript.OnChange := UpdateSQLStrings;
00169 FScriptParser := TZSQLScriptParser.Create;
00170 FScriptParser.DelimiterType := dtDefault;
00171 FScriptParser.Delimiter := ';';
00172 FScriptParser.CleanupStatements := False;
00173 end;
00174
00175 {**
00176 Destroys this component and cleanups the memory.
00177 }
00178 destructor TZSQLProcessor.Destroy;
00179 begin
00180 FParams.Free;
00181 FScript.Free;
00182 FScriptParser.Free;
00183 inherited Destroy;
00184 end;
00185
00186 {**
00187 Gets a parsed statement by it's index.
00188 @return a SQL statement.
00189 }
00190 function TZSQLProcessor.GetStatement(Index: Integer): string;
00191 begin
00192 if (FScriptParser.UncompletedStatement <> '')
00193 and (Index = FScriptParser.StatementCount) then
00194 Result := FScriptParser.UncompletedStatement
00195 else Result := FScriptParser.Statements[Index];
00196 end;
00197
00198 {**
00199 Gets a statements count.
00200 @return a number of parsed statements.
00201 }
00202 function TZSQLProcessor.GetStatementCount: Integer;
00203 begin
00204 Result := FScriptParser.StatementCount;
00205 if FScriptParser.UncompletedStatement <> '' then
00206 Inc(Result);
00207 end;
00208
00209 {**
00210 Sets a new SQL connection component.
00211 @param Value am SQL connection component.
00212 }
00213 procedure TZSQLProcessor.SetConnection(Value: TZConnection);
00214 begin
00215 if FConnection <> Value then
00216 begin
00217 FConnection := Value;
00218 FScriptParser.ClearUncompleted;
00219 end;
00220 end;
00221
00222 {**
00223 Gets a script delimiter type;
00224 }
00225 function TZSQLProcessor.GetDelimiterType: TZDelimiterType;
00226 begin
00227 Result := FScriptParser.DelimiterType;
00228 end;
00229
00230 {**
00231 Sets a new Processor delimiter type.
00232 @param Value a new Processor delimiter type.
00233 }
00234 procedure TZSQLProcessor.SetDelimiterType(Value: TZDelimiterType);
00235 begin
00236 if FScriptParser.DelimiterType <> Value then
00237 begin
00238 FScriptParser.DelimiterType := Value;
00239 FScriptParser.ClearUncompleted;
00240 end;
00241 end;
00242
00243 {**
00244 Gets a script delimiter;
00245 }
00246 function TZSQLProcessor.GetDelimiter: string;
00247 begin
00248 Result := FScriptParser.Delimiter;
00249 end;
00250
00251 {**
00252 Sets a new Processor delimiter.
00253 @param Value a new Processor delimiter.
00254 }
00255 procedure TZSQLProcessor.SetDelimiter(const Value: string);
00256 begin
00257 if FScriptParser.Delimiter <> Value then
00258 begin
00259 FScriptParser.Delimiter := Value;
00260 FScriptParser.ClearUncompleted;
00261 end;
00262 end;
00263
00264 {**
00265 Sets a new set of parameters.
00266 @param Value a set of parameters.
00267 }
00268 procedure TZSQLProcessor.SetParams(Value: TParams);
00269 begin
00270 FParams.AssignValues(Value);
00271 end;
00272
00273 {**
00274 Sets a new SQL script.
00275 @param Value a new SQL script.
00276 }
00277 procedure TZSQLProcessor.SetScript(Value: TStrings);
00278 begin
00279 FScript.Assign(Value);
00280 FScriptParser.ClearUncompleted;
00281 end;
00282
00283 {**
00284 Checks is the database connection assignes and tries to connect.
00285 }
00286 procedure TZSQLProcessor.CheckConnected;
00287 begin
00288 if Connection = nil then
00289 raise EZDatabaseError.Create(SConnectionIsNotAssigned);
00290 Connection.Connect;
00291 end;
00292
00293 {**
00294 Clears Processor contents and all parsed statements.
00295 }
00296 procedure TZSQLProcessor.Clear;
00297 begin
00298 FScript.Clear;
00299 FScriptParser.ClearUncompleted;
00300 end;
00301
00302 {**
00303 Performs OnError Event and returns an error handle action.
00304 @param StatementIndex an index of the statement which failt.
00305 @param E an exception object.
00306 @return an error handle action.
00307 }
00308 function TZSQLProcessor.DoOnError(StatementIndex: Integer;
00309 E: Exception): TZErrorHandleAction;
00310 begin
00311 Result := eaFail;
00312 if Assigned(FOnError) then
00313 FOnError(Self, StatementIndex, E, Result);
00314 end;
00315
00316 {**
00317 Performs an action before execute a statement.
00318 @param StatementIndex an index of the executing statement.
00319 }
00320 procedure TZSQLProcessor.DoBeforeExecute(StatementIndex: Integer);
00321 begin
00322 if Assigned(FBeforeExecute) then
00323 FBeforeExecute(Self, StatementIndex);
00324 end;
00325
00326 {**
00327 Performs an action action execute a statement.
00328 @param StatementIndex an index of the executing statement.
00329 }
00330 procedure TZSQLProcessor.DoAfterExecute(StatementIndex: Integer);
00331 begin
00332 if Assigned(FAfterExecute) then
00333 FAfterExecute(Self, StatementIndex);
00334 end;
00335
00336 {**
00337 Loads a SQL Processor from the local file.
00338 @param FileName a name of the file.
00339 }
00340 procedure TZSQLProcessor.LoadFromFile(const FileName: string);
00341 begin
00342 FScript.LoadFromFile(FileName);
00343 end;
00344
00345 {**
00346 Loads a SQL Processor from the stream.
00347 @param Stream a stream object.
00348 }
00349 procedure TZSQLProcessor.LoadFromStream(Stream: TStream);
00350 begin
00351 FScript.LoadFromStream(Stream);
00352 end;
00353
00354 {**
00355 Executes a parsed SQL Processor.
00356 }
00357 procedure TZSQLProcessor.Execute;
00358 var
00359 I: Integer;
00360 Statement: IZPreparedStatement;
00361 Action: TZErrorHandleAction;
00362 SQL: TZSQLStrings;
00363 begin
00364 if Connection = nil then
00365 raise EZDatabaseError.Create(SConnectionIsNotAssigned);
00366
00367 FConnection.ShowSQLHourGlass;
00368 try
00369 SQL := TZSQLStrings.Create;
00370 SQL.Dataset := Self;
00371 SQL.ParamCheck := FScript.ParamCheck;
00372 SQL.MultiStatements := False;
00373 Parse;
00374
00375 for I := 0 to Pred(StatementCount) do
00376 begin
00377 Action := eaSkip;
00378 DoBeforeExecute(I);
00379 repeat
00380 try
00381 SQL.Text := GetStatement(I);
00382 Statement := CreateStatement(SQL.Statements[0].SQL, nil);
00383 SetStatementParams(Statement, SQL.Statements[0].ParamNamesArray,
00384 FParams);
00385 Statement.ExecuteUpdatePrepared;
00386 Statement := nil;
00387 except
00388 on E: Exception do
00389 begin
00390 if Assigned(Statement) then
00391 Statement := nil;
00392 Action := DoOnError(I, E);
00393 if Action = eaFail then
00394 RaiseSQLException(E)
00395 else if Action = eaAbort then
00396 Exit;
00397 end;
00398 end;
00399 until Action <> eaRetry;
00400 DoAfterExecute(I);
00401
00402 end;
00403 finally
00404 FreeAndNil(SQL);
00405 Connection.HideSQLHourGlass;
00406 end;
00407 end;
00408
00409 {**
00410 Gets a SQL parameter by its name.
00411 @param Value a parameter name.
00412 @return a found parameter object.
00413 }
00414 function TZSQLProcessor.ParamByName(const Value: string): TParam;
00415 begin
00416 Result := FParams.ParamByName(Value);
00417 end;
00418
00419 {**
00420 Parses the loaded SQL Processor.
00421 }
00422 procedure TZSQLProcessor.Parse;
00423 begin
00424 CheckConnected;
00425 FScriptParser.Tokenizer := Connection.DbcDriver.GetTokenizer;
00426 // mdaems 20060429 : Clear would reset the delimiter of the scriptparser
00427 // FScriptParser.Clear;
00428 FScriptParser.ClearUncompleted;
00429 FScriptParser.ParseText(FScript.Text);
00430 end;
00431
00432 {**
00433 Creates a DBC statement for the query.
00434 @param SQL an SQL query.
00435 @param Properties a statement specific properties.
00436 @returns a created DBC statement.
00437 }
00438 function TZSQLProcessor.CreateStatement(const SQL: string;
00439 Properties: TStrings): IZPreparedStatement;
00440 var
00441 Temp: TStrings;
00442 begin
00443 Temp := TStringList.Create;
00444 try
00445 if Assigned(Properties) then
00446 Temp.AddStrings(Properties);
00447
00448 Result := FConnection.DbcConnection.PrepareStatementWithParams(SQL, Temp);
00449 finally
00450 Temp.Free;
00451 end;
00452 end;
00453
00454 {**
00455 Fill prepared statement with parameters.
00456 @param Statement a prepared SQL statement.
00457 @param ParamNames an array of parameter names.
00458 @param Params a collection of SQL parameters.
00459 }
00460 procedure TZSQLProcessor.SetStatementParams(Statement: IZPreparedStatement;
00461 const ParamNames: TStringDynArray; Params: TParams);
00462 var
00463 I: Integer;
00464 TempParam, Param: TParam;
00465 Stream: TStream;
00466 begin
00467 TempParam := TParam.Create(nil);
00468
00469 try
00470 for I := Low(ParamNames) to High(ParamNames) do
00471 begin
00472 Param := Params.FindParam(ParamNames[I]);
00473 if not Assigned(Param) or (Param.ParamType in [ptOutput, ptResult]) then
00474 Continue;
00475
00476 if Param.IsNull then
00477 Statement.SetNull(I + 1, ConvertDatasetToDbcType(Param.DataType))
00478 else begin
00479 case Param.DataType of
00480 ftBoolean:
00481 Statement.SetBoolean(I + 1, Param.AsBoolean);
00482 ftSmallInt:
00483 Statement.SetShort(I + 1, Param.AsSmallInt);
00484 ftInteger, ftAutoInc:
00485 Statement.SetInt(I + 1, Param.AsInteger);
00486 ftFloat:
00487 Statement.SetDouble(I + 1, Param.AsFloat);
00488 ftLargeInt:
00489 Statement.SetLong(I + 1, StrToInt64(Param.AsString));
00490 ftCurrency:
00491 Statement.SetBigDecimal(I + 1, Param.AsCurrency);
00492 ftString:
00493 Statement.SetString(I + 1, Param.AsString);
00494 ftBytes:
00495 Statement.SetString(I + 1, Param.AsString);
00496 ftDate:
00497 Statement.SetDate(I + 1, Param.AsDate);
00498 ftTime:
00499 Statement.SetTime(I + 1, Param.AsTime);
00500 ftDateTime{$IFNDEF VER130}, ftTimestamp{$ENDIF}:
00501 Statement.SetTimestamp(I + 1, Param.AsDateTime);
00502 ftMemo:
00503 begin
00504 Stream := TStringStream.Create(Param.AsMemo);
00505 try
00506 Statement.SetAsciiStream(I + 1, Stream);
00507 finally
00508 Stream.Free;
00509 end;
00510 end;
00511 ftBlob, ftGraphic:
00512 begin
00513 Stream := TStringStream.Create(Param.AsBlob);
00514 try
00515 Statement.SetBinaryStream(I + 1, Stream);
00516 finally
00517 Stream.Free;
00518 end;
00519 end;
00520 end;
00521 end;
00522 end;
00523 finally
00524 TempParam.Free;
00525 end;
00526 end;
00527
00528 {**
00529 Gets the SQL script.
00530 @return the SQL script strings.
00531 }
00532 function TZSQLProcessor.GetScript: TStrings;
00533 begin
00534 Result := FScript;
00535 end;
00536
00537 {**
00538 Updates parameters from SQL statement.
00539 @param Sender an event sender object.
00540 }
00541 procedure TZSQLProcessor.UpdateSQLStrings(Sender: TObject);
00542 var
00543 I: Integer;
00544 OldParams: TParams;
00545 begin
00546 OldParams := TParams.Create;
00547 OldParams.Assign(FParams);
00548 FParams.Clear;
00549
00550 try
00551 for I := 0 to FScript.ParamCount - 1 do
00552 FParams.CreateParam(ftUnknown, FScript.ParamNames[I], ptUnknown);
00553 FParams.AssignValues(OldParams);
00554 finally
00555 OldParams.Free;
00556 end;
00557 end;
00558
00559 {**
00560 Gets a parameters check value.
00561 @return a parameters check value.
00562 }
00563 function TZSQLProcessor.GetParamCheck: Boolean;
00564 begin
00565 Result := FScript.ParamCheck;
00566 end;
00567
00568 {**
00569 Sets a new parameters check value.
00570 @param Value a parameters check value.
00571 }
00572 procedure TZSQLProcessor.SetParamCheck(Value: Boolean);
00573 begin
00574 FScript.ParamCheck := Value;
00575 UpdateSQLStrings(Self);
00576 end;
00577
00578 function TZSQLProcessor.GetCleanupStatements: Boolean;
00579 begin
00580 Result := FScriptParser.CleanupStatements;
00581 end;
00582
00583 procedure TZSQLProcessor.SetCleanupStatements(const Value: Boolean);
00584 begin
00585 if FScriptParser.CleanupStatements <> Value then
00586 begin
00587 FScriptParser.CleanupStatements := Value;
00588 FScriptParser.ClearUncompleted;
00589 end;
00590 end;
00591
00592 end.
00593