ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/fbintf/IBUtils.pas
Revision: 56
Committed: Mon Mar 6 10:20:02 2017 UTC (7 years, 8 months ago) by tony
Content type: text/x-pascal
File size: 9690 byte(s)
Log Message:
Committing updates for Trunk

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
270 implementation
271
272 function Max(n1, n2: Integer): Integer;
273 begin
274 if (n1 > n2) then
275 result := n1
276 else
277 result := n2;
278 end;
279
280 function Min(n1, n2: Integer): Integer;
281 begin
282 if (n1 < n2) then
283 result := n1
284 else
285 result := n2;
286 end;
287
288 function RandomString(iLength: Integer): AnsiString;
289 begin
290 result := '';
291 while Length(result) < iLength do
292 result := result + IntToStr(RandomInteger(0, High(Integer)));
293 if Length(result) > iLength then
294 result := Copy(result, 1, iLength);
295 end;
296
297 function RandomInteger(iLow, iHigh: Integer): Integer;
298 begin
299 result := Trunc(Random(iHigh - iLow)) + iLow;
300 end;
301
302 function StripString(st: AnsiString; CharsToStrip: AnsiString): AnsiString;
303 var
304 i: Integer;
305 begin
306 result := '';
307 for i := 1 to Length(st) do begin
308 if AnsiPos(st[i], CharsToStrip) = 0 then
309 result := result + st[i];
310 end;
311 end;
312
313 function FormatIdentifier(Dialect: Integer; Value: AnsiString): AnsiString;
314 begin
315 Value := Trim(Value);
316 if Dialect = 1 then
317 Value := AnsiUpperCase(Value)
318 else
319 if (Value <> '') and (Value[1] = '"') then
320 Value := '"' + StringReplace (TrimRight(Value), '"', '""', [rfReplaceAll]) + '"'
321 else
322 Value := AnsiUpperCase(Value);
323 Result := Value;
324 end;
325
326 function FormatIdentifierValue(Dialect: Integer; Value: AnsiString): AnsiString;
327 begin
328 Value := Trim(Value);
329 if Dialect = 1 then
330 Value := AnsiUpperCase(Value)
331 else
332 begin
333 if (Value <> '') and (Value[1] = '"') then
334 begin
335 Delete(Value, 1, 1);
336 Delete(Value, Length(Value), 1);
337 Value := StringReplace (Value, '""', '"', [rfReplaceAll]);
338 end
339 else
340 Value := AnsiUpperCase(Value);
341 end;
342 Result := Value;
343 end;
344
345 function FormatIdentifierValueNC(Dialect: Integer; Value: AnsiString): AnsiString;
346 begin
347 Value := Trim(Value);
348 if Dialect = 1 then
349 Value := AnsiUpperCase(Value)
350 else
351 begin
352 if (Value <> '') and (Value[1] = '"') then
353 begin
354 Delete(Value, 1, 1);
355 Delete(Value, Length(Value), 1);
356 Value := AnsiUpperCase(StringReplace (Value, '""', '"', [rfReplaceAll]));
357 end
358 else
359 Value := AnsiUpperCase(Value);
360 end;
361 Result := Value;
362 end;
363
364 function ExtractIdentifier(Dialect: Integer; Value: AnsiString): AnsiString;
365 begin
366 Value := Trim(Value);
367 if Dialect = 1 then
368 Value := AnsiUpperCase(Value)
369 else
370 begin
371 if (Value <> '') and (Value[1] = '"') then
372 begin
373 Delete(Value, 1, 1);
374 Delete(Value, Length(Value), 1);
375 Value := StringReplace (Value, '""', '"', [rfReplaceAll]);
376 end
377 else
378 Value := AnsiUpperCase(Value);
379 end;
380 Result := Value;
381 end;
382
383 function IsReservedWord(w: AnsiString): boolean;
384 var i: integer;
385 begin
386 Result := true;
387 for i := 0 to Length(sqlReservedWords) - 1 do
388 if w = sqlReservedWords[i] then
389 Exit;
390 Result := false;
391 end;
392
393 function QuoteIdentifier(Dialect: Integer; Value: AnsiString): AnsiString;
394 begin
395 if Dialect = 1 then
396 Value := AnsiUpperCase(Trim(Value))
397 else
398 Value := '"' + Value + '"';
399 Result := Value;
400 end;
401
402 function QuoteIdentifierIfNeeded(Dialect: Integer; Value: AnsiString): AnsiString;
403 begin
404 if (Dialect = 3) and
405 ((AnsiUpperCase(Value) <> Value) or IsReservedWord(Value)) then
406 Result := '"' + Value + '"'
407 else
408 Result := Value
409 end;
410
411 function Space2Underscore(s: AnsiString): AnsiString;
412 var
413 k: integer;
414 begin
415 Result := s;
416 for k := 1 to Length(s) do
417 if not (Result[k] in ['0'..'9','A'..'Z','_','$']) then
418 Result[k] := '_';
419 end;
420
421 function SQLSafeString(const s: AnsiString): AnsiString;
422 begin
423 Result := StringReplace(s,'''','''''',[rfReplaceAll]);
424 end;
425
426 end.