Форум: "Базы";
Текущий архив: 2002.03.28;
Скачать: [xml.tar.bz2];
ВнизPack Найти похожие ветки
← →
SDS (2002-02-28 23:09) [2]Вот код, одна процедура пакует одну таблицу, вторая все таблицу по имени алияса
Одна таблица
procedure PackParadoxTable(const ADatabaseName : string; const ATableName : string);
var
TblDesc : CRTblDesc;
TempDBHandle : HDBIDb;
begin
FillChar(TblDesc, sizeof(TblDesc), 0);
with TblDesc do begin
StrPCopy(szTblName, ATableName);
StrCopy(szTblType, szPARADOX);
bPack := true;
end;
try
Check(dbiOpenDatabase(PChar(ADatabaseName), Nil, dbiREADWRITE, dbiOpenExcl, Nil, 0, Nil, Nil, TempDBHandle));
try
Check(dbiDoRestructure(TempDBHandle, 1, @TblDesc, Nil, Nil, Nil, false));
finally
dbiCloseDatabase(TempDBHandle);
end;
except
end;
end;
Все таблицы
procedure PackAllParadoxTables(const ADatabaseName : string);
var
List : TStrings;
i : integer;
NewSession : TSession;
begin
NewSession := TSession.Create(nil);
List := TStringList.Create;
try
NewSession.SessionName := "NewSession";
NewSession.KeepConnections:= False;
NewSession.Open;
NewSession.GetTableNames(ADatabaseName, "*.db",False, False, List);
for i := 0 to List.Count - 1 do
PackParadoxTable(ADatabaseName, List[i]);
finally
List.Free;
NewSession.Free;
end;
end;
Страницы: 1 вся ветка
Форум: "Базы";
Текущий архив: 2002.03.28;
Скачать: [xml.tar.bz2];
Память: 0.44 MB
Время: 0.007 c