Copy Code code as follows:
'===========================================================================================
Checkos ' Check the operating system version
Checkmestate ' Check program run 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 "input error, please try again!" ", 5," Error: Modify failed ", 16+4096 ' hint info
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 reboot the computer!" ", 5," Hint: Modification succeeded ", 64+4096
Else
Wso.popup "Modification failed, you may not have permission!" ", 5," Warning: Modify failed ", 48+4096
End If
Set WSO = Nothing
End Sub
'===========================================================================================
' Small function
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", "& strsource &" File not found! ", 2
End If
If not Exist (strdestination) Then warninginfo "Warning", "move failed, cannot move" & VbCrLf & strsource & "to" & VbCrLf &A mp 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 ("program is running, please do not run this program repeatedly!") "& VbCrLf & VbCrLf & _
"Exit the program you have run, press OK, otherwise press Cancel." (automatically cancels after 3 seconds) "_
, 3, "warning", 1 = 1 Then
Killmeallrun
End If
Set WSO = Nothing
' Warninginfo ' Warning: "," program is running, please do not run this program repeatedly!! ", 1
Wscript.Quit
End If
End Sub
' Detect whether to run repeatedly
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 all 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 >= Or os_ver <= Then
Msgbox "does not support this operating system! ", 48+4096," warning "
Wscript.Quit ' Exit program
End If
End Sub
' Get operating system 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 for
Next
Set os_obj = Nothing
Os_version_arr = Split (os_info. Version, ".")
Getsystemversion = Cint (Os_version_arr (0) & Os_version_arr (1))
End Function
