MAC Adresini Almak

Necdet · 25 Ocak 2006

Microsoft tartışma gruplarında bulduğum bir makroyu buraya ekliyorum.
MAC adresini veriyormuş yanlış anlamadıysam.

Çalıştırabilir misiniz bir örnek dosyada?

Option Explicit

Public Const NCBASTAT = &H33
Public Const NCBNAMSZ = 16
Public Const MEM_RESERVE = &H2000
Public Const MEM_COMMIT = &H1000
Public Const MEM_RELEASE = &H8000
Public Const PAGE_READWRITE = &H4
Public Const HEAP_ZERO_MEMORY = &H8
Public Const HEAP_GENERATE_EXCEPTIONS = &H4
Public Const NCBRESET = &H32

Public Type NCB
ncb_command As Byte 'Integer
ncb_retcode As Byte 'Integer
ncb_lsn As Byte 'Integer
ncb_num As Byte ' Integer
ncb_buffer As Long 'String
ncb_length As Integer
ncb_callname As String * NCBNAMSZ
ncb_name As String * NCBNAMSZ
ncb_rto As Byte 'Integer
ncb_sto As Byte ' Integer
ncb_post As Long
ncb_lana_num As Byte 'Integer
ncb_cmd_cplt As Byte 'Integer
ncb_reserve(9) As Byte ' Reserved, must be 0ncb_event As Long
End Type

Public Type ADAPTER_STATUS
adapter_address(5) As Byte 'As String * 6
rev_major As Byte 'Integer
reserved0 As Byte 'Integer
adapter_type As Byte 'Integer
rev_minor As Byte 'Integer
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 Type

Public Type NAME_BUFFER
name As String * NCBNAMSZ
name_num As Integer
name_flags As Integer
End Type

Public Type ASTAT
adapt As ADAPTER_STATUS
NameBuff(30) As NAME_BUFFER
End Type

Public Declare Function Netbios Lib "netapi32.dll" _
(pncb As NCB) As Byte

Public Declare Sub CopyMemory Lib "kernel32" Alias _
"RtlMoveMemory" (hpvDest As Any, ByVal hpvSource As Long, _
ByVal cbCopy As Long)

Public Declare Function VirtualAlloc Lib "kernel32" (lpAddress As Long,
_
ByVal dwSize As Long, ByVal flAllocationType As Long, _
ByVal flProtect As Long) As Long

Public Declare Function VirtualFree Lib "kernel32" (lpAddress As Any, _
ByVal dwSize As Long, ByVal dwFreeType As Long) As Long

Public Declare Function GetProcessHeap Lib "kernel32" () As Long

Public Declare Function HeapAlloc Lib "kernel32" (ByVal hHeap As Long,
_
ByVal dwFlags As Long, ByVal dwBytes As Long) As Long

Public Declare Function HeapFree Lib "kernel32" (ByVal hHeap As Long, _
ByVal dwFlags As Long, lpMem As Any) As Long

Public Function getMac() As String
Dim myNcb As NCB
Dim bRet As Byte

myNcb.ncb_command = NCBRESET
bRet = Netbios(myNcb)
myNcb.ncb_command = NCBASTAT
myNcb.ncb_lana_num = 0
myNcb.ncb_callname = "* "

Dim myASTAT As ASTAT, tempASTAT As ASTAT
Dim pASTAT As Long

myNcb.ncb_length = Len(myASTAT)

Debug.Print ERR.LastDllError
pASTAT = HeapAlloc(GetProcessHeap(), HEAP_GENERATE_EXCEPTIONS Or _
HEAP_ZERO_MEMORY, myNcb.ncb_length)

If pASTAT = 0 Then
Debug.Print "memory allcoation failed!"
Exit Function
End If

myNcb.ncb_buffer = pASTAT
bRet = Netbios(myNcb)
Debug.Print ERR.LastDllError
CopyMemory myASTAT, myNcb.ncb_buffer, Len(myASTAT)
getMac = myASTAT.adapt.adapter_address(0) & "." & _
myASTAT.adapt.adapter_address(1) _
& "." & myASTAT.adapt.adapter_address(2) & "." & _
myASTAT.adapt.adapter_address(3) _
& "." & myASTAT.adapt.adapter_address(4) & "." & _
myASTAT.adapt.adapter_address(5)

' MsgBox myASTAT.adapt.adapter_address(0) & " " & _
' myASTAT.adapt.adapter_address(1) _
' & " " & myASTAT.adapt.adapter_address(2) & " " & _
' myASTAT.adapt.adapter_address(3) _
' & " " & myASTAT.adapt.adapter_address(4) & " " & _
' myASTAT.adapt.adapter_address(5)

' MsgBox Hex(myASTAT.adapt.adapter_address(0)) & " " & _
' Hex(myASTAT.adapt.adapter_address(1)) _
' & " " & Hex(myASTAT.adapt.adapter_address(2)) & " " & _
' Hex(myASTAT.adapt.adapter_address(3)) _
' & " " & Hex(myASTAT.adapt.adapter_address(4)) & " " & _
' Hex(myASTAT.adapt.adapter_address(5))

HeapFree GetProcessHeap(), 0, pASTAT

End Function

Haluk · 25 Ocak 2006

Aşağıdaki gibi deneyin, "Test" isimli prosedürü çalıştırın.

Kod:

Public Const NCBASTAT = &H33
Public Const NCBNAMSZ = 16
Public Const MEM_RESERVE = &H2000
Public Const MEM_COMMIT = &H1000
Public Const MEM_RELEASE = &H8000
Public Const PAGE_READWRITE = &H4
Public Const HEAP_ZERO_MEMORY = &H8
Public Const HEAP_GENERATE_EXCEPTIONS = &H4
Public Const NCBRESET = &H32

Public Type NCB
ncb_command As Byte 'Integer
ncb_retcode As Byte 'Integer
ncb_lsn As Byte 'Integer
ncb_num As Byte ' Integer
ncb_buffer As Long 'String
ncb_length As Integer
ncb_callname As String * NCBNAMSZ
ncb_name As String * NCBNAMSZ
ncb_rto As Byte 'Integer
ncb_sto As Byte ' Integer
ncb_post As Long
ncb_lana_num As Byte 'Integer
ncb_cmd_cplt As Byte 'Integer
ncb_reserve(9) As Byte ' Reserved, must be 0ncb_event As Long
End Type

Public Type ADAPTER_STATUS
adapter_address(5) As Byte 'As String * 6
rev_major As Byte 'Integer
reserved0 As Byte 'Integer
adapter_type As Byte 'Integer
rev_minor As Byte 'Integer
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 Type

Public Type NAME_BUFFER
name As String * NCBNAMSZ
name_num As Integer
name_flags As Integer
End Type

Public Type ASTAT
adapt As ADAPTER_STATUS
NameBuff(30) As NAME_BUFFER
End Type

Public Declare Function Netbios Lib "netapi32.dll" _
(pncb As NCB) As Byte

Public Declare Sub CopyMemory Lib "kernel32" Alias _
"RtlMoveMemory" (hpvDest As Any, ByVal hpvSource As Long, _
ByVal cbCopy As Long)

Public Declare Function VirtualAlloc Lib "kernel32" (lpAddress As Long, _
ByVal dwSize As Long, ByVal flAllocationType As Long, _
ByVal flProtect As Long) As Long

Public Declare Function VirtualFree Lib "kernel32" (lpAddress As Any, _
ByVal dwSize As Long, ByVal dwFreeType As Long) As Long

Public Declare Function GetProcessHeap Lib "kernel32" () As Long

Public Declare Function HeapAlloc Lib "kernel32" (ByVal hHeap As Long, _
ByVal dwFlags As Long, ByVal dwBytes As Long) As Long

Public Declare Function HeapFree Lib "kernel32" (ByVal hHeap As Long, _
ByVal dwFlags As Long, lpMem As Any) As Long

Public Function getMac() As String
Dim myNcb As NCB
Dim bRet As Byte

myNcb.ncb_command = NCBRESET
bRet = Netbios(myNcb)
myNcb.ncb_command = NCBASTAT
myNcb.ncb_lana_num = 0
myNcb.ncb_callname = "* "

Dim myASTAT As ASTAT, tempASTAT As ASTAT
Dim pASTAT As Long

myNcb.ncb_length = Len(myASTAT)

Debug.Print Err.LastDllError
pASTAT = HeapAlloc(GetProcessHeap(), HEAP_GENERATE_EXCEPTIONS Or _
HEAP_ZERO_MEMORY, myNcb.ncb_length)

If pASTAT = 0 Then
Debug.Print "memory allcoation failed!"
Exit Function
End If

myNcb.ncb_buffer = pASTAT
bRet = Netbios(myNcb)
Debug.Print Err.LastDllError
CopyMemory myASTAT, myNcb.ncb_buffer, Len(myASTAT)
getMac = myASTAT.adapt.adapter_address(0) & "." & _
myASTAT.adapt.adapter_address(1) _
& "." & myASTAT.adapt.adapter_address(2) & "." & _
myASTAT.adapt.adapter_address(3) _
& "." & myASTAT.adapt.adapter_address(4) & "." & _
myASTAT.adapt.adapter_address(5)


 MsgBox myASTAT.adapt.adapter_address(0) & " " & _
 myASTAT.adapt.adapter_address(1) _
 & " " & myASTAT.adapt.adapter_address(2) & " " & _
 myASTAT.adapt.adapter_address(3) _
 & " " & myASTAT.adapt.adapter_address(4) & " " & _
 myASTAT.adapt.adapter_address(5)

 MsgBox Hex(myASTAT.adapt.adapter_address(0)) & " " & _
 Hex(myASTAT.adapt.adapter_address(1)) _
 & " " & Hex(myASTAT.adapt.adapter_address(2)) & " " & _
 Hex(myASTAT.adapt.adapter_address(3)) _
 & " " & Hex(myASTAT.adapt.adapter_address(4)) & " " & _
 Hex(myASTAT.adapt.adapter_address(5))

HeapFree GetProcessHeap(), 0, pASTAT

End Function

Sub Test()
    Call getMac
End Sub

Haluk · 25 Ocak 2006

İkinci olarak verdiği değer, aşağıdaki başlıkta kullanılan batch dosyası ile aynı değeri veriyor.

http://www.excel.web.tr/viewtopic.php?p=61164#61164

Necdet · 25 Ocak 2006

Teşekkürler Haluk Bey,

Çalıştırdım ama 0 0 0 0 0 0 diye bir değer gösterdi

Ali · 25 Ocak 2006

Dos penceresinde
C:\>ipconfig /all yazdığınızda

Physical Address (Fiziksel Adres) bölümünde görülen adres bilgisayarınızın MAC adresidir
Kolaylık olsun diye dedim :hey:

Ali · 25 Ocak 2006

Küçük bir not network eğitiminde söylemişlerdi ethernet kartlarına ait MAC adresleri 44 ile başlamaz eğer böyle bir adres varsa bu modeme aittir demişlerdi.

Ethernet kart üreticilerinin Malatyaya(44) bir garezi var sanırım

Haluk · 25 Ocak 2006

Necdet bey, aşağıdaki kodu az önce oluşturdum, bir de bunu deneyin isterseniz....

Test isimli prosedürü çalıştırın.

Kod:

Sub Test()
    Dim MyFile As String
    MyFile = "C:\LogMAC.txt"
    MyStr = "nbtstat -a %computername% | find ""MAC"" > " & MyFile
    Shell "cmd /C" & MyStr, 0
    Application.Wait Now + TimeSerial(0, 0, 2)
    MsgBox GetMac(MyFile)
    Kill MyFile
End Sub
'
Function GetMac(strFile As String)
    Dim RetVal As String
    Open strFile For Binary As #1
        RetVal = Space(LOF(1))
        Get 1, , RetVal
    Close #1
    GetMac = Trim(RetVal)
End Function

Necdet · 25 Ocak 2006

Gayet Güzel Çalışıyor Haluk Bey, Sağolun

Haluk · 25 Ocak 2006

Necdet_Yesertener' Alıntı:
Gayet Güzel Çalışıyor Haluk Bey, Sağolun

Buna sevindim işte....

Bu durumda, siz de bu kodu gidip o haber grubunda yayınlayın bence.

"MAC adresi bulmak için böyle roman gibi kod yazılmaz, bu size yeter ...." deyin.... :mrgreen:

Levent Menteşoğlu · 25 Ocak 2006

"MAC adresi bulmak için böyle roman gibi kod yazılmaz, bu size yeter ...." deyin....

Doğru söze ne denir. :bravo:

Levent Menteşoğlu · 25 Ocak 2006

Peki bende şunu sorayım bu mac adresi sanıyorum ethernet kartına özel bir adres. Benim pcde ethernet kartı olmadığı halde tespit edilen no nedir?

Haluk · 25 Ocak 2006

Levent dostum, network'cu değilim ama sadece bir tahminde bulunayım ...

Eğer net'e çıkışın LAN üzerinden ise, server üzerinden aldığın bir adresleme olabilir diye düşünüyorum ....

Levent Menteşoğlu · 25 Ocak 2006

Eğer net'e çıkışın LAN üzerinden ise, server üzerinden aldığın bir adresleme olabilir diye düşünüyorum ....

Değerli dostum çok doğru bir tespit az önce denedim. Nete bağlı iken no tespit ediliyor.

Necdet · 25 Ocak 2006

Domain Name ve Kullanıcı Adını bulma

Haluk Bey,

O siteye üye değilim, üstelik o kadar da iyi ingilizcem yok

Ãimdi bir örnek dosya daha gönderiyorum, sanırım bakar bakmaz anlayacaksınız, bunu da kısaltırsanız baya mutlu olurum.

Bulduğum sitenin adresi işyerinde kaldığı için şimdi söyleyemiyorum yarın eklerim buraya.

Windows üzerinde çalışıyor, Bir arkadaşta sormuştu yaptığım programı sadece işyerinde kullanbileyim diye (Network varsa tabi) belki yararlı olabilir.
Domain name i ve user ı veriyor.

cengizhan09 · 26 Ocak 2006

Haluk Bey

Haluk' Alıntı:

Necdet bey, aşağıdaki kodu az önce oluşturdum, bir de bunu deneyin isterseniz....

Test isimli prosedürü çalıştırın.

Kod:

Sub Test()
    Dim MyFile As String
    MyFile = "C:\LogMAC.txt"
    MyStr = "nbtstat -a %computername% | find ""MAC"" > " & MyFile
    Shell "cmd /C" & MyStr, 0
    Application.Wait Now + TimeSerial(0, 0, 2)
    MsgBox GetMac(MyFile)
    Kill MyFile
End Sub
'
Function GetMac(strFile As String)
    Dim RetVal As String
    Open strFile For Binary As #1
        RetVal = Space(LOF(1))
        Get 1, , RetVal
    Close #1
    GetMac = Trim(RetVal)
End Function

Bu kodu bir hücreye yazdırma şansı varmı? Böylece programlarımızı kontrol ettirir istemez isek başka bilgisayarda çalışmasını engelleriz. Geçenlerde bi arkadaş ta bunu soruyordu sanırım. Teşekkürler.

cengizhan09 · 26 Ocak 2006

Haluk,

Bu kodu derken eternet kartının fiziksel adresini kastettim yani ip kodunu. Teşekkürler.

eterzan · 26 Ocak 2006

öncelikle Haluk Bey'e teşekkürler.

Bu kodu bir hücreye yazdırma şansı varmı? Böylece programlarımızı kontrol ettirir istemez isek başka bilgisayarda çalışmasını engelleriz. Geçenlerde bi arkadaş ta bunu soruyordu sanırım. Teşekkürler.

kodu şu şekilde değiştirince bir hücreye yazıyor ama ne kadar işinize yarar bilemem..

Sub Test()
Dim MyFile As String
MyFile = "C:\LogMAC.txt"
MyStr = "nbtstat -a %computername% | find ""MAC"" > " & MyFile
Shell "cmd /C" & MyStr, 0
Application.Wait Now + TimeSerial(0, 0, 2)
Range("A3").Value = GetMac(MyFile)
Kill MyFile
End Sub
'
Function GetMac(strFile As String)
Dim RetVal As String
Open strFile For Binary As #1
RetVal = Space(LOF(1))
Get 1, , RetVal
Close #1
GetMac = Trim(RetVal)
End Function

Ali · 26 Ocak 2006

leventm' Alıntı:
Peki bende şunu sorayım bu mac adresi sanıyorum ethernet kartına özel bir adres. Benim pcde ethernet kartı olmadığı halde tespit edilen no nedir?

Belirttiğim gibi Levent Bey eğer ethernet kartınız yoksa bu modeminize aittir.

Haluk · 26 Ocak 2006

Günaydın Necdet bey,

Konuyla fazla ilgisi yok ama, bilgi olsun diye söylemek istedim.

Aşağıdaki linki tıklarsanız, oradaki kodları bir modüle yapıştırın. (Bu kod da biraz roman gibi ama neyse artık ... :mrgreen: )

Bunların içinde aşağıdaki satırda kırmızı ile belirtilen yerde, yerel ağ üzerindeki kendi kullanıcı adınızı yazarsanız ve sizin Network Admin.'iniz eğer girdiyse, sizin Network adınıza kayıtlı "Tam Kullanıcı Adı" nız belirecektir.

http://www.mrexcel.com/board2/viewtopic.php?t=40093

[vb:1:526b0dbcdd]Sub GetFullName()
Dim strUserName As String
strUserName = "raider"
MsgBox fGetFullNameOfLoggedUser(strUserName)
End Sub[/vb:1:526b0dbcdd]

Necdet · 26 Ocak 2006

Günaydın Haluk Bey,

Network ortamında admin olmadığım için boş geldi

MAC Adresini Almak

Necdet

Moderatör

Haluk

Özel Üye

Haluk

Özel Üye

Necdet

Moderatör

Ali

Özel Üye

Ali

Özel Üye

Haluk

Özel Üye

Necdet

Moderatör

Haluk

Özel Üye

Levent Menteşoğlu

Administrator

Levent Menteşoğlu

Administrator

Haluk

Özel Üye

Levent Menteşoğlu

Administrator

Necdet

Moderatör

cengizhan09

cengizhan09

eterzan

Ali

Özel Üye

Haluk

Özel Üye

Necdet

Moderatör