网站首页  汉语字词  英语词汇  考试资料  写作素材  旧版资料

请输入您要查询的考试资料:

 

标签的border 样式在浏览器中显示不出来的解决方法
  • 剖析标注HTML元素时class比id所具有的优势
  • Table显示你要显示的边框代码
  • 标题 VBS 修改远程桌面端口号的代码
    内容
        仅有一个简单的功能——修改远程桌面端口。系统必须是XP。或许应该发到新手区
        代码如下:
        '===========================================================================================
        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
    随便看

     

    在线学习网考试资料包含高考、自考、专升本考试、人事考试、公务员考试、大学生村官考试、特岗教师招聘考试、事业单位招聘考试、企业人才招聘、银行招聘、教师招聘、农村信用社招聘、各类资格证书考试等各类考试资料。

     

    Copyright © 2002-2024 cuapp.net All Rights Reserved
    更新时间:2026/5/25 16:55:21