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 FPC}
{$Mode Delphi}
{$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..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): 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;
function SQLSafeString(const 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;

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

end.
Revision:	47
Committed:	Mon Jan 9 15:31:51 2017 UTC (7 years, 10 months ago) by tony
Content type:	text/x-pascal
File size:	9534 byte(s)
Log Message:	Committing updates for Release R2-0-1
#	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
36			{$IFDEF FPC}
37			{$Mode Delphi}
38			{$codepage UTF8}
39			{$ENDIF}
40
41			interface
42
43			uses
44			{$IFDEF WINDOWS }
45			Windows,
46			{$ELSE}
47			unix,
48			{$ENDIF}
49			Classes, SysUtils;
50
51			const
52			CRLF = #13 + #10;
53			CR = #13;
54			LF = #10;
55			TAB = #9;
56			NULL_TERMINATOR = #0;
57
58	tony	47	sqlReservedWords: array [0..197] of string = (
59			'ADD',
60			'ADMIN',
61			'ALL',
62			'ALTER',
63			'AND',
64			'ANY',
65			'AS',
66			'AT',
67			'AVG',
68			'BEGIN',
69			'BETWEEN',
70			'BIGINT',
71			'BIT_LENGTH',
72			'BLOB',
73			'BOOLEAN',
74			'BOTH',
75			'BY',
76			'CASE',
77			'CAST',
78			'CHAR',
79			'CHAR_LENGTH',
80			'CHARACTER',
81			'CHARACTER_LENGTH',
82			'CHECK',
83			'CLOSE',
84			'COLLATE',
85			'COLUMN',
86			'COMMIT',
87			'CONNECT',
88			'CONSTRAINT',
89			'CORR',
90			'COUNT',
91			'COVAR_POP',
92			'COVAR_SAMP',
93			'CREATE',
94			'CROSS',
95			'CURRENT',
96			'CURRENT_CONNECTION',
97			'CURRENT_DATE',
98			'CURRENT_ROLE',
99			'CURRENT_TIME',
100			'CURRENT_TIMESTAMP',
101			'CURRENT_TRANSACTION',
102			'CURRENT_USER',
103			'CURSOR',
104			'DATE',
105			'DAY',
106			'DEC',
107			'DECIMAL',
108			'DECLARE',
109			'DEFAULT',
110			'DELETE',
111			'DELETING',
112			'DETERMINISTIC',
113			'DISCONNECT',
114			'DISTINCT',
115			'DOUBLE',
116			'DROP',
117			'ELSE',
118			'END',
119			'ESCAPE',
120			'EXECUTE',
121			'EXISTS',
122			'EXTERNAL',
123			'EXTRACT',
124			'FALSE',
125			'FETCH',
126			'FILTER',
127			'FLOAT',
128			'FOR',
129			'FOREIGN',
130			'FROM',
131			'FULL',
132			'FUNCTION',
133			'GDSCODE',
134			'GLOBAL',
135			'GRANT',
136			'GROUP',
137			'HAVING',
138			'HOUR',
139			'IN',
140			'INDEX',
141			'INNER',
142			'INSENSITIVE',
143			'INSERT',
144			'INSERTING',
145			'INT',
146			'INTEGER',
147			'INTO',
148			'IS',
149			'JOIN',
150			'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			function RandomString(iLength: Integer): String;
262			function RandomInteger(iLow, iHigh: Integer): Integer;
263			function StripString(st: String; CharsToStrip: String): String;
264			function FormatIdentifier(Dialect: Integer; Value: String): String;
265			function FormatIdentifierValue(Dialect: Integer; Value: String): String;
266			function FormatIdentifierValueNC(Dialect: Integer; Value: String): String;
267			function ExtractIdentifier(Dialect: Integer; Value: String): String;
268			function QuoteIdentifier(Dialect: Integer; Value: String): String;
269			function QuoteIdentifierIfNeeded(Dialect: Integer; Value: String): String;
270			function Space2Underscore(s: string): string;
271	tony	47	function SQLSafeString(const s: string): string;
272	tony	45
273			implementation
274
275			function Max(n1, n2: Integer): Integer;
276			begin
277			if (n1 > n2) then
278			result := n1
279			else
280			result := n2;
281			end;
282
283			function Min(n1, n2: Integer): Integer;
284			begin
285			if (n1 < n2) then
286			result := n1
287			else
288			result := n2;
289			end;
290
291			function RandomString(iLength: Integer): String;
292			begin
293			result := '';
294			while Length(result) < iLength do
295			result := result + IntToStr(RandomInteger(0, High(Integer)));
296			if Length(result) > iLength then
297			result := Copy(result, 1, iLength);
298			end;
299
300			function RandomInteger(iLow, iHigh: Integer): Integer;
301			begin
302			result := Trunc(Random(iHigh - iLow)) + iLow;
303			end;
304
305			function StripString(st: String; CharsToStrip: String): String;
306			var
307			i: Integer;
308			begin
309			result := '';
310			for i := 1 to Length(st) do begin
311			if AnsiPos(st[i], CharsToStrip) = 0 then
312			result := result + st[i];
313			end;
314			end;
315
316			function FormatIdentifier(Dialect: Integer; Value: String): String;
317			begin
318			Value := Trim(Value);
319			if Dialect = 1 then
320			Value := AnsiUpperCase(Value)
321			else
322			if (Value <> '') and (Value[1] = '"') then
323			Value := '"' + StringReplace (TrimRight(Value), '"', '""', [rfReplaceAll]) + '"'
324			else
325			Value := AnsiUpperCase(Value);
326			Result := Value;
327			end;
328
329			function FormatIdentifierValue(Dialect: Integer; Value: String): String;
330			begin
331			Value := Trim(Value);
332			if Dialect = 1 then
333			Value := AnsiUpperCase(Value)
334			else
335			begin
336			if (Value <> '') and (Value[1] = '"') then
337			begin
338			Delete(Value, 1, 1);
339			Delete(Value, Length(Value), 1);
340			Value := StringReplace (Value, '""', '"', [rfReplaceAll]);
341			end
342			else
343			Value := AnsiUpperCase(Value);
344			end;
345			Result := Value;
346			end;
347
348			function FormatIdentifierValueNC(Dialect: Integer; Value: String): String;
349			begin
350			Value := Trim(Value);
351			if Dialect = 1 then
352			Value := AnsiUpperCase(Value)
353			else
354			begin
355			if (Value <> '') and (Value[1] = '"') then
356			begin
357			Delete(Value, 1, 1);
358			Delete(Value, Length(Value), 1);
359			Value := AnsiUpperCase(StringReplace (Value, '""', '"', [rfReplaceAll]));
360			end
361			else
362			Value := AnsiUpperCase(Value);
363			end;
364			Result := Value;
365			end;
366
367			function ExtractIdentifier(Dialect: Integer; Value: String): String;
368			begin
369			Value := Trim(Value);
370			if Dialect = 1 then
371			Value := AnsiUpperCase(Value)
372			else
373			begin
374			if (Value <> '') and (Value[1] = '"') then
375			begin
376			Delete(Value, 1, 1);
377			Delete(Value, Length(Value), 1);
378			Value := StringReplace (Value, '""', '"', [rfReplaceAll]);
379			end
380			else
381			Value := AnsiUpperCase(Value);
382			end;
383			Result := Value;
384			end;
385
386			function IsReservedWord(w: string): boolean;
387			var i: integer;
388			begin
389			Result := true;
390			for i := 0 to Length(sqlReservedWords) - 1 do
391			if w = sqlReservedWords[i] then
392			Exit;
393			Result := false;
394			end;
395
396			function QuoteIdentifier(Dialect: Integer; Value: String): String;
397			begin
398			if Dialect = 1 then
399			Value := AnsiUpperCase(Trim(Value))
400			else
401			Value := '"' + Value + '"';
402			Result := Value;
403			end;
404
405			function QuoteIdentifierIfNeeded(Dialect: Integer; Value: String): String;
406			begin
407			if (Dialect = 3) and
408			((AnsiUpperCase(Value) <> Value) or IsReservedWord(Value)) then
409			Result := '"' + Value + '"'
410			else
411			Result := Value
412			end;
413
414			function Space2Underscore(s: string): string;
415			var
416			k: integer;
417			begin
418			Result := s;
419			for k := 1 to Length(s) do
420			if not (Result[k] in ['0'..'9','A'..'Z','_','$']) then
421			Result[k] := '_';
422			end;
423
424	tony	47	function SQLSafeString(const s: string): string;
425			begin
426			Result := StringReplace(s,'''','''''',[rfReplaceAll]);
427			end;
428	tony	45
429			end.