Mega Code Archive
Bde fonksiyonları 1
<![CDATA[
Place a lock on a non-existent table:
This example places and releases persistent lock on the TTable T. This example uses the following input:
AcqAndRelPersistTableLock(Table1);
procedure AcqAndRelPersistTableLock(T: TTable);
var
Drv: PChar;
begin
with T do begin
if (TableType = ttParadox) then
Drv := StrNew(szParadox)
else if (TableType = ttdBASE) then
Drv := StrNew(szdBASE)
else Drv := nil;
try
Check(DbiAcqPersistTableLock(DBHandle, PChar(TableName), Drv));
Check(DbiRelPersistTableLock(DBHandle, PChar(TableName), Drv));
finally
if Assigned(Drv) then StrDispose(Drv);
end;
end;
end;
//*******************************************************************************
Place a write lock on an existing table:
Delphi users should use the method TTable.LockTable rather than directly calling DbiAcqTableLock. This method is defined as:
procedure TTable.LockTable(LockType: TLockType);
The following code places a write lock on a TTable object called Table1:
Table1.LockTable(ltWriteLock);
Place a write lock on the specified cursor's table:
Delphi users should use TTable.LockTable: This example uses the following input:
fDbiAcqTableLock(Table1.Handle);
procedure fDbiAcqTableLock(hTmpCur: hDBICur);
begin
Check(DbiAcqTableLock(hTmpCur, dbiWRITELOCK));
end;
//*******************************************************************************
Add a STANDARD database alias to the configuration file.
This example uses the following input:
fDbiAddAlias1('TestAlias', 'PATH:C:\BDE32\EXAMPLES\TABLES');
procedure fDbiAddAlias1(AliasName, AliasPath: string);
begin
Check(DbiAddAlias(nil, PChar(AliasName), nil, PChar(AliasPath), True));
end;
Example 2: Add an InterBase database alias to the configuration file.
This example uses the following input:
fDbiAddAlias2('RemoteAlias', 'PATH:frobosrv:d:/interbas;' +
'SERVER NAME:frobosrv:d:/interbas/slim.gdb;' +
'USER NAME:test;' +
'SQLQRYMODE:SERVER;' +
'SQLPASSTHRU MODE:SHARED NOAUTOCOMMIT');
Note: The last parameter in the string does not have a semicolon ( ; ) at the end.
procedure fDbiAddAlias2(AliasName, AliasPath: string);
begin
Check(DbiAddAlias(nil, PChar(AliasName), 'INTRBASE', PChar(AliasPath), True));
end;
//******************************************************************************
Add a filter that only shows records that the specified field is not NULL. This example uses the following input:
fDbiAddFilter(Table1, Table1.FieldByName('Addr1'), hFilter);
Note: When done with filter, call DbiDeactivateFilter and DbiDropFilter. If table is connected to data aware cnotrols, call TTable.Refresh.
procedure fDbiAddFilter(Table: TTable; Field: TField; var hF: hDBIFilter);
type
// Setup the node structure
TNodes = record
UNode: CANUnary;
FNode: CANField;
end;
var
Nodes: TNodes;
Expression: CANExpr;
pCan: pByte;
begin
// Uninary Node - set the operator to NOT BLANK or (NOT NULL)
with Nodes.UNode do begin
nodeClass := nodeUNARY;
canOp := canNOTBLANK;
iOperand1 := 12;
end;
// Field Node - set the field number and literal pool offset
with Nodes.FNode do begin
nodeClass := nodeFIELD;
canOp := canFIELD2;
iFieldNum := Field.Index + 1;
iNameOffset := 0;
end;
// Expression - set the expression size, nodes and start positions
with Expression do begin
iVer := 1;
iTotalSize := sizeof(CANExpr) + sizeof(Nodes) + Length(Field.FieldName) + 1;
iNodes := 2;
iNodeStart := sizeof(CANExpr);
iLiteralStart := sizeof(CANExpr) + sizeof(Nodes);
end;
GetMem(pCan, Expression.iTotalSize * sizeof(BYTE));
try
// Move expression, nodes and literal pool into a contiguous memory space
Move(Expression, pCan^, sizeof(CANExpr));
Inc(pCan, sizeof(CANExpr));
Move(Nodes, pCan^, sizeof(Nodes));
Inc(pCan, sizeof(Nodes));
Move(Field.FieldName, pCan^, Length(Field.FieldName) + 1);
Dec(pCan, sizeof(Nodes) + sizeof(CANExpr));
// Add and activate the filter
Check(DbiAddFilter(Table.Handle, 0, 1, False, pCANExpr(pCan), nil, hF));
Check(DbiActivateFilter(Table.Handle, hF));
finally
FreeMem(pCan, Expression.iTotalSize * sizeof(BYTE));
end;
end;
//*********************************************************************************
Add an index to a Paradox 4.0 or 5.0 version table:
This is a primary index. This example uses the following input:
fDbiAddIndex1(Table1);
procedure fDbiAddIndex1(Tbl: TTable);
var
NewIndex: IDXDesc;
begin
if not Tbl.Exclusive then
raise EDatabaseError.Create('TTable.Exclusive must be set to ' +
'true in order to add an index to the table');
with NewIndex do begin
iIndexId:= 0;
bPrimary:= True;
bUnique:= True;
bDescending:= False;
bMaintained:= True;
bSubset:= False;
bExpIdx:= False;
iFldsInKey:= 1;
aiKeyFld[0]:= 1;
bCaseInsensitive:= False;
end;
Check(DbiAddIndex(Tbl.dbhandle, Tbl.handle, PChar(Tbl.TableName),
szParadox, NewIndex, nil));
end;
Example 2: Add an index to a Paradox 4.0 or 5.0 version table.
This is a case insensitive, secondary, maintained index. This example uses the following input:
fDbiAddIndex2(Table1);
The procedure is defined as:
procedure fDbiAddIndex2(Tbl: TTable);
var
NewIndex: IDXDesc;
Buffer: pchar;
begin
if not Tbl.Exclusive then
raise EDatabaseError.Create
('TTable.Exclusive must be set to true in order to ' +
'add an index to the table');
with NewIndex do begin
szName:= 'NewIndex';
iIndexId:= 0;
bPrimary:= False;
bUnique:= False;
bDescending:= False;
bMaintained:= True;
bSubset:= False;
bExpIdx:= False;
iFldsInKey:= 1;
aiKeyFld[0]:= 2;
bCaseInsensitive:= True;
end;
Check(DbiAddIndex(Tbl.dbhandle, Tbl.handle, PChar(Tbl.TableName),
szParadox, NewIndex, nil));
end;
Example 3: Add an index to a Paradox 7.0 version table.
This is a secondary unique / descending index. This example uses the following input:
fDbiAddIndex3(Table1);
The procedure is defined as:
procedure fDbiAddIndex3(Tbl: TTable);
var
NewIndex: IDXDesc;
begin
if not Tbl.Exclusive then
raise EDatabaseError.Create
('TTable.Exclusive must be set to true in order to ' +
'add an index to the table');
NewIndex.szName := 'NewIndex';
NewIndex.iIndexId := 0;
NewIndex.bPrimary := False;
NewIndex.bUnique := TRUE;
NewIndex.bDescending := True;
NewIndex.bMaintained := True;
NewIndex.bSubset := False;
NewIndex.bExpIdx := False;
NewIndex.iFldsInKey := 1;
NewIndex.aiKeyFld[0]:= 2;
NewIndex.bCaseInsensitive := True;
Check(DbiAddIndex(Tbl.dbhandle, Tbl.handle, PChar(Tbl.TableName),
szParadox, NewIndex, nil));
end;
Example 4: Add an index to a dBASE for Windows version table.
This example uses the following input:
fDbiAddIndex4(Table1);
The procedure is defined as:
procedure fDbiAddIndex4(Tbl: TTable);
var
NewIndex: IDXDesc;
begin
NewIndex.szTagName := 'NewIndex1';
NewIndex.bPrimary := False;
NewIndex.bUnique := False;
NewIndex.bDescending := False;
NewIndex.bMaintained := True;
NewIndex.bSubset := False;
NewIndex.bExpIdx := False;
NewIndex.iFldsInKey := 1;
NewIndex.aiKeyFld[0] := 2;
NewIndex.szKeyExp := ''; // Although this is not an Expression index,
NewIndex.szKeyCond := ''; // szKeyExp and szKeyCond must be set blank
NewIndex.bCaseInsensitive := False;
NewIndex.iBlockSize := 0;
Check(DbiAddIndex(Tbl.dbhandle, Tbl.handle, PChar(Tbl.TableName),
szParadox, NewIndex, nil));
end;
Example 5: Add an expression index to a dBASE for Windows version table.
This example uses the following input:
fDbiAddIndex5(Table1);
The procedure is defined as:
procedure fDbiAddIndex5(Tbl: TTable);
var
NewIndex: IDXDesc;
begin
NewIndex.szTagName := 'EXPINDEX';
NewIndex.bPrimary := False;
NewIndex.bUnique := False;
NewIndex.bDescending := False;
NewIndex.bMaintained := True;
NewIndex.bSubset := False;
NewIndex.bExpIdx := True;
NewIndex.iFldsInKey := 1;
NewIndex.aiKeyFld[0] := 2;
NewIndex.szKeyExp := 'UPPER(FIELD1) + UPPER(FIELD2)';
NewIndex.szKeyCond := '';
NewIndex.bCaseInsensitive := False;
NewIndex.iBlockSize := 0;
Check(DbiAddIndex(Tbl.dbhandle, Tbl.handle, PChar(Tbl.TableName),
szDBASE, NewIndex, nil));
end;
]]>