module1.bas

这个文件是有关系统串口通信的实例

Attribute VB_Name = "Module1"
Option Explicit

'*******************************************************
'API常量声明部分
Public Const WSADESCRIPTION_LEN = 256
Public Const WSASYS_STATUS_LEN = 128
Public Const wVersionRequired = &H101
Public Const wMajorVersion = wVersionRequired \ &H100 And &HFF&
Public Const wMinorVersion = wVersionRequired And &HFF&

Public Const ERROR_SUCCESS = 0
Public Const AF_INET = 2    '用于inet_addr函数中，指明类型
'API常量声明结束
'*******************************************************

'*******************************************************
'API结构变量声明部分
Public Type WSAData
    wVersion As Long
    wHighVersion As Long
    szDescription(0 To WSADESCRIPTION_LEN) As Byte
    szSystemStatus(0 To WSASYS_STATUS_LEN) As Byte
    iMaxSockets As Long
    iMaxUdpDg As Long
    lpVendorInfo As Long
End Type

Public Type sockaddr
    sin_family As Integer   '地址类型，一般都是AF_INET，表示为IP地址
    sin_port As Integer     '端口号
    sin_addr As Long        'IP地址
    sin_zero As String * 8
End Type

Public Type HOSTENT
    h_name As Long          '返回主机名称
    h_aliases As Long       '主机别名
    h_addrtype As Integer   '返回IP地址类型
    h_length As Integer     '返回IP地址的长度
    h_addr_list As Long     'IP地址，以网络位顺序的形式返回
End Type
'API结构声明结束
'*******************************************************

'*******************************************************
'API函数声明部分
Public Declare Function WSAStartup Lib "wsock32.dll" _
    (ByVal wVersionRequested As Long, ByRef lpWSAData _
    As WSAData) As Long
Public Declare Function WSACleanup Lib "wsock32.dll" () As Integer
  
Public Declare Function socket Lib "wsock32.dll" (ByVal af As Integer, _
    ByVal sType As Integer, ByVal protocol As Integer) As Integer
Public Declare Function bind Lib "wsock32.dll" (ByVal s As Integer, _
    ByRef name As sockaddr, ByVal namelen As Integer) As Integer

Public Declare Function listen Lib "wsock32.dll" (ByVal s As Integer, ByVal backlog As Integer) As Integer
Public Declare Function accept Lib "wsock32.dll" (ByVal s As Integer, ByRef addr As sockaddr, _
    ByRef addrlen As Integer) As Integer
Public Declare Function recv Lib "wsock32.dll" (ByVal s As Integer, ByVal buf As Any, _
    ByVal buflen As Integer, ByVal flags As Integer) As Integer
Public Declare Function send Lib "wsock32.dll" (ByVal s As Integer, ByRef buf As Any, _
    ByVal buflen As Integer, ByVal flags As Integer) As Integer

Public Declare Function gethostname Lib "wsock32.dll" (ByVal name As String, _
    ByVal namelen As Integer) As Integer
Public Declare Function gethostbyname Lib "wsock32.dll" (ByVal name As String) As Long ' HOSTENT
Public Declare Function gethostbyaddr Lib "wsock32.dll" (ByRef buf As Long, _
    ByVal buflen As Long, ByVal sType As Long) As Long 'HOSTENT

Public Declare Sub MoveMemory Lib "kernel32" _
    Alias "RtlMoveMemory" _
    (pDest As Any, _
    ByVal pSource As Any, _
    ByVal dwLength As Long)
    
Public Declare Function inet_addr Lib "wsock32.dll" (ByVal buf As Any) As Long
'API函数声明结束
'*******************************************************

'声明公用变量
Public WSData As WSAData

Public Function WinSockInit() As Integer
    Dim iReturn As Integer

    iReturn = WSAStartup(wVersionRequired, WSData)
    
    If iReturn <> ERROR_SUCCESS Then
        MsgBox "不能使用WinSock！"
        
        WinSockInit = iReturn
        
        Exit Function
    End If
   
    '应该加入判断版本的代码
   
    WinSockInit = iReturn
End Function

Public Function GetLocalHostName() As String
    Dim sHostName As String * 256
    
    '在判断语句中执行了gethostname函数，sHostName是传址传递，已经被赋值
    If gethostname(sHostName, 256) <> ERROR_SUCCESS Then
        MsgBox "无法获取主机名！"
        GetLocalHostName = ""
        Exit Function
    End If
    GetLocalHostName = sHostName
End Function

Public Function GetIPByName(ByVal sName As String) As String
    Dim HostName As String

    Dim RemoteHost As Long  '该变量用来返回API函数的执行结果
    Dim lHostEnt As HOSTENT
    Dim InAddress As Long
    Dim IPv4() As Byte      '定义动态数组用来存放IP地址
    Dim IPAddress As String
    
    Dim i As Integer
 
    HostName = Space$(256)
    HostName = sName
    
    If sName = "" Then
        MsgBox "请输入一个主机名！"
        Exit Function
    End If

    RemoteHost = gethostbyname(HostName)
    
    If RemoteHost = 0 Then
        GetIPByName = "127.0.0.1"
        Exit Function
    Else
        '由于MSDN中，gethostbyname返回值是结构HOSTENT；而在VB声明中为Long
        '因此，在此需要进行转换
        MoveMemory lHostEnt, RemoteHost, Len(lHostEnt)
        MoveMemory InAddress, lHostEnt.h_addr_list, 4
        
        ReDim IPv4(0 To lHostEnt.h_length - 1) As Byte
        
        MoveMemory IPv4(0), InAddress, lHostEnt.h_length
        
        For i = 0 To lHostEnt.h_length - 1
            IPAddress = IPAddress & IPv4(i) & "."
        Next
        
        '传回IPV4类型的主机IP address,长度减1是减去最后一个“.”
        GetIPByName = Mid$(IPAddress, 1, Len(IPAddress) - 1)
    End If

End Function

Public Function GetNameByIp(ByVal sIp As String) As String
    Dim HostName As String
    
    Dim nIp As Long         '该变量用来获取Long型的IP地址
    Dim RemoteHost As Long
    Dim lHostEnt As HOSTENT

    HostName = Space$(256)
    
    If sIp = "" Then
        MsgBox "请输入一个IP地址！"
        Exit Function
    End If

    '注意inet_addr函数，以及MoveMemory函数
    nIp = inet_addr(sIp)
    RemoteHost = gethostbyaddr(nIp, 4, AF_INET)
    
    If RemoteHost = 0 Then
        GetNameByIp = ""
        Exit Function
    Else
        '由于MSDN中，gethostbyaddr返回值是结构HOSTENT；而在VB声明中为Long
        '因此，在此需要进行转换
        MoveMemory lHostEnt, RemoteHost, Len(lHostEnt)
        '对于字符串变量，使用ByVal关键字，避免传递指针的指针
        MoveMemory ByVal HostName, ByVal lHostEnt.h_name, 256
        
        GetNameByIp = HostName
    End If

End Function