All pastes #280840 Raw Edit

Seykron

public text v1 · immutable
#280840 ·published 2006-12-16 05:36 UTC
rendered paste body
Option Explicit

' Manejo de memoria
'
Const MEM_COMMIT As Long = &H1000
Const MEM_RELEASE As Long = &H8000
Const PAGE_READWRITE As Long = &H4


Public Const MAX_ADAPTER_NAME As Integer = 128
Public Const MAX_HOSTNAME_LEN As Integer = 128
Public Const MAX_DOMAIN_NAME_LEN As Integer = 128
Public Const MAX_SCOPE_ID_LEN As Integer = 256
Public Const MAX_ADAPTER_DESCRIPTION_LENGTH As Integer = 128
Public Const MAX_ADAPTER_NAME_LENGTH As Integer = 256
Public Const MAX_ADAPTER_ADDRESS_LENGTH As Integer = 8
Public Const DEFAULT_MINIMUM_ENTITIES As Integer = 32

Public Const ERROR_BUFFER_OVERFLOW As Integer = 111
Public Const ERROR_SUCCESS As Integer = 0


'Different Adapter types as defined in IPifcons.h

Public Const MIB_IF_TYPE_OTHER As Integer = 1
Public Const MIB_IF_TYPE_ETHERNET As Integer = 6
Public Const MIB_IF_TYPE_TOKENRING As Integer = 9
Public Const MIB_IF_TYPE_FDDI As Integer = 15
Public Const MIB_IF_TYPE_PPP As Integer = 23
Public Const MIB_IF_TYPE_LOOPBACK As Integer = 24
Public Const MIB_IF_TYPE_SLIP As Integer = 28

Public Type IP_ADDR_STRING
  NextPointer         As Long
  IPAddressString(16) As Byte
  IPMaskString(16)    As Byte
  Context             As Integer
End Type

Public Type IP_ADAPTER_INFO
  NextPointer           As Long
  ComboIndex            As Integer
  AdapterName(MAX_ADAPTER_NAME_LENGTH + 4) As Byte
  Description(MAX_ADAPTER_DESCRIPTION_LENGTH + 4) As Byte
  AddressLength         As Integer
  Address(1 To MAX_ADAPTER_ADDRESS_LENGTH) As Byte
  Index                 As Integer
  Type                  As Integer
  DhcpEnabled           As Integer
  CurrentIPAddress      As Long ' Reservado.
  IPAddressList         As IP_ADDR_STRING
  GatewayList           As IP_ADDR_STRING
  DhcpServer            As IP_ADDR_STRING
  HaveWins              As Boolean
  PrimaryWinsServer     As IP_ADDR_STRING
  SecondaryWinsServer   As IP_ADDR_STRING
  LeaseObtained         As Integer
  LeaseExpires          As Integer
End Type


Public Declare Function GetAdaptersInfo Lib "IPHLPAPI.dll" (ByVal pAdapterInfo As Long, ByRef pOutBufLen As Long) As Long

Declare Function VirtualAlloc Lib "kernel32.dll" (ByVal lpAddress As Long, ByVal dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
Declare Function VirtualFree Lib "kernel32.dll" (ByVal lpAddress As Long, ByVal dwSize As Long, ByVal dwFreeType As Long) As Long


Function GetMacAddressList() As String
      Dim lpAdapter As IP_ADAPTER_INFO
      Dim lBuffer&, lSize&
      Dim sMac$, sChar$
      Dim r&, i%
      
  lSize = Len(lpAdapter) * 16
  lBuffer = VirtualAlloc(0&, lSize, MEM_COMMIT, PAGE_READWRITE)
  
  r = GetAdaptersInfo(lBuffer, lSize)
  
  Call CopyMemory(lpAdapter, ByVal lBuffer, ByVal Len(lpAdapter))

  Do
    For i = (MAX_ADAPTER_ADDRESS_LENGTH - lpAdapter.AddressLength + 1) To MAX_ADAPTER_ADDRESS_LENGTH
      sChar = Hex$(lpAdapter.Address(i))
      
      If (lpAdapter.Address(i) < 10) Then sChar = "0" & sChar
      If (i < (lpAdapter.AddressLength + 2)) Then sChar = sChar & "-"
      
      sMac = sMac & sChar
    Next
    
    sMac = sMac & " "
    
    If (lpAdapter.NextPointer = 0) Then Exit Do
    
    Call CopyMemory(lpAdapter, ByVal lpAdapter.NextPointer, ByVal Len(lpAdapter))
  Loop
  
  r = VirtualFree(lBuffer, 0&, MEM_RELEASE)
  GetMacAddressList = RTrim$(sMac)
  
End Function

Function GetMacAddress(ByVal Index As Integer) As String
        Dim sData$()

  sData = Split(GetMacAddressList, " ")
  
  GetMacAddress = sData(Index - 1)
End Function

Function MacLongLo(ByVal Index As Integer) As Long
  MacLongLo = Val("&H" & Mid$(Replace$(GetMacAddress(Index), "-", vbNullString), 7))
End Function

Function MacLongHi(ByVal Index As Integer) As Long
  MacLongHi = Val("&H" & Left$(Replace$(GetMacAddress(Index), "-", vbNullString), 6))
End Function