Mega Code Archive
Bde fonksiyonları 7
<![CDATA[
Örnek 1: Return the size of the record buffer needed to hold information for one record.
Note: Delphi programs should use TTable.RecordSize.
This example uses the following input:
RecBuf := AllocMem(fDbiGetCursorProps1(Table1.Handle));
The function is defined as:
function fDbiGetCursorProps1(hTmpCur: hDbiCur): Word;
var
Prop : CURProps;
begin
Check(DbiGetCursorProps(hTmpCur, Prop));
Result := Prop.iRecBufSize;
end;
Örnek 2: Return information about the table open on the specified cursor.
This example uses the following input:
fDbiGetCursorProps2(Table1.Handle, TmpList);
The procedure is defined as:
procedure fDbiGetCursorProps2(hTmpCur: hDbiCur; CurList: TStringList);
var
Prop : CURProps;
begin
Check(DbiGetCursorProps(hTmpCur, Prop));
with CurList do begin
Add('Table Name: ' + Prop.szName);
Add('Table Type: ' + Prop.szTableType);
Add('Fields: ' + IntToStr(Prop.iFields));
Add('Record Buffer Size: ' + IntToStr(Prop.iRecBufSize));
Add('Indexes: ' + IntToStr(Prop.iIndexes));
Add('Validity Checks: ' + IntToStr(Prop.iValChecks));
Add('Referential Integ Checks: ' + IntToStr(Prop.iRefIntChecks));
Add('Table Level: ' + IntToStr(Prop.iTblLevel));
Add('Language Driver: ' + Prop.szLangDriver);
end;
end;
//************************************************************************************
Retrieve the description of the specified database from the configuration file.
This example uses the following input:
ShowDatabaseDesc('IBLOCAL');
The procedure is defined as:
procedure ShowDatabaseDesc(DBName: string);
const
DescStr = 'Driver Name: %s'#13#10'AliasName: %s'#13#10 +
'Text: %s'#13#10'Physical Name/Path: %s';
var
dbDes: DBDesc;
begin
Check(DbiGetDatabaseDesc(PChar(DBName), @dbDes));
with dbDes do
ShowMessage(Format(DescStr, [szDbType, szName, szText, szPhyName]));
end;
//************************************************************************************
Return the current working directory.
This example uses the following input:
ReturnString:= fDbiGetDirectory(Table1.DBHandle);
The function is defined as:
function fDbiGetDirectory(hDB: hDbiDb): string;
var
Dir: string;
begin
SetLength(Dir, dbiMaxPathLen + 1);
Check(DbiGetDirectory(hDB, False, PChar(Dir)));
SetLength(Dir, StrLen(PChar(Dir)));
Result:= Dir;
end;
//*************************************************************************************
Obtain information about a certain driver.
This example uses the following input:
fDbiGetDriverDesc('INTRBASE', TmpList);
The procedure is defined as:
Procedure fDbiGetDriverDesc(DrvName: string; DriverList: TStringList);
var
DrvDesc : DRVType;
begin
Check(DbiGetDriverDesc(PChar(DrvName), DrvDesc));
with DriverList do begin
Add('Driver Type: ' + DrvDesc.szType);
Add('Text: ' + DrvDesc.szText);
Add('Database Type: ' + DrvDesc.szDbType);
end;
end;
//**************************************************************************************
Show error context string.
After a dbi function returns an error, you can use this procedure to display the error context string associated with the context type specified in eContext. This example uses the following input:
ShowErrorContext(ecTABLENAME);
The procedure is defined as:
procedure ShowErrorContext(eContext: Integer);
var
Ctxt: string;
begin
SetLength(Ctxt, DBIMAXMSGLEN);
DbiGetErrorContext(eContext, PChar(Ctxt));
SetLength(Ctxt, StrLen(PChar(Ctxt)));
if (Ctxt > '') then
ShowMessage(format('Error context string: %s',[Ctxt]));
end;
//***************************************************************************************
Get the error for the specified entry and return the result in a ClientError string. If a native error also exists in the entry, return it as the function result. Raise an EDatabaseError exception if an attempt is made to go beyond the end of the error stack. This example uses the following input:
NativeError := fDbiGetErrorEntry(1, ClientStr);
The function is defined as:
function fDbigetErrorEntry(Entry: Word; var ClientError: string): Longint;
var
L: Longint;
rslt: DBIResult;
begin
SetLength(ClientError, DBIMAXMSGLEN + 1);
rslt := DbiGetErrorEntry(Entry, L, PChar(ClientError));
SetLength(ClientError, StrLen(PChar(ClientError)));
Result := L;
if (rslt = DBIERR_NONE) then
raise EDatabaseError.Create('No errors at stack entry ' + IntToStr(Entry));
end;
//**************************************************************************************
Get descriptive error information about the last error
In addition the the most recent error, this function displays error contexts for up to four error messages on the error stack. This example uses the following input:
fDbiGetErrorInfo(DbiOpenLDList(hCur), ErrorList);
The procedure is defined as:
procedure fDbiGetErrorInfo(ErrorCode: DbiResult; ErrorList: TStringList);
var
ErrorInfo: DBIErrInfo;
ErrorString: string;
begin
if (ErrorCode <> dbiERR_NONE) then begin
ErrorList.Clear;
Check(DbiGetErrorInfo(True,ErrorInfo));
if (ErrorCode = ErrorInfo.iError) then begin
ErrorList.Add('Error Number: ' + IntToStr(ErrorInfo.iError));
ErrorList.Add('Error Code: ' + StrPas(ErrorInfo.szErrcode));
if (StrLen(ErrorInfo.szContext[1]) <> 0) then
ErrorList.Add('Error Context1: ' + StrPas(ErrorInfo.szContext[1]));
if (StrLen(ErrorInfo.szContext[2]) <> 0) then
ErrorList.Add('Error Context2: ' + StrPas(ErrorInfo.szContext[2]));
if (StrLen(ErrorInfo.szContext[3]) <> 0) then
ErrorList.Add('Error Context3: ' + StrPas(ErrorInfo.szContext[3]));
if (StrLen(ErrorInfo.szContext[4]) <> 0) then
ErrorList.Add('Error Context4: ' + StrPas(ErrorInfo.szContext[4]));
end
else begin
SetLength(ErrorString, dbiMaxMsgLen + 1);
Check(DbiGetErrorString(ErrorCode, PChar(ErrorString)));
SetLength(ErrorString, StrLen(PChar(ErrorString)));
ErrorList.Add(ErrorString);
end;
end;
end;
//******************************************************************************
Retrieve the data contents of the requested field from the record buffer:
Delphi users should not need to directly call dbiGetField because Delphi provides a variety of ways to retrieve the value of a particular field. Use the Delphi online help to browse the Value and As... properties of TField. Also see the FieldValues[] array property of TTable.
Get a field in a table and return it in a Variant type variable.
Some field types are not supported and will cause an exception. Most Delphi users should use TField objects to retrieve table information. This example uses the following input:
MStr := fDbiGetField(Table1.Handle, Table1.Fields[0].Index + 1);
The function is:
function fDbiGetField(hTmpCur: hDBICur; FieldNo: Word): Variant;
var
Props: CURProps;
pFlds, pOldFlds: pFLDDesc;
pRecBuf: pBYTE;
FieldString: string;
FieldINT16: Smallint;
FieldINT32: Longint;
FieldUINT16: Word;
FieldFLOAT: Double;
Blank: Boolean;
begin
if (FieldNo < 1) then
raise EDatabaseError.Create('Field number index is 1 based');
Check(DbiGetCursorProps(hTmpCur, Props));
pFlds := AllocMem(Props.iFields * sizeof(FLDDesc));
pOldFlds := pFlds;
pRecBuf := AllocMem(Props.iRecBufSize * sizeof(BYTE));
try
Check(DbiGetFieldDescs(hTmpCur, pFlds));
Inc(pFlds, FieldNo - 1);
Check(DbiGetRecord(hTmpCur, dbiNOLOCK, pRecBuf, nil));
case pFlds.iFldType of
fldDATE, fldTIME, fldTIMESTAMP, fldUNKNOWN, fldBLOB, fldBOOL, fldBCD:
raise EDBEngineError.Create(DBIERR_NOTSUPPORTED);
fldZSTRING:
begin
SetLength(FieldString, pFlds.iUnits1 + 1);
Check(DbiGetField(hTmpCur, FieldNo, pRecBuf,
pBYTE(PChar(FieldString)), Blank));
SetLength(FieldString, StrLen(PChar(FieldString)));
Result := FieldString;
end;
fldINT16:
begin
Check(DbiGetField(hTmpCur, FieldNo, pRecBuf, pBYTE(@FieldINT16),
Blank));
Result := FieldINT16;
end;
fldUINT16:
begin
Check(DbiGetField(hTmpCur, FieldNo, pRecBuf, pBYTE(@FieldUINT16),
Blank));
Result := FieldUINT16;
end;
fldFLOAT:
begin
Check(DbiGetField(hTmpCur, FieldNo, pRecBuf, pBYTE(@FieldFLOAT),
Blank));
Result := FieldFLOAT;
end;
fldINT32, fldUINT32:
begin
Check(DbiGetField(hTmpCur, FieldNo, pRecBuf, pBYTE(@FieldINT32),
Blank));
Result := FieldINT32;
end;
end;
finally
FreeMem(pOldFlds, Props.iFields * sizeof(FLDDesc));
FreeMem(pRecBuf, Props.iRecBufSize * sizeof(BYTE));
end;
end;
]]>