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 IB; |
35 |
< |
|
36 |
< |
{$Mode Delphi} |
37 |
< |
|
38 |
< |
interface |
39 |
< |
|
40 |
< |
uses |
41 |
< |
{$IFDEF WINDOWS } |
42 |
< |
Windows, |
43 |
< |
{$ELSE} |
44 |
< |
unix, |
45 |
< |
{$ENDIF} |
46 |
< |
SysUtils, Classes, IBExternals, IBUtils, DB, IBXConst; |
47 |
< |
|
48 |
< |
type |
49 |
< |
TTraceFlag = (tfQPrepare, tfQExecute, tfQFetch, tfError, tfStmt, tfConnect, |
50 |
< |
tfTransact, tfBlob, tfService, tfMisc); |
51 |
< |
TTraceFlags = set of TTraceFlag; |
52 |
< |
|
53 |
< |
EIBError = class(EDatabaseError) |
54 |
< |
private |
55 |
< |
FSQLCode: Long; |
56 |
< |
FIBErrorCode: Long; |
57 |
< |
public |
58 |
< |
constructor Create(ASQLCode: Long; Msg: string); overload; |
59 |
< |
constructor Create(ASQLCode: Long; AIBErrorCode: Long; Msg: string); overload; |
60 |
< |
property SQLCode: Long read FSQLCode; |
61 |
< |
property IBErrorCode: Long read FIBErrorCode; |
62 |
< |
end; |
63 |
< |
|
64 |
< |
EIBInterBaseError = class(EIBError); |
65 |
< |
EIBClientError = class(EIBError); |
66 |
< |
|
67 |
< |
TIBDataBaseErrorMessage = (ShowSQLCode, |
68 |
< |
ShowIBMessage, |
69 |
< |
ShowSQLMessage); |
70 |
< |
TIBDataBaseErrorMessages = set of TIBDataBaseErrorMessage; |
71 |
< |
TIBClientError = ( |
72 |
< |
ibxeUnknownError, |
73 |
< |
ibxeInterBaseMissing, |
74 |
< |
ibxeInterBaseInstallMissing, |
75 |
< |
ibxeIB60feature, |
76 |
< |
ibxeNotSupported, |
77 |
< |
ibxeNotPermitted, |
78 |
< |
ibxeFileAccessError, |
79 |
< |
ibxeConnectionTimeout, |
80 |
< |
ibxeCannotSetDatabase, |
81 |
< |
ibxeCannotSetTransaction, |
82 |
< |
ibxeOperationCancelled, |
83 |
< |
ibxeDPBConstantNotSupported, |
84 |
< |
ibxeDPBConstantUnknown, |
85 |
< |
ibxeTPBConstantNotSupported, |
86 |
< |
ibxeTPBConstantUnknown, |
87 |
< |
ibxeDatabaseClosed, |
88 |
< |
ibxeDatabaseOpen, |
89 |
< |
ibxeDatabaseNameMissing, |
90 |
< |
ibxeNotInTransaction, |
91 |
< |
ibxeInTransaction, |
92 |
< |
ibxeTimeoutNegative, |
93 |
< |
ibxeNoDatabasesInTransaction, |
94 |
< |
ibxeUpdateWrongDB, |
95 |
< |
ibxeUpdateWrongTR, |
96 |
< |
ibxeDatabaseNotAssigned, |
97 |
< |
ibxeTransactionNotAssigned, |
98 |
< |
ibxeXSQLDAIndexOutOfRange, |
99 |
< |
ibxeXSQLDANameDoesNotExist, |
100 |
< |
ibxeEOF, |
101 |
< |
ibxeBOF, |
102 |
< |
ibxeInvalidStatementHandle, |
103 |
< |
ibxeSQLOpen, |
104 |
< |
ibxeSQLClosed, |
105 |
< |
ibxeDatasetOpen, |
106 |
< |
ibxeDatasetClosed, |
107 |
< |
ibxeUnknownSQLDataType, |
108 |
< |
ibxeInvalidColumnIndex, |
109 |
< |
ibxeInvalidParamColumnIndex, |
110 |
< |
ibxeInvalidDataConversion, |
111 |
< |
ibxeColumnIsNotNullable, |
112 |
< |
ibxeBlobCannotBeRead, |
113 |
< |
ibxeBlobCannotBeWritten, |
114 |
< |
ibxeEmptyQuery, |
115 |
< |
ibxeCannotOpenNonSQLSelect, |
116 |
< |
ibxeNoFieldAccess, |
117 |
< |
ibxeFieldReadOnly, |
118 |
< |
ibxeFieldNotFound, |
119 |
< |
ibxeNotEditing, |
120 |
< |
ibxeCannotInsert, |
121 |
< |
ibxeCannotPost, |
122 |
< |
ibxeCannotUpdate, |
123 |
< |
ibxeCannotDelete, |
124 |
< |
ibxeCannotRefresh, |
125 |
< |
ibxeBufferNotSet, |
126 |
< |
ibxeCircularReference, |
127 |
< |
ibxeSQLParseError, |
128 |
< |
ibxeUserAbort, |
129 |
< |
ibxeDataSetUniDirectional, |
130 |
< |
ibxeCannotCreateSharedResource, |
131 |
< |
ibxeWindowsAPIError, |
132 |
< |
ibxeColumnListsDontMatch, |
133 |
< |
ibxeColumnTypesDontMatch, |
134 |
< |
ibxeCantEndSharedTransaction, |
135 |
< |
ibxeFieldUnsupportedType, |
136 |
< |
ibxeCircularDataLink, |
137 |
< |
ibxeEmptySQLStatement, |
138 |
< |
ibxeIsASelectStatement, |
139 |
< |
ibxeRequiredParamNotSet, |
140 |
< |
ibxeNoStoredProcName, |
141 |
< |
ibxeIsAExecuteProcedure, |
142 |
< |
ibxeUpdateFailed, |
143 |
< |
ibxeNotCachedUpdates, |
144 |
< |
ibxeNotLiveRequest, |
145 |
< |
ibxeNoProvider, |
146 |
< |
ibxeNoRecordsAffected, |
147 |
< |
ibxeNoTableName, |
148 |
< |
ibxeCannotCreatePrimaryIndex, |
149 |
< |
ibxeCannotDropSystemIndex, |
150 |
< |
ibxeTableNameMismatch, |
151 |
< |
ibxeIndexFieldMissing, |
152 |
< |
ibxeInvalidCancellation, |
153 |
< |
ibxeInvalidEvent, |
154 |
< |
ibxeMaximumEvents, |
155 |
< |
ibxeNoEventsRegistered, |
156 |
< |
ibxeInvalidQueueing, |
157 |
< |
ibxeInvalidRegistration, |
158 |
< |
ibxeInvalidBatchMove, |
159 |
< |
ibxeSQLDialectInvalid, |
160 |
< |
ibxeSPBConstantNotSupported, |
161 |
< |
ibxeSPBConstantUnknown, |
162 |
< |
ibxeServiceActive, |
163 |
< |
ibxeServiceInActive, |
164 |
< |
ibxeServerNameMissing, |
165 |
< |
ibxeQueryParamsError, |
166 |
< |
ibxeStartParamsError, |
167 |
< |
ibxeOutputParsingError, |
168 |
< |
ibxeUseSpecificProcedures, |
169 |
< |
ibxeSQLMonitorAlreadyPresent, |
170 |
< |
ibxeCantPrintValue, |
171 |
< |
ibxeEOFReached, |
172 |
< |
ibxeEOFInComment, |
173 |
< |
ibxeEOFInString, |
174 |
< |
ibxeParamNameExpected, |
175 |
< |
ibxeSuccess, |
176 |
< |
ibxeDelphiException, |
177 |
< |
ibxeNoOptionsSet, |
178 |
< |
ibxeNoDestinationDirectory, |
179 |
< |
ibxeNosourceDirectory, |
180 |
< |
ibxeNoUninstallFile, |
181 |
< |
ibxeOptionNeedsClient, |
182 |
< |
ibxeOptionNeedsServer, |
183 |
< |
ibxeInvalidOption, |
184 |
< |
ibxeInvalidOnErrorResult, |
185 |
< |
ibxeInvalidOnStatusResult, |
186 |
< |
ibxeDPBConstantUnknownEx, |
187 |
< |
ibxeTPBConstantUnknownEx, |
188 |
< |
ibxeSV5APIError, |
189 |
< |
ibxeThreadFailed, |
190 |
< |
ibxeFieldSizeError |
191 |
< |
); |
192 |
< |
|
193 |
< |
TStatusVector = array[0..19] of ISC_STATUS; |
194 |
< |
PStatusVector = ^TStatusVector; |
195 |
< |
|
196 |
< |
|
197 |
< |
const |
198 |
< |
IBPalette1 = 'Firebird'; {do not localize} |
199 |
< |
IBPalette2 = 'Firebird Admin'; {do not localize} |
200 |
< |
|
201 |
< |
IBLocalBufferLength = 512; |
202 |
< |
IBBigLocalBufferLength = IBLocalBufferLength * 2; |
203 |
< |
IBHugeLocalBufferLength = IBBigLocalBufferLength * 20; |
204 |
< |
|
205 |
< |
IBErrorMessages: array[TIBClientError] of string = ( |
206 |
< |
SUnknownError, |
207 |
< |
SInterBaseMissing, |
208 |
< |
SInterBaseInstallMissing, |
209 |
< |
SIB60feature, |
210 |
< |
SNotSupported, |
211 |
< |
SNotPermitted, |
212 |
< |
SFileAccessError, |
213 |
< |
SConnectionTimeout, |
214 |
< |
SCannotSetDatabase, |
215 |
< |
SCannotSetTransaction, |
216 |
< |
SOperationCancelled, |
217 |
< |
SDPBConstantNotSupported, |
218 |
< |
SDPBConstantUnknown, |
219 |
< |
STPBConstantNotSupported, |
220 |
< |
STPBConstantUnknown, |
221 |
< |
SDatabaseClosed, |
222 |
< |
SDatabaseOpen, |
223 |
< |
SDatabaseNameMissing, |
224 |
< |
SNotInTransaction, |
225 |
< |
SInTransaction, |
226 |
< |
STimeoutNegative, |
227 |
< |
SNoDatabasesInTransaction, |
228 |
< |
SUpdateWrongDB, |
229 |
< |
SUpdateWrongTR, |
230 |
< |
SDatabaseNotAssigned, |
231 |
< |
STransactionNotAssigned, |
232 |
< |
SXSQLDAIndexOutOfRange, |
233 |
< |
SXSQLDANameDoesNotExist, |
234 |
< |
SEOF, |
235 |
< |
SBOF, |
236 |
< |
SInvalidStatementHandle, |
237 |
< |
SSQLOpen, |
238 |
< |
SSQLClosed, |
239 |
< |
SDatasetOpen, |
240 |
< |
SDatasetClosed, |
241 |
< |
SUnknownSQLDataType, |
242 |
< |
SInvalidColumnIndex, |
243 |
< |
SInvalidParamColumnIndex, |
244 |
< |
SInvalidDataConversion, |
245 |
< |
SColumnIsNotNullable, |
246 |
< |
SBlobCannotBeRead, |
247 |
< |
SBlobCannotBeWritten, |
248 |
< |
SEmptyQuery, |
249 |
< |
SCannotOpenNonSQLSelect, |
250 |
< |
SNoFieldAccess, |
251 |
< |
SFieldReadOnly, |
252 |
< |
SFieldNotFound, |
253 |
< |
SNotEditing, |
254 |
< |
SCannotInsert, |
255 |
< |
SCannotPost, |
256 |
< |
SCannotUpdate, |
257 |
< |
SCannotDelete, |
258 |
< |
SCannotRefresh, |
259 |
< |
SBufferNotSet, |
260 |
< |
SCircularReference, |
261 |
< |
SSQLParseError, |
262 |
< |
SUserAbort, |
263 |
< |
SDataSetUniDirectional, |
264 |
< |
SCannotCreateSharedResource, |
265 |
< |
SWindowsAPIError, |
266 |
< |
SColumnListsDontMatch, |
267 |
< |
SColumnTypesDontMatch, |
268 |
< |
SCantEndSharedTransaction, |
269 |
< |
SFieldUnsupportedType, |
270 |
< |
SCircularDataLink, |
271 |
< |
SEmptySQLStatement, |
272 |
< |
SIsASelectStatement, |
273 |
< |
SRequiredParamNotSet, |
274 |
< |
SNoStoredProcName, |
275 |
< |
SIsAExecuteProcedure, |
276 |
< |
SUpdateFailed, |
277 |
< |
SNotCachedUpdates, |
278 |
< |
SNotLiveRequest, |
279 |
< |
SNoProvider, |
280 |
< |
SNoRecordsAffected, |
281 |
< |
SNoTableName, |
282 |
< |
SCannotCreatePrimaryIndex, |
283 |
< |
SCannotDropSystemIndex, |
284 |
< |
STableNameMismatch, |
285 |
< |
SIndexFieldMissing, |
286 |
< |
SInvalidCancellation, |
287 |
< |
SInvalidEvent, |
288 |
< |
SMaximumEvents, |
289 |
< |
SNoEventsRegistered, |
290 |
< |
SInvalidQueueing, |
291 |
< |
SInvalidRegistration, |
292 |
< |
SInvalidBatchMove, |
293 |
< |
SSQLDialectInvalid, |
294 |
< |
SSPBConstantNotSupported, |
295 |
< |
SSPBConstantUnknown, |
296 |
< |
SServiceActive, |
297 |
< |
SServiceInActive, |
298 |
< |
SServerNameMissing, |
299 |
< |
SQueryParamsError, |
300 |
< |
SStartParamsError, |
301 |
< |
SOutputParsingError, |
302 |
< |
SUseSpecificProcedures, |
303 |
< |
SSQLMonitorAlreadyPresent, |
304 |
< |
SCantPrintValue, |
305 |
< |
SEOFReached, |
306 |
< |
SEOFInComment, |
307 |
< |
SEOFInString, |
308 |
< |
SParamNameExpected, |
309 |
< |
SSuccess, |
310 |
< |
SDelphiException, |
311 |
< |
SNoOptionsSet, |
312 |
< |
SNoDestinationDirectory, |
313 |
< |
SNosourceDirectory, |
314 |
< |
SNoUninstallFile, |
315 |
< |
SOptionNeedsClient, |
316 |
< |
SOptionNeedsServer, |
317 |
< |
SInvalidOption, |
318 |
< |
SInvalidOnErrorResult, |
319 |
< |
SInvalidOnStatusResult, |
320 |
< |
SDPBConstantUnknownEx, |
321 |
< |
STPBConstantUnknownEx, |
322 |
< |
SSV5APIError, |
323 |
< |
SThreadFailed, |
324 |
< |
SFieldSizeError |
325 |
< |
); |
326 |
< |
|
327 |
< |
var |
328 |
< |
IBCS: TRTLCriticalSection; |
329 |
< |
|
330 |
< |
procedure IBAlloc(var P; OldSize, NewSize: Integer); |
331 |
< |
|
332 |
< |
procedure IBError(ErrMess: TIBClientError; const Args: array of const); |
333 |
< |
procedure IBDataBaseError; |
334 |
< |
|
335 |
< |
function StatusVector: PISC_STATUS; |
336 |
< |
function StatusVectorArray: PStatusVector; |
337 |
< |
function CheckStatusVector(ErrorCodes: array of ISC_STATUS): Boolean; |
338 |
< |
function StatusVectorAsText: string; |
339 |
< |
|
340 |
< |
procedure SetIBDataBaseErrorMessages(Value: TIBDataBaseErrorMessages); |
341 |
< |
function GetIBDataBaseErrorMessages: TIBDataBaseErrorMessages; |
342 |
< |
|
343 |
< |
implementation |
344 |
< |
|
345 |
< |
uses |
346 |
< |
IBIntf; |
347 |
< |
|
348 |
< |
var |
349 |
< |
IBDataBaseErrorMessages: TIBDataBaseErrorMessages; |
350 |
< |
threadvar |
351 |
< |
FStatusVector : TStatusVector; |
352 |
< |
|
353 |
< |
procedure IBAlloc(var P; OldSize, NewSize: Integer); |
354 |
< |
var |
355 |
< |
i: Integer; |
356 |
< |
begin |
357 |
< |
ReallocMem(Pointer(P), NewSize); |
358 |
< |
for i := OldSize to NewSize - 1 do PChar(P)[i] := #0; |
359 |
< |
end; |
360 |
< |
|
361 |
< |
procedure IBError(ErrMess: TIBClientError; const Args: array of const); |
362 |
< |
begin |
363 |
< |
raise EIBClientError.Create(Ord(ErrMess), |
364 |
< |
Format(IBErrorMessages[ErrMess], Args)); |
365 |
< |
end; |
366 |
< |
|
367 |
< |
procedure IBDataBaseError; |
368 |
< |
var |
369 |
< |
sqlcode: Long; |
370 |
< |
IBErrorCode: Long; |
371 |
< |
local_buffer: array[0..IBHugeLocalBufferLength - 1] of char; |
372 |
< |
usr_msg: string; |
373 |
< |
status_vector: PISC_STATUS; |
374 |
< |
IBDataBaseErrorMessages: TIBDataBaseErrorMessages; |
375 |
< |
begin |
376 |
< |
usr_msg := ''; |
377 |
< |
|
378 |
< |
{ Get a local reference to the status vector. |
379 |
< |
Get a local copy of the IBDataBaseErrorMessages options. |
380 |
< |
Get the SQL error code } |
381 |
< |
status_vector := StatusVector; |
382 |
< |
IBErrorCode := StatusVectorArray[1]; |
383 |
< |
IBDataBaseErrorMessages := GetIBDataBaseErrorMessages; |
384 |
< |
sqlcode := isc_sqlcode(status_vector); |
385 |
< |
|
386 |
< |
if (ShowSQLCode in IBDataBaseErrorMessages) then |
387 |
< |
usr_msg := usr_msg + 'SQLCODE: ' + IntToStr(sqlcode); {do not localize} |
388 |
< |
Exclude(IBDataBaseErrorMessages, ShowSQLMessage); |
389 |
< |
if (ShowSQLMessage in IBDataBaseErrorMessages) then |
390 |
< |
begin |
391 |
< |
isc_sql_interprete(sqlcode, local_buffer, IBLocalBufferLength); |
392 |
< |
if (ShowSQLCode in IBDataBaseErrorMessages) then |
393 |
< |
usr_msg := usr_msg + CRLF; |
394 |
< |
usr_msg := usr_msg + strpas(local_buffer); |
395 |
< |
end; |
396 |
< |
|
397 |
< |
if (ShowIBMessage in IBDataBaseErrorMessages) then |
398 |
< |
begin |
399 |
< |
if (ShowSQLCode in IBDataBaseErrorMessages) or |
400 |
< |
(ShowSQLMessage in IBDataBaseErrorMessages) then |
401 |
< |
usr_msg := usr_msg + CRLF; |
402 |
< |
while (isc_interprete(local_buffer, @status_vector) > 0) do |
403 |
< |
begin |
404 |
< |
if (usr_msg <> '') and (usr_msg[Length(usr_msg)] <> LF) then |
405 |
< |
usr_msg := usr_msg + CRLF; |
406 |
< |
usr_msg := usr_msg + strpas(local_buffer); |
407 |
< |
end; |
408 |
< |
end; |
409 |
< |
if (usr_msg <> '') and (usr_msg[Length(usr_msg)] = '.') then |
410 |
< |
Delete(usr_msg, Length(usr_msg), 1); |
411 |
< |
raise EIBInterBaseError.Create(sqlcode, IBErrorCode, usr_msg); |
412 |
< |
end; |
413 |
< |
|
414 |
< |
{ Return the status vector for the current thread } |
415 |
< |
function StatusVector: PISC_STATUS; |
416 |
< |
begin |
417 |
< |
result := @FStatusVector; |
418 |
< |
end; |
419 |
< |
|
420 |
< |
function StatusVectorArray: PStatusVector; |
421 |
< |
begin |
422 |
< |
result := @FStatusVector; |
423 |
< |
end; |
424 |
< |
|
425 |
< |
function CheckStatusVector(ErrorCodes: array of ISC_STATUS): Boolean; |
426 |
< |
var |
427 |
< |
p: PISC_STATUS; |
428 |
< |
i: Integer; |
429 |
< |
procedure NextP(i: Integer); |
430 |
< |
begin |
431 |
< |
p := PISC_STATUS(PChar(p) + (i * SizeOf(ISC_STATUS))); |
432 |
< |
end; |
433 |
< |
begin |
434 |
< |
p := @FStatusVector; |
435 |
< |
result := False; |
436 |
< |
while (p^ <> 0) and (not result) do |
437 |
< |
case p^ of |
438 |
< |
3: NextP(3); |
439 |
< |
1, 4: |
440 |
< |
begin |
441 |
< |
NextP(1); |
442 |
< |
i := 0; |
443 |
< |
while (i <= High(ErrorCodes)) and (not result) do |
444 |
< |
begin |
445 |
< |
result := p^ = ErrorCodes[i]; |
446 |
< |
Inc(i); |
447 |
< |
end; |
448 |
< |
NextP(1); |
449 |
< |
end; |
450 |
< |
else |
451 |
< |
NextP(2); |
452 |
< |
end; |
453 |
< |
end; |
454 |
< |
|
455 |
< |
function StatusVectorAsText: string; |
456 |
< |
var |
457 |
< |
p: PISC_STATUS; |
458 |
< |
function NextP(i: Integer): PISC_STATUS; |
459 |
< |
begin |
460 |
< |
p := PISC_STATUS(PChar(p) + (i * SizeOf(ISC_STATUS))); |
461 |
< |
result := p; |
462 |
< |
end; |
463 |
< |
begin |
464 |
< |
p := @FStatusVector; |
465 |
< |
result := ''; |
466 |
< |
while (p^ <> 0) do |
467 |
< |
if (p^ = 3) then |
468 |
< |
begin |
469 |
< |
result := result + Format('%d %d %d', [p^, NextP(1)^, NextP(1)^]) + CRLF; |
470 |
< |
NextP(1); |
471 |
< |
end |
472 |
< |
else begin |
473 |
< |
result := result + Format('%d %d', [p^, NextP(1)^]) + CRLF; |
474 |
< |
NextP(1); |
475 |
< |
end; |
476 |
< |
end; |
477 |
< |
|
478 |
< |
|
479 |
< |
{ EIBError } |
480 |
< |
constructor EIBError.Create(ASQLCode: Long; Msg: string); |
481 |
< |
begin |
482 |
< |
inherited Create(Msg); |
483 |
< |
FSQLCode := ASQLCode; |
484 |
< |
end; |
485 |
< |
|
486 |
< |
constructor EIBError.Create(ASQLCode: Long; AIBErrorCode: Long; Msg: string); |
487 |
< |
begin |
488 |
< |
inherited Create(Msg); |
489 |
< |
FSQLCode := ASQLCode; |
490 |
< |
FIBErrorCode := AIBErrorCode; |
491 |
< |
end; |
492 |
< |
|
493 |
< |
procedure SetIBDataBaseErrorMessages(Value: TIBDataBaseErrorMessages); |
494 |
< |
begin |
495 |
< |
EnterCriticalSection(IBCS); |
496 |
< |
try |
497 |
< |
IBDataBaseErrorMessages := Value; |
498 |
< |
finally |
499 |
< |
LeaveCriticalSection(IBCS); |
500 |
< |
end; |
501 |
< |
end; |
502 |
< |
|
503 |
< |
function GetIBDataBaseErrorMessages: TIBDataBaseErrorMessages; |
504 |
< |
begin |
505 |
< |
EnterCriticalSection(IBCS); |
506 |
< |
try |
507 |
< |
result := IBDataBaseErrorMessages; |
508 |
< |
finally |
509 |
< |
LeaveCriticalSection(IBCS); |
510 |
< |
end; |
511 |
< |
end; |
512 |
< |
|
513 |
< |
initialization |
514 |
< |
// IsMultiThread := True; |
515 |
< |
InitCriticalSection(IBCS); |
516 |
< |
IBDataBaseErrorMessages := [ShowSQLMessage, ShowIBMessage]; |
517 |
< |
|
518 |
< |
finalization |
519 |
< |
DoneCriticalSection(IBCS); |
520 |
< |
|
521 |
< |
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 IB; |
35 |
> |
|
36 |
> |
{$Mode Delphi} |
37 |
> |
|
38 |
> |
interface |
39 |
> |
|
40 |
> |
uses |
41 |
> |
{$IFDEF WINDOWS } |
42 |
> |
Windows, |
43 |
> |
{$ELSE} |
44 |
> |
unix, |
45 |
> |
{$ENDIF} |
46 |
> |
SysUtils, Classes, IBExternals, IBUtils, DB, IBXConst; |
47 |
> |
|
48 |
> |
type |
49 |
> |
TTraceFlag = (tfQPrepare, tfQExecute, tfQFetch, tfError, tfStmt, tfConnect, |
50 |
> |
tfTransact, tfBlob, tfService, tfMisc); |
51 |
> |
TTraceFlags = set of TTraceFlag; |
52 |
> |
|
53 |
> |
EIBError = class(EDatabaseError) |
54 |
> |
private |
55 |
> |
FSQLCode: Long; |
56 |
> |
FIBErrorCode: Long; |
57 |
> |
public |
58 |
> |
constructor Create(ASQLCode: Long; Msg: string); overload; |
59 |
> |
constructor Create(ASQLCode: Long; AIBErrorCode: Long; Msg: string); overload; |
60 |
> |
property SQLCode: Long read FSQLCode; |
61 |
> |
property IBErrorCode: Long read FIBErrorCode; |
62 |
> |
end; |
63 |
> |
|
64 |
> |
EIBInterBaseError = class(EIBError); |
65 |
> |
EIBClientError = class(EIBError); |
66 |
> |
|
67 |
> |
TIBDataBaseErrorMessage = (ShowSQLCode, |
68 |
> |
ShowIBMessage, |
69 |
> |
ShowSQLMessage); |
70 |
> |
TIBDataBaseErrorMessages = set of TIBDataBaseErrorMessage; |
71 |
> |
TIBClientError = ( |
72 |
> |
ibxeUnknownError, |
73 |
> |
ibxeInterBaseMissing, |
74 |
> |
ibxeInterBaseInstallMissing, |
75 |
> |
ibxeIB60feature, |
76 |
> |
ibxeNotSupported, |
77 |
> |
ibxeNotPermitted, |
78 |
> |
ibxeFileAccessError, |
79 |
> |
ibxeConnectionTimeout, |
80 |
> |
ibxeCannotSetDatabase, |
81 |
> |
ibxeCannotSetTransaction, |
82 |
> |
ibxeOperationCancelled, |
83 |
> |
ibxeDPBConstantNotSupported, |
84 |
> |
ibxeDPBConstantUnknown, |
85 |
> |
ibxeTPBConstantNotSupported, |
86 |
> |
ibxeTPBConstantUnknown, |
87 |
> |
ibxeDatabaseClosed, |
88 |
> |
ibxeDatabaseOpen, |
89 |
> |
ibxeDatabaseNameMissing, |
90 |
> |
ibxeNotInTransaction, |
91 |
> |
ibxeInTransaction, |
92 |
> |
ibxeTimeoutNegative, |
93 |
> |
ibxeNoDatabasesInTransaction, |
94 |
> |
ibxeUpdateWrongDB, |
95 |
> |
ibxeUpdateWrongTR, |
96 |
> |
ibxeDatabaseNotAssigned, |
97 |
> |
ibxeTransactionNotAssigned, |
98 |
> |
ibxeXSQLDAIndexOutOfRange, |
99 |
> |
ibxeXSQLDANameDoesNotExist, |
100 |
> |
ibxeEOF, |
101 |
> |
ibxeBOF, |
102 |
> |
ibxeInvalidStatementHandle, |
103 |
> |
ibxeSQLOpen, |
104 |
> |
ibxeSQLClosed, |
105 |
> |
ibxeDatasetOpen, |
106 |
> |
ibxeDatasetClosed, |
107 |
> |
ibxeUnknownSQLDataType, |
108 |
> |
ibxeInvalidColumnIndex, |
109 |
> |
ibxeInvalidParamColumnIndex, |
110 |
> |
ibxeInvalidDataConversion, |
111 |
> |
ibxeColumnIsNotNullable, |
112 |
> |
ibxeBlobCannotBeRead, |
113 |
> |
ibxeBlobCannotBeWritten, |
114 |
> |
ibxeEmptyQuery, |
115 |
> |
ibxeCannotOpenNonSQLSelect, |
116 |
> |
ibxeNoFieldAccess, |
117 |
> |
ibxeFieldReadOnly, |
118 |
> |
ibxeFieldNotFound, |
119 |
> |
ibxeNotEditing, |
120 |
> |
ibxeCannotInsert, |
121 |
> |
ibxeCannotPost, |
122 |
> |
ibxeCannotUpdate, |
123 |
> |
ibxeCannotDelete, |
124 |
> |
ibxeCannotRefresh, |
125 |
> |
ibxeBufferNotSet, |
126 |
> |
ibxeCircularReference, |
127 |
> |
ibxeSQLParseError, |
128 |
> |
ibxeUserAbort, |
129 |
> |
ibxeDataSetUniDirectional, |
130 |
> |
ibxeCannotCreateSharedResource, |
131 |
> |
ibxeWindowsAPIError, |
132 |
> |
ibxeColumnListsDontMatch, |
133 |
> |
ibxeColumnTypesDontMatch, |
134 |
> |
ibxeCantEndSharedTransaction, |
135 |
> |
ibxeFieldUnsupportedType, |
136 |
> |
ibxeCircularDataLink, |
137 |
> |
ibxeEmptySQLStatement, |
138 |
> |
ibxeIsASelectStatement, |
139 |
> |
ibxeRequiredParamNotSet, |
140 |
> |
ibxeNoStoredProcName, |
141 |
> |
ibxeIsAExecuteProcedure, |
142 |
> |
ibxeUpdateFailed, |
143 |
> |
ibxeNotCachedUpdates, |
144 |
> |
ibxeNotLiveRequest, |
145 |
> |
ibxeNoProvider, |
146 |
> |
ibxeNoRecordsAffected, |
147 |
> |
ibxeNoTableName, |
148 |
> |
ibxeCannotCreatePrimaryIndex, |
149 |
> |
ibxeCannotDropSystemIndex, |
150 |
> |
ibxeTableNameMismatch, |
151 |
> |
ibxeIndexFieldMissing, |
152 |
> |
ibxeInvalidCancellation, |
153 |
> |
ibxeInvalidEvent, |
154 |
> |
ibxeMaximumEvents, |
155 |
> |
ibxeNoEventsRegistered, |
156 |
> |
ibxeInvalidQueueing, |
157 |
> |
ibxeInvalidRegistration, |
158 |
> |
ibxeInvalidBatchMove, |
159 |
> |
ibxeSQLDialectInvalid, |
160 |
> |
ibxeSPBConstantNotSupported, |
161 |
> |
ibxeSPBConstantUnknown, |
162 |
> |
ibxeServiceActive, |
163 |
> |
ibxeServiceInActive, |
164 |
> |
ibxeServerNameMissing, |
165 |
> |
ibxeQueryParamsError, |
166 |
> |
ibxeStartParamsError, |
167 |
> |
ibxeOutputParsingError, |
168 |
> |
ibxeUseSpecificProcedures, |
169 |
> |
ibxeSQLMonitorAlreadyPresent, |
170 |
> |
ibxeCantPrintValue, |
171 |
> |
ibxeEOFReached, |
172 |
> |
ibxeEOFInComment, |
173 |
> |
ibxeEOFInString, |
174 |
> |
ibxeParamNameExpected, |
175 |
> |
ibxeSuccess, |
176 |
> |
ibxeDelphiException, |
177 |
> |
ibxeNoOptionsSet, |
178 |
> |
ibxeNoDestinationDirectory, |
179 |
> |
ibxeNosourceDirectory, |
180 |
> |
ibxeNoUninstallFile, |
181 |
> |
ibxeOptionNeedsClient, |
182 |
> |
ibxeOptionNeedsServer, |
183 |
> |
ibxeInvalidOption, |
184 |
> |
ibxeInvalidOnErrorResult, |
185 |
> |
ibxeInvalidOnStatusResult, |
186 |
> |
ibxeDPBConstantUnknownEx, |
187 |
> |
ibxeTPBConstantUnknownEx, |
188 |
> |
ibxeSV5APIError, |
189 |
> |
ibxeThreadFailed, |
190 |
> |
ibxeFieldSizeError |
191 |
> |
); |
192 |
> |
|
193 |
> |
TStatusVector = array[0..19] of ISC_STATUS; |
194 |
> |
PStatusVector = ^TStatusVector; |
195 |
> |
|
196 |
> |
|
197 |
> |
const |
198 |
> |
IBPalette1 = 'Firebird'; {do not localize} |
199 |
> |
IBPalette2 = 'Firebird Admin'; {do not localize} |
200 |
> |
|
201 |
> |
IBLocalBufferLength = 512; |
202 |
> |
IBBigLocalBufferLength = IBLocalBufferLength * 2; |
203 |
> |
IBHugeLocalBufferLength = IBBigLocalBufferLength * 20; |
204 |
> |
|
205 |
> |
IBErrorMessages: array[TIBClientError] of string = ( |
206 |
> |
SUnknownError, |
207 |
> |
SInterBaseMissing, |
208 |
> |
SInterBaseInstallMissing, |
209 |
> |
SIB60feature, |
210 |
> |
SNotSupported, |
211 |
> |
SNotPermitted, |
212 |
> |
SFileAccessError, |
213 |
> |
SConnectionTimeout, |
214 |
> |
SCannotSetDatabase, |
215 |
> |
SCannotSetTransaction, |
216 |
> |
SOperationCancelled, |
217 |
> |
SDPBConstantNotSupported, |
218 |
> |
SDPBConstantUnknown, |
219 |
> |
STPBConstantNotSupported, |
220 |
> |
STPBConstantUnknown, |
221 |
> |
SDatabaseClosed, |
222 |
> |
SDatabaseOpen, |
223 |
> |
SDatabaseNameMissing, |
224 |
> |
SNotInTransaction, |
225 |
> |
SInTransaction, |
226 |
> |
STimeoutNegative, |
227 |
> |
SNoDatabasesInTransaction, |
228 |
> |
SUpdateWrongDB, |
229 |
> |
SUpdateWrongTR, |
230 |
> |
SDatabaseNotAssigned, |
231 |
> |
STransactionNotAssigned, |
232 |
> |
SXSQLDAIndexOutOfRange, |
233 |
> |
SXSQLDANameDoesNotExist, |
234 |
> |
SEOF, |
235 |
> |
SBOF, |
236 |
> |
SInvalidStatementHandle, |
237 |
> |
SSQLOpen, |
238 |
> |
SSQLClosed, |
239 |
> |
SDatasetOpen, |
240 |
> |
SDatasetClosed, |
241 |
> |
SUnknownSQLDataType, |
242 |
> |
SInvalidColumnIndex, |
243 |
> |
SInvalidParamColumnIndex, |
244 |
> |
SInvalidDataConversion, |
245 |
> |
SColumnIsNotNullable, |
246 |
> |
SBlobCannotBeRead, |
247 |
> |
SBlobCannotBeWritten, |
248 |
> |
SEmptyQuery, |
249 |
> |
SCannotOpenNonSQLSelect, |
250 |
> |
SNoFieldAccess, |
251 |
> |
SFieldReadOnly, |
252 |
> |
SFieldNotFound, |
253 |
> |
SNotEditing, |
254 |
> |
SCannotInsert, |
255 |
> |
SCannotPost, |
256 |
> |
SCannotUpdate, |
257 |
> |
SCannotDelete, |
258 |
> |
SCannotRefresh, |
259 |
> |
SBufferNotSet, |
260 |
> |
SCircularReference, |
261 |
> |
SSQLParseError, |
262 |
> |
SUserAbort, |
263 |
> |
SDataSetUniDirectional, |
264 |
> |
SCannotCreateSharedResource, |
265 |
> |
SWindowsAPIError, |
266 |
> |
SColumnListsDontMatch, |
267 |
> |
SColumnTypesDontMatch, |
268 |
> |
SCantEndSharedTransaction, |
269 |
> |
SFieldUnsupportedType, |
270 |
> |
SCircularDataLink, |
271 |
> |
SEmptySQLStatement, |
272 |
> |
SIsASelectStatement, |
273 |
> |
SRequiredParamNotSet, |
274 |
> |
SNoStoredProcName, |
275 |
> |
SIsAExecuteProcedure, |
276 |
> |
SUpdateFailed, |
277 |
> |
SNotCachedUpdates, |
278 |
> |
SNotLiveRequest, |
279 |
> |
SNoProvider, |
280 |
> |
SNoRecordsAffected, |
281 |
> |
SNoTableName, |
282 |
> |
SCannotCreatePrimaryIndex, |
283 |
> |
SCannotDropSystemIndex, |
284 |
> |
STableNameMismatch, |
285 |
> |
SIndexFieldMissing, |
286 |
> |
SInvalidCancellation, |
287 |
> |
SInvalidEvent, |
288 |
> |
SMaximumEvents, |
289 |
> |
SNoEventsRegistered, |
290 |
> |
SInvalidQueueing, |
291 |
> |
SInvalidRegistration, |
292 |
> |
SInvalidBatchMove, |
293 |
> |
SSQLDialectInvalid, |
294 |
> |
SSPBConstantNotSupported, |
295 |
> |
SSPBConstantUnknown, |
296 |
> |
SServiceActive, |
297 |
> |
SServiceInActive, |
298 |
> |
SServerNameMissing, |
299 |
> |
SQueryParamsError, |
300 |
> |
SStartParamsError, |
301 |
> |
SOutputParsingError, |
302 |
> |
SUseSpecificProcedures, |
303 |
> |
SSQLMonitorAlreadyPresent, |
304 |
> |
SCantPrintValue, |
305 |
> |
SEOFReached, |
306 |
> |
SEOFInComment, |
307 |
> |
SEOFInString, |
308 |
> |
SParamNameExpected, |
309 |
> |
SSuccess, |
310 |
> |
SDelphiException, |
311 |
> |
SNoOptionsSet, |
312 |
> |
SNoDestinationDirectory, |
313 |
> |
SNosourceDirectory, |
314 |
> |
SNoUninstallFile, |
315 |
> |
SOptionNeedsClient, |
316 |
> |
SOptionNeedsServer, |
317 |
> |
SInvalidOption, |
318 |
> |
SInvalidOnErrorResult, |
319 |
> |
SInvalidOnStatusResult, |
320 |
> |
SDPBConstantUnknownEx, |
321 |
> |
STPBConstantUnknownEx, |
322 |
> |
SSV5APIError, |
323 |
> |
SThreadFailed, |
324 |
> |
SFieldSizeError |
325 |
> |
); |
326 |
> |
|
327 |
> |
var |
328 |
> |
IBCS: TRTLCriticalSection; |
329 |
> |
|
330 |
> |
procedure IBAlloc(var P; OldSize, NewSize: Integer); |
331 |
> |
|
332 |
> |
procedure IBError(ErrMess: TIBClientError; const Args: array of const); |
333 |
> |
procedure IBDataBaseError; |
334 |
> |
|
335 |
> |
function StatusVector: PISC_STATUS; |
336 |
> |
function StatusVectorArray: PStatusVector; |
337 |
> |
function CheckStatusVector(ErrorCodes: array of ISC_STATUS): Boolean; |
338 |
> |
function StatusVectorAsText: string; |
339 |
> |
|
340 |
> |
procedure SetIBDataBaseErrorMessages(Value: TIBDataBaseErrorMessages); |
341 |
> |
function GetIBDataBaseErrorMessages: TIBDataBaseErrorMessages; |
342 |
> |
|
343 |
> |
implementation |
344 |
> |
|
345 |
> |
uses |
346 |
> |
IBIntf; |
347 |
> |
|
348 |
> |
var |
349 |
> |
IBDataBaseErrorMessages: TIBDataBaseErrorMessages; |
350 |
> |
threadvar |
351 |
> |
FStatusVector : TStatusVector; |
352 |
> |
|
353 |
> |
procedure IBAlloc(var P; OldSize, NewSize: Integer); |
354 |
> |
var |
355 |
> |
i: Integer; |
356 |
> |
begin |
357 |
> |
ReallocMem(Pointer(P), NewSize); |
358 |
> |
for i := OldSize to NewSize - 1 do PChar(P)[i] := #0; |
359 |
> |
end; |
360 |
> |
|
361 |
> |
procedure IBError(ErrMess: TIBClientError; const Args: array of const); |
362 |
> |
begin |
363 |
> |
raise EIBClientError.Create(Ord(ErrMess), |
364 |
> |
Format(IBErrorMessages[ErrMess], Args)); |
365 |
> |
end; |
366 |
> |
|
367 |
> |
procedure IBDataBaseError; |
368 |
> |
var |
369 |
> |
sqlcode: Long; |
370 |
> |
IBErrorCode: Long; |
371 |
> |
local_buffer: array[0..IBHugeLocalBufferLength - 1] of char; |
372 |
> |
usr_msg: string; |
373 |
> |
status_vector: PISC_STATUS; |
374 |
> |
IBDataBaseErrorMessages: TIBDataBaseErrorMessages; |
375 |
> |
begin |
376 |
> |
usr_msg := ''; |
377 |
> |
|
378 |
> |
{ Get a local reference to the status vector. |
379 |
> |
Get a local copy of the IBDataBaseErrorMessages options. |
380 |
> |
Get the SQL error code } |
381 |
> |
status_vector := StatusVector; |
382 |
> |
IBErrorCode := StatusVectorArray[1]; |
383 |
> |
IBDataBaseErrorMessages := GetIBDataBaseErrorMessages; |
384 |
> |
sqlcode := isc_sqlcode(status_vector); |
385 |
> |
|
386 |
> |
if (ShowSQLCode in IBDataBaseErrorMessages) then |
387 |
> |
usr_msg := usr_msg + 'SQLCODE: ' + IntToStr(sqlcode); {do not localize} |
388 |
> |
Exclude(IBDataBaseErrorMessages, ShowSQLMessage); |
389 |
> |
if (ShowSQLMessage in IBDataBaseErrorMessages) then |
390 |
> |
begin |
391 |
> |
isc_sql_interprete(sqlcode, local_buffer, IBLocalBufferLength); |
392 |
> |
if (ShowSQLCode in IBDataBaseErrorMessages) then |
393 |
> |
usr_msg := usr_msg + CRLF; |
394 |
> |
usr_msg := usr_msg + strpas(local_buffer); |
395 |
> |
end; |
396 |
> |
|
397 |
> |
if (ShowIBMessage in IBDataBaseErrorMessages) then |
398 |
> |
begin |
399 |
> |
if (ShowSQLCode in IBDataBaseErrorMessages) or |
400 |
> |
(ShowSQLMessage in IBDataBaseErrorMessages) then |
401 |
> |
usr_msg := usr_msg + CRLF; |
402 |
> |
while (isc_interprete(local_buffer, @status_vector) > 0) do |
403 |
> |
begin |
404 |
> |
if (usr_msg <> '') and (usr_msg[Length(usr_msg)] <> LF) then |
405 |
> |
usr_msg := usr_msg + CRLF; |
406 |
> |
usr_msg := usr_msg + strpas(local_buffer); |
407 |
> |
end; |
408 |
> |
end; |
409 |
> |
if (usr_msg <> '') and (usr_msg[Length(usr_msg)] = '.') then |
410 |
> |
Delete(usr_msg, Length(usr_msg), 1); |
411 |
> |
raise EIBInterBaseError.Create(sqlcode, IBErrorCode, usr_msg); |
412 |
> |
end; |
413 |
> |
|
414 |
> |
{ Return the status vector for the current thread } |
415 |
> |
function StatusVector: PISC_STATUS; |
416 |
> |
begin |
417 |
> |
result := @FStatusVector; |
418 |
> |
end; |
419 |
> |
|
420 |
> |
function StatusVectorArray: PStatusVector; |
421 |
> |
begin |
422 |
> |
result := @FStatusVector; |
423 |
> |
end; |
424 |
> |
|
425 |
> |
function CheckStatusVector(ErrorCodes: array of ISC_STATUS): Boolean; |
426 |
> |
var |
427 |
> |
p: PISC_STATUS; |
428 |
> |
i: Integer; |
429 |
> |
procedure NextP(i: Integer); |
430 |
> |
begin |
431 |
> |
p := PISC_STATUS(PChar(p) + (i * SizeOf(ISC_STATUS))); |
432 |
> |
end; |
433 |
> |
begin |
434 |
> |
p := @FStatusVector; |
435 |
> |
result := False; |
436 |
> |
while (p^ <> 0) and (not result) do |
437 |
> |
case p^ of |
438 |
> |
3: NextP(3); |
439 |
> |
1, 4: |
440 |
> |
begin |
441 |
> |
NextP(1); |
442 |
> |
i := 0; |
443 |
> |
while (i <= High(ErrorCodes)) and (not result) do |
444 |
> |
begin |
445 |
> |
result := p^ = ErrorCodes[i]; |
446 |
> |
Inc(i); |
447 |
> |
end; |
448 |
> |
NextP(1); |
449 |
> |
end; |
450 |
> |
else |
451 |
> |
NextP(2); |
452 |
> |
end; |
453 |
> |
end; |
454 |
> |
|
455 |
> |
function StatusVectorAsText: string; |
456 |
> |
var |
457 |
> |
p: PISC_STATUS; |
458 |
> |
function NextP(i: Integer): PISC_STATUS; |
459 |
> |
begin |
460 |
> |
p := PISC_STATUS(PChar(p) + (i * SizeOf(ISC_STATUS))); |
461 |
> |
result := p; |
462 |
> |
end; |
463 |
> |
begin |
464 |
> |
p := @FStatusVector; |
465 |
> |
result := ''; |
466 |
> |
while (p^ <> 0) do |
467 |
> |
if (p^ = 3) then |
468 |
> |
begin |
469 |
> |
result := result + Format('%d %d %d', [p^, NextP(1)^, NextP(1)^]) + CRLF; |
470 |
> |
NextP(1); |
471 |
> |
end |
472 |
> |
else begin |
473 |
> |
result := result + Format('%d %d', [p^, NextP(1)^]) + CRLF; |
474 |
> |
NextP(1); |
475 |
> |
end; |
476 |
> |
end; |
477 |
> |
|
478 |
> |
|
479 |
> |
{ EIBError } |
480 |
> |
constructor EIBError.Create(ASQLCode: Long; Msg: string); |
481 |
> |
begin |
482 |
> |
inherited Create(Msg); |
483 |
> |
FSQLCode := ASQLCode; |
484 |
> |
end; |
485 |
> |
|
486 |
> |
constructor EIBError.Create(ASQLCode: Long; AIBErrorCode: Long; Msg: string); |
487 |
> |
begin |
488 |
> |
inherited Create(Msg); |
489 |
> |
FSQLCode := ASQLCode; |
490 |
> |
FIBErrorCode := AIBErrorCode; |
491 |
> |
end; |
492 |
> |
|
493 |
> |
procedure SetIBDataBaseErrorMessages(Value: TIBDataBaseErrorMessages); |
494 |
> |
begin |
495 |
> |
EnterCriticalSection(IBCS); |
496 |
> |
try |
497 |
> |
IBDataBaseErrorMessages := Value; |
498 |
> |
finally |
499 |
> |
LeaveCriticalSection(IBCS); |
500 |
> |
end; |
501 |
> |
end; |
502 |
> |
|
503 |
> |
function GetIBDataBaseErrorMessages: TIBDataBaseErrorMessages; |
504 |
> |
begin |
505 |
> |
EnterCriticalSection(IBCS); |
506 |
> |
try |
507 |
> |
result := IBDataBaseErrorMessages; |
508 |
> |
finally |
509 |
> |
LeaveCriticalSection(IBCS); |
510 |
> |
end; |
511 |
> |
end; |
512 |
> |
|
513 |
> |
initialization |
514 |
> |
// IsMultiThread := True; |
515 |
> |
InitCriticalSection(IBCS); |
516 |
> |
IBDataBaseErrorMessages := [ShowSQLMessage, ShowIBMessage]; |
517 |
> |
|
518 |
> |
finalization |
519 |
> |
DoneCriticalSection(IBCS); |
520 |
> |
|
521 |
> |
end. |