ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/journaling/fbintf/IBUtils.pas
Revision: 120
Committed: Mon Jan 22 13:58:20 2018 UTC (6 years, 2 months ago) by tony
Content type: text/x-pascal
Original Path: ibx/trunk/fbintf/IBUtils.pas
File size: 10384 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 old versions of Delphi}
398 function ExtractConnectString(const CreateSQL: AnsiString;
399 var ConnectString: AnsiString): boolean;
400 var i: integer;
401 begin
402 Result := false;
403 i := Pos('''',CreateSQL);
404 if i > 0 then
405 begin
406 ConnectString := CreateSQL;
407 delete(ConnectString,1,i);
408 i := Pos('''',ConnectString);
409 if i > 0 then
410 begin
411 delete(ConnectString,i,Length(ConnectString)-i+1);
412 Result := true;
413 end;
414 end;
415 end;
416 {$ENDIF}
417
418 {Format an SQL Identifier according to SQL Dialect with encapsulation if necessary}
419
420 function QuoteIdentifierIfNeeded(Dialect: Integer; Value: AnsiString): AnsiString;
421 begin
422 if (Dialect = 3) and
423 (IsReservedWord(Value) or not IsSQLIdentifier(Value) or (AnsiUpperCase(Value) <> Value)) then
424 Result := '"' + StringReplace (TrimRight(Value), '"', '""', [rfReplaceAll]) + '"'
425 else
426 Result := Value
427 end;
428
429 {Replaces unknown characters in a string with underscores}
430
431 function Space2Underscore(s: AnsiString): AnsiString;
432 var
433 k: integer;
434 begin
435 Result := s;
436 for k := 1 to Length(s) do
437 if not (Result[k] in ValidSQLIdentifierChars) then
438 Result[k] := '_';
439 end;
440
441 {Reformats an SQL string with single quotes duplicated.}
442
443 function SQLSafeString(const s: AnsiString): AnsiString;
444 begin
445 Result := StringReplace(s,'''','''''',[rfReplaceAll]);
446 end;
447
448 end.