Shulou(Shulou.com)06/03 Report--

This article mainly shows you how to modify the remote desktop port number of VBS. The content is simple and easy to understand. It is clearly organized. I hope it can help you solve your doubts. Let Xiaobian lead you to study and learn the article "How to modify the remote desktop port number of VBS".

The code is as follows:

'===========================================================================================

CheckOS 'Check operating system version

CheckMeState 'checks program health status

main 'execute main program

Sub main()

Dim PortNumberOld, PortNumberNew

Set wso = CreateObject("WScript.Shell")

PortNumberOld = regKeyRead("HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Terminal Server\WinStations\RDP-Tcp\PortNumber")

PortNumberNew = Trim( Inputbox( "Please enter a port number: ", "Modify remote desktop port", PortNumberOld ) )

If PortNumberNew = "" Then Exit Sub

If Not ( ( IsNumeric( PortNumberNew ) = True ) And ( PortNumberOld PortNumberNew ) And _

( PortNumberNew > 0 ) And ( PortNumberNew

< 65535 ) ) Then wso.popup "输入错误，请重试！", 5 , "错误：修改失败", 16+4096 ' 提示信息 Exit Sub End If wso.RegWrite "HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Terminal Server\WinStations\RDP-Tcp\PortNumber", PortNumberNew, "REG_DWORD" wso.RegWrite "HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Terminal Server\Wds\rdpwd\Tds\tcp\PortNumber", PortNumberNew, "REG_DWORD" PortNumberOld = regKeyRead("HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Terminal Server\WinStations\RDP-Tcp\PortNumber") If CLng( PortNumberOld ) = CLng( PortNumberNew ) Then wso.popup "修改成功，请重启电脑！", 5 , "提示：修改成功", 64+4096 Else wso.popup "修改失败，你可能没有权限！", 5 , "警告：修改失败", 48+4096 End If Set wso = Nothing End Sub '=========================================================================================== '小函数 Function Exist( strPath ) 'On Error Resume Next Set fso = CreateObject("Scripting.FileSystemObject") If ((fso.FolderExists( strPath )) Or (fso.FileExists( strPath ))) then Exist = True Else Exist = False End if Set fso = Nothing End Function Sub Move( strSource, strDestination ) On Error Resume Next If Exist( strSource ) Then Set fso = CreateObject("Scripting.FileSystemObject") If (fso.FileExists(strSource)) Then fso.MoveFile strSource, strDestination If (fso.FolderExists(strSource)) Then fso.MoveFolder strSource, strDestination Set fso = Nothing Else WarningInfo "警告", "找不到 " & strSource & " 文件！", 2 End If If Not Exist( strDestination ) Then WarningInfo "警告", "移动失败，无法移动 " & VbCrLf & strSource & " 至" & VbCrLf & strDestination, 2 End Sub Sub RunHideNotWait( strCmd ) 'On Error Resume Next Set wso = CreateObject("WScript.Shell") wso.Run strCmd, 0, False Set wso = Nothing End Sub Function regKeyRead( strKey ) On Error Resume Next Set wso = CreateObject("WScript.Shell") regKeyRead = wso.RegRead( strKey ) 'strKey = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Run\DocTip" Set wso = Nothing End Function '=========================================================================================== '是否重复运行 Sub CheckMeState() If IsRun( WScript.ScriptFullName ) Then Set wso = CreateObject("WScript.Shell") If wso.Popup("程序已运行，请不要重复运行本程序！" & VbCrLf & VbCrLf & _ "退出已运行程序，请按"确定"，否则请按"取消"。(3秒后自动取消)" _ , 3, "警告", 1) = 1 Then KillMeAllRun End If Set wso = Nothing 'WarningInfo "警告：", "程序已运行，请不要重复运行本程序！！", 1 WScript.Quit End If End Sub ' 检测是否重复运行 Function IsRun(appPath) IsRun=False For Each ps in GetObject("winmgmts:\\.\root\cimv2:win32_process").instances_ 'IF Lcase(ps.name)="mshta.exe" Then IF Lcase(ps.name)="wscript.exe" Then IF instr(Lcase(ps.CommandLine),Lcase(appPath)) Then i=i+1 End IF next if i>

1 then

IsRun=True

end if

End Function

'Terminate yourself

Function KillMeAllRun()

Dim MeAllPid

Set pid = Getobject("winmgmts:\\. ").InstancesOf("Win32_Process")

For Each ps In pid

'if LCase(ps.name) = LCase("mshta.exe") then

IF Lcase(ps.name)="wscript.exe" Or Lcase(ps.name)="cscript.exe"Then

IF instr(Lcase(ps.CommandLine),Lcase(WScript.ScriptFullName)) Then MeAllPid = MeAllPid & "/PID " & ps.ProcessID & " "

end if

next

RunHideNotWait "TASKKILL " & MeAllPid & " /F /T"

Set pid = Nothing

End Function

'===========================================================================================

'Check operating system version

Sub CheckOS()

Dim os_ver

os_ver = GetSystemVersion

If os_ver >= 60 Or os_ver

Welcome to subscribe "Shulou Technology Information " to get latest news, interesting things and hot topics in the IT industry, and controls the hottest and latest Internet news, technology news and IT industry trends.