Option Explicit Dim fileName As StringPrivate Sub Command1_Click() Dim strString As String, FileNo Dim sVar
If Winsock1.LocalPort = 0 Then strString = "硈钡梆絪腹﹟ゼ砞﹚" Else strString = Winsock1.LocalPort End If
Text1.Text = "眤诀嘿" & Winsock1.LocalHostName & vbCrLf Text1.Text = Text1.Text & "IP " & Winsock1.LocalIP & vbCrLf Text1.Text = Text1.Text & "硈钡梆" & strString & vbCrLf Text1.Text = Text1.Text & "硄癟﹚" & IIf(Winsock1.Protocol = 0, "TCP ﹚", "UDP ﹚") FileNo = FreeFile() Open fileName For Input As #FileNo While Not EOF(FileNo) Line Input #FileNo, sVar Text1.Text = Text1.Text & sVar & vbCrLf Wend Close #FileNoEnd SubPrivate Sub Command2_Click() Unload Me End SubPrivate Sub Form_Load()
fileName = "c:\IPDetail.txt"
Shell "command.com /c ipconfig.exe > " & fileName DoEvents Do While Trim(Dir(fileName)) = "" DoEvents LoopEnd Sub 你翻译成简体看看,以前写的繁体程序打开就这样子,无奈下 -_-#
Option ExplicitPrivate 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 = 128Private Type HOSTENT hName As Long hAliases As Long hAddrType As Integer hLength As Integer hAddrList As LongEnd 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 LongEnd 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 gethostname Lib "WSOCK32.DLL" (ByVal hostname$, HostLen&) 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&) 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 MsgBox "Winsock.dll is not responding." 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))) sMsg = "Windows Sockets version " & sLowByte & "." & sHighByte sMsg = sMsg & " is not supported by winsock.dll " MsgBox sMsg End End If If WSAD.iMaxSockets < MIN_SOCKETS_REQD Then sMsg = "This application requires a minimum of " sMsg = sMsg & Trim$(Str$(MIN_SOCKETS_REQD)) & " supported sockets." MsgBox sMsg End End If End Sub Sub SocketsCleanup() Dim lReturn As Long lReturn = WSACleanup() If lReturn <> 0 Then MsgBox "Socket error " & Trim$(Str$(lReturn)) & " occurred in Cleanup " End End If End Sub Sub Form_Load() SocketsInitialize End Sub Private Sub Form_Unload(Cancel As Integer) SocketsCleanup End Sub Private Sub Command1_click() Dim hostname As String * 256 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 If gethostname(hostname, 256) = SOCKET_ERROR Then MsgBox "Windows Sockets error " & Str(WSAGetLastError()) Exit Sub Else hostname = Trim$(hostname) End If hostent_addr = gethostbyname(hostname) If hostent_addr = 0 Then MsgBox "Winsock.dll is not responding." Exit Sub End If 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) MsgBox hostname MsgBox ip_address End Sub
'获取本机IP地址,支持多网卡,可以分别获取多个网卡的IPOption ExplicitPrivate 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 ERROR_SUCCESS As Long = 0Private Type IP_ADDRESS_STRING IpAddr(0 To 15) As Byte End TypePrivate Type IP_MASK_STRING IpMask(0 To 15) As Byte End TypePrivate Type IP_ADDR_STRING dwNext As Long IpAddress As IP_ADDRESS_STRING IpMask As IP_MASK_STRING dwContext As Long End TypePrivate Type IP_ADAPTER_INFO dwNext As Long ComboIndex As Long '保留 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 Const NCBASTAT = &H33 Private Const NCBNAMSZ = 16 Private Const HEAP_ZERO_MEMORY = &H8 Private Const HEAP_GENERATE_EXCEPTIONS = &H4 Private Const NCBRESET = &H32Private Type NCB ncb_command As Byte ncb_retcode As Byte ncb_lsn As Byte ncb_num As Byte ncb_buffer As Long ncb_length As Integer ncb_callname As String * NCBNAMSZ ncb_name As String * NCBNAMSZ ncb_rto As Byte ncb_sto As Byte ncb_post As Long ncb_lana_num As Byte ncb_cmd_cplt As Byte ncb_reserve(9) As Byte ' Reserved, must be 0 ncb_event As Long End TypePrivate Type ADAPTER_STATUS adapter_address(5) As Byte rev_major As Byte reserved0 As Byte adapter_type As Byte rev_minor As Byte duration As Integer frmr_recv As Integer frmr_xmit As Integer iframe_recv_err As Integer xmit_aborts As Integer xmit_success As Long recv_success As Long iframe_xmit_err As Integer recv_buff_unavail As Integer t1_timeouts As Integer ti_timeouts As Integer Reserved1 As Long free_ncbs As Integer max_cfg_ncbs As Integer max_ncbs As Integer xmit_buf_unavail As Integer max_dgram_size As Integer pending_sess As Integer max_cfg_sess As Integer max_sess As Integer max_sess_pkt_size As Integer name_count As Integer End TypePrivate Type NAME_BUFFER Name As String * NCBNAMSZ name_num As Integer name_flags As Integer End TypePrivate Type ASTAT adapt As ADAPTER_STATUS NameBuff(30) As NAME_BUFFER End TypePrivate 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 Netbios Lib "netapi32.dll" (pncb As NCB) As Byte Private Declare Function GetProcessHeap Lib "kernel32" () As Long Private Declare Function HeapAlloc Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, ByVal dwBytes As Long) As Long Private Declare Function HeapFree Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, lpMem As Any) As LongPublic Function EthernetAddress(LanaNumber As Long) _ As String Dim udtNCB As NCB Dim bytResponse As Byte Dim udtASTAT As ASTAT Dim udtTempASTAT As ASTAT Dim lngASTAT As Long Dim strOut As String Dim x As Integer udtNCB.ncb_command = NCBRESET bytResponse = Netbios(udtNCB) udtNCB.ncb_command = NCBASTAT udtNCB.ncb_lana_num = LanaNumber udtNCB.ncb_callname = "* " udtNCB.ncb_length = Len(udtASTAT) lngASTAT = HeapAlloc(GetProcessHeap(), _ HEAP_GENERATE_EXCEPTIONS Or HEAP_ZERO_MEMORY, udtNCB.ncb_length) strOut = "" If lngASTAT Then udtNCB.ncb_buffer = lngASTAT bytResponse = Netbios(udtNCB) CopyMemory udtASTAT, udtNCB.ncb_buffer, Len(udtASTAT) With udtASTAT.adapt For x = 0 To 5 strOut = strOut & Right$("00" & Hex$(.adapter_address(x)), 2) Next x End With HeapFree GetProcessHeap(), 0, lngASTAT End If EthernetAddress = strOut End Function Public Function LocalIPAddress() As String Dim cbRequired As Long Dim buff() As Byte Dim Adapter As IP_ADAPTER_INFO Dim AdapterStr As IP_ADDR_STRING Dim ptr1 As Long Dim sIPAddr As String Dim found As Boolean Dim iFound As Integer iFound = 0 sIPAddr = "" Dim sReturn As String sReturn = "" 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 '获取存放在buff()中的数据的指针 ptr1 = VarPtr(buff(0)) Do While (ptr1 <> 0) '将第一个网卡的数据转换到IP_ADAPTER_INFO结构中 CopyMemory Adapter, ByVal ptr1, LenB(Adapter) With Adapter 'IpAddress.IpAddr成员给出了DHCP的IP地址 sIPAddr = TrimNull(StrConv(.IpAddressList.IpAddress.IpAddr, vbUnicode)) If Len(sIPAddr) > 0 Then iFound = iFound + 1 sReturn = sReturn & "第" & iFound & "个网卡的iP是:" & sIPAddr & vbCrLf found = True ' Exit Do End If ptr1 = .dwNext End With 'With Adapter '不再有网卡时,ptr1的值为0 Loop 'Do While (ptr1 <> 0) End If 'If GetAdaptersInfo End If 'If cbRequired > 0 '返回结果字符串 LocalIPAddress = sReturn End FunctionFunction TrimNull(item As String) Dim pos As Integer pos = InStr(item, Chr$(0)) If pos Then TrimNull = Left$(item, pos - 1) Else: TrimNull = item End If End FunctionPrivate Sub Command1_Click() Debug.Print LocalIPAddress End Sub
Dim fileName As StringPrivate Sub Command1_Click()
Dim strString As String, FileNo
Dim sVar
If Winsock1.LocalPort = 0 Then
strString = "硈钡梆絪腹﹟ゼ砞﹚"
Else
strString = Winsock1.LocalPort
End If
Text1.Text = "眤诀嘿" & Winsock1.LocalHostName & vbCrLf
Text1.Text = Text1.Text & "IP " & Winsock1.LocalIP & vbCrLf
Text1.Text = Text1.Text & "硈钡梆" & strString & vbCrLf
Text1.Text = Text1.Text & "硄癟﹚" & IIf(Winsock1.Protocol = 0, "TCP ﹚", "UDP ﹚") FileNo = FreeFile()
Open fileName For Input As #FileNo
While Not EOF(FileNo)
Line Input #FileNo, sVar
Text1.Text = Text1.Text & sVar & vbCrLf
Wend
Close #FileNoEnd SubPrivate Sub Command2_Click()
Unload Me
End SubPrivate Sub Form_Load()
fileName = "c:\IPDetail.txt"
Shell "command.com /c ipconfig.exe > " & fileName
DoEvents Do While Trim(Dir(fileName)) = ""
DoEvents
LoopEnd Sub
你翻译成简体看看,以前写的繁体程序打开就这样子,无奈下 -_-#
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 = 128Private Type HOSTENT
hName As Long
hAliases As Long
hAddrType As Integer
hLength As Integer
hAddrList As LongEnd 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 LongEnd 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 gethostname Lib "WSOCK32.DLL" (ByVal hostname$, HostLen&) 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&) 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
MsgBox "Winsock.dll is not responding."
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)))
sMsg = "Windows Sockets version " & sLowByte & "." & sHighByte
sMsg = sMsg & " is not supported by winsock.dll "
MsgBox sMsg
End
End If If WSAD.iMaxSockets < MIN_SOCKETS_REQD Then
sMsg = "This application requires a minimum of "
sMsg = sMsg & Trim$(Str$(MIN_SOCKETS_REQD)) & " supported sockets."
MsgBox sMsg
End
End If End Sub Sub SocketsCleanup()
Dim lReturn As Long lReturn = WSACleanup() If lReturn <> 0 Then
MsgBox "Socket error " & Trim$(Str$(lReturn)) & " occurred in Cleanup "
End
End If End Sub Sub Form_Load() SocketsInitialize End Sub Private Sub Form_Unload(Cancel As Integer) SocketsCleanup End Sub Private Sub Command1_click()
Dim hostname As String * 256
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 If gethostname(hostname, 256) = SOCKET_ERROR Then
MsgBox "Windows Sockets error " & Str(WSAGetLastError())
Exit Sub
Else
hostname = Trim$(hostname)
End If hostent_addr = gethostbyname(hostname) If hostent_addr = 0 Then
MsgBox "Winsock.dll is not responding."
Exit Sub
End If 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) MsgBox hostname
MsgBox ip_address End Sub
Private Const MAX_ADAPTER_DESCRIPTION_LENGTH As Long = 128
Private Const MAX_ADAPTER_ADDRESS_LENGTH As Long = 8
Private Const ERROR_SUCCESS As Long = 0Private Type IP_ADDRESS_STRING
IpAddr(0 To 15) As Byte
End TypePrivate Type IP_MASK_STRING
IpMask(0 To 15) As Byte
End TypePrivate Type IP_ADDR_STRING
dwNext As Long
IpAddress As IP_ADDRESS_STRING
IpMask As IP_MASK_STRING
dwContext As Long
End TypePrivate Type IP_ADAPTER_INFO
dwNext As Long
ComboIndex As Long '保留
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 Const NCBASTAT = &H33
Private Const NCBNAMSZ = 16
Private Const HEAP_ZERO_MEMORY = &H8
Private Const HEAP_GENERATE_EXCEPTIONS = &H4
Private Const NCBRESET = &H32Private Type NCB
ncb_command As Byte
ncb_retcode As Byte
ncb_lsn As Byte
ncb_num As Byte
ncb_buffer As Long
ncb_length As Integer
ncb_callname As String * NCBNAMSZ
ncb_name As String * NCBNAMSZ
ncb_rto As Byte
ncb_sto As Byte
ncb_post As Long
ncb_lana_num As Byte
ncb_cmd_cplt As Byte
ncb_reserve(9) As Byte ' Reserved, must be 0
ncb_event As Long
End TypePrivate Type ADAPTER_STATUS
adapter_address(5) As Byte
rev_major As Byte
reserved0 As Byte
adapter_type As Byte
rev_minor As Byte
duration As Integer
frmr_recv As Integer
frmr_xmit As Integer
iframe_recv_err As Integer
xmit_aborts As Integer
xmit_success As Long
recv_success As Long
iframe_xmit_err As Integer
recv_buff_unavail As Integer
t1_timeouts As Integer
ti_timeouts As Integer
Reserved1 As Long
free_ncbs As Integer
max_cfg_ncbs As Integer
max_ncbs As Integer
xmit_buf_unavail As Integer
max_dgram_size As Integer
pending_sess As Integer
max_cfg_sess As Integer
max_sess As Integer
max_sess_pkt_size As Integer
name_count As Integer
End TypePrivate Type NAME_BUFFER
Name As String * NCBNAMSZ
name_num As Integer
name_flags As Integer
End TypePrivate Type ASTAT
adapt As ADAPTER_STATUS
NameBuff(30) As NAME_BUFFER
End TypePrivate 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 Netbios Lib "netapi32.dll" (pncb As NCB) As Byte
Private Declare Function GetProcessHeap Lib "kernel32" () As Long
Private Declare Function HeapAlloc Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function HeapFree Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, lpMem As Any) As LongPublic Function EthernetAddress(LanaNumber As Long) _
As String Dim udtNCB As NCB
Dim bytResponse As Byte
Dim udtASTAT As ASTAT
Dim udtTempASTAT As ASTAT
Dim lngASTAT As Long
Dim strOut As String
Dim x As Integer udtNCB.ncb_command = NCBRESET
bytResponse = Netbios(udtNCB)
udtNCB.ncb_command = NCBASTAT
udtNCB.ncb_lana_num = LanaNumber
udtNCB.ncb_callname = "* "
udtNCB.ncb_length = Len(udtASTAT)
lngASTAT = HeapAlloc(GetProcessHeap(), _
HEAP_GENERATE_EXCEPTIONS Or HEAP_ZERO_MEMORY, udtNCB.ncb_length) strOut = ""
If lngASTAT Then
udtNCB.ncb_buffer = lngASTAT
bytResponse = Netbios(udtNCB)
CopyMemory udtASTAT, udtNCB.ncb_buffer, Len(udtASTAT)
With udtASTAT.adapt
For x = 0 To 5
strOut = strOut & Right$("00" & Hex$(.adapter_address(x)), 2)
Next x
End With
HeapFree GetProcessHeap(), 0, lngASTAT
End If
EthernetAddress = strOut
End Function Public Function LocalIPAddress() As String
Dim cbRequired As Long
Dim buff() As Byte
Dim Adapter As IP_ADAPTER_INFO
Dim AdapterStr As IP_ADDR_STRING
Dim ptr1 As Long
Dim sIPAddr As String
Dim found As Boolean
Dim iFound As Integer
iFound = 0
sIPAddr = ""
Dim sReturn As String
sReturn = ""
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
'获取存放在buff()中的数据的指针
ptr1 = VarPtr(buff(0))
Do While (ptr1 <> 0)
'将第一个网卡的数据转换到IP_ADAPTER_INFO结构中
CopyMemory Adapter, ByVal ptr1, LenB(Adapter)
With Adapter
'IpAddress.IpAddr成员给出了DHCP的IP地址
sIPAddr = TrimNull(StrConv(.IpAddressList.IpAddress.IpAddr, vbUnicode))
If Len(sIPAddr) > 0 Then
iFound = iFound + 1
sReturn = sReturn & "第" & iFound & "个网卡的iP是:" & sIPAddr & vbCrLf
found = True
' Exit Do
End If
ptr1 = .dwNext
End With 'With Adapter
'不再有网卡时,ptr1的值为0
Loop 'Do While (ptr1 <> 0)
End If 'If GetAdaptersInfo
End If 'If cbRequired > 0
'返回结果字符串
LocalIPAddress = sReturn
End FunctionFunction TrimNull(item As String)
Dim pos As Integer
pos = InStr(item, Chr$(0))
If pos Then
TrimNull = Left$(item, pos - 1)
Else: TrimNull = item
End If
End FunctionPrivate Sub Command1_Click()
Debug.Print LocalIPAddress
End Sub