Задать пароль на MS ACCESS через ADO

Previous  Top  Next

    
 

 

 

Code:

type

TPasswordAction = (paSet, paChange, paRemove);

 

....

 

function ChangeAccessDBPassword(DatabaseName: string; action: TPasswordAction;

OldPassword: string = ''; NewPassword: string = ''): boolean;

var

DAO: _DBEngine;

db: Database;

ClassID: TGUID;

V35, V36: string;

oldPass, newPass: string;

begin

Result := false;

V35 := 'DAO.DBEngine.35';

V36 := 'DAO.DBEngine.36';

try

   try

     ClassID := ProgIDToClassID(v36);

   except

     try

       ClassID := ProgIDToClassID(v35);

     except

       raise;

     end;

   end;

   DAO := CreateComObject(ClassID) as _DBEngine;

   if action = paSet then

   begin

     db := DAO.OpenDatabase(DatabaseName, true, false, '');

     db.NewPassword(#0, NewPassword);

   end

   else

   begin

     db := DAO.OpenDatabase(DatabaseName, true, false, ';pwd=' + OldPassword);

     if action = paChange then

       db.NewPassword(OldPassword, NewPassword)

     else

       db.NewPassword(OldPassword, #0);

   end;

   Result := true;

except

   // выводим сообщение о ошибке

   on E: Exception do

   begin

     Result := false;

     ShowMessage(e.message);

   end;

end;

end.

 

Пример использования:
устанавливаем новый пароль - БАЗА ДОЛЖНА БЫТЬ НЕ ЗАПАРОЛЕНА, иначе будет ошибка:)

Code:

procedure TForm1.Button1Click(Sender: TObject);

var

newPass: string;

begin

if InputQuery('New password', 'Enter new password', newPass) then

   if ChangeAccessDBPassword(ExtractFilePath(ParamStr(0)) + 'db2.mdb', paSet,

     '', newPass) then

     ShowMessage('OK!')

   else

     ShowMessage('Error!');

end;

 

//изменяем пароль

procedure TForm1.Button2Click(Sender: TObject);

var

oldPass, newPass: string;

begin

if InputQuery('Old password', 'Enter old password', oldPass) then

   if InputQuery('New password', 'Enter new password', newPass) then

     if ChangeAccessDBPassword(ExtractFilePath(ParamStr(0)) + 'db2.mdb',

       paChange, oldPass, newPass) then

       ShowMessage('OK!')

     else

       ShowMessage('Error!');

end;

 

//удаляем пароль

procedure TForm1.Button3Click(Sender: TObject);

var

oldPass: string;

begin

if InputQuery('Password', 'Enter password', oldPass) then

   if ChangeAccessDBPassword(ExtractFilePath(ParamStr(0)) + 'db2.mdb',

     paRemove, oldPass, '') then

     ShowMessage('OK!')

   else

     ShowMessage('Error!');

end;

 

Взято из http://forum.sources.ru

Автор:dron-s

 
©Drkb::02751