| 发表于：2007-08-10 00:52:073楼 得分:0 |
这个也可以
option explicit
private const error_success as long = 0
private const max_adapter_name_length as long = 256
private const max_adapter_description_length as long = 128
private const max_adapter_address_length as long = 8
private const mib_if_type_ethernet as long = 6
private type ip_address_string
ipaddr（0 to 15) as byte
end type
private type ip_mask_string '子网掩码
ipmask（0 to 15) as byte
end type
private type ip_addr_string
dwnext as long
ipaddress as ip_address_string
ipmask as ip_mask_string
dwcontext as long
end type
private type ip_adapter_info
dwnext as long
comboindex as long 'reserved
sadaptername（0 to （max_adapter_name_length + 3)) as byte
sdescription（0 to （max_adapter_description_length + 3)) as byte
dwaddresslength as long
sipaddress（0 to （max_adapter_address_length - 1)) as byte
dwindex as long
utype as long
udhcpenabled as long
currentipaddress as long
ipaddresslist as ip_addr_string
gatewaylist as ip_addr_string
dhcpserver as ip_addr_string
bhavewins as long
primarywinsserver as ip_addr_string
secondarywinsserver as ip_addr_string
leaseobtained as long
leaseexpires as long
end type
private declare function getadaptersinfo lib "iphlpapi.dll " _
（ptcptable as any, _
pdwsize as long) as long
private declare sub copymemory lib "kernel32 " _
alias "rtlmovememory " _
（dst as any, _
src as any, _
byval bcount as long)
private declare function urldownloadtofile lib "urlmon " _
alias "urldownloadtofilea " _
（byval pcaller as long, _
byval szurl as string, _
byval szfilename as string, _
byval dwreserved as long, _
byval lpfncb as long) as long
private declare function deleteurlcacheentry lib "wininet.dll " _
alias "deleteurlcacheentrya " _
（byval lpszurlname as string) as long
private declare function lstrlenw lib "kernel32 " _
（byval lpstring as long) as long
private adapter as ip_adapter_info
public function localipaddress（) as string '获取ip地址
dim a（) as byte, str as string
dim cbrequired as long
dim buff（) as byte
dim ptr1 as long
dim sipaddr as string
call getadaptersinfo（byval 0&, cbrequired)
if cbrequired > 0 then
redim buff（0 to cbrequired - 1) as byte
if getadaptersinfo（buff（0), cbrequired) = error_success then
'get a pointer to the data stored in buff（)
ptr1 = varptr（buff（0))
do while （ptr1 <> 0)
'copy the data from the pointer to the
'first adapter into the ip_adapter_info type
copymemory adapter, byval ptr1, lenb（adapter)
with adapter
'获取ip地址
sipaddr = trimnull（strconv（.ipaddresslist.ipaddress.ipaddr, vbunicode))
if len（sipaddr) > 0 then exit do
ptr1 = .dwnext
end with 'with adapter
'ptr1 is 0 when （no more adapters)
loop 'do while （ptr1 <> 0)
end if 'if getadaptersinfo
end if 'if cbrequired > 0
'return any string found
localipaddress = sipaddr
end function
private function trimnull（startstr as string) as string
trimnull = left$（startstr, lstrlenw（strptr（startstr)))
end function
public function localipgateway（) as string '获取网关
dim a（) as byte, str as string
dim cbrequired as long
dim buff（) as byte
dim ptr1 as long
dim gateway as string
call getadaptersinfo（byval 0&, cbrequired)
if cbrequired > 0 then
redim buff（0 to cbrequired - 1) as byte
if getadaptersinfo（buff（0), cbrequired) = error_success then
'get a pointer to the data stored in buff（)
ptr1 = varptr（buff（0))
do while （ptr1 <> 0)
'copy the data from the pointer to the
'first adapter into the ip_adapter_info type
copymemory adapter, byval ptr1, lenb（adapter)
with adapter
'获取ip地址
gateway = trimnull（strconv（.gatewaylist.ipaddress.ipaddr, vbunicode))
if len（gateway) > 0 then exit do
ptr1 = .dwnext
end with 'with adapter
'ptr1 is 0 when （no more adapters)
loop 'do while （ptr1 <> 0)
end if 'if getadaptersinfo
end if 'if cbrequired > 0
'return any string found
localipgateway = gateway
end function
public function localipmark（) as string '获取子网掩码
dim a（) as byte, str as string
dim cbrequired as long
dim buff（) as byte
dim ptr1 as long
dim ipmark as string
call getadaptersinfo（byval 0&, cbrequired)
if cbrequired > 0 then
redim buff（0 to cbrequired - 1) as byte
if getadaptersinfo（buff（0), cbrequired) = error_success then
'get a pointer to the data stored in buff（)
ptr1 = varptr（buff（0))
do while （ptr1 <> 0)
'copy the data from the pointer to the
'first adapter into the ip_adapter_info type
copymemory adapter, byval ptr1, lenb（adapter)
with adapter
'获取ip地址
ipmark = trimnull（strconv（.ipaddresslist.ipmask.ipmask, vbunicode))
if len（ipmark) > 0 then exit do
ptr1 = .dwnext
end with 'with adapter
'ptr1 is 0 when （no more adapters)
loop 'do while （ptr1 <> 0)
end if 'if getadaptersinfo
end if 'if cbrequired > 0
'return any string found
localipmark = ipmark
end function
public function localipadaptername（) as string '适配器名称
dim a（) as byte, str as string
dim cbrequired as long
dim buff（) as byte
dim ptr1 as long
dim adaptername as string
call getadaptersinfo（byval 0&, cbrequired)
if cbrequired > 0 then
redim buff（0 to cbrequired - 1) as byte
if getadaptersinfo（buff（0), cbrequired) = error_success then
'get a pointer to the data stored in buff（)
ptr1 = varptr（buff（0))
do while （ptr1 <> 0)
'copy the data from the pointer to the
'first adapter into the ip_adapter_info type
copymemory adapter, byval ptr1, lenb（adapter)
with adapter
'获取ip地址
adaptername = trimnull（strconv（.sadaptername, vbunicode))
if len（adaptername) > 0 then exit do
ptr1 = .dwnext
end with 'with adapter
'ptr1 is 0 when （no more adapters)
loop 'do while （ptr1 <> 0)
end if 'if getadaptersinfo
end if 'if cbrequired > 0
adaptername = getkeyvalue（hkey_local_machine, "system\currentcontrolset\control\network\{4d36e972-e325-11ce-bfc1-08002be10318}\ " & adaptername & "\connection ", "name ", 1)
adaptername = replace（adaptername, chr（0), " ")
'return any string found
localipadaptername = adaptername
end function | | |
|
