home *** CD-ROM | disk | FTP | other *** search
/ CD Shareware Magazine 1996 December / CD_shareware_12-96.iso / WIN / Programa / PXREST.ZIP / RESTRUCT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-04-30  |  4.6 KB  |  150 lines
  1. {$A+,B-,C-,D+,E-,F-,G+,H+,I+,J+,K-,L+,M-,N+,O+,P+,Q+,R+,S+,T-,U-,V+,W-,X+,Y-,Z1}
  2. {$MINSTACKSIZE $00004000}
  3. {$MAXSTACKSIZE $00100000}
  4. {$IMAGEBASE $00400000}
  5. {$APPTYPE GUI}
  6.  
  7. // This unit contains all the procedures needed to alter Paradox version level,
  8. //      block size, and strict integrity constraints.
  9.  
  10. unit restruct;
  11.  
  12. interface
  13.  
  14. uses
  15.   DBTables;
  16.  
  17. // Alter table's version level
  18. // Input Example: AlterVersion(Table1, 7);
  19. procedure AlterVersion(Table: TTable; Version: Byte);
  20.  
  21. // Alter table's block size
  22. // Input Example: AlterBlockSize(Table1, 4096);
  23. procedure AlterBlockSize(Table: TTable; BlockSize: Integer);
  24.  
  25. // Alter table's strict integrity constraint
  26. // Input Example: AlterStrictIntegrity(Table1, TRUE);
  27. procedure AlterStrictIntegrity(Table: TTable; SI: Boolean);
  28.  
  29. implementation
  30.  
  31. uses
  32.   DB, BDE;
  33.  
  34. const
  35.   // Constants used by EDatabaseError exceptions that are raised during
  36.   //   abnormal termination
  37.   notOpenError =
  38.     'Table must be open to complete restructure operation';
  39.   notExclusiveError =
  40.     'Table must be opened exclusively to complete restructure operation';
  41.   mustBeParadoxTable =
  42.     'Table is not a Paradox table type';
  43.  
  44.  
  45. // Calls DbiDoRestructure with the Option to change and the OptData which is
  46. //   the new value of the option.
  47. // Since a database handle is needed and the table cannot be opened when
  48. //   restructuring is done, a new database handle is created and set to the
  49. //   directory where the table resides.
  50. procedure RestructureTable(Table: TTable; Option, OptData: string);
  51. var
  52.   DirName: string;
  53.   hDb: hDBIDb;
  54.   TblDesc: CRTblDesc;
  55.   Props: CurProps;
  56.   pFDesc: FLDDesc;
  57.  
  58. begin
  59.   // If the table is not opened, raise an error.  Need the table open to get
  60.   //   the table directory.
  61.   if Table.Active <> True then
  62.     raise EDatabaseError.Create(notOpenError);
  63.   // If the table is not opened exclusively, raise an error.  DbiDoRestructure
  64.   //   will need exclusive access to the table.
  65.   if Table.Exclusive <> True then
  66.     raise EDatabaseError.Create(notExclusiveError);
  67.  
  68.   Check(DbiGetCursorProps(Table.Handle, Props));
  69.   // If the table is not a Paradox type, raise an error.  These options only
  70.   //   work with Paradox tables.
  71.   if StrComp(Props.szTableType, szPARADOX) <> 0 then
  72.     raise EDatabaseError.Create(mustBeParadoxTable);
  73.  
  74.   // Get the directory of the opened table.
  75.   SetLength(DirName, DBIMAXTBLNAMELEN);
  76.   Check(DbiGetDirectory(Table.DBHandle, False, PChar(DirName)));
  77.   SetLength(DirName, StrLen(PChar(DirName)));
  78.   // Close the table.
  79.   Table.Close;
  80.  
  81.   // Open a new database
  82.   Check(DbiOpenDatabase(nil, nil, dbiREADWRITE, dbiOPENEXCL,
  83.                 nil, 0, nil, nil, hDb));
  84.  
  85.   // Set the database's working directory to the table directory.
  86.   Check(DbiSetDirectory(hDb, PChar(DirName)));
  87.  
  88.   // Setup the Table descriptor for DbiDoRestructure
  89.   FillChar(TblDesc, SizeOf(TblDesc), #0);
  90.   StrPCopy(TblDesc.szTblName, Table.Tablename);
  91.   StrCopy(TblDesc.szTblType, szParadox);
  92.  
  93.   // The optional parameters are passed in through the FLDDesc structure.
  94.   //   It is possible to change many Options at one time by using a pointer
  95.   //   to a FLDDesc (pFLDDesc) and allocating memory for the structure.
  96.   pFDesc.iOffset := 0;
  97.   pFDesc.iLen := Length(OptData) + 1;
  98.   StrPCopy(pFDesc.szName, Option);
  99.  
  100.   // The changed values of the optional parameters are in a contiguous memory
  101.   //   space.  Sonce only one parameter is being used, the OptData variable
  102.   //   can be used as a contiguous memory space.
  103.   TblDesc.iOptParams := 1;  // Only one optional parameter
  104.   TblDesc.pFldOptParams := @pFDesc;
  105.   TblDesc.pOptData := @OptData[1];
  106.  
  107.   try
  108.     // Restructure the table with the new parameter.
  109.     Check(DbiDoRestructure(hDb, 1, @TblDesc, nil, nil, nil, False));
  110.   finally
  111.     Table.Open;
  112.   end;
  113. end;
  114.  
  115. // Setup RestructureTable parameters for changing the table version
  116. procedure AlterVersion(Table: TTable; Version: Byte);
  117. var
  118.   sVersion: string;
  119.  
  120. begin
  121.   sVersion := IntToStr(Version);
  122.   RestructureTable(Table, 'LEVEL', sVersion);
  123. end;
  124.  
  125. // Setup RestructureTable parameters for changing the table block size
  126. procedure AlterBlockSize(Table: TTable; BlockSize: Integer);
  127. var
  128.   sBlockSize: string;
  129.  
  130. begin
  131.   sBlockSize := IntToStr(BlockSize);
  132.   RestructureTable(Table, 'BLOCK SIZE', sBlockSize);
  133. end;
  134.  
  135. // Setup RestructureTable parameters for changing the table strict integrity
  136. procedure AlterStrictIntegrity(Table: TTable; SI: Boolean);
  137. var
  138.   sSI: string;
  139.  
  140. begin
  141.   if SI = True then
  142.     sSI := 'TRUE'
  143.   else
  144.     sSi := 'FALSE';
  145.  
  146.   RestructureTable(Table, 'STRICTINTEGRTY', sSI);
  147. end;
  148.  
  149. end.
  150.