Mega Code Archive
Bde fonksiyonları 8
<![CDATA[
Retrieve a list of descriptors for all fields in the table associated with the given TTable:
This function prints out the field numbers and names of the table. This example uses the following input:
fDbiGetFieldDescs(Table1);
The procedure is:
procedure ShowFields(T: TTable);
var
curProp: CURProps;
pfldDes, pCurFld: pFLDDesc;
// pfldDes is a pointer to a list of field descriptors.
// It must be allocated with (iFields * sizeof(FLDDesc))
// where iFields is a field in the structure curProps
// from DbiGetCursorProps
// pCurFld is a pointer the description of one field in the list.
i: Integer; // counter
MemSize: Integer;
FieldList: string;
begin
Check(DbiGetCursorProps(T.Handle, curProp));
// Get enough memory for one field desc times the # of fields
MemSize := curProp.iFields * SizeOf(FLDDesc);
pfldDes := AllocMem(MemSize);
try
pCurFld := pfldDes;
Check(DbiGetFieldDescs(T.Handle, pfldDes));
I := 0;
FieldList := '';
while (i < curProp.iFields) do begin
FieldList := FieldList + Format('%d - %s'#13#10,[pCurFld^.iFldNum,
pCurFld^.szName]);
// increment pointer to the next record
inc(pCurFld);
inc(i);
end;
finally
ShowMessage(FieldList);
FreeMem(pfldDes, MemSize);
end;
//********************************************************************************
Retrieve a description of the specified field type.
This example uses the following input:
fDbiGetFieldTypeDesc(szPARADOX, 'PDOX 7.0', 'ALPHA', MyFieldType);
The procedure is:
procedure fDbiGetFieldTypeDesc(DriverType, TableType, FieldType: PChar;
var FieldTypeInfo: TStringList);
function BoolVal(InBool: Boolean): string;
begin
if InBool then Result:= 'True'
else Result:= 'False';
end;
var
FieldTypeRec: FLDType;
begin
Check(DbiGetFieldTypeDesc(DriverType, TableType, FieldType, FieldTypeRec));
FieldTypeInfo.Add
('Field ID Type: ' + IntToStr(FieldTypeRec.iId));
FieldTypeInfo.Add('Symbolic Name: ' + StrPas(FieldTypeRec.szName));
FieldTypeInfo.Add('Descriptive Text: ' + StrPas(FieldTypeRec.szText));
FieldTypeInfo.Add('Physical / Native Type: ' + IntToStr (FieldTypeRec.iPhyType));
FieldTypeInfo.Add('Default Translated Type: ' + IntToStr (FieldTypeRec.iXltType));
FieldTypeInfo.Add('Default Translated Subtype: ' + IntToStr (FieldTypeRec.iXltSubType));
FieldTypeInfo.Add('Maximum Units Allowed (1): ' + IntToStr (FieldTypeRec.iMaxUnits1));
FieldTypeInfo.Add('Maximum Units Allowed (2): ' + IntToStr (FieldTypeRec.iMaxUnits2));
FieldTypeInfo.Add('Physical Size: ' + IntToStr (FieldTypeRec.iPhySize));
FieldTypeInfo.Add('Field Required: ' + BoolVal(FieldTypeRec.bRequired));
FieldTypeInfo.Add('Supports user-specified default: ' + BoolVal(FieldTypeRec.bDefaultVal));
FieldTypeInfo.Add('Supports Min Val constraint: ' + BoolVal(FieldTypeRec.bMinVal));
FieldTypeInfo.Add('Supports Max Val constraint: ' + BoolVal(FieldTypeRec.bMaxVal));
FieldTypeInfo.Add('Supports Referential Integerity: ' + BoolVal(FieldTypeRec.bRefIntegrity));
FieldTypeInfo.Add('Supports Other Checks: ' + BoolVal(FieldTypeRec.bOtherChecks));
FieldTypeInfo.Add('Can Be Keyed: ' + BoolVal(FieldTypeRec.bKeyed));
FieldTypeInfo.Add('Multiple Fields of this Type: ' + BoolVal(FieldTypeRec.bMultiplePerTable));
FieldTypeInfo.Add('Minimum Units Required (1): ' + IntToStr (FieldTypeRec.iMinUnits1));
FieldTypeInfo.Add('Minimum Units Required (2): ' + IntToStr (FieldTypeRec.iMinUnits2));
FieldTypeInfo.Add('Field Type Can be Created: ' + BoolVal(FieldTypeRec.bCreateable));
end;
//**************************************************************************************
Return the filter information for the specified table and filter handles. This example uses the following input:
FInfo := fDbiGetFilterInfo(CustomerTbl.Handle, hFilter);
The function is:
function fDbiGetFilterInfo(hTmpCur: hDBICur; hFilter: hDBIFilter): FILTERInfo;
var
Props: CURProps;
begin
Check(DbiGetCursorProps(hTmpCur, Props));
if (Props.iFilters = 0) then
raise EDatabaseError.Create('Ther is not filter associated with the cursor');
Check(DbiGetFilterInfo(hTmpCur, hFIlter, 0, 0, Result));
end;
//***************************************************************************************
Get the properties of a specific index associated with a cursor:
This function returns the IDXDesc properties specified by the IndexName parameter of TTable T's index.
function GetIndexDesc(T: TTable; IndexName: string): IDXDesc;
var
hNewCur: hDbiCur;
iIndexId: LongInt;
InfoStr: string;
pInfoStr: array[0..100] of char;
begin
Check(DbiCloneCursor(T.Handle, False, False, hNewCur));
try
iIndexId := 1;
Check(DbiSwitchToIndex(hNewCur, PChar(IndexName), nil, iIndexId, False));
Check(DbiGetIndexDesc(hNewCur, 0, Result)); //'0' specifies the active index
finally
Check(DbiCloseCursor(hNewCur));
end;
end;
//*************************************************************************************
Get the properties of all indexes for TTable T:
This function loops through all the indexes and shows the names and fields in the key. This example uses the following input:
ShowIndexDescs(Table1);
The procedure is:
procedure ShowIndexDescs(T: TTable);
const
IDXStr = '%sIndex name: %s. Number of fields in key: %d'#13#10;
var
CurProp: CURProps;
pIndexDesc, pTmpMem: pIdxDesc;
i, MemSize: Integer;
ShowString, IDXName: string;
begin
Check(DbiGetCursorProps(T.Handle, CurProp));
MemSize := CurProp.iIndexes * sizeof(IDXDesc);
pIndexDesc := AllocMem(MemSize);
try
pTmpMem := pIndexDesc;
Check(DbiGetIndexDescs(T.Handle, pIndexDesc));
i := 0;
ShowString := '';
while (i < curProp.iIndexes) do begin
with pTmpMem^ do begin
// primary index does not have a name for PARADOX tables }
if bPrimary and (StrComp(curProp.szTableType, szParadox) = 0) then
IDXName := 'Primary'
else
IDXName := szName;
ShowString := Format(IDXStr, [ShowString, IDXName, iFldsInKey])
end;
// increment pointer to the next record
inc(pTmpMem);
inc(i);
end;
finally
FreeMem(pIndexDesc, MemSize);
ShowMessage(ShowString);
end;
end;
//**********************************************************************************
Return the description of any useful index on the specified field.
You can also use this function can just to check if an index exists for the given field. When you pass a handle of the table, a valid field number, and a TStringList, the procedure appends the information accessed from a IdxDesc Record to the TStringList. This example uses the following input:
fDbiGetIndexForField(DBASEAnimals.handle, 1, False, MyIndexInfo);
The procedure is:
procedure fDbiGetIndexForField(hCursor: hDBICur; Field: TField; IndexInfo: TStringList);
function BoolVal(InBool: Boolean): String;
begin
if InBool then Result:= 'True'
else Result:= 'False';
end;
var
KeyArray: string;
x: Word;
MyidxDesc: IdxDesc;
begin
Check(DbiGetIndexForField(hCursor, Field.Index + 1, True, MyidxDesc));
with IndexInfo do begin
Add('Index Name: ' + MyidxDesc.szname);
Add('Index Number: ' + IntToStr(MyidxDesc.iIndexId));
Add('Tag Name (dBASE): ' + MyidxDesc.szTagName);
Add('Index Format: ' + MyidxDesc.szformat);
Add('Primary: ' + BoolVal(MyidxDesc.bPrimary));
Add('Descending: ' + BoolVal(MyidxDesc.bDescending));
Add('Maintained: ' + BoolVal(MyidxDesc.bMaintained));
Add('Subset: ' + BoolVal(MyidxDesc.bSubset));
Add('ExpIdx: ' + BoolVal(MyidxDesc.bExpIdx));
Add('Fields In Key: ' + IntToStr(MyidxDesc.iFldsInKey));
Add('Key Length: ' + IntToStr(MyidxDesc.iKeyLen));
Add('Out of Date: ' + BoolVal(MyidxDesc.bOutofDate));
Add('Key Expression Type: ' + IntToStr(MyidxDesc.iKeyExpType));
for x:= 0 to (MyidxDesc.iFldsInKey –1) do
KeyArray:= KeyArray + IntToStr(MyidxDesc.aiKeyFld[x]) + ', ';
Add('Field Numbers used in Key: ' + KeyArray);
Add('Key Expression: ' + MyidxDesc.szKeyExp);
Add('Key Condition: ' + MyidxDesc.szKeyCond);
Add('Case Insensitive: ' + BoolVal(MyidxDesc.bCaseInsensitive));
Add('iBlockSize: ' + IntToStr(MyidxDesc.iBlockSize));
Add('iRestrNum: ' + IntToStr(MyidxDesc.iRestrNum));
end;
end;
//***********************************************************************************
Obtain the current dBASE language driver and display its name in a dialog box.
procedure fDbiGetLDName;
var
S: string;
begin
SetLength(S, dbiMaxNameLen + 1);
Check(DbigetLDName(szDBASE, nil, PChar(S)));
SetLength(S, StrLen(PChar(S)));
ShowMessage('Current dBase Language driver is ' + S);
end;
//************************************************************************************
Obtain the language driver information for TDataSet descendant D.
TStrings LdObjList is filled with the language driver information. This example uses the following input:
fDbiGetLdObj(Table1, Listbox1.Items);
The procedure is:
procedure fDbiGetLdObj(D: TDataSet; LdObjList: TStrings);
var
MypLdObj: pLDDesc;
begin
Check(DbiGetLdObj(D.Handle, Pointer(MypLdObj)));
with MypLdObj^, LdObjList do begin
Add(Format('Name: %s', [szName]));
Add(Format('Description: %s', [szDesc]));
Add(Format('Code Page: %d', [iCodePage]));
case PrimaryCpPlatform of
1: Add('Primary Platform: DOS(OEM) platform');
2: Add('Primary Platform: Windows (ANSI) platform');
6: Add('Primary Platform: HP UNIX (ROMAN8) platform');
else
Add(Format('Primary Platform: Other (%d)', [PrimaryCpPlatform]));
end;
end;
end;
]]>