ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/fbintf/IBUtils.pas
Revision: 47
Committed: Mon Jan 9 15:31:51 2017 UTC (7 years, 10 months ago) by tony
Content type: text/x-pascal
File size: 9534 byte(s)
Log Message:
Committing updates for Release R2-0-1

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