Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Базы";
Текущий архив: 2003.06.02;
Скачать: [xml.tar.bz2];

Вниз

Как упаковать таблицу Paradox?   Найти похожие ветки 

 
Dimaz-z   (2003-05-13 19:26) [0]

Начинающий я, помогите, напишите код, как упаковать таблицу Paradox? Заранее спасибо!


 
Kulinar   (2003-05-13 19:48) [1]

1) Добавить в uses dbiProcs
2)procedure PackTable(table:ttable);
var
props: CURProps;
hdb:hDBIDb;
tabledesc:CRTblDesc;
begin

table.active:=false;
Table.Exclusive := True;
Table.Active := True;

if not table.active then
raise edatabaseerror.Create("table must be open to pack");
if not table.exclusive then
raise edatabaseerror.Create("table must be open exclusively to pack");
check(dbigetcursorprops(table.handle,props));
if props.sztabletype=szparadox then begin
fillchar(tabledesc,sizeof(tabledesc),0);
check(dbigetobjfromobj(hdbiobj(table.handle),objdatabase,hdbiobj(hdb)));
strpcopy(tabledesc.sztblname, table.tablename);
strpcopy(tabledesc.sztbltype,props.sztabletype);
tabledesc.bpack:=true;
table.close;
check(dbidorestructure(hdb,1,@tabledesc, nil,nil,nil, false));
end
else
if (props.sztabletype=szdbase) then
check (dbipacktable(table.dbhandle, table.handle, nil, szdbase,true))
else
raise edatabaseerror.create("table must be either of paradox or dbase"+"typetopack");
table.active:=false;
table.exclusive:=false;
table.open;
end;
3)где надо:
packTable(Table);


 
leonon   (2003-05-13 19:48) [2]

Вот как эта функция реализована в RXLib-е

procedure PackTable(Table: TTable);
{ This routine copied and modified from demo unit TableEnh.pas
from Borland Int. }
var
{ FCurProp holds information about the structure of the table }
FCurProp: CurProps;
{ Specific information about the table structure, indexes, etc. }
TblDesc: CRTblDesc;
{ Uses as a handle to the database }
hDb: hDbiDB;
{ Path to the currently opened table }
TablePath: array[0..dbiMaxPathLen] of Char;
Exclusive: Boolean;
begin
if not Table.Active then _DBError(SDataSetClosed);
Check(DbiGetCursorProps(Table.Handle, FCurProp));
if StrComp(FCurProp.szTableType, szParadox) = 0 then begin
{ Call DbiDoRestructure procedure if PARADOX table }
hDb := nil;
{ Initialize the table descriptor }
FillChar(TblDesc, SizeOf(CRTblDesc), 0);
with TblDesc do begin
{ Place the table name in descriptor }
StrPCopy(szTblName, Table.TableName);
{ Place the table type in descriptor }
StrCopy(szTblType, FCurProp.szTableType);
bPack := True;
bProtected := FCurProp.bProtected;
end;
{ Get the current table"s directory. This is why the table MUST be
opened until now }
Check(DbiGetDirectory(Table.DBHandle, False, TablePath));
{ Close the table }
Table.Close;
try
{ NOW: since the DbiDoRestructure call needs a valid DB handle BUT the
table cannot be opened, call DbiOpenDatabase to get a valid handle.
Setting TTable.Active = False does not give you a valid handle }
Check(DbiOpenDatabase(nil, szCFGDBSTANDARD, dbiReadWrite, dbiOpenExcl, nil,
0, nil, nil, hDb));
{ Set the table"s directory to the old directory }
Check(DbiSetDirectory(hDb, TablePath));
{ Pack the PARADOX table }
Check(DbiDoRestructure(hDb, 1, @TblDesc, nil, nil, nil, False));
{ Close the temporary database handle }
Check(DbiCloseDatabase(hDb));
finally
{ Re-Open the table }
Table.Open;
end;
end
else if StrComp(FCurProp.szTableType, szDBase) = 0 then begin
{ Call DbiPackTable procedure if dBase table }
Exclusive := Table.Exclusive;
Table.Close;
try
Table.Exclusive := True;
Table.Open;
try
Check(DbiPackTable(Table.DBHandle, Table.Handle, nil, nil, True));
finally
Table.Close;
end;
finally
Table.Exclusive := Exclusive;
Table.Open;
end;
end
else DbiError(DBIERR_WRONGDRVTYPE);
end;

Может чем поможет? :))))


 
Дмитрий К.К.   (2003-05-14 05:23) [3]

Библиотека RX (must have).


 
Dimaz-z   (2003-05-14 13:20) [4]

Спасибо!



Страницы: 1 вся ветка

Форум: "Базы";
Текущий архив: 2003.06.02;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.46 MB
Время: 0.007 c
7-3195
JohnKorsh
2003-03-31 12:10
2003.06.02
Как правильно работать с COM портом через API?


14-3052
Mrk
2003-05-15 23:59
2003.06.02
RX library for Delphi6


3-2749
Dim!S
2003-05-13 09:03
2003.06.02
Выборка с уточнением даты


1-2959
Nesterovsky
2003-05-18 11:21
2003.06.02
Как в TListView отображать записи разным шрифтом


1-2918
Maxx_SR
2003-05-20 17:28
2003.06.02
Internal Error 484





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский