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