Browse Source

Переписал сервисные функции. Файл Servicec.vb переименован в LVNC-RS-Svc.vb.

Модуль Services переименован в Svc. Жобавлена функция инициализации, функция запуска winvnc.exe (пока только в качестве приложения).
master
cyrax 6 years ago
parent
commit
34564361ba
  1. 2
      LVNC-RS/IniFile.vb
  2. 255
      LVNC-RS/LVNC-RS-Svc.vb
  3. 2
      LVNC-RS/LVNC-RS.vbproj
  4. 158
      LVNC-RS/Services.vb
  5. 78
      LVNC-RS/frmLVNC-RS-Main.vb

2
LVNC-RS/IniFile.vb

@ -89,7 +89,7 @@ Public Class IniFile
oWriter.WriteLine(String.Format("{0}={1}", k.Name, k.Value))
Else
Trace.WriteLine(String.Format("Writing Key: {0}", k.Name))
oWriter.WriteLine(String.Format("{0}", k.Name))
oWriter.WriteLine(String.Format("{0}=", k.Name))
End If
Next
Next

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

@ -0,0 +1,255 @@
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
' Настройки приложения
Private oConfigFile As New IniFile
' Процесс winvnc.exe
Private VNCProc As Process = Nothing
''' <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
' Генерируем 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

2
LVNC-RS/LVNC-RS.vbproj

@ -114,7 +114,7 @@
<DependentUpon>Settings.settings</DependentUpon>
<DesignTimeSharedInput>True</DesignTimeSharedInput>
</Compile>
<Compile Include="Services.vb" />
<Compile Include="LVNC-RS-Svc.vb" />
</ItemGroup>
<ItemGroup>
<EmbeddedResource Include="frmLVNC-RS-Main.resx">

158
LVNC-RS/Services.vb

@ -1,158 +0,0 @@
Module Services
Private sRunTimeDir As String = getRunTimeDir() & "\LVNC-RS"
Private oConfigFile As New IniFile
Public sSupportID As String = String.Empty
Public sSupportPasswd As String = String.Empty
Public byProxyStatus As Byte = 0
Public sProxyHost As String = String.Empty
Public sProxyPort As String = String.Empty
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"}
}
Private Function getRunTimeDir() As String
Dim sRegShellPath As String = "Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders"
Dim sAllUsersDir As String
Dim regKey As Global.Microsoft.Win32.RegistryKey
Dim sCommonDesktop As String
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
Public Sub checkRunTimeComponents()
Dim resItem As Object
Dim resContent As Byte()
With My.Computer.FileSystem
If Not .DirectoryExists(sRunTimeDir) Then
.CreateDirectory(sRunTimeDir)
End If
If Not .DirectoryExists(sRunTimeDir & "\UltraVNC") Then
.CreateDirectory(sRunTimeDir & "\UltraVNC")
End If
For i As Integer = 0 To UBound(aExecResources)
resItem = My.Resources.ResourceManager.GetObject(aExecResources(i, 0))
If TypeOf (resItem) Is String Then
resContent = System.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
Next
End With
oConfigFile.Load(sRunTimeDir & "\lvnc_rs.ini")
sProxyHost = oConfigFile.GetKeyValue("repeater", "host")
sProxyPort = oConfigFile.GetKeyValue("repeater", "serverport")
End Sub
Public Sub getSupportID()
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
sSupportID = iID.ToString
End Sub
Public Sub getSupportPasswd()
Dim rndGen As New System.Random
sSupportPasswd = rndGen.Next(1000, 10000).ToString
End Sub
Public Sub checkProxy(ByRef sHost As String, ByRef sPort As String)
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(sHost)
Catch ex As Exception
byProxyStatus = 2
Exit Sub
End Try
If hostEntry.AddressList.Count > 0 Then
ipAddress = hostEntry.AddressList.FirstOrDefault
epHost = New Net.IPEndPoint(ipAddress, Convert.ToInt32(sPort))
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
byProxyStatus = 1
Else
byProxyStatus = 2
End If
socket.Disconnect(False)
End Sub
End Module

78
LVNC-RS/frmLVNC-RS-Main.vb

@ -1,26 +1,44 @@
Public Class frmLVNCRSMain
Private Sub frmLVNCRSMain_Load(sender As Object, e As EventArgs) Handles Me.Load
Services.checkRunTimeComponents()
Services.getSupportID()
Services.getSupportPasswd()
Services.checkProxy(Services.sProxyHost, Services.sProxyPort)
txtLVNCSupportID.Text = String.Empty
txtLVNCSupportPasswd.Text = String.Empty
tsButtonRunAs.Image = Nothing
tsLabelSrvStatus.Image = Nothing
tsLabelSrvStatus.Text = "Подготовка..."
End Sub
If My.User.IsInRole(ApplicationServices.BuiltInRole.Administrator) Then
tsButtonRunAs.Image = Global.LVNC_RS.My.Resources.is_admin_on
Else
tsButtonRunAs.Image = Global.LVNC_RS.My.Resources.is_admin_off
End If
Private Sub frmLVNCRSMain_Shown(sender As Object, e As EventArgs) Handles Me.Shown
Me.Show()
Me.Refresh()
If Services.byProxyStatus = 1 Then
tsLabelSrvStatus.Image = Global.LVNC_RS.My.Resources.online
Else
tsLabelSrvStatus.Image = Global.LVNC_RS.My.Resources.offline
End If
If Svc.Init() Then
tsLabelSrvStatus.Text = String.Empty
Svc.CheckProxy()
'If My.User.IsInRole(ApplicationServices.BuiltInRole.Administrator) Then
' tsButtonRunAs.Image = Global.LVNC_RS.My.Resources.is_admin_on
'Else
' tsButtonRunAs.Image = Global.LVNC_RS.My.Resources.is_admin_off
'End If
If Svc.bProxyStatus = 1 Then
tsLabelSrvStatus.Image = My.Resources.online
txtLVNCSupportID.Text = Format(Convert.ToInt32(Svc.sSupportID), "### ### ##0")
txtLVNCSupportPasswd.Text = Svc.sSupportPasswd
txtLVNCSupportID.Text = Format(Convert.ToInt32(Services.sSupportID), "### ### ##0")
txtLVNCSupportPasswd.Text = Services.sSupportPasswd
Svc.StartVNC()
Else
tsLabelSrvStatus.Image = My.Resources.offline
tsLabelSrvStatus.Text = "Не готов! Проверьте подключение к сети."
End If
tCheckTimer.Enabled = True
tCheckTimer.Enabled = True
Else
MsgBox("ОЙ! Что-то пошло не так...", MsgBoxStyle.Critical)
Application.Exit()
End If
End Sub
Private Sub tsButtonRunAs_Click(sender As Object, e As EventArgs) Handles tsButtonRunAs.Click
@ -52,21 +70,23 @@
'Application.Exit()
End Sub
Private Sub frmLVNCRSMain_Shown(sender As Object, e As EventArgs) Handles Me.Shown
Me.Show()
Dim sProxy As String = "digital-freak.ru"
Dim sport As String = "5900"
Services.checkProxy(sProxy, sport)
End Sub
Private Sub tCheckTimer_Tick(sender As Object, e As EventArgs) Handles tCheckTimer.Tick
Services.checkProxy(Services.sProxyHost, Services.sProxyPort)
Dim bProxyOldStatus As Byte = Svc.bProxyStatus
Svc.CheckProxy()
If Services.byProxyStatus = 1 Then
tsLabelSrvStatus.Image = Global.LVNC_RS.My.Resources.online
If Svc.bProxyStatus = 1 Then
tsLabelSrvStatus.Image = My.Resources.online
tsLabelSrvStatus.Text = String.Empty
txtLVNCSupportID.Text = Format(Convert.ToInt32(Svc.sSupportID), "### ### ##0")
txtLVNCSupportPasswd.Text = Svc.sSupportPasswd
Else
tsLabelSrvStatus.Image = Global.LVNC_RS.My.Resources.offline
tsLabelSrvStatus.Image = My.Resources.offline
If bProxyOldStatus = 1 Then
tsLabelSrvStatus.Text = "Ошибка! Проверьте подключение к сети."
Else
tsLabelSrvStatus.Text = "Не готов! Проверьте подключение к сети."
End If
End If
End Sub
End Class

Loading…
Cancel
Save