📄 dbunit.pas
字号:
PublishBDEResult(DbRslt);
if DbRslt = DBIERR_NONE then
begin
FillChar(TblDesc, SizeOf(CRTBlDesc), 0);
TblDesc.iFldCount := iFld;
GetMem(TblDesc.pFldDesc, (iFld * SizeOf(FldDesc)));
TblDesc.iIdxCount := iIdx;
GetMem(TblDesc.pIdxDesc, (iIdx * SizeOf(IdxDesc)));
TblDesc.iSecRecCount := iSec; { this comes back corrupted (WIN32 only) ... will refill later }
GetMem(TblDesc.pSecDesc, (iSec * SizeOf(SecDesc)));
TblDesc.iValChkCount := iVal; { always seems to come back zero ... will fill later }
GetMem(TblDesc.pVchkDesc, (iVal * SizeOf(VCHKDesc)));
TblDesc.iRintCount := iRI; { always seems to come back zero ... will fill later }
GetMem(TblDesc.pRIntDesc, (iRI * SizeOf(RIntDesc)));
TblDesc.iOptParams := iOptP;
GetMem(TblDesc.pfldOptParams, (iOptP * sizeOf(FLDDesc)));
GetMem(TblDesc.pOptData, (iOptD * DBIMAXSCFLDLEN));
try
{ retrieve table description from source table }
DbRslt := TUFillCRTblDesc(FBDEUtil.vhTSes, @TblDesc, KillExt(SrcTablePath), pPassword);
PublishBDEResult(DbRslt);
if DbRslt = DBIERR_NONE then
begin
{ replace table name in structure with destination table name }
StrCopy(TblDesc.szTblName, KillExt(DestTablePath));
{ free any memory allocation for items that will need to be replaced }
{$IFDEF WIN32}
if (TblDesc.pSecDesc <> nil) then
FreeMem(TblDesc.pSecDesc, (iSec * SizeOf(SecDesc)));
{$ENDIF}
if (TblDesc.pvchkDesc <> nil) then
FreeMem(TblDesc.pvchkDesc, (iVal * SizeOf(VCHKDesc)));
{ now fill in all the "holes" in the table description structure }
DBRslt := DbiOpenDatabase(nil, nil, dbiReadWrite, dbiOpenExcl, nil, 0, nil, nil, hDb);
PublishBDEResult(DBRslt);
if DBRslt = DBIERR_NONE then
begin
try
{ set the database directory to source for now }
DBAnsiToNative(strDatabase, SrcDBPath, (SizeOf(SrcDBPath) - 1));
DBRslt := DbiSetDirectory(hDb, SrcDBPath);
PublishBDEResult(DBRslt);
if DBRslt = DBIERR_NONE then
begin
{ for some reason, validity checks and referential integrity always come back
zero from 'TUFillCRTblDescCount'. Must fill in validity checks manually. Do
not want RI rules anyway on a clone operation (would be invalid) }
DBRslt := DbiOpenVchkList(hDb, NeedsExt(SrcTablePath), nil, TmpCursor);
if DBRslt = DBIERR_NONE then
begin
try
DBRslt := DbiSetToBegin(TmpCursor); { set to start of in-mem table }
PublishBDEResult(DBRslt);
if DBRslt = DBIERR_NONE then
begin
{ get record count and allocate structure }
DBRslt := DbiGetRecordCount(TmpCursor, TmpCount);
PublishBDEResult(DBRslt);
if DBRslt = DBIERR_NONE then
begin
TblDesc.iValChkCount := TmpCount;
GetMem(TblDesc.pVchkDesc, (TmpCount * SizeOf(VCHKDesc)));
pVCheckDesc := TblDesc.pVchkDesc;
repeat
DBRslt := DbiGetNextRecord(TmpCursor, dbiNOLOCK, @VCheck, nil);
if (DBRslt <> DBIERR_EOF) then
begin
pVCheckDesc^ := VCheck;
inc(pVCheckDesc);
end;
until DBRslt <> DBIERR_NONE;
end;
end;
finally
DBRslt := DbiCloseCursor(TmpCursor);
PublishBDEResult(DBRslt);
end;
end;
{$IFDEF WIN32}
{ auxilliary security info also comes back corrupted (looks like a
"packed record" alignment problem in TUTILITY ... reload }
DBRslt := DbiOpenSecurityList(hDb, NeedsExt(SrcTablePath), nil, TmpCursor);
if DBRslt = DBIERR_NONE then
begin
try
DBRslt := DbiSetToBegin(TmpCursor); { set to start of in-mem table }
PublishBDEResult(DBRslt);
if DBRslt = DBIERR_NONE then
begin
{ get record count and allocate structure }
DBRslt := DbiGetRecordCount(TmpCursor, TmpCount);
PublishBDEResult(DBRslt);
if DBRslt = DBIERR_NONE then
begin
TblDesc.iSecRecCount := TmpCount;
GetMem(TblDesc.pSECDesc, (TmpCount * SizeOf(SECDesc)));
ptmpSecDesc := TblDesc.pSECDesc;
repeat
DBRslt := DbiGetNextRecord(TmpCursor, dbiNOLOCK, @tmpSecDesc, nil);
if (DBRslt <> DBIERR_EOF) then
begin
ptmpSecDesc^ := tmpSecDesc;
inc(ptmpSecDesc);
end;
until DBRslt <> DBIERR_NONE;
end;
end;
finally
DBRslt := DbiCloseCursor(TmpCursor);
PublishBDEResult(DBRslt);
end;
end;
{$ENDIF}
{ now handle special mode operations }
case Mode of
cmDropAllIndices: { drop all indices }
begin
if (iIdx > 0) then
begin
TblDesc.iIdxCount := 0;
FreeMem(TblDesc.pIdxDesc, (iIdx * SizeOf(IdxDesc)));
TblDesc.pIdxDesc := nil;
end;
end;
cmChangeAutoIncToInt: { change AutoInc field to Integer }
begin
AutoIncField := 0; { assume none for now }
pTestFldDesc := TblDesc.pFldDesc;
for i := 1 to TblDesc.iFldCount do
begin
if (pTestFldDesc^.iFldType = fldPDXAUTOINC) then
begin
pTestFldDesc^.iFldType := fldPDXLONG;
AutoIncField := pTestFldDesc^.iFldNum;
Break; { only one per table allowed }
end;
inc(pTestFldDesc);
end;
end;
cmChangeIntToAutoInc: { change Integer field (saved index) back to AutoInc }
begin
if (AutoIncField > 0) then
begin
pTestFldDesc := TblDesc.pFldDesc;
for i := 1 to TblDesc.iFldCount do
begin
if (AutoIncField = i) then
begin
pTestFldDesc^.iFldType := fldPDXAUTOINC; { set AutoInc field type }
Break; { only one per table allowed }
end;
inc(pTestFldDesc);
end;
end;
end;
cmDropSecondary: { drop all secondary indices }
begin
if (iIdx > 0) then
begin
pTestIdxDesc := TblDesc.pIdxDesc; { points to original index desc }
FoundPrimaryIndex := False;
pPrimaryIdxDesc := nil;
for i := 1 to iIdx do
begin
if pTestIdxDesc^.bPrimary then
begin
{ allocate structure to hold only primary index ... copy }
GetMem(pPrimaryIdxDesc, SizeOf(IDXDesc));
pPrimaryIdxDesc^ := pTestIdxDesc^;
FoundPrimaryIndex := True;
Break; { can only be one primary index }
end;
inc(pTestIdxDesc);
end;
FreeMem(TblDesc.pIdxDesc, (iIdx * SizeOf(IdxDesc))); { free original memory }
{ if a primary index was located, assign to table descriptor }
if FoundPrimaryIndex then
begin
iIdx := 1;
TblDesc.iIdxCount := 1;
TblDesc.pIdxDesc := pPrimaryIdxDesc;
end
else
begin
iIdx := 0;
TblDesc.iIdxCount := 0;
TblDesc.pIdxDesc := nil;
end;
end;
end;
end; { case }
{ if all OK so far ... continue to create table }
if (DBRslt = DBIERR_NONE) then
begin
{ set the database directory to dest }
DBAnsiToNative(strCloneDir, DestDBPath, (SizeOf(DestDBPath) - 1));
DBRslt := DbiSetDirectory(hDb, DestDBPath);
PublishBDEResult(DBRslt);
if DBRslt = DBIERR_NONE then
begin
DBRslt := DbiCreateTable(hDb, True, TblDesc);
PublishBDEResult(DBRslt);
Result := (DbRslt = DBIERR_NONE);
end;
end;
end;
finally
DbiCloseDatabase(hDb);
end;
end;
end;
finally
with TblDesc do
begin
if (pFldDesc <> nil) then
FreeMem(pFldDesc, (iFld * SizeOf(FldDesc)));
if (pIdxDesc <> nil) then
FreeMem(pIdxDesc, (iIdx * SizeOf(IdxDesc)));
if (pSecDesc <> nil) then
FreeMem(pSecDesc, (iSec * SizeOf(SecDesc)));
if (pVchkDesc <> nil) then
FreeMem(pVchkDesc, (iVal * SizeOf(VCHKDesc)));
if (pRIntDesc <> nil) then
FreeMem(pRIntDesc, (iRI * SizeOf(RIntDesc)));
if (pfldOptParams <> nil) then
FreeMem(pfldOptParams, (iOptP * sizeOf(FLDDesc)));
if (pOptData <> nil) then
FreeMem(pOptData, (iOptD * DBIMAXSCFLDLEN));
end;
end;
end;
end;
end;
finally
FBDEUtil.Free;
end;
end;
{ DBCompareTables -- compares the table structure of two tables (see help for complete description) }
function DBCompareTables(CheckTable, BaseTable: TTable; var FOpType: array of CROptype;
var IOpType: array of CROptype; var pFldDes: pFldDesc): Boolean;
var
i : Integer;
TableHasChanged : Boolean;
CurrentFieldHasChanged : Boolean;
CurrentIndexHasChanged : Boolean;
IndexCount : Integer;
IndexLookupName : String;
IndexID : Integer;
CheckList : TList;
OrigFldIndex : Integer;
OrgFldDefs : TFieldDef;
MemSize : Integer;
curProp : CURProps;
pCurFld : pFLDDesc;
DBRslt : DBIResult;
begin
{ Update definition records }
CheckTable.FieldDefs.Update;
CheckTable.IndexDefs.Update;
BaseTable.FieldDefs.Update;
BaseTable.IndexDefs.Update;
{ Allocate memory for Field descriptor and get current decription }
BaseTable.Open;
try
DBRslt := DbiGetCursorProps(BaseTable.Handle, curProp);
PublishBDEResult(DBRslt);
if DBRslt = DBIERR_NONE then
begin
MemSize := curProp.iFields * SizeOf(FLDDesc);
pFldDes := AllocMem(MemSize);
pCurFld := pfldDes;
DBRslt := DbiGetFieldDescs(BaseTable.Handle, pfldDes);
PublishBDEResult(DBRslt);
if DBRslt <> DBIERR_NONE then
begin
Result := False;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -