00001 {*********************************************************}
00002 { }
00003 { Zeos Database Objects }
00004 { SQL Query Strings 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 ZSqlStrings;
00055
00056 interface
00057
00058 {$I ZComponent.inc}
00059
00060 uses
00061 {$IFNDEF VER130BELOW}
00062 Types,
00063 {$ENDIF}
00064 Classes, SysUtils, DB, ZSysUtils, ZDbcIntfs, ZTokenizer, ZGenericSqlToken,
00065 Contnrs, ZCompatibility;
00066
00067 type
00068 {** Represents a SQL statement description object. }
00069 TZSQLStatement = class (TObject)
00070 private
00071 FSQL: string;
00072 FParamIndices: TIntegerDynArray;
00073 FParams: TStrings;
00074
00075 function GetParamCount: Integer;
00076 function GetParamName(Index: Integer): string;
00077 function GetParamNamesArray: TStringDynArray;
00078 public
00079 constructor Create(const SQL: string; const ParamIndices: TIntegerDynArray;
00080 Params: TStrings);
00081 property SQL: string read FSQL;
00082 property ParamCount: Integer read GetParamCount;
00083 property ParamNames[Index: Integer]: string read GetParamName;
00084 property ParamIndices: TIntegerDynArray read FParamIndices;
00085 property ParamNamesArray: TStringDynArray read GetParamNamesArray;
00086 end;
00087
00088 {** Imlements a string list with SQL statements. }
00089 TZSQLStrings = class (TStringList)
00090 private
00091 FDataset: TObject;
00092 FParamCheck: Boolean;
00093 FStatements: TObjectList;
00094 FParams: TStringList;
00095 FMultiStatements: Boolean;
00096
00097 function GetParamCount: Integer;
00098 function GetParamName(Index: Integer): string;
00099 function GetStatement(Index: Integer): TZSQLStatement;
00100 function GetStatementCount: Integer;
00101 procedure SetDataset(Value: TObject);
00102 procedure SetParamCheck(Value: Boolean);
00103 procedure SetMultiStatements(Value: Boolean);
00104 protected
00105 procedure Changed; override;
00106 function FindParam(const ParamName: string): Integer;
00107 procedure RebuildAll;
00108 public
00109 constructor Create;
00110 destructor Destroy; override;
00111
00112 property Dataset: TObject read FDataset write SetDataset;
00113 property ParamCheck: Boolean read FParamCheck write SetParamCheck;
00114 property ParamCount: Integer read GetParamCount;
00115 property ParamNames[Index: Integer]: string read GetParamName;
00116 property StatementCount: Integer read GetStatementCount;
00117 property Statements[Index: Integer]: TZSQLStatement read GetStatement;
00118 property MultiStatements: Boolean read FMultiStatements
00119 write SetMultiStatements;
00120 end;
00121
00122 implementation
00123
00124 uses ZMessages, ZAbstractRODataset, ZDatasetUtils, ZSqlProcessor;
00125
00126 { TZSQLStatement }
00127
00128 {**
00129 Creates a SQL statement object and assignes the main properties.
00130 @param SQL a SQL statement.
00131 @param ParamIndices a parameter indices.
00132 @param Params a list with all parameter names.
00133 }
00134 constructor TZSQLStatement.Create(const SQL: string;
00135 const ParamIndices: TIntegerDynArray; Params: TStrings);
00136 begin
00137 FSQL := SQL;
00138 FParamIndices := ParamIndices;
00139 FParams := Params;
00140 end;
00141
00142 {**
00143 Gets a parameters count for this statement.
00144 @return a parameters count.
00145 }
00146 function TZSQLStatement.GetParamCount: Integer;
00147 begin
00148 if Assigned(FParamIndices) then
00149 Result := High(FParamIndices) - Low(FParamIndices) + 1
00150 else Result := 0;
00151 end;
00152
00153 {**
00154 Gets a parameter name by it's index inside the statement.
00155 @return a parameter name.
00156 }
00157 function TZSQLStatement.GetParamName(Index: Integer): string;
00158 begin
00159 if Assigned(FParamIndices) then
00160 Result := FParams[FParamIndices[Index + Low(FParamIndices)]]
00161 else Result := '';
00162 end;
00163
00164 {**
00165 Gets an array of parameter names.
00166 @return an array of parameter names.
00167 }
00168 function TZSQLStatement.GetParamNamesArray: TStringDynArray;
00169 var
00170 I: Integer;
00171 begin
00172 SetLength(Result, High(FParamIndices) - Low(FParamIndices) + 1);
00173 for I := Low(Result) to High(Result) do
00174 Result[I] := FParams[FParamIndices[I + Low(FParamIndices)]];
00175 end;
00176
00177 { TZSQLStrings }
00178
00179 {**
00180 Creates a SQL strings object and assigns the main properties.
00181 }
00182 constructor TZSQLStrings.Create;
00183 begin
00184 FParams := TStringList.Create;
00185 FParamCheck := True;
00186 FStatements := TObjectList.Create;
00187 FMultiStatements := True;
00188 end;
00189
00190 {**
00191 Destroys this object and cleanups the memory.
00192 }
00193 destructor TZSQLStrings.Destroy;
00194 begin
00195 FParams.Free;
00196 FStatements.Free;
00197 inherited Destroy;
00198 end;
00199
00200 {**
00201 Gets a parameter count.
00202 @return a count of SQL parameters.
00203 }
00204 function TZSQLStrings.GetParamCount: Integer;
00205 begin
00206 Result := FParams.Count;
00207 end;
00208
00209 {**
00210 Gets parameter name by it's index.
00211 @param Index a parameter index.
00212 @return a parameter name.
00213 }
00214 function TZSQLStrings.GetParamName(Index: Integer): string;
00215 begin
00216 Result := FParams[Index];
00217 end;
00218
00219 {**
00220 Gets a SQL statements count.
00221 @return a SQL statements count.
00222 }
00223 function TZSQLStrings.GetStatementCount: Integer;
00224 begin
00225 Result := FStatements.Count;
00226 end;
00227
00228 {**
00229 Gets a SQL statement by it's index.
00230 @param Index a SQL statement index.
00231 @return a SQL statement object.
00232 }
00233 function TZSQLStrings.GetStatement(Index: Integer): TZSQLStatement;
00234 begin
00235 Result := TZSQLStatement(FStatements[Index]);
00236 end;
00237
00238 {**
00239 Sets a new ParamCheck value.
00240 @param Value a new ParamCheck value.
00241 }
00242 procedure TZSQLStrings.SetParamCheck(Value: Boolean);
00243 begin
00244 if FParamCheck <> Value then
00245 begin
00246 FParamCheck := Value;
00247 RebuildAll;
00248 end;
00249 end;
00250
00251 {**
00252 Sets a new MultiStatements value.
00253 @param Value a new MultiStatements value.
00254 }
00255 procedure TZSQLStrings.SetMultiStatements(Value: Boolean);
00256 begin
00257 if FMultiStatements <> Value then
00258 begin
00259 FMultiStatements := Value;
00260 RebuildAll;
00261 end;
00262 end;
00263
00264 {**
00265 Sets a new correspondent dataset object.
00266 @param Value a new dataset object.
00267 }
00268 procedure TZSQLStrings.SetDataset(Value: TObject);
00269 begin
00270 if FDataset <> Value then
00271 begin
00272 FDataset := Value;
00273 RebuildAll;
00274 end;
00275 end;
00276
00277 {**
00278 Finds a parameter by it's name.
00279 @param ParamName a parameter name.
00280 @return an index of found parameters or -1 if nothing was found.
00281 }
00282 function TZSQLStrings.FindParam(const ParamName: string): Integer;
00283 begin
00284 {$IFNDEF VER130BELOW}
00285 FParams.CaseSensitive := False;
00286 {$ENDIF}
00287 Result := FParams.IndexOf(ParamName);
00288 end;
00289
00290 {**
00291 Rebuilds all SQL statements.
00292 }
00293 procedure TZSQLStrings.RebuildAll;
00294 var
00295 Tokens: TStrings;
00296 TokenValue: string;
00297 TokenType: TZTokenType;
00298 TokenIndex: Integer;
00299 ParamIndex: Integer;
00300 ParamIndices: TIntegerDynArray;
00301 ParamIndexCount: Integer;
00302 ParamName, SQL: string;
00303 Driver: IZDriver;
00304 Tokenizer: IZTokenizer;
00305
00306 procedure NextToken;
00307 begin
00308 TokenType := TZTokenType({$IFDEF FPC}Pointer({$ENDIF}
00309 Tokens.Objects[TokenIndex]{$IFDEF FPC}){$ENDIF});
00310 TokenValue := Tokens[TokenIndex];
00311 Inc(TokenIndex);
00312 end;
00313
00314 begin
00315 FParams.Clear;
00316 FStatements.Clear;
00317 SQL := '';
00318 ParamIndexCount := 0;
00319 SetLength(ParamIndices, ParamIndexCount);
00320
00321 { Optimization for empty query. }
00322 If Length(Trim(Text)) = 0 then
00323 Exit;
00324
00325 { Optimization for single query without parameters. }
00326 if (not FParamCheck or (Pos(':', Text) = 0))
00327 and (not FMultiStatements or (Pos(';', Text) = 0)) then
00328 begin
00329 FStatements.Add(TZSQLStatement.Create(Text, ParamIndices, FParams));
00330 Exit;
00331 end;
00332
00333 { Defines a SQL specific tokenizer object. }
00334 Tokenizer := CommonTokenizer;
00335 if FDataset is TZAbstractRODataset then
00336 begin
00337 if Assigned(TZAbstractRODataset(FDataset).Connection) then
00338 begin
00339 Driver := TZAbstractRODataset(FDataset).Connection.DbcDriver;
00340 if Assigned(Driver) then
00341 Tokenizer := Driver.GetTokenizer;
00342 end;
00343 end
00344 else if FDataset is TZSQLProcessor then
00345 begin
00346 if Assigned(TZSQLProcessor(FDataset).Connection) then
00347 begin
00348 Driver := TZSQLProcessor(FDataset).Connection.DbcDriver;
00349 if Assigned(Driver) then
00350 Tokenizer := Driver.GetTokenizer;
00351 end;
00352 end;
00353
00354 Tokens := Tokenizer.TokenizeBufferToList(Text,
00355 [toSkipComments, toUnifyWhitespaces]);
00356 try
00357 TokenIndex := 0;
00358 repeat
00359 NextToken;
00360 { Processes parameters. }
00361 if ParamCheck and (TokenValue = ':') then
00362 begin
00363 NextToken;
00364 if (TokenType <> ttEOF) and (TokenValue <> ':') then
00365 begin
00366 { Check for correct parameter type. }
00367 if not (TokenType in [ttWord, ttQuoted]) then
00368 raise EZDatabaseError.Create(SIncorrectToken);
00369
00370 SQL := SQL + '?';
00371
00372 ParamName := TokenValue;
00373 if (ParamName <> '') and (ParamName[1] in [#39, '`', '"', '[']) then
00374 begin
00375 ParamName := Tokenizer.GetQuoteState.
00376 DecodeString(ParamName, ParamName[1]);
00377 end;
00378
00379 ParamIndex := FindParam(ParamName);
00380 if ParamIndex < 0 then
00381 ParamIndex := FParams.Add(ParamName);
00382
00383 Inc(ParamIndexCount);
00384 SetLength(ParamIndices, ParamIndexCount);
00385 ParamIndices[ParamIndexCount - 1] := ParamIndex;
00386
00387 Continue;
00388 end;
00389 end;
00390
00391 { Adds a DML statement. }
00392 if (TokenType = ttEOF) or (FMultiStatements and (TokenValue = ';')) then
00393 begin
00394 SQL := Trim(SQL);
00395 if SQL <> '' then
00396 FStatements.Add(TZSQLStatement.Create(SQL, ParamIndices, FParams));
00397
00398 SQL := '';
00399 ParamIndexCount := 0;
00400 SetLength(ParamIndices, ParamIndexCount);
00401 end
00402 { Adds a default token. }
00403 else
00404 SQL := SQL + TokenValue;
00405 until TokenType = ttEOF;
00406 finally
00407 Tokens.Free;
00408 end;
00409 end;
00410
00411 {**
00412 Performs action when the content of this string list is changed.
00413 }
00414 procedure TZSQLStrings.Changed;
00415 begin
00416 {$IFNDEF VER130BELOW}
00417 if UpdateCount = 0 then
00418 {$ENDIF}
00419 RebuildAll;
00420 inherited Changed;
00421 end;
00422
00423 end.