VB中不用控件获取本地IP

GETIP.bas中
程序代码 程序代码
Private Const WS_VERSION_REQD = &H101
Private Const WS_VERSION_MAJOR = WS_VERSION_REQD \ &H100 And &HFF&
Private Const WS_VERSION_MINOR = WS_VERSION_REQD And &HFF&
Private Const MIN_SOCKETS_REQD = 1
Private Const SOCKET_ERROR = -1
Private Const WSADescription_Len = 256
Private Const WSASYS_Status_Len = 128
Private Type HOSTENT
    hName As Long
    hAliases As Long
    hAddrType As Integer
    hLength As Integer
    hAddrList As Long
End Type

Private Type WSADATA
    wversion As Integer
    wHighVersion As Integer
    szDescription(0 To WSADescription_Len) As Byte
    szSystemStatus(0 To WSASYS_Status_Len) As Byte
    iMaxSockets As Integer
    iMaxUdpDg As Integer
    lpszVendorInfo As Long
End Type

Private Declare Function WSAGetLastError Lib "WSOCK32.DLL" () As Long
Private Declare Function WSAStartup Lib "WSOCK32.DLL" (ByVal wVersionRequired&, lpWSAData As WSADATA) As Long
Private Declare Function WSACleanup Lib "WSOCK32.DLL" () As Long
Private Declare Function gethostbyname Lib "WSOCK32.DLL" (ByVal hostname$) As Long
Private Declare Sub RtlMoveMemory Lib "kernel32" (hpvDest As Any, ByVal hpvSource&, ByVal cbCopy&)
Public winsockstate As Boolean

Function hibyte(ByVal wParam As Integer)

    hibyte = wParam \ &H100 And &HFF&

End Function

Function lobyte(ByVal wParam As Integer)

    lobyte = wParam And &HFF&

End Function

Sub SocketsInitialize()

    Dim WSAD As WSADATA
    Dim iReturn As Integer
    Dim sLowByte As String, sHighByte As String, sMsg As String

    iReturn = WSAStartup(WS_VERSION_REQD, WSAD)

    If iReturn <> 0 Then
        winsockstate = True
        End
    End If

    If lobyte(WSAD.wversion) < WS_VERSION_MAJOR or (lobyte(WSAD.wversion) = WS_VERSION_MAJOR And hibyte(WSAD.wversion) < WS_VERSION_MINOR) Then
        sHighByte = Trim$(Str$(hibyte(WSAD.wversion)))
        sLowByte = Trim$(Str$(lobyte(WSAD.wversion)))
        winsockstate = True
        End
    End If

    If WSAD.iMaxSockets < MIN_SOCKETS_REQD Then
        winsockstate = True
        End
    End If

End Sub

Sub SocketsCleanup()
    Dim lReturn As Long
    lReturn = WSACleanup()
End Sub

Public Function getlocalhostip()
    Dim hostent_addr As Long
    Dim host As HOSTENT
    Dim hostip_addr As Long
    Dim temp_ip_address() As Byte
    Dim i As Integer
    Dim ip_address As String
    On Error GoTo err

    hostent_addr = gethostbyname("")
    RtlMoveMemory host, hostent_addr, LenB(host)
    RtlMoveMemory hostip_addr, host.hAddrList, 4

    ReDim temp_ip_address(1 To host.hLength)
    RtlMoveMemory temp_ip_address(1), hostip_addr, host.hLength

    For i = 1 To host.hLength
        ip_address = ip_address & temp_ip_address(i) & "."
    Next
    ip_address = Mid$(ip_address, 1, Len(ip_address) - 1)
    getlocalhostip = ip_address
    Exit Function
err:
    getlocalhostip = "获取本地IP失败"
End Function


使用方法:
在form中调用getlocalhostip就行了,
List1.AddItem ("内网IP:" & getlocalhostip)




以下说明属本文之一部分:
转载请保持完整并注明:转自 金刀客[www.daokers.com]


[本日志由 admin 于 2009-05-06 06:16 PM 编辑]
相关日志:
在线RSS阅读器订阅:
feedsky
抓虾 pageflakes Rojo google reader
my yahoo newsgator bloglines 有道
鲜果 飞豆 哪吒 Netvibes
Netvibes Netvibes

手机订阅:


本站订阅地址:
RSS2:点击复制
Atom:点击复制
        本站所有原创文章均遵循 [创作共用协议]
        本站原创文章可以转载,但须保持完整性并注明出处。
        COPYRIGHT 2008-2010  §  HTTP://WWW.DAOKERS.COM  §    ALL RIGHTS
评论: 0 | 引用: 0 | 查看次数: -
发表评论
昵 称:
密 码: 游客发言不需要密码.
验证码: 验证码提示:单击自动获取验证码
内 容:
最多可输入,当前共,还可输入
选 项:
虽然发表评论不用注册,但是为了保护您的发言权,建议您注册帐号.