ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/fbintf/IBUtils.pas
Revision: 107
Committed: Thu Jan 18 14:37:40 2018 UTC (6 years, 10 months ago) by tony
Content type: text/x-pascal
File size: 10024 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 FormatIdentifier(Dialect: Integer; Value: AnsiString): AnsiString;
262 function FormatIdentifierValue(Dialect: Integer; Value: AnsiString): AnsiString;
263 function FormatIdentifierValueNC(Dialect: Integer; Value: AnsiString): AnsiString;
264 function ExtractIdentifier(Dialect: Integer; Value: AnsiString): AnsiString;
265 function QuoteIdentifier(Dialect: Integer; Value: AnsiString): AnsiString;
266 function QuoteIdentifierIfNeeded(Dialect: Integer; Value: AnsiString): AnsiString;
267 function Space2Underscore(s: AnsiString): AnsiString;
268 function SQLSafeString(const s: AnsiString): AnsiString;
269 function IsSQLIdentifier(Value: AnsiString): boolean;
270
271 implementation
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 function FormatIdentifier(Dialect: Integer; Value: AnsiString): AnsiString;
315 begin
316 Value := Trim(Value);
317 if Dialect = 1 then
318 Value := AnsiUpperCase(Value)
319 else
320 if (Value <> '') and (Value[1] = '"') then
321 Value := '"' + StringReplace (TrimRight(Value), '"', '""', [rfReplaceAll]) + '"'
322 else
323 Value := AnsiUpperCase(Value);
324 Result := Value;
325 end;
326
327 function FormatIdentifierValue(Dialect: Integer; Value: AnsiString): AnsiString;
328 begin
329 Value := Trim(Value);
330 if Dialect = 1 then
331 Value := AnsiUpperCase(Value)
332 else
333 begin
334 if (Value <> '') and (Value[1] = '"') then
335 begin
336 Delete(Value, 1, 1);
337 Delete(Value, Length(Value), 1);
338 Value := StringReplace (Value, '""', '"', [rfReplaceAll]);
339 end
340 else
341 Value := AnsiUpperCase(Value);
342 end;
343 Result := Value;
344 end;
345
346 function FormatIdentifierValueNC(Dialect: Integer; Value: AnsiString): AnsiString;
347 begin
348 Value := Trim(Value);
349 if Dialect = 1 then
350 Value := AnsiUpperCase(Value)
351 else
352 begin
353 if (Value <> '') and (Value[1] = '"') then
354 begin
355 Delete(Value, 1, 1);
356 Delete(Value, Length(Value), 1);
357 Value := AnsiUpperCase(StringReplace (Value, '""', '"', [rfReplaceAll]));
358 end
359 else
360 Value := AnsiUpperCase(Value);
361 end;
362 Result := Value;
363 end;
364
365 function ExtractIdentifier(Dialect: Integer; Value: AnsiString): AnsiString;
366 begin
367 Value := Trim(Value);
368 if Dialect = 1 then
369 Value := AnsiUpperCase(Value)
370 else
371 begin
372 if (Value <> '') and (Value[1] = '"') then
373 begin
374 Delete(Value, 1, 1);
375 Delete(Value, Length(Value), 1);
376 Value := StringReplace (Value, '""', '"', [rfReplaceAll]);
377 end
378 else
379 Value := AnsiUpperCase(Value);
380 end;
381 Result := Value;
382 end;
383
384 function IsReservedWord(w: AnsiString): boolean;
385 var i: integer;
386 begin
387 Result := true;
388 for i := 0 to Length(sqlReservedWords) - 1 do
389 if w = sqlReservedWords[i] then
390 Exit;
391 Result := false;
392 end;
393
394 function QuoteIdentifier(Dialect: Integer; Value: AnsiString): AnsiString;
395 begin
396 if Dialect = 1 then
397 Value := AnsiUpperCase(Trim(Value))
398 else
399 Value := '"' + Value + '"';
400 Result := Value;
401 end;
402
403 const
404 ValidSQLIdentifierChars = ['A'..'Z','a'..'z','0'..'9','_','$'];
405
406 function IsSQLIdentifier(Value: AnsiString): boolean;
407 var i: integer;
408 begin
409 Result := false;
410 for i := 1 to Length(Value) do
411 if not (Value[i] in ValidSQLIdentifierChars) then Exit;
412 Result := true;
413 end;
414
415 function QuoteIdentifierIfNeeded(Dialect: Integer; Value: AnsiString): AnsiString;
416 begin
417 if (Dialect = 3) and
418 (IsReservedWord(Value) or not IsSQLIdentifier(Value)) then
419 Result := '"' + Value + '"'
420 else
421 Result := Value
422 end;
423
424 function Space2Underscore(s: AnsiString): AnsiString;
425 var
426 k: integer;
427 begin
428 Result := s;
429 for k := 1 to Length(s) do
430 if not (Result[k] in ['0'..'9','A'..'Z','_','$']) then
431 Result[k] := '_';
432 end;
433
434 function SQLSafeString(const s: AnsiString): AnsiString;
435 begin
436 Result := StringReplace(s,'''','''''',[rfReplaceAll]);
437 end;
438
439 end.