ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/fbintf/IBUtils.pas
Revision: 121
Committed: Mon Jan 22 13:58:23 2018 UTC (6 years, 10 months ago) by tony
Content type: text/x-pascal
File size: 10419 byte(s)
Log Message:
Fixes Merged

File Contents

# User Rev Content
1 tony 45 {************************************************************************}
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 tony 56 {$IFDEF MSWINDOWS}
36 tony 118 {$DEFINE WINDOWS}
37 tony 56 {$ENDIF}
38 tony 45
39     {$IFDEF FPC}
40     {$Mode Delphi}
41     {$codepage UTF8}
42 tony 118 {$define HASREQEX}
43 tony 45 {$ENDIF}
44    
45 tony 118
46 tony 45 interface
47    
48 tony 56 uses Classes, SysUtils;
49 tony 45
50     const
51     CRLF = #13 + #10;
52     CR = #13;
53     LF = #10;
54     TAB = #9;
55     NULL_TERMINATOR = #0;
56    
57 tony 47 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 tony 45
258     function Max(n1, n2: Integer): Integer;
259     function Min(n1, n2: Integer): Integer;
260 tony 56 function RandomString(iLength: Integer): AnsiString;
261 tony 45 function RandomInteger(iLow, iHigh: Integer): Integer;
262 tony 56 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 tony 107 function IsSQLIdentifier(Value: AnsiString): boolean;
269 tony 117 function ExtractConnectString(const CreateSQL: AnsiString; var ConnectString: AnsiString): boolean;
270 tony 45
271     implementation
272    
273 tony 118 {$IFDEF HASREQEX}
274 tony 117 uses RegExpr;
275 tony 118 {$ENDIF}
276 tony 117
277 tony 45 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 tony 56 function RandomString(iLength: Integer): AnsiString;
294 tony 45 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 tony 56 function StripString(st: AnsiString; CharsToStrip: AnsiString): AnsiString;
308 tony 45 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 tony 117 {Extracts SQL Identifier typically from a Dialect 3 encoding}
319 tony 45
320 tony 117 function ExtractIdentifier(Dialect: Integer; Value: AnsiString): AnsiString;
321 tony 45 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 tony 117 {Returns true if "w" is a Firebird SQL reserved word}
340 tony 45
341 tony 56 function IsReservedWord(w: AnsiString): boolean;
342 tony 45 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 tony 117 {Format an SQL Identifier according to SQL Dialect}
352    
353 tony 56 function QuoteIdentifier(Dialect: Integer; Value: AnsiString): AnsiString;
354 tony 45 begin
355     if Dialect = 1 then
356     Value := AnsiUpperCase(Trim(Value))
357     else
358 tony 117 Value := '"' + StringReplace (Value, '""', '"', [rfReplaceAll]) + '"';
359 tony 45 Result := Value;
360     end;
361    
362 tony 107 const
363     ValidSQLIdentifierChars = ['A'..'Z','a'..'z','0'..'9','_','$'];
364    
365 tony 117 {Returns true if the value is a valid SQL Identifier - note lower case accepted}
366    
367 tony 107 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 tony 117 {Extracts the Database Connect string from a Create Database Statement}
377    
378 tony 118 {$IFDEF HASREQEX}
379 tony 117 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 tony 118 {$ELSE}
397 tony 121 {cruder version of above for Delphi. Older versions lack regular expression
398     handling.}
399 tony 118 function ExtractConnectString(const CreateSQL: AnsiString;
400     var ConnectString: AnsiString): boolean;
401     var i: integer;
402     begin
403     Result := false;
404     i := Pos('''',CreateSQL);
405     if i > 0 then
406     begin
407     ConnectString := CreateSQL;
408     delete(ConnectString,1,i);
409     i := Pos('''',ConnectString);
410     if i > 0 then
411     begin
412     delete(ConnectString,i,Length(ConnectString)-i+1);
413     Result := true;
414     end;
415     end;
416     end;
417     {$ENDIF}
418 tony 117
419     {Format an SQL Identifier according to SQL Dialect with encapsulation if necessary}
420    
421 tony 56 function QuoteIdentifierIfNeeded(Dialect: Integer; Value: AnsiString): AnsiString;
422 tony 45 begin
423     if (Dialect = 3) and
424 tony 115 (IsReservedWord(Value) or not IsSQLIdentifier(Value) or (AnsiUpperCase(Value) <> Value)) then
425 tony 117 Result := '"' + StringReplace (TrimRight(Value), '"', '""', [rfReplaceAll]) + '"'
426 tony 45 else
427     Result := Value
428     end;
429    
430 tony 117 {Replaces unknown characters in a string with underscores}
431    
432 tony 56 function Space2Underscore(s: AnsiString): AnsiString;
433 tony 45 var
434     k: integer;
435     begin
436     Result := s;
437     for k := 1 to Length(s) do
438 tony 117 if not (Result[k] in ValidSQLIdentifierChars) then
439 tony 45 Result[k] := '_';
440     end;
441    
442 tony 117 {Reformats an SQL string with single quotes duplicated.}
443    
444 tony 56 function SQLSafeString(const s: AnsiString): AnsiString;
445 tony 47 begin
446     Result := StringReplace(s,'''','''''',[rfReplaceAll]);
447     end;
448 tony 45
449     end.