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