ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/fbintf/IBUtils.pas
Revision: 118
Committed: Mon Jan 22 13:58:14 2018 UTC (6 years, 9 months ago) by tony
Content type: text/x-pascal
File size: 10462 byte(s)
Log Message:
Fixes Merged

File Contents

# Content
1 {************************************************************************}
2 { }
3 { Borland Delphi Visual Component Library }
4 { InterBase Express core components }
5 { }
6 { Copyright (c) 1998-2000 Inprise Corporation }
7 { }
8 { InterBase Express is based in part on the product }
9 { Free IB Components, written by Gregory H. Deatz for }
10 { Hoagland, Longo, Moran, Dunst & Doukas Company. }
11 { Free IB Components is used under license. }
12 { }
13 { The contents of this file are subject to the InterBase }
14 { Public License Version 1.0 (the "License"); you may not }
15 { use this file except in compliance with the License. You }
16 { may obtain a copy of the License at http://www.Inprise.com/IPL.html }
17 { Software distributed under the License is distributed on }
18 { an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either }
19 { express or implied. See the License for the specific language }
20 { governing rights and limitations under the License. }
21 { The Original Code was created by InterBase Software Corporation }
22 { and its successors. }
23 { Portions created by Inprise Corporation are Copyright (C) Inprise }
24 { Corporation. All Rights Reserved. }
25 { Contributor(s): Jeff Overcash }
26 { }
27 { IBX For Lazarus (Firebird Express) }
28 { Contributor: Tony Whyman, MWA Software http://www.mwasoftware.co.uk }
29 { Portions created by MWA Software are copyright McCallum Whyman }
30 { Associates Ltd 2011 }
31 { }
32 {************************************************************************}
33
34 unit IBUtils;
35 {$IFDEF MSWINDOWS}
36 {$DEFINE WINDOWS}
37 {$IF CompilerVersion >= 28}
38 {Delphi XE7 onwards}}
39 {$define HASREQEX}
40 {$IFEND}
41 {$ENDIF}
42
43 {$IFDEF FPC}
44 {$Mode Delphi}
45 {$codepage UTF8}
46 {$define HASREQEX}
47 {$ENDIF}
48
49
50 interface
51
52 uses Classes, SysUtils;
53
54 const
55 CRLF = #13 + #10;
56 CR = #13;
57 LF = #10;
58 TAB = #9;
59 NULL_TERMINATOR = #0;
60
61 sqlReservedWords: array [0..197] of string = (
62 'ADD',
63 'ADMIN',
64 'ALL',
65 'ALTER',
66 'AND',
67 'ANY',
68 'AS',
69 'AT',
70 'AVG',
71 'BEGIN',
72 'BETWEEN',
73 'BIGINT',
74 'BIT_LENGTH',
75 'BLOB',
76 'BOOLEAN',
77 'BOTH',
78 'BY',
79 'CASE',
80 'CAST',
81 'CHAR',
82 'CHAR_LENGTH',
83 'CHARACTER',
84 'CHARACTER_LENGTH',
85 'CHECK',
86 'CLOSE',
87 'COLLATE',
88 'COLUMN',
89 'COMMIT',
90 'CONNECT',
91 'CONSTRAINT',
92 'CORR',
93 'COUNT',
94 'COVAR_POP',
95 'COVAR_SAMP',
96 'CREATE',
97 'CROSS',
98 'CURRENT',
99 'CURRENT_CONNECTION',
100 'CURRENT_DATE',
101 'CURRENT_ROLE',
102 'CURRENT_TIME',
103 'CURRENT_TIMESTAMP',
104 'CURRENT_TRANSACTION',
105 'CURRENT_USER',
106 'CURSOR',
107 'DATE',
108 'DAY',
109 'DEC',
110 'DECIMAL',
111 'DECLARE',
112 'DEFAULT',
113 'DELETE',
114 'DELETING',
115 'DETERMINISTIC',
116 'DISCONNECT',
117 'DISTINCT',
118 'DOUBLE',
119 'DROP',
120 'ELSE',
121 'END',
122 'ESCAPE',
123 'EXECUTE',
124 'EXISTS',
125 'EXTERNAL',
126 'EXTRACT',
127 'FALSE',
128 'FETCH',
129 'FILTER',
130 'FLOAT',
131 'FOR',
132 'FOREIGN',
133 'FROM',
134 'FULL',
135 'FUNCTION',
136 'GDSCODE',
137 'GLOBAL',
138 'GRANT',
139 'GROUP',
140 'HAVING',
141 'HOUR',
142 'IN',
143 'INDEX',
144 'INNER',
145 'INSENSITIVE',
146 'INSERT',
147 'INSERTING',
148 'INT',
149 'INTEGER',
150 'INTO',
151 'IS',
152 'JOIN',
153 'LEADING',
154 'LEFT',
155 'LIKE',
156 'LONG',
157 'LOWER',
158 'MAX',
159 'MAXIMUM_SEGMENT',
160 'MERGE',
161 'MIN',
162 'MINUTE',
163 'MONTH',
164 'NATIONAL',
165 'NATURAL',
166 'NCHAR',
167 'NO',
168 'NOT',
169 'NULL',
170 'NUMERIC',
171 'OCTET_LENGTH',
172 'OF',
173 'OFFSET',
174 'ON',
175 'ONLY',
176 'OPEN',
177 'OR',
178 'ORDER',
179 'OUTER',
180 'OVER',
181 'PARAMETER',
182 'PLAN',
183 'POSITION',
184 'POST_EVENT',
185 'PRECISION',
186 'PRIMARY',
187 'PROCEDURE',
188 'RDB$DB_KEY',
189 'RDB$RECORD_VERSION',
190 'REAL',
191 'RECORD_VERSION',
192 'RECREATE',
193 'RECURSIVE',
194 'REFERENCES',
195 'REGR_AVGX',
196 'REGR_AVGY',
197 'REGR_COUNT',
198 'REGR_INTERCEPT',
199 'REGR_R2',
200 'REGR_SLOPE',
201 'REGR_SXX',
202 'REGR_SXY',
203 'REGR_SYY',
204 'RELEASE',
205 'RETURN',
206 'RETURNING_VALUES',
207 'RETURNS',
208 'REVOKE',
209 'RIGHT',
210 'ROLLBACK',
211 'ROW',
212 'ROW_COUNT',
213 'ROWS',
214 'SAVEPOINT',
215 'SCROLL',
216 'SECOND',
217 'SELECT',
218 'SENSITIVE',
219 'SET',
220 'SIMILAR',
221 'SMALLINT',
222 'SOME',
223 'SQLCODE',
224 'SQLSTATE',
225 'SQLSTATE',
226 'START',
227 'STDDEV_POP',
228 'STDDEV_SAMP',
229 'SUM',
230 'TABLE',
231 'THEN',
232 'TIME',
233 'TIMESTAMP',
234 'TO',
235 'TRAILING',
236 'TRIGGER',
237 'TRIM',
238 'TRUE',
239 'UNION',
240 'UNIQUE',
241 'UNKNOWN',
242 'UPDATE',
243 'UPDATING',
244 'UPPER',
245 'USER',
246 'USING',
247 'VALUE',
248 'VALUES',
249 'VAR_POP',
250 'VAR_SAMP',
251 'VARCHAR',
252 'VARIABLE',
253 'VARYING',
254 'VIEW',
255 'WHEN',
256 'WHERE',
257 'WHILE',
258 'WITH',
259 'YEAR'
260 );
261
262 function Max(n1, n2: Integer): Integer;
263 function Min(n1, n2: Integer): Integer;
264 function RandomString(iLength: Integer): AnsiString;
265 function RandomInteger(iLow, iHigh: Integer): Integer;
266 function StripString(st: AnsiString; CharsToStrip: AnsiString): AnsiString;
267 function ExtractIdentifier(Dialect: Integer; Value: AnsiString): AnsiString;
268 function QuoteIdentifier(Dialect: Integer; Value: AnsiString): AnsiString;
269 function QuoteIdentifierIfNeeded(Dialect: Integer; Value: AnsiString): AnsiString;
270 function Space2Underscore(s: AnsiString): AnsiString;
271 function SQLSafeString(const s: AnsiString): AnsiString;
272 function IsSQLIdentifier(Value: AnsiString): boolean;
273 function ExtractConnectString(const CreateSQL: AnsiString; var ConnectString: AnsiString): boolean;
274
275 implementation
276
277 {$IFDEF HASREQEX}
278 uses RegExpr;
279 {$ENDIF}
280
281 function Max(n1, n2: Integer): Integer;
282 begin
283 if (n1 > n2) then
284 result := n1
285 else
286 result := n2;
287 end;
288
289 function Min(n1, n2: Integer): Integer;
290 begin
291 if (n1 < n2) then
292 result := n1
293 else
294 result := n2;
295 end;
296
297 function RandomString(iLength: Integer): AnsiString;
298 begin
299 result := '';
300 while Length(result) < iLength do
301 result := result + IntToStr(RandomInteger(0, High(Integer)));
302 if Length(result) > iLength then
303 result := Copy(result, 1, iLength);
304 end;
305
306 function RandomInteger(iLow, iHigh: Integer): Integer;
307 begin
308 result := Trunc(Random(iHigh - iLow)) + iLow;
309 end;
310
311 function StripString(st: AnsiString; CharsToStrip: AnsiString): AnsiString;
312 var
313 i: Integer;
314 begin
315 result := '';
316 for i := 1 to Length(st) do begin
317 if AnsiPos(st[i], CharsToStrip) = 0 then
318 result := result + st[i];
319 end;
320 end;
321
322 {Extracts SQL Identifier typically from a Dialect 3 encoding}
323
324 function ExtractIdentifier(Dialect: Integer; Value: AnsiString): AnsiString;
325 begin
326 Value := Trim(Value);
327 if Dialect = 1 then
328 Value := AnsiUpperCase(Value)
329 else
330 begin
331 if (Value <> '') and (Value[1] = '"') then
332 begin
333 Delete(Value, 1, 1);
334 Delete(Value, Length(Value), 1);
335 Value := StringReplace (Value, '""', '"', [rfReplaceAll]);
336 end
337 else
338 Value := AnsiUpperCase(Value);
339 end;
340 Result := Value;
341 end;
342
343 {Returns true if "w" is a Firebird SQL reserved word}
344
345 function IsReservedWord(w: AnsiString): boolean;
346 var i: integer;
347 begin
348 Result := true;
349 for i := 0 to Length(sqlReservedWords) - 1 do
350 if w = sqlReservedWords[i] then
351 Exit;
352 Result := false;
353 end;
354
355 {Format an SQL Identifier according to SQL Dialect}
356
357 function QuoteIdentifier(Dialect: Integer; Value: AnsiString): AnsiString;
358 begin
359 if Dialect = 1 then
360 Value := AnsiUpperCase(Trim(Value))
361 else
362 Value := '"' + StringReplace (Value, '""', '"', [rfReplaceAll]) + '"';
363 Result := Value;
364 end;
365
366 const
367 ValidSQLIdentifierChars = ['A'..'Z','a'..'z','0'..'9','_','$'];
368
369 {Returns true if the value is a valid SQL Identifier - note lower case accepted}
370
371 function IsSQLIdentifier(Value: AnsiString): boolean;
372 var i: integer;
373 begin
374 Result := false;
375 for i := 1 to Length(Value) do
376 if not (Value[i] in ValidSQLIdentifierChars) then Exit;
377 Result := true;
378 end;
379
380 {Extracts the Database Connect string from a Create Database Statement}
381
382 {$IFDEF HASREQEX}
383 function ExtractConnectString(const CreateSQL: AnsiString;
384 var ConnectString: AnsiString): boolean;
385 var RegexObj: TRegExpr;
386 begin
387 RegexObj := TRegExpr.Create;
388 try
389 {extact database file spec}
390 RegexObj.ModifierG := false; {turn off greedy matches}
391 RegexObj.ModifierI := true; {case insensitive match}
392 RegexObj.Expression := '^ *CREATE +(DATABASE|SCHEMA) +''(.*)''';
393 Result := RegexObj.Exec(CreateSQL);
394 if Result then
395 ConnectString := system.copy(CreateSQL,RegexObj.MatchPos[2],RegexObj.MatchLen[2]);
396 finally
397 RegexObj.Free;
398 end;
399 end;
400 {$ELSE}
401 {cruder version of above for old versions of Delphi}
402 function ExtractConnectString(const CreateSQL: AnsiString;
403 var ConnectString: AnsiString): boolean;
404 var i: integer;
405 begin
406 Result := false;
407 i := Pos('''',CreateSQL);
408 if i > 0 then
409 begin
410 ConnectString := CreateSQL;
411 delete(ConnectString,1,i);
412 i := Pos('''',ConnectString);
413 if i > 0 then
414 begin
415 delete(ConnectString,i,Length(ConnectString)-i+1);
416 Result := true;
417 end;
418 end;
419 end;
420 {$ENDIF}
421
422 {Format an SQL Identifier according to SQL Dialect with encapsulation if necessary}
423
424 function QuoteIdentifierIfNeeded(Dialect: Integer; Value: AnsiString): AnsiString;
425 begin
426 if (Dialect = 3) and
427 (IsReservedWord(Value) or not IsSQLIdentifier(Value) or (AnsiUpperCase(Value) <> Value)) then
428 Result := '"' + StringReplace (TrimRight(Value), '"', '""', [rfReplaceAll]) + '"'
429 else
430 Result := Value
431 end;
432
433 {Replaces unknown characters in a string with underscores}
434
435 function Space2Underscore(s: AnsiString): AnsiString;
436 var
437 k: integer;
438 begin
439 Result := s;
440 for k := 1 to Length(s) do
441 if not (Result[k] in ValidSQLIdentifierChars) then
442 Result[k] := '_';
443 end;
444
445 {Reformats an SQL string with single quotes duplicated.}
446
447 function SQLSafeString(const s: AnsiString): AnsiString;
448 begin
449 Result := StringReplace(s,'''','''''',[rfReplaceAll]);
450 end;
451
452 end.