ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/IBUtils.pas
Revision: 19
Committed: Mon Jul 7 13:00:15 2014 UTC (9 years, 8 months ago) by tony
Content type: text/x-pascal
File size: 8638 byte(s)
Log Message:
Committing updates for Release R1-1-0

File Contents

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