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}

interface

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

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

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 ExtractIdentifier(Dialect: Integer; Value: String): String;
function QuoteIdentifier(Dialect: Integer; Value: 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 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 QuoteIdentifier(Dialect: Integer; Value: String): String;
begin
  if Dialect = 1 then
    Value := AnsiUpperCase(Trim(Value))
  else
    Value := '"' + Value + '"';
  Result := Value;
end;

end.
Revision:	17
Committed:	Sat Dec 28 19:22:24 2013 UTC (10 years, 3 months ago) by tony
Content type:	text/x-pascal
File size:	5617 byte(s)
Log Message:	Committing updates for Release R1-0-5
#	User	Rev	Content
1	tony	17	{************************************************************************}
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			interface
39
40			uses
41			{$IFDEF WINDOWS }
42			Windows,
43			{$ELSE}
44			unix,
45			{$ENDIF}
46			Classes, SysUtils;
47
48			const
49			CRLF = #13 + #10;
50			CR = #13;
51			LF = #10;
52			TAB = #9;
53			NULL_TERMINATOR = #0;
54
55			function Max(n1, n2: Integer): Integer;
56			function Min(n1, n2: Integer): Integer;
57			function RandomString(iLength: Integer): String;
58			function RandomInteger(iLow, iHigh: Integer): Integer;
59			function StripString(st: String; CharsToStrip: String): String;
60			function FormatIdentifier(Dialect: Integer; Value: String): String;
61			function FormatIdentifierValue(Dialect: Integer; Value: String): String;
62			function ExtractIdentifier(Dialect: Integer; Value: String): String;
63			function QuoteIdentifier(Dialect: Integer; Value: String): String;
64
65			implementation
66
67			function Max(n1, n2: Integer): Integer;
68			begin
69			if (n1 > n2) then
70			result := n1
71			else
72			result := n2;
73			end;
74
75			function Min(n1, n2: Integer): Integer;
76			begin
77			if (n1 < n2) then
78			result := n1
79			else
80			result := n2;
81			end;
82
83			function RandomString(iLength: Integer): String;
84			begin
85			result := '';
86			while Length(result) < iLength do
87			result := result + IntToStr(RandomInteger(0, High(Integer)));
88			if Length(result) > iLength then
89			result := Copy(result, 1, iLength);
90			end;
91
92			function RandomInteger(iLow, iHigh: Integer): Integer;
93			begin
94			result := Trunc(Random(iHigh - iLow)) + iLow;
95			end;
96
97			function StripString(st: String; CharsToStrip: String): String;
98			var
99			i: Integer;
100			begin
101			result := '';
102			for i := 1 to Length(st) do begin
103			if AnsiPos(st[i], CharsToStrip) = 0 then
104			result := result + st[i];
105			end;
106			end;
107
108			function FormatIdentifier(Dialect: Integer; Value: String): String;
109			begin
110			Value := Trim(Value);
111			if Dialect = 1 then
112			Value := AnsiUpperCase(Value)
113			else
114			if (Value <> '') and (Value[1] = '"') then
115			Value := '"' + StringReplace (TrimRight(Value), '"', '""', [rfReplaceAll]) + '"'
116			else
117			Value := AnsiUpperCase(Value);
118			Result := Value;
119			end;
120
121			function FormatIdentifierValue(Dialect: Integer; Value: String): String;
122			begin
123			Value := Trim(Value);
124			if Dialect = 1 then
125			Value := AnsiUpperCase(Value)
126			else
127			begin
128			if (Value <> '') and (Value[1] = '"') then
129			begin
130			Delete(Value, 1, 1);
131			Delete(Value, Length(Value), 1);
132			Value := StringReplace (Value, '""', '"', [rfReplaceAll]);
133			end
134			else
135			Value := AnsiUpperCase(Value);
136			end;
137			Result := Value;
138			end;
139
140			function ExtractIdentifier(Dialect: Integer; Value: String): String;
141			begin
142			Value := Trim(Value);
143			if Dialect = 1 then
144			Value := AnsiUpperCase(Value)
145			else
146			begin
147			if (Value <> '') and (Value[1] = '"') then
148			begin
149			Delete(Value, 1, 1);
150			Delete(Value, Length(Value), 1);
151			Value := StringReplace (Value, '""', '"', [rfReplaceAll]);
152			end
153			else
154			Value := AnsiUpperCase(Value);
155			end;
156			Result := Value;
157			end;
158
159			function QuoteIdentifier(Dialect: Integer; Value: String): String;
160			begin
161			if Dialect = 1 then
162			Value := AnsiUpperCase(Trim(Value))
163			else
164			Value := '"' + Value + '"';
165			Result := Value;
166			end;
167
168			end.