ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/udr/client/IBUtils.pas
Revision: 209
Committed: Wed Mar 14 12:48:51 2018 UTC (6 years, 8 months ago) by tony
Content type: text/x-pascal
Original Path: ibx/trunk/fbintf/IBUtils.pas
File size: 14866 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 143 uses Classes, SysUtils, IB;
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 209 sqlReservedWords: array [0..198] of string = (
58 tony 47 '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 tony 209 'KEY',
150 tony 47 '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 tony 45
259     function Max(n1, n2: Integer): Integer;
260     function Min(n1, n2: Integer): Integer;
261 tony 56 function RandomString(iLength: Integer): AnsiString;
262 tony 45 function RandomInteger(iLow, iHigh: Integer): Integer;
263 tony 56 function StripString(st: AnsiString; CharsToStrip: 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 tony 107 function IsSQLIdentifier(Value: AnsiString): boolean;
270 tony 117 function ExtractConnectString(const CreateSQL: AnsiString; var ConnectString: AnsiString): boolean;
271 tony 143 function MakeConnectString(ServerName, DatabaseName: AnsiString; Protocol: TProtocol;
272     PortNo: AnsiString = ''): AnsiString;
273     function ParseConnectString(ConnectString: AnsiString;
274     var ServerName, DatabaseName: AnsiString; var Protocol: TProtocolAll;
275     var PortNo: AnsiString): boolean;
276     function GetProtocol(ConnectString: AnsiString): TProtocolAll;
277 tony 45
278     implementation
279    
280 tony 118 {$IFDEF HASREQEX}
281 tony 117 uses RegExpr;
282 tony 118 {$ENDIF}
283 tony 117
284 tony 45 function Max(n1, n2: Integer): Integer;
285     begin
286     if (n1 > n2) then
287     result := n1
288     else
289     result := n2;
290     end;
291    
292     function Min(n1, n2: Integer): Integer;
293     begin
294     if (n1 < n2) then
295     result := n1
296     else
297     result := n2;
298     end;
299    
300 tony 56 function RandomString(iLength: Integer): AnsiString;
301 tony 45 begin
302     result := '';
303     while Length(result) < iLength do
304     result := result + IntToStr(RandomInteger(0, High(Integer)));
305     if Length(result) > iLength then
306     result := Copy(result, 1, iLength);
307     end;
308    
309     function RandomInteger(iLow, iHigh: Integer): Integer;
310     begin
311     result := Trunc(Random(iHigh - iLow)) + iLow;
312     end;
313    
314 tony 56 function StripString(st: AnsiString; CharsToStrip: AnsiString): AnsiString;
315 tony 45 var
316     i: Integer;
317     begin
318     result := '';
319     for i := 1 to Length(st) do begin
320     if AnsiPos(st[i], CharsToStrip) = 0 then
321     result := result + st[i];
322     end;
323     end;
324    
325 tony 117 {Extracts SQL Identifier typically from a Dialect 3 encoding}
326 tony 45
327 tony 117 function ExtractIdentifier(Dialect: Integer; Value: AnsiString): AnsiString;
328 tony 45 begin
329     Value := Trim(Value);
330     if Dialect = 1 then
331     Value := AnsiUpperCase(Value)
332     else
333     begin
334     if (Value <> '') and (Value[1] = '"') then
335     begin
336     Delete(Value, 1, 1);
337     Delete(Value, Length(Value), 1);
338     Value := StringReplace (Value, '""', '"', [rfReplaceAll]);
339     end
340     else
341     Value := AnsiUpperCase(Value);
342     end;
343     Result := Value;
344     end;
345    
346 tony 117 {Returns true if "w" is a Firebird SQL reserved word}
347 tony 45
348 tony 56 function IsReservedWord(w: AnsiString): boolean;
349 tony 45 var i: integer;
350     begin
351     Result := true;
352     for i := 0 to Length(sqlReservedWords) - 1 do
353     if w = sqlReservedWords[i] then
354     Exit;
355     Result := false;
356     end;
357    
358 tony 117 {Format an SQL Identifier according to SQL Dialect}
359    
360 tony 56 function QuoteIdentifier(Dialect: Integer; Value: AnsiString): AnsiString;
361 tony 45 begin
362     if Dialect = 1 then
363     Value := AnsiUpperCase(Trim(Value))
364     else
365 tony 117 Value := '"' + StringReplace (Value, '""', '"', [rfReplaceAll]) + '"';
366 tony 45 Result := Value;
367     end;
368    
369 tony 107 const
370     ValidSQLIdentifierChars = ['A'..'Z','a'..'z','0'..'9','_','$'];
371    
372 tony 117 {Returns true if the value is a valid SQL Identifier - note lower case accepted}
373    
374 tony 107 function IsSQLIdentifier(Value: AnsiString): boolean;
375     var i: integer;
376     begin
377     Result := false;
378     for i := 1 to Length(Value) do
379     if not (Value[i] in ValidSQLIdentifierChars) then Exit;
380     Result := true;
381     end;
382    
383 tony 117 {Extracts the Database Connect string from a Create Database Statement}
384    
385 tony 118 {$IFDEF HASREQEX}
386 tony 117 function ExtractConnectString(const CreateSQL: AnsiString;
387     var ConnectString: AnsiString): boolean;
388     var RegexObj: TRegExpr;
389     begin
390     RegexObj := TRegExpr.Create;
391     try
392     {extact database file spec}
393     RegexObj.ModifierG := false; {turn off greedy matches}
394     RegexObj.ModifierI := true; {case insensitive match}
395     RegexObj.Expression := '^ *CREATE +(DATABASE|SCHEMA) +''(.*)''';
396     Result := RegexObj.Exec(CreateSQL);
397     if Result then
398 tony 143 ConnectString := RegexObj.Match[2];
399 tony 117 finally
400     RegexObj.Free;
401     end;
402     end;
403 tony 143
404     function ParseConnectString(ConnectString: AnsiString; var ServerName,
405     DatabaseName: AnsiString; var Protocol: TProtocolAll; var PortNo: AnsiString
406     ): boolean;
407     var RegexObj: TRegExpr;
408     scheme: AnsiString;
409     begin
410     ServerName := '';
411     DatabaseName := ConnectString;
412     PortNo := '';
413     Protocol := unknownProtocol;
414     RegexObj := TRegExpr.Create;
415     try
416     {extact database file spec}
417     RegexObj.ModifierG := false; {turn off greedy matches}
418     RegexObj.Expression := '^([a-zA-Z]+)://([a-zA-Z0-9\-\.]+)(|:[0-9a-zA-Z\-]+)/(.*)$';
419     Result := RegexObj.Exec(ConnectString);
420     if Result then
421     begin
422     {URL type connect string}
423     scheme := AnsiUpperCase(RegexObj.Match[1]);
424     ServerName := RegexObj.Match[2];
425     if RegexObj.MatchLen[3] > 0 then
426     PortNo := system.Copy(ConnectString,RegexObj.MatchPos[3]+1,RegexObj.MatchLen[3]-1);
427     DatabaseName := RegexObj.Match[4];
428     if scheme = 'INET' then
429     Protocol := inet
430     else
431     if scheme = 'XNET' then
432     Protocol := xnet
433     else
434     if scheme = 'WNET' then
435     Protocol := wnet
436     end
437     else
438     begin
439     RegexObj.Expression := '^([a-zA-Z]:\\.*)';
440     Result := RegexObj.Exec(ConnectString);
441     if Result then
442     Protocol := Local {Windows with leading drive ID}
443     else
444     begin
445     RegexObj.Expression := '^([a-zA-Z0-9\-\.]+)(|/[0-9a-zA-Z\-]+):(.*)$';
446     Result := RegexObj.Exec(ConnectString);
447     if Result then
448     begin
449     {Legacy TCP Format}
450     ServerName := RegexObj.Match[1];
451     if RegexObj.MatchLen[2] > 0 then
452     PortNo := system.Copy(ConnectString,RegexObj.MatchPos[2]+1,RegexObj.MatchLen[2]-1);
453     DatabaseName := RegexObj.Match[3];
454     Protocol := TCP;
455     end
456     else
457     begin
458     RegexObj.Expression := '^\\\\([a-zA-Z0-9\-\.]+)(|@[0-9a-zA-Z\-]+)\\(.*)$';
459     Result := RegexObj.Exec(ConnectString);
460     if Result then
461     begin
462     {Netbui}
463     ServerName := RegexObj.Match[1];
464     if RegexObj.MatchLen[2] > 0 then
465     PortNo := system.Copy(ConnectString,RegexObj.MatchPos[2]+1,RegexObj.MatchLen[2]-1);
466     DatabaseName := RegexObj.Match[3];
467     Protocol := NamedPipe
468     end
469     else
470     begin
471     Result := true;
472     Protocol := Local; {Assume local}
473     end;
474     end;
475     end;
476     end;
477     finally
478     RegexObj.Free;
479     end;
480     end;
481    
482     function GetProtocol(ConnectString: AnsiString): TProtocolAll;
483     var ServerName,
484     DatabaseName: AnsiString;
485     PortNo: AnsiString;
486     begin
487     ParseConnectString(ConnectString,ServerName,DatabaseName,Result,PortNo);
488     end;
489    
490 tony 118 {$ELSE}
491 tony 121 {cruder version of above for Delphi. Older versions lack regular expression
492     handling.}
493 tony 118 function ExtractConnectString(const CreateSQL: AnsiString;
494     var ConnectString: AnsiString): boolean;
495     var i: integer;
496     begin
497     Result := false;
498     i := Pos('''',CreateSQL);
499     if i > 0 then
500     begin
501     ConnectString := CreateSQL;
502     delete(ConnectString,1,i);
503     i := Pos('''',ConnectString);
504     if i > 0 then
505     begin
506     delete(ConnectString,i,Length(ConnectString)-i+1);
507     Result := true;
508     end;
509     end;
510     end;
511 tony 143
512     function GetProtocol(ConnectString: AnsiString): TProtocolAll;
513     begin
514     Result := unknownProtocol; {not implemented for Delphi}
515     end;
516    
517     function ParseConnectString(ConnectString: AnsiString;
518     var ServerName, DatabaseName: AnsiString; var Protocol: TProtocolAll;
519     var PortNo: AnsiString): boolean;
520     begin
521     Result := false;
522     end;
523    
524 tony 118 {$ENDIF}
525 tony 117
526 tony 143 {Make a connect string in format appropriate protocol}
527    
528     function MakeConnectString(ServerName, DatabaseName: AnsiString;
529     Protocol: TProtocol; PortNo: AnsiString): AnsiString;
530     begin
531     if PortNo <> '' then
532     case Protocol of
533     NamedPipe:
534     ServerName := ServerName + '@' + PortNo;
535     Local,
536     SPX,
537     xnet: {do nothing};
538     TCP:
539     ServerName := ServerName + '/' + PortNo;
540     else
541     ServerName := ServerName + ':' + PortNo;
542     end;
543    
544     case Protocol of
545     TCP: Result := ServerName + ':' + DatabaseName; {do not localize}
546     SPX: Result := ServerName + '@' + DatabaseName; {do not localize}
547     NamedPipe: Result := '\\' + ServerName + '\' + DatabaseName; {do not localize}
548     Local: Result := DatabaseName; {do not localize}
549     inet: Result := 'inet://' + ServerName + '/'+ DatabaseName; {do not localize}
550     wnet: Result := 'wnet://' + ServerName + '/'+ DatabaseName; {do not localize}
551     xnet: Result := 'xnet://' + ServerName + '/'+ DatabaseName; {do not localize}
552     end;
553     end;
554    
555 tony 117 {Format an SQL Identifier according to SQL Dialect with encapsulation if necessary}
556    
557 tony 56 function QuoteIdentifierIfNeeded(Dialect: Integer; Value: AnsiString): AnsiString;
558 tony 45 begin
559     if (Dialect = 3) and
560 tony 115 (IsReservedWord(Value) or not IsSQLIdentifier(Value) or (AnsiUpperCase(Value) <> Value)) then
561 tony 117 Result := '"' + StringReplace (TrimRight(Value), '"', '""', [rfReplaceAll]) + '"'
562 tony 45 else
563     Result := Value
564     end;
565    
566 tony 117 {Replaces unknown characters in a string with underscores}
567    
568 tony 56 function Space2Underscore(s: AnsiString): AnsiString;
569 tony 45 var
570     k: integer;
571     begin
572     Result := s;
573     for k := 1 to Length(s) do
574 tony 117 if not (Result[k] in ValidSQLIdentifierChars) then
575 tony 45 Result[k] := '_';
576     end;
577    
578 tony 117 {Reformats an SQL string with single quotes duplicated.}
579    
580 tony 56 function SQLSafeString(const s: AnsiString): AnsiString;
581 tony 47 begin
582     Result := StringReplace(s,'''','''''',[rfReplaceAll]);
583     end;
584 tony 45
585     end.