在Delphi中,如何Pack一个Visual Foxpro类型的数据库表???(100分)

  • 主题发起人 主题发起人 apolloone
  • 开始时间 开始时间
这段程序是台湾人写的一部分,先写在这儿我也不懂,如果你需要的话,我可以Email给你
Var
isBatch := False;
goAhead := False;
msgStr := '';
if PackTbl then
msgStr := 'Do you want to pack table'
else if IndexTbl then
msgStr := 'Do you want to regenerate indexes for table';
isConnected := Database1.Connected;
if not Database1.Connected then
Database1.Connected := True;
if List1.Count > 1 then
begin
case MessageDlg('Tables in Database "' +
UpperCase(Listbox1.Items[ListBox1.ItemIndex]) +
' " can be processed' + #13 +
'in a batch or individually' + #13 + #13 +
'Do you want to process all tables in a batch?',
mtConfirmation, [mbYes, mbNo], 0) of
mrYes: begin
isBatch := True;
goAhead := True;
end;
mrNo: begin
isBatch := False;
goAhead := False;
end;
end;
end;

for i := 0 to List1.Count - 1 do
begin
Edit1.Text := List1;
ProgressBar1.Position := Trunc(100 * i / (List1.Count));
Application.ProcessMessages;
Table1.TableName := List1;
isActive := Table1.Active;
isExclusive := Table1.Exclusive;
if isBatch = False then
begin
if MessageDlg(msgStr + #13 + #13 + '"' + UpperCase(List1) + '" ?',
mtConfirmation, [mbYes, mbNo], 0) = mrYes then
goAhead := True
else goAhead := False;
end;

if goAhead then
begin
with Table1 do begin
DisableControls;
try
// ensure that Table's Exclusive property is set to True
// before the Table is opened
Active := False;
Exclusive := True;
Active := True;
// Packing (restructuring) table
if (IsPackTbl = True) then
begin
strcopy(TType, GetTableType(Table1.Handle));
// if it's a Paradox Table
if strcomp(TType, szParadox) = 0 then
PackParadoxTable(Table1)
// else if it's a dBase table then using DbiPackTable()
// to pack tables
else if strcomp(TType, szDBase) = 0 then
rslt := DbiPackTable(DBHandle, Handle, nil, nil, True)
else
MessageDlg('Only dBASE and Paradox tables ' + #13 +
'can be packed or re-indexed',
mtInformation, [mbOK], 0);
end
// Re-generating indexes for both Paradox and dBase tables
else if (IsPackTbl = False) then
rslt := DbiRegenIndexes(Handle);
// Error handling procedure
if (rslt <> DBIERR_NONE) then
begin
errorMsgPtr := @errorMsg;
DbiGetErrorString(rslt, errorMsgPtr);
MessageDlg(errorMsg, mtError, [mbOK], 0);
end;
finally
Active := False;
Exclusive := isExclusive;
Active := isActive;
end; // try ..
EnableControls;
end; // with table1 ..
end; // if goAhead
end; // For ..
Database1.Connected := isConnected;
List1.Free;
ProgressBar1.Position := 0;
if IsPackTbl = True then
Edit1.Text := 'All Tables packed'
else if IsPackTbl = False then
Edit1.Text := 'Re-generating indexes completed';
PackTbl := False;
IndexTbl := False;
BtnStatus;
end;

 
bde.hlp中BDE API函数dbi...中有相应的函数
 
建议您还是不要选用Foxpro,如果您可以决定采用什么数据库。
至少也应选用Access或者是InterBase.
 
ttForpro类型其实文件格式就是dBASE iii +的格式.你可以使用bde的API pack之.
如果不想用bde,自己把dbf和dbt中的数据按格式重新写一遍就pack了.需要了解
dbf和dbt的文件格式.挺简单的。
 
如果你用Pack查找一下应该就会找到答案的!
如保PACK一个DBF数据库呢?
function PackTable(Table: TTable): Boolean;
var
Props : CURProps;
begin
if not Table.Active then
raise EDatabaseError.Create('Table必需已经打开');
if not Table.Exclusive then
raise EDatabaseError.Create('Table必需以独占方式打开');
Check(DbiGetCursorProps(Table.Handle, Props));//检测数据库类型
if (Props.szTableType = szDBASE) then
begin
Check(DbiPackTable(Table.DBHandle, Table.Handle, nil, szDBASE,

True));
Result := True;
end
else
raise EDatabaseError.Create('Table必需是dBASE或FoxPro类型');
Table.Open;
end;

在程序中的应用方法:
......
Table1.Exclusive := True;//以独占方式打开
Table1.Open;
while not Table1.Eof do Table1.delete;//删除记录
PackTable(Table1);//PACK表
......

 
 
多人接受答案了。
 
后退
顶部