module1.bas

用 VB 写的对云台进行控制

Attribute VB_Name = "modPublic"

Option Explicit
'***********************************************
'声明
'***********************************************
'指定下述一个或多个标志 (用OR运算符合并到一起)
'强迫中止没有响应的进程
Public Const EWX_FORCE = 4
'中止进程，然后注销
Public Const EWX_LOGOFF = 0
'关掉系统电源（如果可能的话，ATX电源就可以）
Public Const EWX_SHUTDOWN = 1
'重新引导系统
Public Const EWX_REBOOT = 2
'如果可能，关掉电源
Public Const EWX_POWEROFF = 8

'***********************************************
'声明重启动Windows的函数
'***********************************************
Private Declare Function SHRestartSystemMB Lib "shell32" Alias "#59" (ByVal hOwner As Long, ByVal sExtraPrompt As String, ByVal uFlags As Long) As Long
Private Declare Function GetActiveWindow Lib "user32" () As Long            'Use Me.hwnd in VB
'***********************************************
'声明引用winio.dll中的函数
'***********************************************
Declare Function InstallWinIoDriver Lib "winio.dll" (ByRef pszWinIoDriverPath As String, ByVal IsDemandLoaded As Boolean) As Boolean

Declare Function InitializeWinIo Lib "winio.dll" () As Boolean

Declare Function SetPortVal Lib "winio.dll" (ByVal wPortAddr As Integer, ByVal dwPortVal As Integer, ByVal bSize As Byte) As Boolean

Declare Sub ShutdownWinIo Lib "winio.dll" ()
Declare Sub RemoveWinIoDriver Lib "winio.dll" ()
'***********************************************
'声明结束
'***********************************************

'********************************************************
'功能：提示用户系统设置更新后是否重新启动系统
'      用户点击“是”则重新启动，“否”不重新启动，
'      无选则等待15秒后自动重启
'参数：[sExtraMessage]  显示组户的额外信息
'      [lMode]          以EWX_开头的常量
'*********************************************************
Function SystemUpdatedRestart(Optional ByVal sExtraMessage As String = vbNullString, Optional lMode As Long = EWX_LOGOFF) As Long
    On Error Resume Next
    If Len(sExtraMessage) Then
        'Format and convert extra message
        If Right$(sExtraMessage, 2) <> vbNewLine Then
            sExtraMessage = sExtraMessage & vbNewLine & vbNewLine
        End If
        sExtraMessage = StrConv(sExtraMessage, vbUnicode)
    End If
    SystemUpdatedRestart = SHRestartSystemMB(GetActiveWindow, sExtraMessage, EWX_FORCE + lMode)
    On Error GoTo 0
End Function

'***********************************************
'功能：将一个字节形的数转换为二进制数，以字符串形式返回
'***********************************************
Public Function CBin(ByVal Number As Byte) As String
    Dim temp As Byte
    '将1置于一个字节的首位
    temp = &H80
    
    Do Until temp < 1
        If Number >= temp Then  'Number在此位为1
           CBin = CBin + "1"
           Number = Number - temp
        Else                    'Number在此位为0
            CBin = CBin + "0"
        End If
        temp = temp / 2 'temp 所表示的1右移
    Loop '循环直到1从一个字节右端移出去
End Function

'***********************************************
'功能：将一个以字符串形式表示的二进制数转换为十进制数
'***********************************************
Public Function CDecFromBin(ByVal xBin As String) As Integer
    Dim i As Integer
    Dim res As Integer
    res = 0
    '逐位计算得到
    For i = 1 To Len(xBin)
        res = res * 2 + CByte(Mid(xBin, i, 1))
    Next i
    CDecFromBin = res
End Function