Public Enum REG_TOPLEVEL_KEYS
HKEY_CLASSES_ROOT = &H80000000
HKEY_CURRENT_CONFIG = &H80000005
HKEY_CURRENT_USER = &H80000001
HKEY_DYN_DATA = &H80000006
HKEY_LOCAL_MACHINE = &H80000002
HKEY_PERFORMANCE_DATA = &H80000004
HKEY_USERS = &H80000003
End Enum
Private Const REG_DWORD = 4
Private Const REG_SZ = 1
Private Declare Function RegCreateKey Lib _
"advapi32.dll" Alias "RegCreateKeyA" _
(ByVal Hkey As Long, ByVal lpSubKey As _
String, phkResult As Long) As Long
Private Declare Function RegCloseKey Lib _
"advapi32.dll" (ByVal Hkey As Long) As Long
Private Declare Function RegSetValueEx Lib _
"advapi32.dll" Alias "RegSetValueExA" _
(ByVal Hkey As Long, ByVal _
lpValueName As String, ByVal _
Reserved As Long, ByVal dwType _
As Long, lpData As Any, ByVal _
cbData As Long) As Long
'''''''''''''''''''''
Private Const Naziv_App = "EVD Evidencija rada"
Private Const Licenca_App = "MojProgram_licenca"
Private Const Siguna_Pozicija = "LocationEVD"
Private Const Moja_Frontbaza = "MYP.DLL"
''''''''''''''''''''''''
Private Function WriteStringToRegistry(Hkey As _
REG_TOPLEVEL_KEYS, strPath As String, strValue As String, _
strdata As String, reg As Boolean) As Boolean
Dim bAns As Boolean
On Error GoTo ErrorHandler
Dim keyhand As Long
Dim r As Long
If reg = False Then
r = RegCreateKey(Hkey, strPath, keyhand)
If r = 0 Then
r = RegSetValueEx(keyhand, strValue, 0, _
REG_SZ, ByVal strdata, Len(strdata))
r = RegCloseKey(keyhand)
End If
Else
Dim nVal As Long
nVal = "00000001"
r = RegCreateKey(Hkey, strPath, keyhand)
If r = 0 Then
r = RegSetValueEx(keyhand, strValue, 0, _
REG_DWORD, nVal, Len(nVal)) '''ByVal strdata, Len(strdata))
r = RegCloseKey(keyhand)
End If
End If
WriteStringToRegistry = (r = 0)
Exit Function
ErrorHandler:
WriteStringToRegistry = False
Exit Function
End Function
Private Sub Form_Load()
On Error GoTo Err_Form_Load
Dim objShell As Object
Dim objKill As Object
Dim office_path As String, app_path As String, reg_path As String, Description_path As String, AllowSubfolders_path As String
Dim search_mode As Integer, i As Integer, verzija As Integer
Set objShell = CreateObject("Wscript.Shell")
objShell.run "taskkill.exe /F /IM EXCEL.EXE", 0, True
objShell.run "taskkill.exe /F /IM MSACCESS.EXE", 0, True
For i = 14 To 1 Step -1
If Len(office_path) = 0 Then
verzija = i
office_path = objShell.RegRead("HKLM\SOFTWARE\Microsoft\Office\" & i & ".0\Access\InstallRoot\Path")
reg_path = objShell.RegRead("HKCU\SOFTWARE\Microsoft\Office\" & i & ".0\Access\Security\Trusted Locations\" & Siguna_Pozicija & "\Path")
Description_path = objShell.RegRead("HKCU\SOFTWARE\Microsoft\Office\" & i & ".0\Access\Security\Trusted Locations\" & Siguna_Pozicija & "\Description")
AllowSubfolders_path = objShell.RegRead("HKCU\SOFTWARE\Microsoft\Office\" & i & ".0\Access\Security\Trusted Locations\" & Siguna_Pozicija & "\AllowSubfolders")
End If
Next
If App.Path <> reg_path Then
WriteStringToRegistry HKEY_CURRENT_USER, "Software\Microsoft\Office\" & verzija & ".0\Access\Security\Trusted Locations\" & Siguna_Pozicija, "Path", App.Path, False
WriteStringToRegistry HKEY_CURRENT_USER, "Software\Microsoft\Office\" & verzija & ".0\Access\Security\Trusted Locations\" & Siguna_Pozicija, "Date", Now, False
End If
If Description_path <> Licenca_App Then
WriteStringToRegistry HKEY_CURRENT_USER, "Software\Microsoft\Office\" & verzija & ".0\Access\Security\Trusted Locations\" & Siguna_Pozicija, "Description", Licenca_App, False
End If
If AllowSubfolders_path = "" Then
WriteStringToRegistry HKEY_CURRENT_USER, "Software\Microsoft\Office\" & verzija & ".0\Access\Security\Trusted Locations\" & Siguna_Pozicija, "AllowSubfolders", "1", True
End If
If Len(office_path) = 0 Then
MsgBox "Microsoft(Runtime) Instalacija nije pronaena, Molim vas re-instalirajte Microsoft Office Access (Runtime).", vbCritical, "Program Error!"
End
End If
app_path = App.Path
objShell.run Chr(34) & office_path & "MSACCESS.EXE" & Chr(34) & " " & Chr(34) & app_path & "\" & Moja_Frontbaza
End
Err_Form_Load:
If Err.Number = -2147024894 Then
Resume Next
Else
MsgBox Err.Description
End If
End Sub