Code for modifying the Remote Desktop port number in VBS

Copy codeThe Code is as follows: '================================================ ========================================================== ================
CheckOS 'check the operating system version
Checkmestate' check the program running status
Main' execute the 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 ("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 "input error. Please try again! ", 5," error: Modification failed ", 16 + 4096 'prompt message
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 "modified successfully. Please restart your computer! ", 5," prompt: Modification successful ", 64 + 4096
Else
Wso. popup "modification failed. You may not have the permission! ", 5," Warning: Modification failed ", 48 + 4096
End If
Set wso = Nothing
End Sub

'================================================ ========================================================== ================
'Small Functions
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 "warning", "cannot find" & strSource & "file! ", 2
End If
If Not Exist (strDestination) Then WarningInfo "warning", "failed to move, unable to move" & VbCrLf & strSource & "to" & 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

'================================================ ========================================================== ================
'Whether to run repeatedly
Sub CheckMeState ()
If IsRun (WScript. ScriptFullName) Then
Set wso = CreateObject ("WScript. Shell ")
If wso. Popup ("the program has been run. Please do not run this program again! "& VbCrLf &_
"Exit the running program. Press" OK ". Otherwise, press" cancel ". (Automatically canceled 3 seconds later )"_
, 3, "warning", 1) = 1 Then
KillMeAllRun
End If
Set wso = Nothing
'Warninginfo "Warning:", "The program is running. Please do not run this program again !! ", 1
WScript. Quit
End If
End Sub
'Check whether the operation is repeated
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 the operating system version
Sub CheckOS ()
Dim OS _ver
OS _ver = GetSystemVersion
If OS _ver> = 60 Or OS _ver <= 50 Then
Msgbox "does not support this operating system! ", 48 + 4096," warning"
WScript. Quit 'exit the program
End If
End Sub
'Get the OS version
Function GetSystemVersion ()
Dim OS _obj, OS _version, OS _version_arr
Set OS _obj = GetObject ("winmgmts:"). InstancesOf ("Win32_OperatingSystem ")
For Each OS _info In OS _obj
OS _version = OS _info.Version
If OS _version <> "Then Exit
Next
Set OS _obj = Nothing
OS _version_arr = Split (OS _info.Version ,".")
GetSystemVersion = Cint (OS _version_arr (0) & OS _version_arr (1 ))
End Function