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