Attribute VB_Name = "mComm32API"
'*/-------------------------------------------------------------
'*/模 塊 名:mComm32API.bas
'*/功    能:API串口打開、關閉、寫數據、讀數據等函數
'*/-------------------------------------------------------------

Option Explicit

'定義端口
Public Type COMStat
 fCtsHold As Long
 fDsrHold As Long
 fRlsdHold As Long
 fXoffHold As Long
 fXoffSent As Long
 fEof As Long
 fTxim As Long
 fReserved As Long
 cbInQue As Long
 cbOutQue As Long
End Type

'定義超時溢出
Public Type COMMTimeOuts
 ReadIntervalTimeout As Long
 ReadTotalTimeoutMultiplier As Long
 ReadTotalTimeoutConstant As Long
 WriteTotalTimeoutMultiplier As Long
 WriteTotalTimeoutConstant As Long
End Type

'定義DCB塊
Public Type DCB
 DCBlength As Long
 BaudRate As Long
 fBinary As Long
 fParity As Long
 fOutxCtsFlow As Long
 fOutxDsrFlow As Long
 fDtrControl As Long
 fDsrSensitivity As Long
 fTXContinueOnXoff As Long
 fOutX As Long
 fInX As Long
 fErrorChar As Long
 fNull As Long
 fRtsControl As Long
 fAbortOnError As Long
 fDummy2 As Long
 wReserved As Integer
 XonLim As Integer
 XoffLim As Integer
 ByteSize As Byte
 Parity As Byte
 StopBits As Byte
 XonChar As Byte
 XoffChar As Byte
 ErrorChar As Byte
 EofChar As Byte
 EvtChar As Byte
End Type

'API
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFilename As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function SetCommTimeouts Lib "kernel32" (ByVal hFile As Long, lpCommTimeouts As COMMTimeOuts) As Long
Private Declare Function GetLastError Lib "kernel32" () As Long
Private Declare Function BuildCommDCB Lib "kernel32" Alias "BuildCommDCBA" (ByVal lpDef As String, lpDCB As DCB) As Long
Private Declare Function SetCommState Lib "kernel32" (ByVal hCommDev As Long, lpDCB As DCB) As Long
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As Long) As Long
Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, lpOverlapped As Long) As Long
Private Declare Function FlushFileBuffers Lib "kernel32" (ByVal hFile As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

'端口全局變量
Public ComNum As Long
Public bRead(255) As Byte
Public statuGSM As Boolean

'*/-------------------------------------------------------------
'*/函 數 名:StartCOM32
'*/功    能:打開指定端口
'*/返 回 值:Long
'*/         1---串口號無效;
'*/         2---串口連接超時;
'*/         3---波特率設置無效(DCB無法建立);
'*/         4---波特率設置無效(DCB無法設置);
'*/         5---發送AT指令不響應(端口打開不成功);
'*/參    數:ComNumber      指定端口號
'*/         Comsettings    端口參數，波特率，數據位，停止位，奇偶校驗
'*/-------------------------------------------------------------

Public Function StartCOM32(ComNumber As String, Comsettings As String) As Long
    On Error GoTo HandelInitCOM
    Dim ComSetup As DCB, BarDCB As DCB
    Dim Answer, Stat As COMStat
    Dim CtimeOut As COMMTimeOuts
    Dim retval As Long, RetBytes As Long
    
    ComNum = CreateFile(ComNumber, &HC0000000, 0, 0&, &H3, 0, 0)
    If ComNum = -1 Then
        StartCOM32 = 1
        Exit Function
    End If
    CtimeOut.ReadIntervalTimeout = 2
    CtimeOut.ReadTotalTimeoutConstant = 1
    CtimeOut.ReadTotalTimeoutMultiplier = 1
    CtimeOut.WriteTotalTimeoutConstant = 10
    CtimeOut.WriteTotalTimeoutMultiplier = 1
    retval = SetCommTimeouts(ComNum, CtimeOut)
    If retval = -1 Then
        retval = GetLastError()
        retval = CloseHandle(ComNum)
        StartCOM32 = 2
        Exit Function
    End If
    retval = BuildCommDCB(Comsettings, BarDCB)
    If retval = -1 Then
        retval = GetLastError()
        retval = CloseHandle(ComNum)
        StartCOM32 = 3
        Exit Function
    End If
    retval = SetCommState(ComNum, BarDCB)
    If retval = -1 Then
        retval = GetLastError()
        retval = CloseHandle(ComNum)
        StartCOM32 = 4
        Exit Function
    End If
    If InStr(SendAT("AT", 5), "OK") > 0 Then
       If inDevice Then StartCOM32 = 0
    Else
       If InStr(SendAT("AT", 5), "OK") > 0 Then
          If inDevice Then StartCOM32 = 0
       Else
          StartCOM32 = -1
      End If
    End If
HandelInitCOM:
    Exit Function
End Function

'*/-------------------------------------------------------------
'*/函 數 名:ReadCOM32
'*/功    能:讀取端口返回的數據
'*/返 回 值:字符
'*/-------------------------------------------------------------
Public Function ReadCOM32() As String
    On Error GoTo HandelPureCOM
    Dim RetBytes As Long, i As Integer, ReadStr As String, retval As Long
    Dim CheckTotal As Integer, CheckDigitLC As Integer
    
    retval = ReadFile(ComNum, bRead(0), 255, RetBytes, 0)
    ReadStr = ""
    If (RetBytes > 0) Then
        For i = 0 To RetBytes - 1
            ReadStr = ReadStr & Chr(bRead(i))
        Next i
    Else
        Call FlushCOM32
    End If
    ReadCOM32 = ReadStr
HandelPureCOM:
    Exit Function
End Function

'*/-------------------------------------------------------------
'*/函 數 名:WriteCOM32
'*/功    能:向指定端口寫入數據
'*/返 回 值:整型
'*/參    數:COMString   向端口發送的指定字符
'*/-------------------------------------------------------------
Public Function WriteCOM32(COMString As String) As Integer
    On Error GoTo HandelWriteLPT
    Dim RetBytes As Long, LenVal As Long, retval As Long
    
    If Len(COMString) > 255 Then
        WriteCOM32 Left$(COMString, 255)
        WriteCOM32 Right$(COMString, Len(COMString) - 255)
        Exit Function
    End If
    For LenVal = 0 To Len(COMString) - 1
        bRead(LenVal) = Asc(Mid$(COMString, LenVal + 1, 1))
    Next LenVal
    retval = WriteFile(ComNum, bRead(0), Len(COMString), RetBytes, 0)
    WriteCOM32 = RetBytes
    
HandelWriteLPT:
    Exit Function
End Function

'*/-------------------------------------------------------------
'*/函 數 名:CloseCOM32
'*/功    能:關閉指定端口
'*/-------------------------------------------------------------
Public Function CloseCOM32()
    CloseCOM32 = CloseHandle(ComNum)
End Function

'*/-------------------------------------------------------------
'*/函 數 名:FlushCOM32
'*/功    能:關閉指定端口數據棧和清除緩沖區
'*/-------------------------------------------------------------
Public Function FlushCOM32()
    Call FlushFileBuffers(ComNum)
End Function

'*/-------------------------------------------------------------
'*/函 數 名:SendAT
'*/功    能:發送AT指令函數
'*/返 回 值:字符
'*/參    數:sAT          AT指令字符 不帶回車，程序自動加入
'*/         DeleyTime    延時值，在某些返回值需要等待，默認為5,
'*/                      讀取短信時要加大,如20
'*/-------------------------------------------------------------
Public Function SendAT(sAT As String, DeleyTime As Integer) As String
    Dim tTimeOut As Long, DataCOM32 As String
    Call WriteCOM32(sAT & vbCr)
    Pause 0.1   '寫入時延時
    DataCOM32 = DataCOM32 & ReadCOM32()
    Pause 0.1   '讀取延時
    Debug.Print DataCOM32
    tTimeOut = Timer
    DoEvents
    If InStr(DataCOM32, "ERROR") = 0 Then
      Do While Not InStr(DataCOM32, "OK") > 0
        DataCOM32 = DataCOM32 & ReadCOM32()
        If Timer > tTimeOut + DeleyTime Then
          DataCOM32 = "超時!" & vbCrLf
          Exit Do
        End If
      Loop
    End If
    Call FlushCOM32
    SendAT = DataCOM32
End Function

'*/-------------------------------------------------------------
'*/過 程 名:Pause
'*/功    能:暫停函數，延時用
'*/返 回 值:無
'*/參    數:Dauer 延時值
'*/-------------------------------------------------------------
Sub Pause(Dauer)
    Dim Start As Long
    Start = Timer
    Do While Timer < Start + Dauer
        DoEvents
    Loop
End Sub