Wolfgang Chien's Homepage | Delphi學習筆記 - 問答篇 |
小弟有一個 TTable 的 .DBF ,可是時間一久就愈來愈大了,卻找不到有 Pack>這樣的函數請問有可辦法解決,謝謝
我從 DChat.exe 的原始程式中截出一段程式來, 您可以參考看看其中 pack 的作法. 當時我用遞迴的方法, 將指定目錄(含子目錄)中的 dbf 全部 pack 一遍.
DChat.Exe DelphiChat 討論資料庫的原始程式您可以在Delphi學習筆記(創作篇)中找到
{ Delphi 1.0 uses ..., DB, DBTables, DBConsts, DbiTypes, DbiProcs, DbiErrs, .. } (*--------------------------------------------------*) (* PACK 資料庫 (* (* (*--------------------------------------------------*) procedure TfrmMain.DoPackTable(const sCurrentPath: string); var SearchRec: TSearchRec; iFindResult: integer; tblBePack: TTable; begin iFindResult := FindFirst(sCurrentPath + '*.DBF', faAnyFile, SearchRec); while iFindResult = 0 do begin frmWait.lblPrompt.Caption := 'Packing: ' + SearchRec.Name; frmWait.lblPrompt.Refresh; Application.ProcessMessages; tblBePack := TTable.Create(Self); Application.ProcessMessages; with tblBePack do begin DatabaseName := sCurrentPath; TableName := SearchRec.Name; TableType := ttDBase; Exclusive := True; Open; Application.ProcessMessages; DbiPackTable(DBHandle, Handle, nil, nil, True); Application.ProcessMessages; Close; Free; end; Application.ProcessMessages; iFindResult := FindNext(SearchRec); end; (* 向下搜尋子目錄 *) iFindResult := FindFirst(sCurrentPath + '*.', faDirectory, SearchRec); while iFindResult = 0 do begin Application.ProcessMessages; if (SearchRec.Name[1] <> '.') and (gsTempDir <> sCurrentPath + SearchRec.Name + '\') then begin DoPackTable(sCurrentPath + SearchRec.Name + '\'); end; iFindResult := FindNext(SearchRec); end; end;
首頁 | 學習筆記 | 主題公園 | 軟體下載 | 關於本站 | 討論信群 | 相約下次 |