udr/client/IBUtils.pas

{************************************************************************}
{                                                                        }
{       Borland Delphi Visual Component Library                          }
{       InterBase Express core components                                }
{                                                                        }
{       Copyright (c) 1998-2000 Inprise Corporation                      }
{                                                                        }
{    InterBase Express is based in part on the product                   }
{    Free IB Components, written by Gregory H. Deatz for                 }
{    Hoagland, Longo, Moran, Dunst & Doukas Company.                     }
{    Free IB Components is used under license.                           }
{                                                                        }
{    The contents of this file are subject to the InterBase              }
{    Public License Version 1.0 (the "License"); you may not             }
{    use this file except in compliance with the License. You            }
{    may obtain a copy of the License at http://www.Inprise.com/IPL.html }
{    Software distributed under the License is distributed on            }
{    an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either              }
{    express or implied. See the License for the specific language       }
{    governing rights and limitations under the License.                 }
{    The Original Code was created by InterBase Software Corporation     }
{       and its successors.                                              }
{    Portions created by Inprise Corporation are Copyright (C) Inprise   }
{       Corporation. All Rights Reserved.                                }
{    Contributor(s): Jeff Overcash                                       }
{                                                                        }
{    IBX For Lazarus (Firebird Express)                                  }
{    Contributor: Tony Whyman, MWA Software http://www.mwasoftware.co.uk }
{    Portions created by MWA Software are copyright McCallum Whyman      }
{    Associates Ltd 2011                                                 }
{                                                                        }
{************************************************************************}

unit IBUtils;
{$IFDEF MSWINDOWS} 
{$DEFINE WINDOWS}
{$ENDIF}

{$IFDEF FPC}
{$Mode Delphi}
{$codepage UTF8}
{$define HASREQEX}
{$ENDIF}


interface

uses Classes, SysUtils, IB;

const
  CRLF = #13 + #10;
  CR   = #13;
  LF   = #10;
  TAB  = #9;
  NULL_TERMINATOR = #0;

  sqlReservedWords: array [0..197] of string = (
  'ADD',
  'ADMIN',
  'ALL',
  'ALTER',
  'AND',
  'ANY',
  'AS',
  'AT',
  'AVG',
  'BEGIN',
  'BETWEEN',
  'BIGINT',
  'BIT_LENGTH',
  'BLOB',
  'BOOLEAN',
  'BOTH',
  'BY',
  'CASE',
  'CAST',
  'CHAR',
  'CHAR_LENGTH',
  'CHARACTER',
  'CHARACTER_LENGTH',
  'CHECK',
  'CLOSE',
  'COLLATE',
  'COLUMN',
  'COMMIT',
  'CONNECT',
  'CONSTRAINT',
  'CORR',
  'COUNT',
  'COVAR_POP',
  'COVAR_SAMP',
  'CREATE',
  'CROSS',
  'CURRENT',
  'CURRENT_CONNECTION',
  'CURRENT_DATE',
  'CURRENT_ROLE',
  'CURRENT_TIME',
  'CURRENT_TIMESTAMP',
  'CURRENT_TRANSACTION',
  'CURRENT_USER',
  'CURSOR',
  'DATE',
  'DAY',
  'DEC',
  'DECIMAL',
  'DECLARE',
  'DEFAULT',
  'DELETE',
  'DELETING',
  'DETERMINISTIC',
  'DISCONNECT',
  'DISTINCT',
  'DOUBLE',
  'DROP',
  'ELSE',
  'END',
  'ESCAPE',
  'EXECUTE',
  'EXISTS',
  'EXTERNAL',
  'EXTRACT',
  'FALSE',
  'FETCH',
  'FILTER',
  'FLOAT',
  'FOR',
  'FOREIGN',
  'FROM',
  'FULL',
  'FUNCTION',
  'GDSCODE',
  'GLOBAL',
  'GRANT',
  'GROUP',
  'HAVING',
  'HOUR',
  'IN',
  'INDEX',
  'INNER',
  'INSENSITIVE',
  'INSERT',
  'INSERTING',
  'INT',
  'INTEGER',
  'INTO',
  'IS',
  'JOIN',
  'LEADING',
  'LEFT',
  'LIKE',
  'LONG',
  'LOWER',
  'MAX',
  'MAXIMUM_SEGMENT',
  'MERGE',
  'MIN',
  'MINUTE',
  'MONTH',
  'NATIONAL',
  'NATURAL',
  'NCHAR',
  'NO',
  'NOT',
  'NULL',
  'NUMERIC',
  'OCTET_LENGTH',
  'OF',
  'OFFSET',
  'ON',
  'ONLY',
  'OPEN',
  'OR',
  'ORDER',
  'OUTER',
  'OVER',
  'PARAMETER',
  'PLAN',
  'POSITION',
  'POST_EVENT',
  'PRECISION',
  'PRIMARY',
  'PROCEDURE',
  'RDB$DB_KEY',
  'RDB$RECORD_VERSION',
  'REAL',
  'RECORD_VERSION',
  'RECREATE',
  'RECURSIVE',
  'REFERENCES',
  'REGR_AVGX',
  'REGR_AVGY',
  'REGR_COUNT',
  'REGR_INTERCEPT',
  'REGR_R2',
  'REGR_SLOPE',
  'REGR_SXX',
  'REGR_SXY',
  'REGR_SYY',
  'RELEASE',
  'RETURN',
  'RETURNING_VALUES',
  'RETURNS',
  'REVOKE',
  'RIGHT',
  'ROLLBACK',
  'ROW',
  'ROW_COUNT',
  'ROWS',
  'SAVEPOINT',
  'SCROLL',
  'SECOND',
  'SELECT',
  'SENSITIVE',
  'SET',
  'SIMILAR',
  'SMALLINT',
  'SOME',
  'SQLCODE',
  'SQLSTATE',
  'SQLSTATE',
  'START',
  'STDDEV_POP',
  'STDDEV_SAMP',
  'SUM',
  'TABLE',
  'THEN',
  'TIME',
  'TIMESTAMP',
  'TO',
  'TRAILING',
  'TRIGGER',
  'TRIM',
  'TRUE',
  'UNION',
  'UNIQUE',
  'UNKNOWN',
  'UPDATE',
  'UPDATING',
  'UPPER',
  'USER',
  'USING',
  'VALUE',
  'VALUES',
  'VAR_POP',
  'VAR_SAMP',
  'VARCHAR',
  'VARIABLE',
  'VARYING',
  'VIEW',
  'WHEN',
  'WHERE',
  'WHILE',
  'WITH',
  'YEAR'
  );

function Max(n1, n2: Integer): Integer;
function Min(n1, n2: Integer): Integer;
function RandomString(iLength: Integer): AnsiString;
function RandomInteger(iLow, iHigh: Integer): Integer;
function StripString(st: AnsiString; CharsToStrip: AnsiString): AnsiString;
function ExtractIdentifier(Dialect: Integer; Value: AnsiString): AnsiString;
function QuoteIdentifier(Dialect: Integer; Value: AnsiString): AnsiString;
function QuoteIdentifierIfNeeded(Dialect: Integer; Value: AnsiString): AnsiString;
function Space2Underscore(s: AnsiString): AnsiString;
function SQLSafeString(const s: AnsiString): AnsiString;
function IsSQLIdentifier(Value: AnsiString): boolean;
function ExtractConnectString(const CreateSQL: AnsiString; var ConnectString: AnsiString): boolean;
function MakeConnectString(ServerName, DatabaseName: AnsiString; Protocol: TProtocol;
              PortNo: AnsiString = ''): AnsiString;
function ParseConnectString(ConnectString: AnsiString;
              var ServerName, DatabaseName: AnsiString; var Protocol: TProtocolAll;
              var PortNo: AnsiString): boolean;
function GetProtocol(ConnectString: AnsiString): TProtocolAll;

implementation

{$IFDEF HASREQEX}
uses RegExpr;
{$ENDIF}

function Max(n1, n2: Integer): Integer;
begin
  if (n1 > n2) then
    result := n1
  else
    result := n2;
end;

function Min(n1, n2: Integer): Integer;
begin
  if (n1 < n2) then
    result := n1
  else
    result := n2;
end;

function RandomString(iLength: Integer): AnsiString;
begin
  result := '';
  while Length(result) < iLength do
    result := result + IntToStr(RandomInteger(0, High(Integer)));
  if Length(result) > iLength then
    result := Copy(result, 1, iLength);
end;

function RandomInteger(iLow, iHigh: Integer): Integer;
begin
  result := Trunc(Random(iHigh - iLow)) + iLow;
end;

function StripString(st: AnsiString; CharsToStrip: AnsiString): AnsiString;
var
  i: Integer;
begin
  result := '';
  for i := 1 to Length(st) do begin
    if AnsiPos(st[i], CharsToStrip) = 0 then
      result := result + st[i];
  end;
end;

{Extracts SQL Identifier typically from a  Dialect 3 encoding}

function ExtractIdentifier(Dialect: Integer; Value: AnsiString): AnsiString;
begin
  Value := Trim(Value);
  if Dialect = 1 then
    Value := AnsiUpperCase(Value)  
  else
  begin
    if (Value <> '') and (Value[1] = '"') then
    begin
      Delete(Value, 1, 1);
      Delete(Value, Length(Value), 1);
      Value := StringReplace (Value, '""', '"', [rfReplaceAll]);
    end
    else
      Value := AnsiUpperCase(Value);
  end;
  Result := Value;
end;

{Returns true if "w" is a Firebird SQL reserved word}

function IsReservedWord(w: AnsiString): boolean;
var i: integer;
begin
     Result := true;
     for i := 0 to Length(sqlReservedWords) - 1 do
         if w = sqlReservedWords[i] then
            Exit;
     Result := false;
end;

{Format an SQL Identifier according to SQL Dialect}

function QuoteIdentifier(Dialect: Integer; Value: AnsiString): AnsiString;
begin
  if Dialect = 1 then
    Value := AnsiUpperCase(Trim(Value))
  else
    Value := '"' + StringReplace (Value, '""', '"', [rfReplaceAll]) + '"';
  Result := Value;
end;

const
  ValidSQLIdentifierChars = ['A'..'Z','a'..'z','0'..'9','_','$'];

{Returns true if the value is a valid SQL Identifier - note lower case accepted}

function IsSQLIdentifier(Value: AnsiString): boolean;
var i: integer;
begin
  Result := false;
  for i := 1 to Length(Value) do
    if not (Value[i] in ValidSQLIdentifierChars) then Exit;
  Result := true;
end;

{Extracts the Database Connect string from a Create Database Statement}

{$IFDEF HASREQEX}
function ExtractConnectString(const CreateSQL: AnsiString;
  var ConnectString: AnsiString): boolean;
var RegexObj: TRegExpr;
begin
  RegexObj := TRegExpr.Create;
  try
    {extact database file spec}
    RegexObj.ModifierG := false; {turn off greedy matches}
    RegexObj.ModifierI := true; {case insensitive match}
    RegexObj.Expression := '^ *CREATE +(DATABASE|SCHEMA) +''(.*)''';
    Result := RegexObj.Exec(CreateSQL);
    if Result then
      ConnectString := RegexObj.Match[2];
  finally
    RegexObj.Free;
  end;
end;

function ParseConnectString(ConnectString: AnsiString; var ServerName,
  DatabaseName: AnsiString; var Protocol: TProtocolAll; var PortNo: AnsiString
  ): boolean;
var RegexObj: TRegExpr;
    scheme: AnsiString;
begin
  ServerName := '';
  DatabaseName := ConnectString;
  PortNo := '';
  Protocol := unknownProtocol;
  RegexObj := TRegExpr.Create;
  try
    {extact database file spec}
    RegexObj.ModifierG := false; {turn off greedy matches}
    RegexObj.Expression := '^([a-zA-Z]+)://([a-zA-Z0-9\-\.]+)(|:[0-9a-zA-Z\-]+)/(.*)$';
    Result := RegexObj.Exec(ConnectString);
    if Result then
    begin
      {URL type connect string}
      scheme := AnsiUpperCase(RegexObj.Match[1]);
      ServerName := RegexObj.Match[2];
      if RegexObj.MatchLen[3] > 0 then
        PortNo := system.Copy(ConnectString,RegexObj.MatchPos[3]+1,RegexObj.MatchLen[3]-1);
      DatabaseName := RegexObj.Match[4];
      if scheme = 'INET' then
        Protocol := inet
      else
      if scheme = 'XNET' then
        Protocol := xnet
      else
      if scheme = 'WNET' then
        Protocol := wnet
    end
    else
    begin
      RegexObj.Expression := '^([a-zA-Z]:\\.*)';
      Result := RegexObj.Exec(ConnectString);
      if Result then
        Protocol := Local {Windows with leading drive ID}
      else
      begin
        RegexObj.Expression := '^([a-zA-Z0-9\-\.]+)(|/[0-9a-zA-Z\-]+):(.*)$';
        Result := RegexObj.Exec(ConnectString);
        if Result then
        begin
          {Legacy TCP Format}
          ServerName := RegexObj.Match[1];
          if RegexObj.MatchLen[2] > 0 then
            PortNo := system.Copy(ConnectString,RegexObj.MatchPos[2]+1,RegexObj.MatchLen[2]-1);
          DatabaseName := RegexObj.Match[3];
          Protocol := TCP;
        end
        else
        begin
          RegexObj.Expression := '^\\\\([a-zA-Z0-9\-\.]+)(|@[0-9a-zA-Z\-]+)\\(.*)$';
          Result := RegexObj.Exec(ConnectString);
          if Result then
          begin
            {Netbui}
            ServerName := RegexObj.Match[1];
            if RegexObj.MatchLen[2] > 0 then
              PortNo := system.Copy(ConnectString,RegexObj.MatchPos[2]+1,RegexObj.MatchLen[2]-1);
            DatabaseName := RegexObj.Match[3];
            Protocol := NamedPipe
          end
          else
          begin
            Result := true;
            Protocol := Local; {Assume local}
          end;
        end;
      end;
    end;
  finally
    RegexObj.Free;
  end;
end;

function GetProtocol(ConnectString: AnsiString): TProtocolAll;
var ServerName,
    DatabaseName: AnsiString;
    PortNo: AnsiString;
begin
  ParseConnectString(ConnectString,ServerName,DatabaseName,Result,PortNo);
end;

{$ELSE}
{cruder version of above for Delphi. Older versions lack regular expression
 handling.}
function ExtractConnectString(const CreateSQL: AnsiString;
  var ConnectString: AnsiString): boolean;
var i: integer;
begin
  Result := false;
  i := Pos('''',CreateSQL);
  if i > 0 then
  begin
    ConnectString := CreateSQL;
    delete(ConnectString,1,i);
    i := Pos('''',ConnectString);
    if i > 0 then
    begin
      delete(ConnectString,i,Length(ConnectString)-i+1);
      Result := true;
    end;
  end;
end;

function GetProtocol(ConnectString: AnsiString): TProtocolAll;
begin
  Result := unknownProtocol; {not implemented for Delphi}
end;

function ParseConnectString(ConnectString: AnsiString;
              var ServerName, DatabaseName: AnsiString; var Protocol: TProtocolAll;
              var PortNo: AnsiString): boolean;
begin
  Result := false;
end;

{$ENDIF}

{Make a connect string in format appropriate protocol}

function MakeConnectString(ServerName, DatabaseName: AnsiString;
  Protocol: TProtocol; PortNo: AnsiString): AnsiString;
begin
  if PortNo <> '' then
    case Protocol of
    NamedPipe:
      ServerName := ServerName + '@' + PortNo;
    Local,
    SPX,
    xnet: {do nothing};
    TCP:
      ServerName := ServerName + '/' + PortNo;
    else
      ServerName := ServerName + ':' + PortNo;
    end;

  case Protocol of
    TCP:        Result := ServerName + ':' + DatabaseName; {do not localize}
    SPX:        Result := ServerName + '@' + DatabaseName; {do not localize}
    NamedPipe:  Result := '\\' + ServerName + '\' + DatabaseName; {do not localize}
    Local:      Result := DatabaseName; {do not localize}
    inet:       Result := 'inet://' + ServerName + '/'+ DatabaseName; {do not localize}
    wnet:       Result := 'wnet://' + ServerName + '/'+ DatabaseName; {do not localize}
    xnet:       Result := 'xnet://' + ServerName + '/'+ DatabaseName;  {do not localize}
  end;
end;

{Format an SQL Identifier according to SQL Dialect with encapsulation if necessary}

function QuoteIdentifierIfNeeded(Dialect: Integer; Value: AnsiString): AnsiString;
begin
  if (Dialect = 3) and
    (IsReservedWord(Value) or not IsSQLIdentifier(Value) or (AnsiUpperCase(Value) <> Value)) then
     Result := '"' + StringReplace (TrimRight(Value), '"', '""', [rfReplaceAll]) + '"'
  else
    Result := Value
end;

{Replaces unknown characters in a string with underscores}

function Space2Underscore(s: AnsiString): AnsiString;
var
   k: integer;
begin
     Result := s;
     for k := 1 to Length(s) do
         if not (Result[k] in ValidSQLIdentifierChars)  then
            Result[k] := '_';
end;

{Reformats an SQL string with single quotes duplicated.}

function SQLSafeString(const s: AnsiString): AnsiString;
begin
  Result := StringReplace(s,'''','''''',[rfReplaceAll]);
end;

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