ftproc.bas

Rs232串口通信专题范例,Vusual Basic,Mscomm,PCOMMPRO

Attribute VB_Name = "FtProc"
Option Explicit

Public Const FT_XMIT = 0
Public Const FT_RECV = 1

Public Const FTZMDM = 3

Public Const MAX_PATH = 260     'Win32 defined

Public GxFname As String * MAX_PATH
Public GrFname As String * MAX_PATH
Public GrPath As String * MAX_PATH

Dim G_buftab(0) As Long     ' This is received file name buffer for
                            ' ZModem & Ymodem & Kermit.
                            
Public Const GMEM_FIXED = &H0
Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (ByVal lpString1 As Long, ByVal lpString2 As String) As Long
Declare Function lstrcpyn Lib "kernel32" Alias "lstrcpynA" (ByVal lpString1 As String, ByVal lpString2 As Long, ByVal iMaxLength As Long) As Long
Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As Long) As Long


'''''''''''''''''''''''''''''''''''''''''''''''''''''
'传输回呼函式
'用以显示状态
'''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function xCallBack(ByVal xmitlen As Long, ByVal buflen As Long, ByVal buf As Long, ByVal flen As Long) As Long
    On Error Resume Next
    DoEvents
    Call Form1.RefreshState(xmitlen, flen, GxFname)
    xCallBack = 0
End Function

'''''''''''''''''''''''''''''''''''''''''''''''''''''
'接收回呼函式
'用以显示状态
'''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function rCallBack(ByVal recvlen As Long, ByVal buflen As Long, ByVal buf As Long, ByVal flen As Long) As Long
    On Error Resume Next
    DoEvents
    Call lstrcpyn(GrFname, G_buftab(0), lstrlen(G_buftab(0)) + 1)
    DoEvents
    Form1.txtReceive = App.Path & "\" & GrFname
    Call Form1.RefreshState(recvlen, flen, GrFname)
    rCallBack = 0
End Function

'''''''''''''''''''''''''''''''''''''''''''''''''''''
'传输函式
'以数值表示传送或是接收
'''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Sub FtFunc(Port As Long, Direction As Integer)
Dim ret As Long
'Direction:0  ->传送， 1-->接收
    If (Direction = 0) Then
            ret = sio_FtZmodemTx(Port, GxFname, AddressOf xCallBack, 27)
    Else
            '取得档名
            G_buftab(0) = GlobalLock(GlobalAlloc(GMEM_FIXED, MAX_PATH + 1))
            Call lstrcpy(G_buftab(0), "")
            ret = sio_FtZmodemRx(Port, G_buftab(0), 1, AddressOf rCallBack, 27)
            GlobalFree (G_buftab(0))
    End If
    If ret < 0 Then
         MsgBox "传送/接收过程失败", vbCritical + vbOKOnly, "系统警告"
    Else
        If (Direction = 0) Then
            MsgBox "传送完成!", vbInformation + vbOKOnly, "系统讯息"
        Else
            MsgBox "接收完成!", vbInformation + vbOKOnly, "系统讯息"
        End If
    End If
End Sub