trunk/fbintf/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..198] 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',
  'KEY',
  '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:	209
Committed:	Wed Mar 14 12:48:51 2018 UTC (6 years, 8 months ago) by tony
Content type:	text/x-pascal
File size:	14866 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	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.