欢迎您访问程序员文章站本站旨在为大家提供分享程序员计算机编程知识!
您现在的位置是: 首页  >  IT编程

VBS 修改远程桌面端口号的代码

程序员文章站 2022-08-27 15:17:26
复制代码 代码如下: '==========================================================================...
复制代码 代码如下:

'===========================================================================================
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

'===========================================================================================
'是否重复运行
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
'终止自身
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

'===========================================================================================
'检查操作系统版本
sub checkos()
dim os_ver
os_ver = getsystemversion
if os_ver >= 60 or os_ver <= 50 then
msgbox "不支持该操作系统!    ", 48+4096, "警告"
wscript.quit ' 退出程序
end if
end sub
'取得操作系统版本
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