VBS 修改远程桌面端口号的代码
程序员文章站
2022-04-10 13:45:40
复制代码 代码如下: '==========================================================================...
复制代码 代码如下:
'===========================================================================================
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