ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/fbintf/IBUtils.pas
Revision: 120
Committed: Mon Jan 22 13:58:20 2018 UTC (6 years, 9 months ago) by tony
Content type: text/x-pascal
File size: 10384 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     {cruder version of above for old versions of Delphi}
398     function ExtractConnectString(const CreateSQL: AnsiString;
399     var ConnectString: AnsiString): boolean;
400     var i: integer;
401     begin
402     Result := false;
403     i := Pos('''',CreateSQL);
404     if i > 0 then
405     begin
406     ConnectString := CreateSQL;
407     delete(ConnectString,1,i);
408     i := Pos('''',ConnectString);
409     if i > 0 then
410     begin
411     delete(ConnectString,i,Length(ConnectString)-i+1);
412     Result := true;
413     end;
414     end;
415     end;
416     {$ENDIF}
417 tony 117
418     {Format an SQL Identifier according to SQL Dialect with encapsulation if necessary}
419    
420 tony 56 function QuoteIdentifierIfNeeded(Dialect: Integer; Value: AnsiString): AnsiString;
421 tony 45 begin
422     if (Dialect = 3) and
423 tony 115 (IsReservedWord(Value) or not IsSQLIdentifier(Value) or (AnsiUpperCase(Value) <> Value)) then
424 tony 117 Result := '"' + StringReplace (TrimRight(Value), '"', '""', [rfReplaceAll]) + '"'
425 tony 45 else
426     Result := Value
427     end;
428    
429 tony 117 {Replaces unknown characters in a string with underscores}
430    
431 tony 56 function Space2Underscore(s: AnsiString): AnsiString;
432 tony 45 var
433     k: integer;
434     begin
435     Result := s;
436     for k := 1 to Length(s) do
437 tony 117 if not (Result[k] in ValidSQLIdentifierChars) then
438 tony 45 Result[k] := '_';
439     end;
440    
441 tony 117 {Reformats an SQL string with single quotes duplicated.}
442    
443 tony 56 function SQLSafeString(const s: AnsiString): AnsiString;
444 tony 47 begin
445     Result := StringReplace(s,'''','''''',[rfReplaceAll]);
446     end;
447 tony 45
448     end.