modmain.bas

对NAT有详细的总结分析

Attribute VB_Name = "modMain"
Public unatRouter As NATUPNPLib.UPnPNAT

Public strUnableResolveExtIP As String

'应用程序入口
Public Sub Main()
    Set unatRouter = New UPnPNAT
    strUnableResolveExtIP = "<Unable to resolve external IP>"
        
    mdiMain.Show
End Sub

'获得NAT外网地址
Public Function GetExternalIP() As String
    On Error GoTo DealError
    Dim lMapper As NATUPNPLib.IStaticPortMappingCollection
    Set lMapper = unatRouter.StaticPortMappingCollection
    Dim lMappedPort As NATUPNPLib.IStaticPortMapping
    Dim lExtIP As String
        
    If Not lMapper Is Nothing Then
        For Each lMappedPort In lMapper
            lExtIP = lMappedPort.ExternalIPAddress
            Exit For
        Next
        GetExternalIP = lExtIP
    Else
        GetExternalIP = strUnableResolveExtIP
    End If
    Exit Function
DealError:
    GetExternalIP = strUnableResolveExtIP
    ErrorPrint (Err.Number)
End Function

'设置NAT的端口映射，以让外网客户端主动访问内网客户端某服务/端口
Public Function SetExternalPort(lngExtPort As Long, strProtocol As String, lngInPort As Long, strInClient As String, blnEnable As Boolean, strDescription As String) As Boolean
    On Error GoTo DealError
    Dim lMapper As NATUPNPLib.IStaticPortMappingCollection
    Set lMapper = unatRouter.StaticPortMappingCollection
    Dim lMappedPort As NATUPNPLib.IStaticPortMapping
    Dim t As NATUPNPLib.IStaticPortMapping
    If Not lMapper Is Nothing Then
        Set lMappedPort = lMapper.Add(lngExtPort, strProtocol, lngInPort, strInClient, blnEnable, strDescription)
        SetExternalPort = True
    Else
        SetExternalPort = False
    End If
    Exit Function
DealError:
    SetExternalPort = False
    ErrorPrint (Err.Number)
End Function

'取消NAT的某端口映射
Public Function DeleteExternalPort(lngExtPort As Long, strProtocol As String) As Boolean
    On Error GoTo DealError
    Dim blnDeleted As Boolean
    blnDeleted = False
    DeleteExternalPort = True
    
    Dim lMapper As NATUPNPLib.IStaticPortMappingCollection
    Set lMapper = unatRouter.StaticPortMappingCollection
    Dim lMappedPort As NATUPNPLib.IStaticPortMapping
    
    
    If Not lMapper Is Nothing Then
        For Each lMappedPort In lMapper
            If lMappedPort.ExternalPort = lngExtPort And lMappedPort.Protocol = strProtocol Then
                lMapper.Remove lngExtPort, strProtocol
                blnDeleted = True
                Exit For
            End If
        Next
    Else
        DeleteExternalPort = False
    End If
    If blnDeleted = False Then
        MsgBox "无此外网端口映射，不需删除"
        DeleteExternalPort = True
    End If
    Exit Function
DealError:
    DeleteExternalPort = False
    ErrorPrint (Err.Number)
End Function