PACK for PARADOX tables

Hi,
here you have the source code of a component that can pack dbase tables and paradox tables. by the way it can regenerate indexes too. It's not my code but it's freeware.
If you don't know what to do with that let me know.
Jeurk


------------------
{============================ BSPKTBL Distribution Notes ==================================}
{DESCRIPTION
-----------
BSPkTbl is a simple improved component for Delphi 1 and 2 {not yet tested on 3, but should be ok)
BSPkTbl includes two additional functions which Borland seem to have 'forgotten' - a simple
and effective way of packing and reindexing Dbase and Paradox tables. TBSPktbl is a direct
replacement for  TTable in your applications, and may call two extra functions:

1. PACK (returns 'True:boolean' if successful)
2. REGENINDEXES (returns 'True:boolean' if successful)



{COPYRIGHT NOTICE}
{BSPktbl is distributed as FREEWARE, but remains the COPYRIGHT of
BUSINESS SOFTWARE (UK) (email  ebinfo@compuserve.com ). Business Software grants you the right
to include this compiled component in your DELPHI application, whether COMMERCIAL, SHAREWARE, or
FREEWARE, BUT YOU MAY NOT DISTRIBUTE THIS SOURCE CODE OR ITS COMPILED .DCU  IN ANY FORM OTHER
THAN AS IT EXISTS HERE; COMPLETE WITH THIS NOTICE AND ALL THE TEXT BELOW. BSPktbl may be included
in any shareware or freeware libraries or compilation disks, provided no charge other than the
usual media cost recovery is made.}

{IF YOU HAVE ANY DOUBTS ABOUT WHETHER YOU MAY LEGALLY USE OR DISTRIBUTE THIS COMPONENT,
CONTACT BUSINESS SOFTWARE BY E-MAIL.}

{VISIT BUSINESS SOFTWARE'S WEB SITE AT HTTP://OURWORLD.COMPUSERVE.COM/HOMEPAGES/EBINFO/  for
more interesting components and applications}

{WARRANTY / ACCEPTANCE OF LIABILITY / INDEMNITY}
{ABSOLUTELY NONE WHATSOEVER}


{INSTALLATION}
{1.Copy this file into your DELPHI/LIB directory, or wherever your library files are kept}
{2.Select OPTIONS|INSTALL COMPONENTS|ADD...}
{3.ADD This file; BSPktbl.PAS to the INSTALLED UNITS listbox}
{4.Click OK}

{USING BSPktbl}
{Use just as you would a normal TTable component. Before calling PACK or REGENINDEXES, you must
make sure that either:

     The TABLETYPE property is correctly set to reflect the tabletype i.e. ttDbase or ttParadox

     or:

     The TABLENAME property must have the file extension added i.e. 'ANIMALS.DBF' or 'BIOLIFE.DB'


EXCLUSIVE must be set to true!}

unit BSPktbl;

interface
uses dbtables,db,dbiprocs,dbierrs,dbitypes,classes,sysutils;

Type
TBSPktbl=class(TTable)
private
  ftblprops:curprops;
  bopen:boolean;
  ex:string[4];

  procedure fixtabletype;
public
  constructor create(aowner:Tcomponent); override;
  destructor  destroy; override;
  function pack:boolean;
  function regenindexes:boolean;
end;


procedure register;
procedure bdecheck(BDERes: DBIResult);

implementation

procedure register;
begin
registercomponents('BSoft',[TBSPktbl]);
end;

constructor TBSPktbl.create(Aowner:Tcomponent);
begin
inherited create(aowner);
end;

destructor TBSPktbl.destroy;
begin
inherited destroy;
end;



procedure BDECheck(BDERes: DBIResult);
begin
if (BDERes <> DBIERR_NONE) then DBIError(BDERes);
end;

function TBSPktbl.pack:boolean;
var
hDB:                   hDBIdb;
pTblDesc:              pCRTblDesc;

procedure packpdx;
begin
result:=false;
GetMem(pTblDesc,sizeOf(CRTblDesc));
FillChar(pTblDesc^,SizeOf(CRTblDesc),0);
AnsiToNative(DBLocale,TableName,pTblDesc^.szTblName,255);
pTblDesc^.szTblType := FTblProps.szTableType;
pTblDesc^.bPack := True;
hDB := DBHandle;
close;
   try
   BDECheck(DBIDoRestructure(hdb,1,pTblDesc,nil,nil,nil,False));
   result:=true;
   finally
   if pTblDesc <> nil then FreeMem(pTblDesc,sizeOf(CRTblDesc));
   end;
end;

procedure packdbf;
begin
try
open;
BDECheck(DBIPackTable(DBHandle,Handle,nil,nil,TRUE));
result:=true;
except
result:=false;
end;
end;

begin
result:=false;
pTblDesc := nil;
bopen:=active;   {store previous state}
fixtabletype;
if exclusive then
 begin
    try
    open;
    if (tabletype=ttParadox) then  packpdx {paradox}
      else if (tabletype=ttDBASE) then  packdbf {Dbase}
    except
    result:=false;
    end;
 end;
active:=bopen;     {restore previous state}
end;


function TBSPktbl.regenindexes:boolean;
begin
result:=false;
bopen:=active;
fixtabletype;
if exclusive then
  begin
   try
   open;
   BDEcheck(dbiregenindexes(handle));
   result:=true;
   except
   result:=false;
   end;
  end;
active:=bopen;
end;




procedure TBSPktbl.fixtabletype;
begin
if active then close;
ex:=uppercase(extractfileext(tablename));
if (ex='') then
   begin
        if (tabletype=ttparadox) then tablename:=tablename+'.DB' else
           if (tabletype=ttdbase) then tablename:=tablename+'.DBF';
   end
else
  begin
  if (ex='.DBF') then tabletype:=ttDBASE else
   if (ex='.DB') then tabletype:=ttParadox else
      tabletype:=ttDefault;
   end;
end;



end.

Opssssss!!!!!! And now I need help! And I need it very much!!! ;)
problem is: when I made pack for my PARADOX table, all passwords were deleted:( How I can save passwords? Or how I can get
TblDesc:CRTblDesc from my table? Thanx...

I have used the component listed above - as well as, another freeware components TPacker & RX Library - they all remove teh password.  Don't know why this happens but I haven't found an answer either :o(

Hi all,

Have found some components on a disk, maybe you can use these? I 'll give the titles on monday... If these don't work properly, then .... It's time to develope one ourselfs, don't you think?

Regards, ZIF.

Hi all!!!
How I can see, it's the BIG problem :) And I think, that it's time to write own library :] He-he, and I'm ready to do this but there is 1 problem... Who knows, how to get variable of type CRTblDesc from any TABLE?
Best Regards,
Hind

Hi,

I won't help you more hind, cause it's not my knowledge. I could supply a component
that is working for me. But no more. Sorry. Try to send your projects to the others
experts if they want.
Good luck

Probably doesn'r make a lot of sense to 're-create the wheel'.  Why not just fix one of the components/procedures that don't work.  The best cabdidate would be the Borland BDE Pack example on their website.  It doesn't work at ALL!!  I'm guessing that if we can get that one to work, the passwords won't be removed - maybe?

Ok, here are the components I know of, BUT never tested them! Just found them this week on a disk.... If you want to try them out, then just ask them, give me your email or email me...

BDETools 1.0
DBPack & Copy
DBUtlty
Packing DBase & Paradox Tables in Delphi
TTableDBF


Tom.Deprez@uz.kuleuven.ac.be

Regards, ZiF.

Hind,

I have a utility that will work for you.  It is part of the RXLib called PackTable.  In the eariler versions of teh library, it removed Paradox passwords, however, one of teh authors have sent me a patch.  If your already using the RXLib,  add this line to the Pack procedure after line bPack := True;

bProtected := FCurProp.bProtected;

If your not already using RxLib - you should.  It has over 25 different Freeware components and several other procedures that really help your application look more professional. The newest version 2.40 fixes teh issue above, as well as, adds editable DB Lookup, improved app events, GIF animator, GIF list and more.

Download teh RXLib from http://rx.demo.ru.  This is the only utility I've seen that doesn't remove the password.

Good Luck!

Jay

Zif - Might as well use the updated RxLib instead of trying to fix/create another.

OK... I'll try to look this RxLib. And I think that it will be decision for our problem ;) And 80 points I give you, d4jaj1.
Thanx!