Top.Mail.Ru
Мастера DELPHI, Delphi programming community Титульная страница Поиск, карта сайта Написать письмо 
| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL |
| Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

сжать базу [D7, XP]


Chort ©   (2006-08-13 23:21:00) 

Здравствуйте! Каким образом можно программно сжать базу данных Access. Как в Access   "Сервис-Служебные программы-Сжать и востановить базу".Спасибо!

Chort   (2006-08-14 22:09:00) [1]

Не смотря на дубли не сжимает и все тут!

umbra   (2006-08-14 17:28:00) [2]


> D:\мои доки\ноль\ноль_1.1\softvok.mdb

пути с пробелами, которые являются аргументами командной строки надо брать в двойные кавычки. Дубль третий:

procedure TForm1.Button1Click(Sender: TObject);
begin
ShellExecute(0, 'open', 'C:\Program Files\Microsoft Office\OFFICE11\msaccess.exe',
'/compact "D:\мои доки\ноль\ноль_1.1\softvok.mdb"', nil, SW_SHOWNORMAL);
end;

UMU   (2006-08-14 16:57:00) [3]

...кусок проги, полностью рабочий


unit Unit1;

interface

uses
 windows,SysUtils,Dialogs,DAO2000,ComObj, Messages, Classes, Graphics, Controls, StdCtrls, Forms, shellapi,
  DBCtrls,DB, Buttons, DBTables, Mask, ExtCtrls, ComCtrls, Menus,mmsystem,
 ADODB, jpeg;

type
 TForm1 = class(TForm)
   Button1: TButton;
   ProgressBar1: TProgressBar;
   Edit1: TEdit;
   Label1: TLabel;
   procedure Button1Click(Sender: TObject);
   procedure CompactDatabase_JRO(DatabaseName: string; DestDatabaseName: string =
 ''; Password: string = '');
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.CompactDatabase_JRO(DatabaseName: string; DestDatabaseName: string =
 ''; Password: string = '');
const
 Provider = 'Provider=Microsoft.Jet.OLEDB.4.0;';
var
 TempName: array[0..MAX_PATH] of Char; // èìÿ âðåìåííîãî ôàéëà
 TempPath: string; // ïóòü äî íåãî
 Name: string;
 Src, Dest: WideString;
 V: Variant;
Begin
 ProgressBar1.Max:=100;
 ProgressBar1.StepBy(5);
 try
   Src := Provider + 'Data Source=' + DatabaseName;
   if DestDatabaseName '' then
     Name := DestDatabaseName
   else
   begin
     // âûõîäíàÿ áàçà íå óêàçàíà - èñïîëüçóåì âðåìåííûé ôàéë
     // ïîëó÷àåì ïóòü äëÿ âðåìåííîãî ôàéëà
     TempPath := ExtractFilePath(DatabaseName);
     if TempPath = '' then
       TempPath := GetCurrentDir;
     //ïîëó÷àåì èìÿ âðåìåííîãî ôàéëà
     GetTempFileName(PChar(TempPath), 'mdb', 0, TempName);
     Name := StrPas(TempName);
   end;
   ProgressBar1.StepBy(10);
   DeleteFile(PChar(Name)); // ýòîãî ôàéëà íå äîëæíî ñóùåñòâîâàòü :))
   Dest := Provider + 'Data Source=' + Name;
   ProgressBar1.StepBy(25);
   if Password '' then
   begin
     Src := Src + ';Jet OLEDB:Database Password=' + Password;
     Dest := Dest + ';Jet OLEDB:Database Password=' + Password;
   end;
   ProgressBar1.StepBy(35);
   V := CreateOleObject('jro.JetEngine');
   try
     V.CompactDatabase(Src, Dest); // ñæèìàåì
   finally
     V := 0;
   end;
   ProgressBar1.StepBy(50);
   if DestDatabaseName = '' then
   begin // ò.ê. âûõîäíàÿ áàçà íå óêàçàíà
     ProgressBar1.StepBy(65);
     DeleteFile(PChar(DatabaseName)); //òî óäàëÿåì íå óïàêîâàííóþ áàçó
     ProgressBar1.StepBy(75);
     RenameFile(Name, DatabaseName); // è ïåðåèìåíîâûâà&# 229;ì óïàêîâàííóþ áàçó
     ProgressBar1.StepBy(90);
   end;
 except
   // âûäàåì ñîîáùåíèå îá èñêëþ÷èòåëüíî&# 233; ñèòóàöèè
   on E: Exception do
     ShowMessage(e.message);

 end;
 ProgressBar1.StepBy(100);
End;

procedure TForm1.Button1Click(Sender: TObject);
Var PatchToBase:String;
Begin
   Screen.Cursor := crHourGlass;//Ìåíÿåì êóðñîð ìûøû
   PatchToBase:=Edit1.Text;//Çàïèñûâàåì ïóòü ê áàçå â ïåðåìåííóþ
   Progressbar1.Brush.Color := clWhite;//Öâåò ProgressBar
   PostMessage(ProgressBar1.Handle, $0409, 10, clGreen);//Öâåò ProgressBar

   CompactDatabase_JRO(PatchToBase, '', '');//Âûçûâàåì ïðîöåäóðó

   //CompactDatabase ñ ïàðàìåòðîì PatchToBase (ïóòü ê áàçå)
   Screen.Cursor := crDefault;//Âîññòàíàâëèâà&# 229;ì êóðñîð ìûøû
   showMessage('Ñæàòèå çàâåðøåíî');
   Close;
End;

END.

Chort   (2006-08-14 16:54:00) [4]

to umbra
сделал так
procedure TForm1.Button1Click(Sender: TObject);
begin
ShellExecute(0, 'open', 'C:\Program Files\Microsoft Office\OFFICE11\msaccess.exe',
 '/compact D:\мои доки\ноль\ноль_1.1\softvok.mdb', nil, SW_SHOWNORMAL);
end;
компилится нормально, вот только ничего не сжимает. Как было 6,19 метров так и осталось. Попробовал Сжать через Access - сжалось до 1,31 метров.

umbra   (2006-08-14 12:49:00) [5]


> Ну c:\mybase.mdb -это моя база данных, а c:\mycompressedbase.
> mdb' может уже сжатая.

именно так. чтобы сжаттая база копировалась в оригинальную, надо убрать второе имя, т.е.
ShellExecute(0, 'open', 'c:\program files\office\msaccess.exe', '/compact c:\mybase.mdb', nil, SW_SHOWNORMAL);

Chort   (2006-08-14 12:15:00) [6]


> Он говорит "Предыдущее объявление 'Access_Compact' не было
> отмечено директивой overload.

Это я понял, что сецчас сделать ?добавить этот overload в первую процедуру?

easy   (2006-08-14 12:08:00) [7]

Он говорит "Предыдущее объявление 'Access_Compact' не было отмечено директивой overload.

Chort   (2006-08-14 11:53:00) [8]

to umbra
объясните что означаб c:\mybase.mdb и c:\mycompressedbase.mdb',
Ну c:\mybase.mdb -это моя база данных, а c:\mycompressedbase.mdb' может уже сжатая. Если так то мне нужну текущую одну базу сжимать и востанавливать заменяяя ее же, а не создавать новую сжатую.

to Easy
Спасибо за ссылку
попробовал
procedure Access_Compact(const aAccess: string);
const
 bak_ext = '.$$$';
 stAccessDB = 'Provider=Microsoft.Jet.OLEDB.4.0;'+
                     'Data Source=%s';
var
 JetEngine : OleVariant;
 TempName : string;
begin
 TempName := ChangeFileExt(aAccess, bak_ext);
 DeleteFile(TempName);
 JetEngine := CreateOleObject('JRO.JetEngine');
 try
   JetEngine.CompactDatabase(
     Format(stAccessDB, [aAccess]),
     Format(stAccessDB, [TempName]));
   DeleteFile(aAccess);
   RenameFile(TempName, aAccess);
 finally
   JetEngine := Unassigned;
 end;
end;

procedure Access_Compact(const SrcConn, Dstfile: string);overload;
const
 stAccessDB = 'Provider=Microsoft.Jet.OLEDB.4.0;'+
                     'Jet OLEDB:Engine Type=4;'+ //Engine Type=5 (Access2000)
                     'Data Source=%s';
var
  JetEngine : OleVariant;
begin
  JetEngine := CreateOleObject('JRO.JetEngine');
  try
     JetEngine.CompactDatabase(SrcConn, Format(stAccessDB, [dstfile]));
  finally
     JetEngine := Unassigned;
  end;
end;
Первая процедура компилится нормально, а вот вторая матюкается
Previous declaration of 'Access_Compact' was not marked this the 'overload' directive.

umbra   (2006-08-14 10:09:00) [9]

ShellExecute(0, 'open', 'c:\program files\office\msaccess.exe', '/compact c:\mybase.mdb c:\mycompressedbase.mdb', nil, SW_SHOWNORMAL);

easy   (2006-08-14 09:34:00) [10]

http://dfc.com.ru/?sid=2&id=10&itemid=114

Anatoly Podgoretsky   (2006-08-13 23:54:00) [11]

Создать OLE объект и рулить его методами.

Наверх

Титульная страница Поиск, карта сайта Написать письмо