general.bas

这是一本学习串口编程喝计算机监控的好书里面是用VB开发的源代码

Attribute VB_Name = "General"
Option Explicit
'depend on StringProcess.bas
'''''''''''''''''''''''''''Components''''''''''''''''''''''''''
'                                                             '
'      Microsoft DataGrid Control 6.0(OLEDB)                  '
'      Microsoft Windows Common Controls 6.0(SP3)             '
'      Microsoft Winsock Control 6.0                          '
'      Microsoft Comm Control 6.0                             '
'      Microsoft Common Dialog Control 6.0(SP3)               '
'                                                             '
'**************************************************************

'''''''''''''''''''''''''''References''''''''''''''''''''''''''
'                                                             '
'      Microsoft ActiveX Data Objects 2.0 Library(ADO)        '
'      Microsoft Scripting Runtime(file system)               '
'      Microsoft Data Binding Collection                      '
'                                                             '
'**************************************************************

Public Const MAX_RESULT_CHARS = 16384       'must below 32K

Public Const HWND_TOPMOST As Long = -1
Public Const SWP_NOMOVE As Long = &H1
Public Const SWP_NOSIZE As Long = &H2
Public Const SND_ASYNC = &H1

'user defined type required by Shell_NotifyIcon API call
Public Type NOTIFYICONDATA
    cbSize As Long
    hWnd As Long
    uId As Long
    uFlags As Long
    uCallBackMessage As Long
    hIcon As Long
    szTip As String * 64
End Type

'constants required by Shell_NotifyIcon API call:
Public Const NIM_ADD = &H0
Public Const NIM_MODIFY = &H1
Public Const NIM_DELETE = &H2
Public Const NIF_MESSAGE = &H1
Public Const NIF_ICON = &H2
Public Const NIF_TIP = &H4
Public Const WM_MOUSEMOVE = &H200
Public Const WM_LBUTTONDOWN = &H201     'Button down
Public Const WM_LBUTTONUP = &H202       'Button up
Public Const WM_LBUTTONDBLCLK = &H203   'Double-click
Public Const WM_RBUTTONDOWN = &H204     'Button down
Public Const WM_RBUTTONUP = &H205       'Button up
Public Const WM_RBUTTONDBLCLK = &H206   'Double-click
Public Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long
Public Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean
Public nID As NOTIFYICONDATA

Public Declare Sub SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long)
Public Declare Function GetTickCount Lib "kernel32" () As Long
Public Declare Function PlaySound Lib "winmm.dll" Alias "PlaySoundA" (ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long
Public Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Public Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Public Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Public Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long

Public strHistory As String

Public Sub DisplayString(txtBox As TextBox, strData As String)
    If Len(strData) > MAX_RESULT_CHARS Then
        strHistory = strHistory + Mid(strData, 1, 4096)
        strData = Mid(strData, 4097)
    End If
    txtBox.Text = strData
    txtBox.SelStart = Len(strData)
End Sub

Public Sub SetForm(ctrlForm As Form, ctrlLeft As Integer, ctrlTop As Integer)
    ctrlForm.Left = ctrlLeft
    ctrlForm.Top = ctrlTop
End Sub

Public Function GetTimeStamp(nLine As Integer) As String
    Dim strTick As String
    Dim strTime As String
    
    strTick = "TickCount:" + Trim(Str(GetTickCount()))
    strTime = "Time: " + Format(Time, "H:MM:SS")
    GetTimeStamp = vbCrLf + strTick + " // " + strTime + String(nLine, "=") + vbCrLf
End Function

Public Function CheckTime(ByVal strSource As String) As Boolean
    'format 12:13:51 true for right
    Dim tTest As Date
    On Error GoTo ERROR_MARK
    
    tTest = CDate(strSource)
    CheckTime = True
    
ERROR_MARK:
End Function

Public Function CheckDate(ByVal strSource As String) As Boolean
    'format 2003-11-21   true for right
    Dim dTest As Date
    On Error GoTo ERROR_MARK
    
    dTest = CDate(strSource)
    CheckDate = True
  
ERROR_MARK:
End Function

Public Function CheckShortDate(ByVal strSource As String) As Boolean
    Dim strTmp As String
    
    strTmp = Mid(strSource, 1, 2) + "-" + Mid(strSource, 3, 2) + "-" + Mid(strSource, 5)
    CheckShortDate = CheckDate(Format(strTmp, "yyyy-mm-dd"))
End Function

Public Sub DelayTime(nCount As Integer)
    Dim lStart As Long
    Dim I As Integer
    
    lStart = GetTickCount
    Do While True
        If GetTickCount - lStart > nCount Then Exit Do
        I = I + 1
        I = I - 1
        DoEvents
    Loop
End Sub

Public Function MaxOfTwo(vFirst As Variant, vSecond As Variant) As Variant
    If vFirst >= vSecond Then
        MaxOfTwo = vFirst
    Else
        MaxOfTwo = vSecond
    End If
End Function

Public Function GetElapseSeconds(strOldTime As String) As String
    Dim dOld As Date
    Dim lOld As Long
    Dim lNow As Long
    
    dOld = CDate(strOldTime)
    lOld = Hour(dOld) * 3600 + Minute(dOld) * 60 + Second(dOld)
    lNow = Hour(Now) * 3600 + Minute(Now) * 60 + Second(Now)
    If lNow < lOld Then lNow = lNow + 24 * 3600
    
    GetElapseSeconds = Trim(Str(lNow - lOld))
End Function

Public Function GetMyComputerName() As String
    'need StringProcess.bas
    Dim strComputerName As String
    Dim length As Long
    Dim strTmp As String
    
    length = 255
    strComputerName = Space(length)
    GetComputerName strComputerName, length
    strTmp = GetNoString(strComputerName, " ", 0)
    GetMyComputerName = Mid(strTmp, 1, Len(strTmp) - 1)
End Function

Public Function GetMyUserName() As String
    'need StringProcess.bas
    Dim strUserName As String
    Dim length As Long
    Dim strTmp As String
    
    length = 255
    strUserName = Space(length)
    GetUserName strUserName, length
    strTmp = GetNoString(strUserName, " ", 0)
    GetMyUserName = Mid(strTmp, 1, Len(strTmp) - 1)
End Function

Public Function GetMySysDir() As String
    'need StringProcess.bas
    Dim strSystemDir As String
    Dim length As Long
    Dim strTmp As String
    
    length = 255
    strSystemDir = Space(length)
    GetSystemDirectory strSystemDir, length
    strTmp = GetNoString(strSystemDir, " ", 0)
    GetMySysDir = Mid(strTmp, 1, Len(strTmp) - 1)
End Function

Public Function GetMyWinDir() As String
    'need StringProcess.bas
    Dim strWindowsDir As String
    Dim length As Long
    Dim strTmp As String
    
    length = 255
    strWindowsDir = Space(length)
    GetWindowsDirectory strWindowsDir, length
    strTmp = GetNoString(strWindowsDir, " ", 0)
    GetMyWinDir = Mid(strTmp, 1, Len(strTmp) - 1)
End Function