LVNC-RS/LVNC-RS/LVNC-RS-Svc.vb

Module Svc
    ' Каталог исполняемых файлов UltraVNC
    Private sRunTimeDir As String = String.Empty

    ' Исполняемые и конфигурационные файлы UltraVNC
    ' В процессе инициализации распаковываются из ресурсов приложения в <sRunTimeDir>
    Private aExecResources(,) As String = {
        {"lvnc_rs_ini", "\lvnc_rs.ini"},
        {"ultravnc_ini", "\UltraVNC\ultravnc.ini"},
        {"setpasswd_exe", "\UltraVNC\setpasswd.exe"},
        {"winvnc_exe", "\UltraVNC\winvnc.exe"},
        {"authadmin_dll", "\UltraVNC\authadmin.dll"},
        {"ddengine_dll", "\UltraVNC\ddengine.dll"},
        {"SCHook_dll", "\UltraVNC\SCHook.dll"},
        {"vnchooks_dll", "\UltraVNC\vnchooks.dll"},
        {"SecureVNCPlugin_dsm", "\UltraVNC\SecureVNCPlugin.dsm"}
    }

    ' Адрес хоста и порт VNC-прокси
    Private sProxyHost As String = String.Empty
    Private sProxyPort As String = String.Empty

    ' ID сеанса для подключения
    Public sSupportID As String = String.Empty
    ' Пароль для подключения
    Public sSupportPasswd As String = String.Empty

    ' Флаг доступности VNC-прокси
    ' Может принимать следующие значения:
    '   0 = Неопределённое состояние (при старте приложения);
    '   1 = Прокси доступен для подключения;
    '   2 = Покси недоступен.
    Public bProxyStatus As Byte = 0

    ' Режим и права доступа
    ' Возможны следующие значения:
    ' 0 = Неопределённое состояние (при старте приложения);
    ' 1 = От имени обычного пользователя. VNC еще не запущен;
    ' 2 = От имени обычного пользователя. VNC работает в режиме приложения;
    ' 3 = От имени обычного пользователя. VNC работает как служба;
    ' 4 = От имени администратора. VNC еще не запущен;
    ' 5 = От имени администратора. VNC работает как служба;
    Public bExecMode As Byte = 0

    ' Настройки приложения
    Private oConfigFile As New IniFile

    ' Процесс winvnc.exe
    Private VNCProc As Process = Nothing
    Private sVNCServiceName As String = "uvnc_service"

    ''' <summary>
    '''     Инициализация приложения
    ''' </summary>
    ''' <returns>
    '''     True  - в случае успешной инициализации
    '''     False - что-то пошло не так
    ''' </returns>
    Public Function Init() As Boolean
        sRunTimeDir = GetAllUsersDir() & "\LVNC-RS"

        If sRunTimeDir.Length > 0 Then
            ' Если расположение каталога исполняемых файлов получено,
            ' проверяем его наличие на диске и, при необходимости, создаем.
            ' Так же проверяем наличие всех файлов UltraVNC. При необходимости
            ' распаковываем из ресурсов.
            If Not CheckExecResources() Then
                Return False
            End If

            ' Читаем настройки
            oConfigFile.Load(sRunTimeDir & "\lvnc_rs.ini")
            sProxyHost = oConfigFile.GetKeyValue("repeater", "host")
            sProxyPort = oConfigFile.GetKeyValue("repeater", "serverport")

            If sProxyHost.Length = 0 Or sProxyPort.Length = 0 Then Return False

            bExecMode = GetExecutionMode()

            ' Генерируем ID и пароль
            sSupportID = GetSupportID()
            sSupportPasswd = GetSupportPasswd()

            Return True
        Else
            Return False
        End If
    End Function

    Public Sub CheckProxy()
        Dim hostEntry As Net.IPHostEntry
        Dim ipAddress As Net.IPAddress
        Dim epHost As Net.IPEndPoint
        Dim socket As Net.Sockets.Socket

        Try
            hostEntry = Net.Dns.GetHostEntry(sProxyHost)
        Catch ex As Exception
            bProxyStatus = 2
            Exit Sub
        End Try

        If hostEntry.AddressList.Count > 0 Then
            ipAddress = hostEntry.AddressList.FirstOrDefault
            epHost = New Net.IPEndPoint(ipAddress, Convert.ToInt32(sProxyPort))
            socket = New Net.Sockets.Socket(Net.Sockets.AddressFamily.InterNetwork, Net.Sockets.SocketType.Stream, Net.Sockets.ProtocolType.Tcp)

            Try
                socket.Connect(epHost)
            Catch ex As Exception

            End Try
        End If

        If socket.Connected Then
            bProxyStatus = 1
        Else
            bProxyStatus = 2
        End If

        Try
            socket.Disconnect(False)
        Catch ex As Exception

        End Try
    End Sub

    Public Function StartVNC() As Boolean
        Dim sVNCDir As String = sRunTimeDir & "\UltraVNC"
        Dim sVNCExec As String = sVNCDir & "\winvnc.exe"
        Dim sVNCExecParam As String = "-autoreconnect ID:" & sSupportID & " -connect " & sProxyHost & ":" & sProxyPort & " -run"

        Dim VNCStartInfo As New ProcessStartInfo
        With VNCStartInfo
            .Arguments = sVNCExecParam
            .FileName = sVNCExec
            .UseShellExecute = True
            .WorkingDirectory = sVNCDir
        End With

        Try
            VNCProc = Process.Start(VNCStartInfo)
        Catch ex As System.ComponentModel.Win32Exception
            Return False
        End Try

        AddHandler VNCProc.Exited, AddressOf VNCProcessExited

        Return True
    End Function

    Public Sub StopVNC()
        If VNCProc IsNot Nothing And Not VNCProc.HasExited Then
            VNCProc.CloseMainWindow()
            VNCProc.WaitForExit(1000)

            If Not VNCProc.HasExited Then
                VNCProc.Kill()
            End If
        End If

        VNCProc = Nothing
        bExecMode =
    End Sub

    Private Sub VNCProcessExited(ByVal sender As Object, ByVal e As System.EventArgs)
        VNCProc.Close()
    End Sub

    Private Function GetAllUsersDir() As String
        Dim sRegShellPath As String = "Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders"
        Dim sAllUsersDir As String = String.Empty
        Dim sCommonDesktop As String = String.Empty

        Dim regKey As Global.Microsoft.Win32.RegistryKey

        Try
            regKey = Global.Microsoft.Win32.Registry.LocalMachine.OpenSubKey(sRegShellPath, False)
            sCommonDesktop = regKey.GetValue("Common Desktop")
        Catch ex As Exception
            sCommonDesktop = ""
        End Try

        If sCommonDesktop.Length > 0 Then
            Dim a() = sCommonDesktop.Split("\")
            Dim l As Integer = a.Length - 2
            ReDim Preserve a(l)

            sAllUsersDir = String.Join("\", a)
        Else
            sAllUsersDir = ""
        End If

        Return sAllUsersDir
    End Function

    Private Function CheckExecResources() As Boolean
        Dim resItem As Object
        Dim resContent As Byte()

        If Not IO.Directory.Exists(sRunTimeDir) Then
            IO.Directory.CreateDirectory(sRunTimeDir)
        End If

        If Not IO.Directory.Exists(sRunTimeDir & "\UltraVNC") Then
            IO.Directory.CreateDirectory(sRunTimeDir & "\UltraVNC")
        End If

        For i As Integer = 0 To UBound(aExecResources)
            If Not IO.File.Exists(sRunTimeDir & aExecResources(i, 1)) Then
                resItem = My.Resources.ResourceManager.GetObject(aExecResources(i, 0))
                If TypeOf (resItem) Is String Then
                    resContent = Text.Encoding.Default.GetBytes(resItem.ToString)
                Else
                    resContent = resItem
                End If

                Using file As New IO.FileStream(sRunTimeDir & aExecResources(i, 1), IO.FileMode.Create)
                    file.Write(resContent, 0, resContent.Length)
                End Using
            End If
        Next

        Return True
    End Function

    Private Function GetSupportID() As String
        ' Если ID сохранён в файле настроек, возвращаем его
        Dim sID As String = oConfigFile.GetKeyValue("lvnc", "ID")
        If sID IsNot Nothing And sID <> String.Empty Then Return sID

        ' Генерация ID на основе MAC-адреса первого доступного и активного сетевого интерфейса (Ethernet или Wi-Fi)
        Dim aNics() As Net.NetworkInformation.NetworkInterface = Net.NetworkInformation.NetworkInterface.GetAllNetworkInterfaces()
        Dim sMAC As String = String.Empty
        Dim iID As Integer = 0

        For Each nic As Net.NetworkInformation.NetworkInterface In aNics
            If (nic.NetworkInterfaceType = Net.NetworkInformation.NetworkInterfaceType.Ethernet Or
                    nic.NetworkInterfaceType = Net.NetworkInformation.NetworkInterfaceType.Wireless80211) And
                    nic.OperationalStatus = Net.NetworkInformation.OperationalStatus.Up Then
                sMAC = nic.GetPhysicalAddress.ToString
                Exit For
            End If
        Next

        Dim strBuilder As New Text.StringBuilder(sMAC)
        Dim startIndex As Integer = strBuilder.Length - (strBuilder.Length Mod 2) - 2

        For i As Integer = startIndex To 2 Step -2
            strBuilder.Insert(i, ":"c)
        Next i

        Dim aMAC() = strBuilder.ToString.Split(":")
        Dim n As Integer = 0
        For i As Integer = 0 To UBound(aMAC)
            n = Convert.ToInt32(aMAC(i), 16)
            Debug.Print(n)

            iID = ((iID * 16) + n) Mod 99999999

            If iID < 99999999 Then
                iID = iID + 10000000
            End If
        Next

        ' Сохраняем ID в конфиг
        oConfigFile.SetKeyValue("lvnc", "ID", iID.ToString)
        oConfigFile.Save(sRunTimeDir & "\lvnc_rs.ini")

        Return iID.ToString
    End Function

    Private Function GetSupportPasswd() As String
        ' Проверяем наличие сохранённого пароля на случай перезапуска от имени администратора
        Dim pwd As String = oConfigFile.GetKeyValue("lvnc", "passwd")
        If pwd IsNot Nothing And pwd <> String.Empty Then
            If bExecMode = 3 Then
                Return pwd
            End If
        End If

        Dim rndGen As New System.Random

        pwd = rndGen.Next(1000, 10000).ToString

        Dim vncSetPasswd As New ProcessStartInfo
        With vncSetPasswd
            .Arguments = pwd
            .FileName = sRunTimeDir & "\UltraVNC\setpasswd.exe"
            .UseShellExecute = True
            .WindowStyle = ProcessWindowStyle.Hidden
            .WorkingDirectory = sRunTimeDir & "\UltraVNC"
        End With

        Try
            Dim p As Process = Process.Start(startInfo)
            p.WaitForExit()
        Catch ex As System.ComponentModel.Win32Exception
            Return String.Empty
        End Try

        Return pwd
    End Function

    Private Function GetExecutionMode() As Byte
        Dim bMode As Byte = 0

        If My.User.IsInRole(ApplicationServices.BuiltInRole.Administrator) Then
            bMode = 4

            If IsServiceInstalled(sVNCServiceName) Then
                If GetServiceStatus(sVNCServiceName) = "running" Then
                    bMode = 5
                End If
            End If
        Else
            bMode = 1

            If IsServiceInstalled(sVNCServiceName) Then
                If GetServiceStatus(sVNCServiceName) = "running" Then
                    bMode = 3
                End If
            Else
                If VNCProc Is Nothing Then
                    For Each p As Process In Process.GetProcesses()
                        If p.ProcessName.Contains("winvnc") Then
                            VNCProc = p
                        End If
                    Next

                    If VNCProc IsNot Nothing Then
                        StopVNC()
                    End If
                Else
                    bMode = 2
                End If
            End If
        End If

        Return bMode
    End Function

    Private Function IsServiceInstalled(ByVal sServiceName As String) As Boolean
        Dim bResult As Boolean = False
        Dim oServiceArray() As ServiceProcess.ServiceController = ServiceProcess.ServiceController.GetServices

        For Each oServiceController As ServiceProcess.ServiceController In oServiceArray
            If oServiceController.ServiceName.Trim.ToUpper = sServiceName.Trim.ToUpper Then
                Dim i As New ServiceProcess.ServiceControllerPermissionAttribute(Security.Permissions.SecurityAction.Demand)
                Dim d As New ServiceProcess.ServiceControllerPermission
                Try
                    If d.Any Then
                        d.ToString()
                    End If
                Catch ex As Exception
                End Try

                bResult = True

                Exit For
            End If
        Next

        Return bResult
    End Function

    Public Function GetServiceStatus(ByVal sServiceName As String) As String
        Dim sStatus As String = "NA"
        Dim oWinSvc As New ServiceProcess.ServiceController

        oWinSvc.ServiceName = sServiceName

        Select Case oWinSvc.Status
            Case ServiceProcess.ServiceControllerStatus.Stopped
                sStatus = "stoped"
            Case ServiceProcess.ServiceControllerStatus.Running
                sStatus = "running"
        End Select

        Return sStatus
    End Function
End Module