|
| | | |
• I.1. Access - baza danych cz. 1 •
- 1.1 Jak pobrać ścieżkę folderu bazy danych ?
- 1.2 Jak pobrać nazwę pliku bazy danych ?
- 1.3 Jak otworzyć drugą bazę danych ?
- 1.4 Jak pokazać (ukryć) okno bazy danych ?
- 1.5 Jak sprawdzić, czy baza danych otwarta jest na wyłączność ?
- 1.6 Jak zmienić ("usunąć") pojawiającą się podczas startu bitmapę Accessa ?
- 1.7 Zniknęły mi niektóre obiekty w oknie bazy => Opcje bazy danych (SetOption) ?
- 1.8 Jak zmienić ikonę i tytuł okna Accessa, jak zabezpieczyć bazę przed klawiszem SHIFT => Opcje startowe bazy (Autostart) ?
- 1.9 Zabezpieczyłem bazę danych (plik *.mdb) za pomocą opcji startowych i nie mogę wejść w tryb projektowania. Co robić ?
- 1.10 Jak otworzyć bazę zabezpieczoną hasłem ?
- 1.11 Jak uniemożliwić otwarcie drugiej instancji bazy ?
- 1.12 Jak sprawdzić, czy jest otwarta druga instancja MS Access ?
- 1.13 Jak zapamiętać dane konfiguracyjne by zawsze były dostępne ?
- 1.14 Jak wylistować wszystkie utworzone obiekty w bazie ?
- 1.15 Jak odzyskać uszkodzona bazę, (plik bazy istniejący przed ostatnią defragmentacją) ?
| | | | |
|
| | |
|
1.9 Zabezpieczyłem bazę danych (plik *.mdb) za pomocą opcji startowych i nie mogę wejść w tryb projektowania. Co robić ?
1. Otwórz bazę trzymając wciśnięty klawisz Shift.
2. Skorzystaj z przykładowej bazy Stanley'a P. Shifter
3. Spróbuj odbezpieczyć bazę na "piechotę":

' W tym celu :
' 1. Utwórz nową, pustą bazę.
' 2. Utwórz makro o nazwie "AutoKeys" ("AutoKlawisze").

' 3. Utwórz moduł o nazwie np. "Module1" i wklej do niego poniżej prezentowany kod:
' 4. Jeżeli masz w zabezpieczonej bazie makro o nazwie "AutoKeys" ("AutoKlawisze") to je zaimportuj tymczasowo do bieżącej bazy.
' 5. Wyeksportuj makro i moduł do zewnętrznego pliku bazy (Twojej zabezpieczonej bazy) - w tym celu: kliknij w oknie DB na makrze "AutoKeys" lewym przyciskiem myszy i wybierz opcję "Save as/Export... i potwierdź przyciskiem OK, że chcesz eksportować do zewnętrznego pliku.
' 6. To samo wykonaj dla modułu "Module1".
' 7. Uruchom Twoją zabezpieczoną bazę i poczekaj, aż zostaną wykonane wszytkie procedury startowe, które ustawiłeś.
' 8. Trzymając wciśnięty klawisz Ctrl naciśnij klawisz U
' 9. Sprawdź, czy się udało.

Public Function zbUnlockDB()
Dim fRet As Boolean
On Error Resume Next
DoCmd.Rename "AutoExec_Old", acMacro, "AutoExec"
CurrentDb.Properties.Delete ("StartUpForm")
On Error GoTo 0
' ustawienia obowiązują dopiero po ponownym uruchomieniu bazy
fRet = zbChangeProperty("StartUpShowDBWindow", _
dbBoolean, True)
fRet = zbChangeProperty("AllowBypassKey", dbBoolean, True)
fRet = zbChangeProperty("AllowSpecialKeys", dbBoolean, True)
fRet = zbChangeProperty("AllowFullMenus", dbBoolean, True)
fRet = zbChangeProperty("AllowBuiltInToolbars", dbBoolean, True)
fRet = zbChangeProperty("AllowShortcutMenus", dbBoolean, True)
Call Shell(SysCmd(acSysCmdAccessDir) & _
"MsAccess.exe" & " """ & CurrentDb.Name & """", _
vbMaximizedFocus)
DoCmd.Quit
End Function

Public Function zbChangeProperty(sPrpName As String, _
vPrpType As Variant, _
vPrpValue As Variant) As Boolean
Dim dbs As Database
Dim prp As Property
On Error Resume Next
Set dbs = CurrentDb
With dbs
IsObject (.Properties(sPrpName))
If Err.Number = 0 Then
On Error GoTo 0
.Properties(sPrpName) = vPrpValue
Else
On Error GoTo 0
Set prp = .CreateProperty(sPrpName, vPrpType, vPrpValue)
.Properties.Append prp
.Properties.Refresh
Set prp = Nothing
End If
End With
Set dbs = Nothing
If Err.Number = 0 Then zbChangeProperty = True
End Function
ΔΔΔ | | | | |
 |
| | |
|
1.10 Jak otworzyć bazę zabezpieczoną hasłem ?
' Metoda I
w oparciu o artykuł:
How to open a password-protected database through Automation in Access 2000
' Wadą tego rozwiązania jest automatyczne zamknięcie otwartej bazy, gdy zostaje zamknięta baza macierzysta (ponieważ zostaje wtedy zresetowana zmienna acc .) Z tego samego powodu zmienna acc musi być typy Static, by nowa instancja MS Access nie została zamknięta po zakończeniu procedury.
Private Sub OpenPasswordProtectedDB( _
sDbPathName As String, _
Optional sPassword As String = "")
Static acc As Access.Application
Dim db As DAO.Database
Set acc = New Access.Application
acc.Visible = True
Set db = acc.DBEngine.OpenDatabase(sDbPathName, False, _
False, ";PWD=" & sPassword)
acc.OpenCurrentDatabase sDbPathName
db.Close
Set db = Nothing
End Sub

' Metoda II

Private Declare Function LockWindowUpdate Lib "user32" _
(ByVal hwndLock As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long

Private Sub knOpenPasswordProtectedDB( _
sDbPathName As String, _
Optional sPassword As String = "")
Dim lPID As Long
Dim acc As Access.Application ' już nie musi być nawet Static
Dim dbs As DAO.Database
Dim sTmpDB As String
sTmpDB = Environ$("TEMP") & "\~tmpDB.mdb"
If Len(Dir(sTmpDB)) > 0 Then Kill sTmpDB
' utwórz bazę tymczasową
DBEngine.CreateDatabase sTmpDB, dbLangGeneral
' zablokuj odświeżanie ekranu
LockWindowUpdate GetDesktopWindow
On Error Resume Next
' niektóre błędy musimy sami przechwycić
' • błąd uruchomienia Shell'a
lPID = Shell(SysCmd(acSysCmdAccessDir) & _
"msaccess.exe " & _
sTmpDB, vbMaximizedFocus)
If lPID = 0 Then
If Len(Dir(sTmpDB)) > 0 Then Kill sTmpDB
LockWindowUpdate False
Exit Sub
End If
DoEvents: DoEvents: DoEvents: DoEvents
' ustaw referencje do bazy tymczasowej
Set acc = GetObject(sTmpDB)
' skoro już ją mam, to zamykam bazę sTmpDB
acc.CloseCurrentDatabase
If Len(Dir(sTmpDB)) > 0 Then Kill sTmpDB
Set dbs = acc.DBEngine.OpenDatabase(sDbPathName, _
False, False, ";PWD=" & sPassword)
' • błąd otwarcia bazy
If Err.Number <> 0 Then
acc.Quit
If Not (dbs Is Nothing) Then Set dbs = Nothing
Set acc = Nothing
LockWindowUpdate False
Exit Sub
End If
On Error GoTo 0
' odblokuj odświeżanie okien
LockWindowUpdate False
acc.OpenCurrentDatabase sDbPathName
dbs.Close
Set dbs = Nothing
Set acc = Nothing
End Sub

' Metoda III
' metoda opiera się na znalezieniu okna do wpisywania hasła bazy,
' i wpisaniu w okno klasy "Edit", lub w nowszych wersjach Windows,
' w oknie klasy "RichEdit20W" hasła bazy, a następnie zasymulowaniu
' kliknięcia w przycisk OK.
' 15.12.2011 - dostosowano do MS Access 2007 oraz MS Access 2010 64bit.
' Działa w wersji Runtime.
#If VBA7 Then
Private Declare PtrSafe Function LockWindowUpdate Lib "user32" _
(ByVal hwndLock As LongPtr) As Long
Private Declare PtrSafe Function GetDesktopWindow Lib "user32" () As LongPtr
Private Declare PtrSafe Function IsWindowVisible Lib "user32" _
(ByVal hwnd As LongPtr) As Long
Private Declare PtrSafe Function FindWindowEx Lib "user32" _
Alias "FindWindowExA" _
(ByVal hWnd1 As LongPtr, _
ByVal hWnd2 As LongPtr, _
ByVal lpsz1 As String, _
ByVal lpsz2 As String) As LongPtr
Private Declare PtrSafe Function SendMessage Lib "user32" _
Alias "SendMessageA" _
(ByVal hwnd As LongPtr, _
ByVal wMsg As Long, _
ByVal wParam As LongPtr, _
lParam As Any) As LongPtr
#Else
Private Declare Function LockWindowUpdate Lib "user32" _
(ByVal hwndLock As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function IsWindowVisible Lib "user32" _
(ByVal hwnd As Long) As Long
Private Declare Function FindWindowEx Lib "user32" _
Alias "FindWindowExA" _
(ByVal hWnd1 As Long, _
ByVal hWnd2 As Long, _
ByVal lpsz1 As String, _
ByVal lpsz2 As String) As Long
Private Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" _
(ByVal hwnd As Long, _
ByVal Msg As Long, _
wParam As Any, _
lParam As Any) As Long
#End If
Private Const WM_SETTEXT = &HC
Private Const BM_CLICK = &HF5

Private Sub zbOpenPasswordProtectedDB( _
sDbPathName As String, _
Optional sPassword As String = "")
#If VBA7 Then
Dim hDsk As LongPtr
Dim hDlg As LongPtr
Dim hNext As LongPtr
#Else
Dim hDsk As Long
Dim hDlg As Long
Dim hNext As Long
#End If
Dim lPID As Long
Const MY_CLASS_DIALOG As String = "#32770"
Const MY_CLASS_EDIT_2000 As String = "Edit"
Const MY_CLASS_EDIT_2007 As String = "RichEdit20W"
' sprawdź, czy baza istnieje, jeżeli nie to wyjdź z procedury
If Len(Dir(sDbPathName)) = 0 Then Exit Sub
' zablokuj odświeżanie ekranu
hDsk = GetDesktopWindow
LockWindowUpdate hDsk
On Error Resume Next
lPID = Shell(SysCmd(acSysCmdAccessDir) & _
"msaccess.exe " & _
"""" & sDbPathName & "", vbMaximizedFocus)
If lPID = 0 Then
LockWindowUpdate False
Exit Sub
End If
DoEvents: DoEvents: DoEvents: DoEvents
Do
hNext = FindWindowEx(hDsk, ByVal hNext, _
MY_CLASS_DIALOG, vbNullString)
Loop Until hNext = 0 Or IsWindowVisible(hNext) <> 0
If hNext = 0 Then
LockWindowUpdate False
Exit Sub
End If
hDlg = hNext
' pobierz wersję MS Access, ponieważ w Access 2007 i Access 2010
' zmieniono klasę okna edycyjnego w oknie dialogowym do wpisywania hasła
If Val(Application.SysCmd(acSysCmdAccessVer)) < 12 Then
hNext = FindWindowEx(hDlg, 0&, MY_CLASS_EDIT_2000, vbNullString)
Else
hNext = FindWindowEx(hDlg, 0&, MY_CLASS_EDIT_2007, vbNullString)
End If
If hNext = 0 Then
LockWindowUpdate False
Exit Sub
End If
SendMessage hNext, WM_SETTEXT, _
ByVal 0&, ByVal sPassword
hNext = FindWindowEx(hDlg, 0&, "Button", "OK")
SendMessage hNext, BM_CLICK, ByVal 1&, ByVal 0&
On Error GoTo 0
' odblokuj odświeżanie okien
LockWindowUpdate False
End Sub

' Metoda IV

<cyt>
Od czasu access'2000+ mamy chyba nieco oszczędniejszą metodę: tworzenie pliku adp (!) (jakieś 10x mniejszy plik, niż puste mdb). Choć w pliku adp nie ma referencji do DAO, to zupełnie nam to nie przeszkadza, bo operujemy na ogólnych metodach MS Access.
Pominąłem Twoje LockWindowUpdate, aby nie zaciemniać. Poza tym ja w dobie najprzeróżniejszych przeszkadzaczy w otwarciu jakichkolwiek plików Office'owych trochę się tego blokowania boję. Zastąpiłem go otwarciem Shell'a w stanie zminimalizowanym i przywrócenie jednym prostym RunCommand.

Private Sub knOpenPasswordProtectedDB( _
sDbPathName As String, _
Optional sPassword As String = "")
Dim lPID As Long
Dim acc As Access.Application
Dim dbs As DAO.Database
Dim sTmpDB As String
sTmpDB = Environ$("TEMP") & "\~tmpDB.adp"
If Len(Dir(sTmpDB)) > 0 Then Kill sTmpDB
' utwórz bazę tymczasową (~tmpDB.adp)
Application.CreateAccessProject sTmpDB
'^^^^^^^^^^^^^^^^^^^
On Error Resume Next
lPID = Shell(SysCmd(acSysCmdAccessDir) & _
"msaccess.exe " & _
sTmpDB, vbMinimizedNoFocus)
'^^^^^^^^^^^^^^
DoEvents: DoEvents: DoEvents: DoEvents
' chwyć obiekt application
Set acc = GetObject(sTmpDB)
' tu się kończy rola adp :)
acc.CloseCurrentDatabase
If Len(Dir(sTmpDB)) > 0 Then Kill sTmpDB
Set dbs = acc.DBEngine.OpenDatabase( _
sDbPathName, False, _
False, ";PWD=" & sPassword)
If Err.Number <> 0 Then
acc.Quit
If Not (dbs Is Nothing) Then Set dbs = Nothing
Set acc = Nothing
Exit Sub
End If
On Error GoTo 0
acc.OpenCurrentDatabase sDbPathName
acc.DoCmd.RunCommand acCmdAppMaximize
'^^^^^^^^^^^^^^^^
dbs.Close
Set dbs = Nothing
Set acc = Nothing
End Sub
</cyt>

• Komentarz Krzysztofa Pozorka do przykładu Krzysztofa Naworyty:
<cyt>
.... No i przy okazji chce zwrócić uwagę na dodatkową zaletę rozwiązania KN. Krzysiek użył pustego pliku ADP zamiast MDB, co jest celowe i ważne, bo podczas otwierania takiego pliku Access nie pyta się o hasło bazy użytkownika, nawet jeśli pracujemy na zabezpieczonym koncie.
</cyt>

ΔΔΔ | | | | |
|
| |