Option Explicit
'=========// IP 주소 가져오기 //==========================================================
Public Const ERROR_SUCCESS As Long = 0
Public Const MAX_ADAPTER_NAME_LENGTH As Long = 256
Public Const MAX_ADAPTER_DESCRipTION_LENGTH As Long = 128
Public Const MAX_ADAPTER_ADDRESS_LENGTH As Long = 8
 

Public Type ip_ADDRESS_STRING
  ipAddr(0 To 15) As Byte
End Type

 
Public Type ip_MASK_STRING
  ipMask(0 To 15) As Byte
End Type

 

Public Type ip_ADDR_STRING
  dwNext As Long
  ipAddress As ip_ADDRESS_STRING
  ipMask As ip_MASK_STRING
  dwContext As Long
End Type
 

Public 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


Public Declare Function GetAdaptersInfo Lib "iphlpapi.dll" _
(pTcpTable As Any, _
  pdwSize As Long) As Long


Public Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" _
  (dst As Any, _
  src As Any, _
  ByVal bcount As Long)
 

Public Declare Function DeleteUrlCacheEntry Lib "Wininet.dll" _
  Alias "DeleteUrlCacheEntryA" _
  (ByVal lpszUrlName As String) As Long
     

Public Declare Function lstrlenW Lib "kernel32" _
  (ByVal lpString As Long) As Long


 
Public Function LocalipAddress() As String
   
    On Error Resume Next
   
    Dim cbRequired As Long
    Dim buff() As Byte
    Dim ptr1 As Long
    Dim sipAddr As String
    Dim Adapter As ip_ADAPTER_INFO
   
    LocalipAddress = ""

    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
        ptr1 = VarPtr(buff(0))
        Do While (ptr1 <> 0)
            CopyMemory Adapter, ByVal ptr1, LenB(Adapter)
            With Adapter
              sipAddr = TrimNull(StrConv(.ipAddressList.ipAddress.ipAddr, vbUnicode))
              If Len(sipAddr) > 0 Then Exit Do
              ptr1 = .dwNext
            End With  'With Adapter
        Loop  'Do While (ptr1 <> 0
      End If  'If GetAdaptersInfo
  End If  'If cbRequired > 0
 
  LocalipAddress = sipAddr
 
End Function

Public Function TrimNull(startstr As String) As String

  TrimNull = Left$(startstr, lstrlenW(StrPtr(startstr)))

End Function<div class='small'>[이 게시물은 관리자님에 의해 2011-10-31 16:46:12 기타에서 이동 됨]</div>