ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/IBUtils.pas
(Generate patch)

Comparing ibx/trunk/runtime/IBUtils.pas (file contents):
Revision 32 by tony, Tue Jul 14 15:31:25 2015 UTC vs.
Revision 33 by tony, Sat Jul 18 12:30:52 2015 UTC

# Line 1 | Line 1
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.
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.

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines