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

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

Err_Form_Load:

If Err.Number = -2147024894 Then

    Resume Next

    MsgBox Err.Description

End If

End Sub