trunk/runtime/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;

{$Mode Delphi}

{$IF FPC_FULLVERSION >= 20700 }
{$codepage UTF8}
{$ENDIF}

interface

uses
{$IFDEF WINDOWS }
  Windows,
{$ELSE}
  unix,
{$ENDIF}
  Classes, SysUtils;

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

  sqlReservedWords: array [0..166] of string = (
  'ADD','ADMIN','ALL','ALTER','AND','ANY','AS','AT','AVG','BEGIN','BETWEEN','BIGINT','BIT_LENGTH','BLOB','BOTH',
'BY','CASE','CAST','CHAR','CHAR_LENGTH','CHARACTER','CHARACTER_LENGTH','CHECK','CLOSE','COLLATE','COLUMN',
'COMMIT','CONNECT','CONSTRAINT','COUNT','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','DISCONNECT','DISTINCT','DOUBLE','DROP','ELSE','END',
'ESCAPE','EXECUTE','EXISTS','EXTERNAL','EXTRACT','FETCH','FILTER','FLOAT','FOR','FOREIGN','FROM','FULL',
'FUNCTION','GDSCODE','GLOBAL','GRANT','GROUP','HAVING','HOUR','IN','INDEX','INNER','INSENSITIVE','INSERT',
'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','ON',
'ONLY','OPEN','OR','ORDER','OUTER','PARAMETER','PLAN','POSITION','POST_EVENT','PRECISION','PRIMARY',
'PROCEDURE','RDB$DB_KEY','REAL','RECORD_VERSION','RECREATE','RECURSIVE','REFERENCES','RELEASE','RETURNING_VALUES',
'RETURNS','REVOKE','RIGHT','ROLLBACK','ROW_COUNT','ROWS','SAVEPOINT','SECOND','SELECT','SENSITIVE',
'SET','SIMILAR','SMALLINT','SOME','SQLCODE','SQLSTATE','START','SUM','TABLE','THEN','TIME',
'TIMESTAMP','TO','TRAILING','TRIGGER','TRIM','UNION','UNIQUE','UPDATE','UPPER','USER','USING',
'VALUE','VALUES','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): String;
function RandomInteger(iLow, iHigh: Integer): Integer;
function StripString(st: String; CharsToStrip: String): String;
function FormatIdentifier(Dialect: Integer; Value: String): String;
function FormatIdentifierValue(Dialect: Integer; Value: String): String;
function FormatIdentifierValueNC(Dialect: Integer; Value: String): String;
function ExtractIdentifier(Dialect: Integer; Value: String): String;
function QuoteIdentifier(Dialect: Integer; Value: String): String;
function QuoteIdentifierIfNeeded(Dialect: Integer; Value: String): String;
function Space2Underscore(s: string): string;

implementation

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): String;
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: String; CharsToStrip: String): String;
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;

function FormatIdentifier(Dialect: Integer; Value: String): String;
begin
  Value := Trim(Value);
  if Dialect = 1 then
    Value := AnsiUpperCase(Value)
  else
    if (Value <> '') and (Value[1] = '"') then
      Value := '"' + StringReplace (TrimRight(Value), '"', '""', [rfReplaceAll]) + '"'
    else
      Value := AnsiUpperCase(Value);
  Result := Value;
end;

function FormatIdentifierValue(Dialect: Integer; Value: String): String;
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;

function FormatIdentifierValueNC(Dialect: Integer; Value: String): String;
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 := AnsiUpperCase(StringReplace (Value, '""', '"', [rfReplaceAll]));
    end
    else
      Value := AnsiUpperCase(Value);
  end;
  Result := Value;
end;

function ExtractIdentifier(Dialect: Integer; Value: String): String;
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;

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

function QuoteIdentifier(Dialect: Integer; Value: String): String;
begin
  if Dialect = 1 then
    Value := AnsiUpperCase(Trim(Value))
  else
    Value := '"' + Value + '"';
  Result := Value;
end;

function QuoteIdentifierIfNeeded(Dialect: Integer; Value: String): String;
begin
  if (Dialect = 3) and
    ((AnsiUpperCase(Value) <> Value) or IsReservedWord(Value)) then
     Result := '"' + Value + '"'
  else
    Result := Value
end;

function Space2Underscore(s: string): string;
var
   k: integer;
begin
     Result := s;
     for k := 1 to Length(s) do
         if not (Result[k] in ['0'..'9','A'..'Z','_','$'])  then
            Result[k] := '_';
end;


end.
Revision:	39
Committed:	Tue May 17 08:14:52 2016 UTC (8 years, 6 months ago) by tony
Content type:	text/x-pascal
File size:	8461 byte(s)
Log Message:	Committing updates for Release R1-4-1
#	User	Rev	Content
1	tony	33	{************************************************************************}
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
36			{$Mode Delphi}
37
38	tony	39	{$IF FPC_FULLVERSION >= 20700 }
39			{$codepage UTF8}
40			{$ENDIF}
41
42	tony	33	interface
43
44			uses
45			{$IFDEF WINDOWS }
46			Windows,
47			{$ELSE}
48			unix,
49			{$ENDIF}
50			Classes, SysUtils;
51
52			const
53			CRLF = #13 + #10;
54			CR = #13;
55			LF = #10;
56			TAB = #9;
57			NULL_TERMINATOR = #0;
58
59			sqlReservedWords: array [0..166] of string = (
60			'ADD','ADMIN','ALL','ALTER','AND','ANY','AS','AT','AVG','BEGIN','BETWEEN','BIGINT','BIT_LENGTH','BLOB','BOTH',
61			'BY','CASE','CAST','CHAR','CHAR_LENGTH','CHARACTER','CHARACTER_LENGTH','CHECK','CLOSE','COLLATE','COLUMN',
62			'COMMIT','CONNECT','CONSTRAINT','COUNT','CREATE','CROSS','CURRENT','CURRENT_CONNECTION','CURRENT_DATE',
63			'CURRENT_ROLE','CURRENT_TIME','CURRENT_TIMESTAMP','CURRENT_TRANSACTION','CURRENT_USER','CURSOR','DATE',
64			'DAY','DEC','DECIMAL','DECLARE','DEFAULT','DELETE','DISCONNECT','DISTINCT','DOUBLE','DROP','ELSE','END',
65			'ESCAPE','EXECUTE','EXISTS','EXTERNAL','EXTRACT','FETCH','FILTER','FLOAT','FOR','FOREIGN','FROM','FULL',
66			'FUNCTION','GDSCODE','GLOBAL','GRANT','GROUP','HAVING','HOUR','IN','INDEX','INNER','INSENSITIVE','INSERT',
67			'INT','INTEGER','INTO','IS','JOIN','LEADING','LEFT','LIKE','LONG','LOWER','MAX','MAXIMUM_SEGMENT','MERGE',
68			'MIN','MINUTE','MONTH','NATIONAL','NATURAL','NCHAR','NO','NOT','NULL','NUMERIC','OCTET_LENGTH','OF','ON',
69			'ONLY','OPEN','OR','ORDER','OUTER','PARAMETER','PLAN','POSITION','POST_EVENT','PRECISION','PRIMARY',
70			'PROCEDURE','RDB$DB_KEY','REAL','RECORD_VERSION','RECREATE','RECURSIVE','REFERENCES','RELEASE','RETURNING_VALUES',
71			'RETURNS','REVOKE','RIGHT','ROLLBACK','ROW_COUNT','ROWS','SAVEPOINT','SECOND','SELECT','SENSITIVE',
72			'SET','SIMILAR','SMALLINT','SOME','SQLCODE','SQLSTATE','START','SUM','TABLE','THEN','TIME',
73			'TIMESTAMP','TO','TRAILING','TRIGGER','TRIM','UNION','UNIQUE','UPDATE','UPPER','USER','USING',
74			'VALUE','VALUES','VARCHAR','VARIABLE','VARYING','VIEW','WHEN','WHERE','WHILE','WITH','YEAR');
75
76			function Max(n1, n2: Integer): Integer;
77			function Min(n1, n2: Integer): Integer;
78			function RandomString(iLength: Integer): String;
79			function RandomInteger(iLow, iHigh: Integer): Integer;
80			function StripString(st: String; CharsToStrip: String): String;
81			function FormatIdentifier(Dialect: Integer; Value: String): String;
82			function FormatIdentifierValue(Dialect: Integer; Value: String): String;
83			function FormatIdentifierValueNC(Dialect: Integer; Value: String): String;
84			function ExtractIdentifier(Dialect: Integer; Value: String): String;
85			function QuoteIdentifier(Dialect: Integer; Value: String): String;
86			function QuoteIdentifierIfNeeded(Dialect: Integer; Value: String): String;
87			function Space2Underscore(s: string): string;
88
89			implementation
90
91			function Max(n1, n2: Integer): Integer;
92			begin
93			if (n1 > n2) then
94			result := n1
95			else
96			result := n2;
97			end;
98
99			function Min(n1, n2: Integer): Integer;
100			begin
101			if (n1 < n2) then
102			result := n1
103			else
104			result := n2;
105			end;
106
107			function RandomString(iLength: Integer): String;
108			begin
109			result := '';
110			while Length(result) < iLength do
111			result := result + IntToStr(RandomInteger(0, High(Integer)));
112			if Length(result) > iLength then
113			result := Copy(result, 1, iLength);
114			end;
115
116			function RandomInteger(iLow, iHigh: Integer): Integer;
117			begin
118			result := Trunc(Random(iHigh - iLow)) + iLow;
119			end;
120
121			function StripString(st: String; CharsToStrip: String): String;
122			var
123			i: Integer;
124			begin
125			result := '';
126			for i := 1 to Length(st) do begin
127			if AnsiPos(st[i], CharsToStrip) = 0 then
128			result := result + st[i];
129			end;
130			end;
131
132			function FormatIdentifier(Dialect: Integer; Value: String): String;
133			begin
134			Value := Trim(Value);
135			if Dialect = 1 then
136			Value := AnsiUpperCase(Value)
137			else
138			if (Value <> '') and (Value[1] = '"') then
139			Value := '"' + StringReplace (TrimRight(Value), '"', '""', [rfReplaceAll]) + '"'
140			else
141			Value := AnsiUpperCase(Value);
142			Result := Value;
143			end;
144
145			function FormatIdentifierValue(Dialect: Integer; Value: String): String;
146			begin
147			Value := Trim(Value);
148			if Dialect = 1 then
149			Value := AnsiUpperCase(Value)
150			else
151			begin
152			if (Value <> '') and (Value[1] = '"') then
153			begin
154			Delete(Value, 1, 1);
155			Delete(Value, Length(Value), 1);
156			Value := StringReplace (Value, '""', '"', [rfReplaceAll]);
157			end
158			else
159			Value := AnsiUpperCase(Value);
160			end;
161			Result := Value;
162			end;
163
164			function FormatIdentifierValueNC(Dialect: Integer; Value: String): String;
165			begin
166			Value := Trim(Value);
167			if Dialect = 1 then
168			Value := AnsiUpperCase(Value)
169			else
170			begin
171			if (Value <> '') and (Value[1] = '"') then
172			begin
173			Delete(Value, 1, 1);
174			Delete(Value, Length(Value), 1);
175			Value := AnsiUpperCase(StringReplace (Value, '""', '"', [rfReplaceAll]));
176			end
177			else
178			Value := AnsiUpperCase(Value);
179			end;
180			Result := Value;
181			end;
182
183			function ExtractIdentifier(Dialect: Integer; Value: String): String;
184			begin
185			Value := Trim(Value);
186			if Dialect = 1 then
187			Value := AnsiUpperCase(Value)
188			else
189			begin
190			if (Value <> '') and (Value[1] = '"') then
191			begin
192			Delete(Value, 1, 1);
193			Delete(Value, Length(Value), 1);
194			Value := StringReplace (Value, '""', '"', [rfReplaceAll]);
195			end
196			else
197			Value := AnsiUpperCase(Value);
198			end;
199			Result := Value;
200			end;
201
202			function IsReservedWord(w: string): boolean;
203			var i: integer;
204			begin
205			Result := true;
206			for i := 0 to Length(sqlReservedWords) - 1 do
207			if w = sqlReservedWords[i] then
208			Exit;
209			Result := false;
210			end;
211
212			function QuoteIdentifier(Dialect: Integer; Value: String): String;
213			begin
214			if Dialect = 1 then
215			Value := AnsiUpperCase(Trim(Value))
216			else
217			Value := '"' + Value + '"';
218			Result := Value;
219			end;
220
221			function QuoteIdentifierIfNeeded(Dialect: Integer; Value: String): String;
222			begin
223			if (Dialect = 3) and
224			((AnsiUpperCase(Value) <> Value) or IsReservedWord(Value)) then
225			Result := '"' + Value + '"'
226			else
227			Result := Value
228			end;
229
230			function Space2Underscore(s: string): string;
231			var
232			k: integer;
233			begin
234			Result := s;
235			for k := 1 to Length(s) do
236			if not (Result[k] in ['0'..'9','A'..'Z','_','$']) then
237			Result[k] := '_';
238			end;
239
240
241			end.