Mega Code Archive
Bde fonksiyonları 13
<![CDATA[
Return a list of users sharing the same network file
The returned list is appended it to the string list object specified in the UserList parameter. This example uses the following input:
fDbiOpenUserList(ListBox1.Items);
The procedure is:
procedure fDbiOpenUserList(UserList: TStrings);
var
TmpCursor: hDbiCur;
rslt: dbiResult;
UsrDesc: USERDesc;
begin
Check(DbiOpenUserList(TmpCursor));
repeat
rslt:= DbiGetNextRecord(TmpCursor, dbiNOLOCK, @UsrDesc, nil);
if (rslt <> DBIERR_EOF) then begin
UserList.Add('User name: ' + UsrDesc.szUserName);
UserList.Add('Net Session: ' + IntToStr(UsrDesc.iNetSession));
UserList.Add('Product Class: ' + IntToStr (UsrDesc.iProductClass));
end;
until (rslt <> DBIERR_NONE);
Check(DbiCloseCursor(TmpCursor));
end;
//**************************************************************************************
Create a table containing information about validity checks for fields within the specified table:
Returns information about validity checks for fields in the dataset specified in the Tbl parameter. The information is appended to the string list object specified in the VchkList parameter.
This example uses the following input:
fDbiOpenVchkList(OrdersTable, ListBox1.Items);
The procedure is:
procedure fDbiOpenVchkList(Tbl: TTable; var VCheckList: TStrings);
var
TmpCursor: hdbicur;
VCheck: VCHKDesc;
rslt: dbiResult;
begin
Check(DbiOpenVchkList(Tbl.DbHandle, PChar(Tbl.TableName), nil
, TmpCursor));
Check(DbiSetToBegin(TmpCursor));
VCheckList.Clear;
repeat
rslt := DbiGetNextRecord(TmpCursor, dbiNOLOCK, @VCheck, nil
);
if (rslt <> DBIERR_EOF) then begin
VCheckList.Add('Field Number: ' + IntToStr(VCheck.ifldNum));
If VCheck.bRequired = True then
VCheckList.Add('Field is required: TRUE')
else
VCheckList.Add('Field is required: FALSE');
If VCheck.bHasMinVal = True then
VCheckList.Add('Has Minimum Value: TRUE')
else
VCheckList.Add('Has Minimum Value: FALSE');
If VCheck.bHasMaxVal = True then
VCheckList.Add('Has Maximum Value: TRUE')
else
VCheckList.Add('Has Maximum Value: FALSE');
If VCheck.bHasDefVal = True then
VCheckList.Add('Has Default Value: TRUE')
else
VCheckList.Add('Has Default Value: FALSE');
end;
until rslt <> DBIERR_NONE;
Check(DbiCloseCursor(TmpCursor));
end;
//*************************************************************************************
Example 1: Pack a Paradox or dBASE table.
This example will pack a Paradox or dBASE table therfore removing already deleted rows in a table. This function will also regenerate all out-of-date indexes (maintained indexes). This example uses the following input:
PackTable(Table1)
The function is defined as follows:
// Pack a Paradox or dBASE table
// The table must be opened execlusively before calling this function...
procedure PackTable(Table: TTable);
var
Props: CURProps;
hDb: hDBIDb;
TableDesc: CRTblDesc;
begin
// Make sure the table is open exclusively so we can get the db handle...
if not Table.Active then
raise EDatabaseError.Create('Table must be opened to pack');
if not Table.Exclusive then
raise EDatabaseError.Create('Table must be opened exclusively to pack');
// Get the table properties to determine table type...
Check(DbiGetCursorProps(Table.Handle, Props));
// If the table is a Paradox table, you must call DbiDoRestructure...
if Props.szTableType = szPARADOX then begin
// Blank out the structure...
FillChar(TableDesc, sizeof(TableDesc), 0);
// Get the database handle from the table's cursor handle...
Check(DbiGetObjFromObj(hDBIObj(Table.Handle), objDATABASE, hDBIObj(hDb)));
// Put the table name in the table descriptor...
StrPCopy(TableDesc.szTblName, Table.TableName);
// Put the table type in the table descriptor...
StrPCopy(TableDesc.szTblType, Props.szTableType);
// Set the Pack option in the table descriptor to TRUE...
TableDesc.bPack := True;
// Close the table so the restructure can complete...
Table.Close;
// Call DbiDoRestructure...
Check(DbiDoRestructure(hDb, 1, @TableDesc, nil, nil, nil, False));
end
else
// If the table is a dBASE table, simply call DbiPackTable...
if (Props.szTableType = szDBASE) then
Check(DbiPackTable(Table.DBHandle, Table.Handle, nil, szDBASE, True))
else
// Pack only works on PAradox or dBASE; nothing else...
raise EDatabaseError.Create('Table must be either of Paradox or dBASE ' +
'type to pack');
Table.Open;
end;
//************************************************************************************
Modify the current record and blob.
The field specified must be a valid memo blob. The pointer pTmpRecBuf must have valid record information. This example uses the following input:
fBlobExample1(hCur, pRecBuf, 7, "Blob text goes here!!");
The procedure is:
procedure fBlobExample2(hTmpCur: hDBICur; pTmpRecBuf: pBYTE;uFldNum: LongInt;NewText: string);
begin
Check(DbiOpenBlob(hTmpCur, pTmpRecBuf, uFldNum, dbiREADWRITE));
Check(DbiPutBlob(hTmpCur, pTmpRecBuf, uFldNum, 0, StrLen(PChar(NewText)) + 1, PChar(NewText)));
Check(DbiModifyRecord(hTmpCur, pTmpRecBuf, True));
Check(DbiFreeBlob(hTmpCur, pTmpRecBuf, uFldNum));
end;
//*************************************************************************************
Create a table on disk by using a given SQL statement.
The filename is also passed as the parameter TblName. The function returns the number of rows in the result table. This example uses the following input:
fDbiQExec(Database1.Handle, 'QUERY.DB', 'SELECT * FROM TEST;');
fDbiQExec(Table1.DBHandle, 'QUERY2.DB', 'SELECT * FROM CUSTOMER');
The function is:
function fDbiQExec(hTmpDb: hDBIDB; TblName, SQL: string): Longint;
var
hStmt: hDBIStmt;
hQryCur, hNewCur: hDBICur;
iRecCount: LongInt;
begin
hQryCur := nil;
hNewCur := nil;
hStmt := nil;
try
Check(DbiQAlloc(hTmpDb, qrylangSQL, hStmt));
Check(DbiQPrepare(hStmt, PChar(SQL)));
Check(DbiQExec(hStmt, @hQryCur));
Check(DbiQInstantiateAnswer(hStmt, hQryCur, PChar(TblName), szPARADOX,
True, @hNewCur));
Check(DbiGetRecordCount(hNewCur, iRecCount));
Result := iRecCount;
finally
if (hStmt <> nil) then
Check(DbiQFree(hStmt));
if (hNewCur <> nil) then
Check(DbiCloseCursor(hNewCur));
end;
end;
//************************************************************************************
Execute a SQL statement and return the numbers in the result set if applicable.
Count will be 0 if a result set is not created. The function also returns the number of rows in the result table. This example uses the following input:
fDbiQExecDirect('Select * from CUSTOMER', Database1.Handle, hTmpCur);
The function is:
function fDbiQExecDirect(QryStr: string; hTmpDb: hDBIDb; var hTmpCur: hDBICur): Longint;
var
Count: Longint;
begin
Check(DbiQExecDirect(hTmpDb, qrylangSQL, PChar(QryStr), @hTmpCur));
if (hTmpCur <> nil) then begin
Check(DbiGetRecordCount(hTmpCur, Count));
Result := Count;
end
else
Result := 0;
end;
//*************************************************************************************
Return the original database, table, and field names for a query.
The query from which the base descriptions come is specified in the Query parameter. Descriptions are added to the string list object specified in the List parameter. This example uses the following input:
GetBaseDescs(Query2, Memo1.Lines);
procedure GetBaseDescs(Query: TQuery; List: TStrings);
var
hCur: hDBICur;
rslt: DBIResult;
Descs: STMTBaseDesc;
begin
hCur := nil;
try
Check(DbiQGetBaseDescs(Query.STMTHandle, hCur));
repeat
rslt := DbiGetNextRecord(hCur, dbiNOLOCK, @Descs, nil);
if (rslt = DBIERR_NONE) then
List.Add(Format('DB Name: %s Table Name: %s Field Name: %s',
[Descs.szDatabase, Descs.szTableName, Descs.szFieldName]))
else
if (rslt <> DBIERR_EOF) then
Check(rslt);
until (rslt <> DBIERR_NONE);
finally
if (hCur <> nil) then
check(DbiCloseCursor(hCur));
end;
end;
//********************************************************************************
Regenerate an index to ensure that it is up to date.
This example uses the following input:
fDbiRegenIndex(Table1, 'ByCompany', '', 1);
The procedure is:
procedure fDbiRegenIndex(Tbl: TTable; IndexName, TagName: string; IndexNum: Word);
begin
Check(DbiRegenIndex(Tbl.DBHandle, nil, PChar(Tbl.TableName), nil,
PChar(IndexName), PChar(TagName), IndexNum));
end;
//*********************************************************************************
Regenerate all indexes associated with a cursor.
This function regenerates the indexes associated with the Ttable specified in the TblName parameter. This example uses the following input:
fDbiRegenIndexes(BIOLIFE_TABLE);
The procedure is:
procedure fDbiRegenIndexes(TblName: TTable);
begin
Check(DbiRegenIndexes(TblName.Handle));
end;
//**********************************************************************************
Place and release persistent lock on the TTable T.
The function AcqAndRelPersistentTableLock, below, acquires a persistent table lock on the table used by the TTable specified in the T parameter. This example uses the following input:
AcqAndRelPersistTableLock(Table1);
The procedure is:
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;
]]>