Imports System.ComponentModel
Imports System.Configuration.Install
Imports System.IO
Imports Microsoft.Win32

<RunInstaller(True)> Public Class CacheUtilsInstaller
    Inherits System.Configuration.Install.Installer
 ....


    'Constant Declaration
    Private Const ODBC_ADD_DSN As Integer =  1  ' Add data source
    Private Const ODBC_CONFIG_DSN As Integer =  2  ' Configure (edit) data source
    Private Const ODBC_REMOVE_DSN As Integer =  3 
    Private Const ODBC_DRIVER$ = "InterSystems ODBC"
    Private Const ODBC_DRIVER_REG_KEY$ = "SOFTWARE\ODBC\ODBCINST.INI\InterSystems ODBC"
    Private Const MDAC_REG_KEY$ = "SOFTWARE\Classes\MDACVer.Version\CurVer"
    Private Const key$ = "assemblypath"

    Declare Auto Function SQLGetInstalledDrivers Lib "odbccp32.dll" (ByRef lpszBuf$, ByVal cbBufMax%, ByRef pcbBufOut%) As Boolean

    Declare Auto Function SQLConfigDataSource Lib "odbccp32.dll" (ByVal hwndParent As IntPtr, ByVal fRequest As Integer, ByVal lpszDriver As String, ByVal lpszAttributes As String) As Boolean


    Private Sub CacheUtilsInstaller_Committed(ByVal sender As Object, ByVal e As System.Configuration.Install.InstallEventArgs) Handles MyBase.AfterInstall
        'пытаемся создать файл конфигурации сети

        'инсталация MDAC
        InstallMDAC()
        'инсталация драйвера ODBC для Cache
        If InstallCacheODBC() Then
            'если всё ОК, то прописываем DSN
            Me.InstallDSN()
        End If
    End Sub

    'инсталация MDAC
    Private Sub InstallMDAC()
        Dim regKey As RegistryKey = Registry.LocalMachine
        Dim mdacRegKey As RegistryKey
        Try
            'проверяем установлена ли нужная версия MDAC
            mdacRegKey = regKey.OpenSubKey(Me.MDAC_REG_KEY)
            If Not mdacRegKey Is Nothing Then
                Dim curVer$ = mdacRegKey.GetValue("", "")
                If curVer <> "" Then
                    'MDACVer.Version.2.70
                    'получаем установленную версию MDAC
                    Try
                        curVer = curVer.Replace("MDACVer.Version.", "")
                        Dim sep$ = Globalization.CultureInfo.CurrentCulture.NumberFormat.NumberDecimalSeparator
                        curVer = curVer.Replace(".", sep)
                        Dim tempAr$() = curVer.Split(sep)
                        If tempAr.Length >  2  Then
                            curVer = tempAr( 0 ) + sep + tempAr( 1 )
                        End If
                        Dim ver As Single = Convert.ToSingle(curVer)
                        'если версия 2.7 и выше то выходим
                        If ver >=  2 . 7  Then Exit Sub
                    Catch ex As Exception
                        MsgBox(ex.Message, MsgBoxStyle.Critical)
                    End Try
                    mdacRegKey.Close()
                End If
                'если нет, то устанавливаем
                Dim url$ = Me.GetInstPath + "\bin\mdac_typ.exe"
                StartProcess(url)
            End If
        Finally
            regKey.Close()
        End Try

    End Sub

    'инсталация драйвера ODBC для Cache
    Private Function InstallCacheODBC() As Boolean
        Dim regKey As RegistryKey = Registry.LocalMachine
        'проверяем установлен ли драйвер ODBC для Cache
        If regKey.OpenSubKey(Me.ODBC_DRIVER_REG_KEY) Is Nothing Then
            'если нет, то устанавливаем
            Dim url$ = Me.GetInstPath + "\bin\ODBCDriver.exe"
            Return StartProcess(url)
        End If
        regKey.Close()
        Return True

    End Function

    

    'ппрописывание DSN
    Private Sub InstallDSN()
        'создаем файл конфигурации
        If ApiSettingsUtil.CreateAPISettingsFile(GetInstPath) Then
            'если получилось, то пробуем создать источник данных (DSN)
            'CreateDSN()
        End If
    End Sub


    Private Function GetInstPath$()
        Return Path.GetDirectoryName(Me.Context.Parameters(key))
    End Function

    'создание источника данных (DSN)
    Private Sub CreateDSN()

        'создаем хеш параметров
        Dim dsnParams As Hashtable = Me.ParseDSN()
        Dim cacheParams As Hashtable = ParseCache()
        'создаем DSN
        Dim driverParams$ = "DSN=" + dsnParams("dsn") + "\0" + _
                            "Namespace=" + cacheParams("ns") + "\0" + _
                            "Password=" + dsnParams("pas") + "\0" + _
                            "Host=" + cacheParams("tcp") + "\0" + _
                            "Port=" + cacheParams("port") + "\0" + _
                            "UID=" + dsnParams("usrn") + "\0"
        ' MsgBox(driverparams)
        'Host (IP Address)  Port  User Name
        Dim res As Boolean = SQLConfigDataSource(IntPtr.Zero, ODBC_ADD_DSN, ODBC_DRIVER, driverParams)
    End Sub

    'создание хеша параметров
    Private Function ParseDSN() As Hashtable
        'получаем из созданного файла конфинурации параметры соединения через ODBC
        Dim dsn$ = GetConStr("odbc")
        Dim ht As New Hashtable

        Dim ind% = dsn.IndexOf("dsn=") + "dsn=".Length
        ht("dsn") = dsn.Substring(ind, dsn.IndexOf(";", ind) - ind)

        ind = dsn.IndexOf("uid=") + "uid=".Length
        ht("usrn") = dsn.Substring(ind, dsn.IndexOf(";", ind) - ind)

        ind = dsn.IndexOf("pwd=") + "pwd=".Length
        ht("pas") = dsn.Substring(ind, dsn.Length - ind)

        Return ht
    End Function

    Private Function ParseCache() As Hashtable

        Dim cache$ = GetConStr("con_tcp_ip")
        Dim ht As New Hashtable

        Dim ind% = cache.IndexOf("cn_iptcp:") + "cn_iptcp:".Length
        ht("tcp") = cache.Substring(ind, cache.IndexOf("[", ind) - ind)

        ind = cache.IndexOf("[") + "[".Length
        ht("port") = cache.Substring(ind, cache.IndexOf("]", ind) - ind)

        ind = cache.IndexOf("]:") + "]:".Length
        ht("ns") = cache.Substring(ind, cache.Length - ind)

        Return ht
    End Function


    Private Function GetConStr(ByVal root$)
        Dim f$ = Me.GetInstPath + "\ApiSettings.xml"
        Return GetXmlFileTagValue(f, root)
    End Function

    'зчитування значення елемента xml-файлу
    Public Shared Function GetXmlFileTagValue(ByVal XmlFile$, ByVal Tag$) As String
        Dim xmlDoc As New Xml.XmlDocument
        Dim ln As Xml.XmlNodeList
        Try
            xmlDoc.Load(XmlFile)
            ln = xmlDoc.GetElementsByTagName(Tag)
            Return Trim(ln.Item( 0 ).ChildNodes.Item( 0 ).Value)
        Catch

        End Try
    End Function




End Class

 Private Function StartProcess(ByVal url$) As Boolean
        Dim si As New ProcessStartInfo(url)
        Return Me.StartProcess(si)
    End Function