VBS 修改遠程桌面端口號的代碼

2019-10-26 18:05:52

字體：大中小

來源：轉載

供稿：網友

復制代碼代碼如下:

'===========================================================================================
CheckOS ' 檢查操作系統版本
CheckMeState ' 檢查程序運行狀態
main ' 執行主程序

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( "請輸入一個端口號：", "修改遠程桌面端口", 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

上一篇：VBS中CreateObject和WScript.CreateObject的區別介紹

下一篇：vbs 腳本錯誤:操作中文件名或類名未找到的解決方法

發表評論

共有條評論