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 ' Настройки приложения Private oConfigFile As New IniFile ' Процесс winvnc.exe Private VNCProc As Process = Nothing ''' ''' Инициализация приложения ''' ''' ''' 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 ' Генерируем 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 Return True End Function Public Function StopVNC() As Boolean If VNCProc IsNot Nothing And VNCProc.Id <> 0 Then VNCProc. End If End Function 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 Return pwd Dim rndGen As New System.Random Return (rndGen.Next(1000, 10000).ToString) End Function End Module