|
1.13 Jak zapamiętać dane konfiguracyjne by zawsze były dostępne ?


<cyt>
[...]
> | W jaki sposób zapamiętać tę nazwę użytkownika by była ona dostępna
> | zawsze w dowolnym momencie i nie można było jej zmienić.
[...]
Wygodnie też jest trzymać różne informacje (np. hasło) w specjalnej sekcji, utworzonej dla naszej aplikacji.
Zapis nazwy użytkownika:
SaveSetting "Aplikacja", "Uprawnienia", "Uzytkownik", "Sierotka Marysia"
Odczyt:
MsgBox GetSetting("Aplikacja", "Uprawnienia", "Uzytkownik")
Komunikat zwróci nazwę "Sierotka Marysia".
</cyt>

Rozwijając przykład Krzysztofa poniżej przedstawiam krótki opis tej metody:
Private Sub btnTest_Click()
' • SaveSetting:
' zapisuje lub tworzy wpis w rejestrze Windows
' SaveSetting appname, section, key, setting
SaveSetting "MyApp", "frmMy", "Left", "200"
SaveSetting "MyApp", "frmMy", "Top", "300"
SaveSetting "MyApp", "frmMy", "Width", "150"
SaveSetting "MyApp", "frmMy", "Height", "100"

' • GetSetting:
' zwraca wartość klucza dla pozycji podanej aplikacji w rejestrze Windows.
' GetSetting(appname, section, key [,default])
' • [default] - wartość zwracana gdy dane ustawienie klucza nie ma wartości
Debug.Print "Left="; GetSetting("MyApp", "frmMy", "Left", "0")
Debug.Print "Top="; GetSetting("MyApp", "frmMy", "Top", "0")
Debug.Print "Width="; GetSetting("MyApp", "frmMy", "Width", "200")
Debug.Print "Height="; GetSetting("MyApp", "frmMy", "Height", "150")

' można też dane odczytać dane hurtowo z danej sekcji:
' • GetAllSettings:
' zwraca listę ustawień kluczy oraz ich wartości (pierwotnie utworzonych przez instrukcję SaveSetting) funkcji dla pozycji w rejestrze Windows odpowiadającej podanej aplikacji.
' GetAllSettings(appname, section)
Dim vRet As Variant
Dim i As Long
vRet = GetAllSettings("MyApp", "frmMy")
Debug.Print "==== Hurtowo ===="
For i = LBound(vRet) To UBound(vRet)
Debug.Print vRet(i, 0); "="; vRet(i, 1)
Next

' • DeleteSetting:
' Usuwa sekcję lub ustawienie klucza z pozycji aplikacji w rejestrze Windows.
' DeleteSetting appname, section[, key]
' usuń klucz "Left"
DeleteSetting "MyApp", "frmMy", "Left"
' usuń całą sekcje "frmMy"
DeleteSetting "MyApp", "frmMy"
DoCmd.RunCommand acCmdDebugWindow
End Sub
ΔΔΔ | |
|
1.14 Jak wylistować wszystkie utworzone obiekty w bazie ?
Private Const MY_TABLE As Long = 1
Private Const MY_ATTACHED_TABLE As Long = 6
Private Const MY_ATTACHED_TABLE_ODBC As Long = 4
Private Const MY_QUERY As Long = 5
Private Const MY_FORM As Long = -32768
Private Const MY_REPORT As Long = -32764
Private Const MY_MODULE As Long = -32761
Private Const MY_MACRO As Long = -32766

' jeżeli obiekt (typ obiektu) istnieje funkcja zwraca True i w argumencie ByRef aRet() zwraca tablicę typu string z nazwami obiektów, jeżeli obiekt (typ obiektu) nie istnieje funkcja zwraca False,
Private Function zbListObjectInDB(lTypeObject As Long, _
aRet() As String) As Boolean
On Error GoTo ErrHandler
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim sSQL As String
Dim sWhere As String
Dim i As Long
Select Case lTypeObject
Case MY_TABLE
' pomiń tabele systemowe i tymczasowe
sWhere = "(Left$([Name],4) <> ""Msys"") AND " & _
"(Left$([Name],1)<>""~"") AND (Type)=" & MY_TABLE
Case MY_ATTACHED_TABLE
sWhere = "Type=" & MY_ATTACHED_TABLE
Case MY_ATTACHED_TABLE_ODBC
sWhere = "Type=" & MY_ATTACHED_TABLE_ODBC
Case MY_QUERY
' pomiń kwerendy tymczasowe
sWhere = "(Left$([Name],1)<>""~"")" & _
" AND (Type)=" & MY_QUERY
Case MY_FORM
sWhere = "Type=" & MY_FORM
Case MY_REPORT
sWhere = "Type=" & MY_REPORT
Case MY_MODULE
sWhere = "Type=" & MY_MODULE
Case MY_MACRO
sWhere = "Type=" & MY_MACRO
Case Else
Exit Function
End Select
sSQL = "SELECT Name FROM MsysObjects WHERE " & _
sWhere & " ORDER BY Name"
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset(sSQL, dbOpenDynaset)
With rst
If .BOF Then
GoTo ExitHere
Else
.MoveLast
.MoveFirst
ReDim aRet(0 To .RecordCount - 1)
Do
aRet(i) = .Fields("[Name]")
i = i + 1
.MoveNext
Loop Until .EOF
zbListObjectInDB = True
End If
End With
ExitHere:
rst.Close
Set rst = Nothing
Set dbs = Nothing
Exit Function
ErrHandler:
MsgBox "Błąd nr: " & Err.Number & vbNewLine & Err.Description
Resume ExitHere
End Function

Private Sub btnTest_Click()
Dim aObjectName() As String
Dim i As Long
If zbListObjectInDB(MY_TABLE, aObjectName()) Then
Debug.Print "==== TABELE ===="
For i = LBound(aObjectName) To UBound(aObjectName)
Debug.Print Space(5) & aObjectName(i)
Next
End If
If zbListObjectInDB(MY_ATTACHED_TABLE, aObjectName()) Then
Debug.Print "==== TABELE DOŁĄCZONE ===="
For i = LBound(aObjectName) To UBound(aObjectName)
Debug.Print Space(5) & aObjectName(i)
Next
End If
If zbListObjectInDB(MY_ATTACHED_TABLE_ODBC, _
aObjectName()) Then
Debug.Print "==== TABELE DOŁĄCZONE ODBC===="
For i = LBound(aObjectName) To UBound(aObjectName)
Debug.Print Space(5) & aObjectName(i)
Next
End If
If zbListObjectInDB(MY_QUERY, aObjectName()) Then
Debug.Print "==== KWERENDY ===="
For i = LBound(aObjectName) To UBound(aObjectName)
Debug.Print Space(5) & aObjectName(i)
Next
End If
If zbListObjectInDB(MY_FORM, aObjectName()) Then
Debug.Print "==== FORMULARZE ===="
For i = LBound(aObjectName) To UBound(aObjectName)
Debug.Print Space(5) & aObjectName(i)
Next
End If
If zbListObjectInDB(MY_REPORT, aObjectName()) Then
Debug.Print "==== RAPORTY ===="
For i = LBound(aObjectName) To UBound(aObjectName)
Debug.Print Space(5) & aObjectName(i)
Next
End If
If zbListObjectInDB(MY_MODULE, aObjectName()) Then
Debug.Print "==== MODUŁY ===="
For i = LBound(aObjectName) To UBound(aObjectName)
Debug.Print Space(5) & aObjectName(i)
Next
End If
If zbListObjectInDB(MY_MACRO, aObjectName()) Then
Debug.Print "==== MAKRA ===="
For i = LBound(aObjectName) To UBound(aObjectName)
Debug.Print Space(5) & aObjectName(i)
Next
End If
DoCmd.RunCommand acCmdDebugWindow
End Sub
ΔΔΔ | |