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

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

Как программно сжать БД MS Access? [D7, MS Access]

46_55_41_44 ©   (2004-08-02 09:59:00) 

Как программно сжать базу данных?
Ну всмысле compact...
Подчеркиваю ПРОГРАММНО! :)

---

46_55_41_44   (2004-08-02 12:21:00) [1]

> AndB ©   (02.08.04 12:19) [4]
> "Можно" (с) Anatoly Podgoretsky

Как это сделать???

---

46_55_41_44   (2004-08-02 12:20:00) [2]

Как????

---

AndB   (2004-08-02 12:19:00) [3]

"Можно" (с) Anatoly Podgoretsky

---

46_55_41_44   (2004-08-02 12:11:00) [4]

Ну народ спасибо...
Большое спасибо.. Помогло..
А можно ли таким же макаром создать БД?

---

Zlod3y   (2004-08-02 11:02:00) [5]

procedure CompactDatabase_DAO(DatabaseName,Password:String);
var
 TempName: array[0..MAX_PATH] of char;
 TempPath: string;
 Name: string;
 tmpDAO: _DBEngine;
 ClassID: TGUID;
 V35, V36: string;
begin
 V35:='DAO.DBEngine.35';
 V36:='DAO.DBEngine.36';
 try
   try
     ClassID := ProgIDToClassID(v35);
   except
     try
       ClassID := ProgIDToClassID(v36);
     except
       raise;
     end;
   end;
   TempPath:=ExtractFilePath(DatabaseName);
   if TempPath='' then TempPath:=GetCurrentDir;
   GetTempFileName(PChar(TempPath),'mdb',0,TempName);
   Name:=StrPas(TempName);
   DeleteFile(PChar(Name));
   if Password <> '' then Password:=';pwd='+Password;
   tmpDAO := CreateComObject(ClassID) as _DBEngine;
   tmpDAO.CompactDatabase(DatabaseName,Name,0,0,Password);
   DeleteFile(PChar(DatabaseName));
   RenameFile(Name,DatabaseName);
 except
   on E: Exception do ShowMessage(e.message);
 end;
end;


или

procedure 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
  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;
      DeleteFile(PChar(Name));
      Dest := Provider + 'Data Source=' + Name;
      if Password<>'' then begin
          Src := Src + ';Jet OLEDB:Database Password=' + Password;
          Dest := Dest + ';Jet OLEDB:Database Password=' + Password;
      end;

      V:=CreateOleObject('jro.JetEngine');
      try
          V.CompactDatabase(Src,Dest);
      finally
          V:=0;
      end;
      if DestDatabaseName='' then begin
          DeleteFile(PChar(DatabaseName));
          RenameFile(Name,DatabaseName);
      end;
  except
   on E: Exception do ShowMessage(e.message);
  end;
end;


ещё не забудь добавить в uses DAO2000 или ComObj

---

AndB   (2004-08-02 11:00:00) [6]

var je  : Variant;
   Dest,Src : WideString;
....
try
  Screen.Cursor := crHourGlass;
  Src := 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=' + curBase;
  Dest:= 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=' + ExtractFilePath(curBase) + '\_pack$.mdb';
 try
   je := CreateOleObject('JRO.JetEngine');
 except
   MessageBox(Application.Handle, PChar('Не могу создать объект JetEngine'), PChar('Ошибка'),MB_ICONINFORMATION);
   exit;
 end;
  ads.Close; conn.Connected := False; // текущее подключение
  je.CompactDatabase(src, dest);
  DeleteFile(curBase);
  RenameFile(ExtractFilePath(curBase) + '\_pack$.mdb', curBase);
  conn.Connected := True; ads.Open;  // открыли обратно
finally
  screen.Cursor := crDefault;
end;
_________________________
без претензии на совершенство, но работает.

---

Наверх