Module Svc ' Каталог исполняемых файлов UltraVNC Private sRunTimeDir As String = String.Empty ' Исполняемые и конфигурационные файлы UltraVNC ' В процессе инициализации распаковываются из ресурсов приложения в 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" ''' ''' Инициализация приложения ''' ''' ''' True - в случае успешной инициализации ''' False - что-то пошло не так ''' 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