Get MAC-Address ?

Everything else that doesn't fall into one of the other PB categories.
Post Reply
HB
New User
New User
Posts: 5
Joined: Fri Mar 11, 2005 6:30 pm
Location: Germany

Get MAC-Address ?

Post by HB »

Hi, i try to make a little tool for a school. There is a network with 46 clients and i hope the tool will make the work with the clients a little bit easier :) . My problem now is, how can i get the mac-address from the networkadapter? In Visual Basic i can use the WMI Object,but in PureBasic? And can i change the IP of the client? Now yet my tool can get the username, the networkname , the ip and it can change the networkname. PureBasic is a great programming language and i hope anyone have an idea. :D
Top
traumatic
PureBasic Expert
PureBasic Expert
Posts: 1661
Joined: Sun Apr 27, 2003 4:41 pm
Location: Germany
Contact:
Contact traumatic

Re: Get MAC-Address ?

Post by traumatic »

Welcome to the forums.

Does this help?
viewtopic.php?t=14166

BTW: I searched the forums for "mac address" ... ;)
Good programmers don't comment their code. It was hard to write, should be hard to read.
Top
TerryHough
Enthusiast
Enthusiast
Posts: 781
Joined: Fri Apr 25, 2003 6:51 pm
Location: NC, USA
Contact:
Contact TerryHough

Post by TerryHough »

Maybe this utility written in PB will help you

http://elfecc.no-ip.info/purebasic/inde ... fo_NetStat
Top
HB
New User
New User
Posts: 5
Joined: Fri Mar 11, 2005 6:30 pm
Location: Germany

Post by HB »

Wow, thanks for the help :D . I will try it, i think it will take a time :wink: . I will present the result of my work so it will be ready :) .
Top
TerryHough
Enthusiast
Enthusiast
Posts: 781
Joined: Fri Apr 25, 2003 6:51 pm
Location: NC, USA
Contact:
Contact TerryHough

Post by TerryHough »

The link I gave in the above post is related, but wasn't what I really
intended to post. (Forgot that did not include code)

Here is a starting place for you...

Code: Select all

; GetNetworkAdapters - 09/25/2003 updated/modified by TerryHough
; from PB forums by AngelSoul
; post http://purebasic.myforums.net/viewtopic.php?t=7347

; CPUSpeed - updated by TerryHough 09/25/2003
; from PB forums by Hi-Toro
; post http://purebasic.myforums.net/viewtopic.php?t=3811

; GetFreeDiskSpace - 09/24/2003 Updated by TerryHough
; from PB forums by GPI
; post http://purebasic.myforums.net/viewtopic.php?t=7541

; OSVersion - 09/24/2003 updated by TerryHough
; from PB forums by Hi-Toro
; post http://purebasic.myforums.net/viewtopic.php?t=3811&postdays=0&postorder=asc&start=0

; Computer and User Name - updated by TerryHough 09/29/2003
; from PB forums by sec
; post http://purebasic.myforums.net/viewtopic.php?t=7662

Procedure.s GetOSVersion()
Shared OSVersion$.s
OSVersion$ = ""
lpVersionInformation.OSVERSIONINFO
lpVersionInformation\dwOSVersionInfoSize = SizeOf(OSVERSIONINFO)
If GetVersionEx_(@lpVersionInformation)
  Select lpVersionInformation\dwPlatformId
  Case #VER_PLATFORM_WIN32s
    GetVersion$ = "Windows 3.1"
  Case #VER_PLATFORM_WIN32_WINDOWS
    Select lpVersionInformation\dwMinorVersion
    Case 0
      GetVersion$ = "Windows 95"
    Case 10
      GetVersion$ = "Windows 98"
    Case 90
      GetVersion$ = "Windows ME"
      Default
      GetVersion$ = "Unknown"
    EndSelect
  Case #VER_PLATFORM_WIN32_NT
    Select lpVersionInformation\dwMajorVersion
    Case 3
      GetVersion$ = "Windows NT 3.51"
    Case 4
      GetVersion$ = "Windows NT 4.0"
    Case 5
      Select lpVersionInformation\dwMinorVersion
      Case 0
        GetVersion$ = "Windows 2000"
      Case 1
        GetVersion$ = "Windows XP"
        Default
        GetVersion$ = "Unknown"
      EndSelect
      Default
      GetVersion$ = "Unknown"
    EndSelect
    Default
      GetVersion$ = "Unknown"
  EndSelect
  OSVersion$ + "  Platform: " + GetVersion$ + Chr(10) + "  Version: " + Str(lpVersionInformation\dwMajorVersion) + "." + Str(lpVersionInformation\dwMinorVersion) + Chr(10) + "  Build: " + Str(PeekW(@lpVersionInformation\dwBuildNumber)) + "." + Str(PeekW(@lpVersionInformation\dwBuildNumber+2)) + Chr(10) + "  Other: " + PeekS(@lpVersionInformation\szCSDVersion[0])
Else
  OSVersion$ + "Unable to retrieve OS version information."
EndIf
ProcedureReturn OSVersion$
EndProcedure

Structure HiLow 
  lowlow.w 
  lowhi.w 
  hilow.w 
  hihi.w 
EndStructure 

Procedure.s GetFreeSpace(p$) 
  #div=10 
  #mask=(1<<#div)-1 
  #mul=16-#div 
  If Left(p$,2)="\\" 
    a=FindString(p$,"\",3) 
  Else 
    a=FindString(p$,"\",1) 
  EndIf 
  If a=0 : a=Len(p$) : EndIf 
  p$=Left(p$,a) 
  If GetDiskFreeSpaceEx_(@p$,@free.HiLow,@Total.HiLow,@TotalFree.HiLow) 
    hilow=free\hilow&$ffff 
    hihi=free\hihi&$ffff 
    lowlow=free\lowlow&$ffff 
    lowhi=free\lowhi&$ffff 
    
    p=1 
    While hihi>0 Or hilow>0 Or lowhi>0 
      ;Debug RSet(Bin(hihi),16,"o")+RSet(Bin(hilow),16,"o")+RSet(Bin(lowhi),16,"o")+RSet(Bin(lowlow),16,"o") 
      
      lowlow=(lowlow>>#div)+((lowhi&#mask)<<#mul) 
      lowhi =(lowhi >>#div)+((hilow&#mask)<<#mul) 
      hilow =(hilow >>#div)+((hihi&#mask)<<#mul) 
      hihi  =(hihi>>#div) 
      
      p+1 
    Wend 
    ;Debug RSet(Bin(hihi),16,"o")+RSet(Bin(hilow),16,"o")+RSet(Bin(lowhi),16,"o")+RSet(Bin(lowlow),16,"o") 
    If lowlow>1024 
      a$= StrF(lowlow/1024,2)+" "+StringField("Byte,KB,MB,GB,TB",p+1,",") 
    Else 
      a$= StrF(lowlow,2)+" "+StringField("Byte,KB,MB,GB,TB",p,",") 
    EndIf 
  Else 
  
    a$="---" 
  EndIf 
  ProcedureReturn a$ 
EndProcedure 

Structure bit64
  LowPart.l
  HighPart.l
EndStructure 

Procedure CPUSpeed()
  DefType.bit64 ulEAX_EDX, ulFreq, ulTicks, ulValue, ulStartCounter, ulResult
  QueryPerformanceFrequency_(ulFreq)
  QueryPerformanceCounter_(ulTicks)
  ulValue\LowPart = ulTicks\LowPart + ulFreq\LowPart
  
  ! RDTSC
  MOV ulEAX_EDX\LowPart, eax
  MOV ulEAX_EDX\HighPart, edx
  
  ulStartCounter\LowPart = ulEAX_EDX\LowPart
  While (ulTicks\LowPart <= ulValue\LowPart)
    QueryPerformanceCounter_(ulTicks)
  Wend
    
  ! RDTSC
  MOV ulEAX_EDX\LowPart, eax
  MOV ulEAX_EDX\HighPart, edx
  
  ulResult\LowPart = ulEAX_EDX\LowPart - ulStartCounter\LowPart
  ProcedureReturn ulResult\LowPart / 1000000
EndProcedure; Takes 1 second to calculate...

Global Hostname$.s
Global DNSServer$.s
Global Adapter$.s

Declare GetAdaptersInfo(Total)
Structure IP_ADDR_STRING
  Nxt.l
  IP.b[16]
  Mask.b[16]
  Context.l
EndStructure

Structure IP_ADAPTER_INFO
  Nxt.l
  ComboIndex.l
  AdapterName.b[260]
  Description.b[132]
  AddressLength.l
  Adr.b[8]
  Index.l
  Type.l
  DhcpEnabled.l
  CurrentIpAddress.l
  IpAddressList.IP_ADDR_STRING
  GatewayList.IP_ADDR_STRING
  DhcpServer.IP_ADDR_STRING
  HaveWins.l
  PrimaryWinsServer.IP_ADDR_STRING
  SecondaryWinsServer.IP_ADDR_STRING
  LeaseObtained.l
  LeaseExpires.l
EndStructure

Structure FIXED_INFO
  HostName.b[132]
  DomainName.b[132]
  CurrentDnsServer.l
  DnsServerList.IP_ADDR_STRING
  NodeType.l
  ScopeId.b[260]
  EnableRouting.l
  EnableProxy.l
  EnableDns.l
EndStructure

Structure IP_INFO
  AdapterName.s
  IP.s
  AdapterType.l
  AdapterTypeDesc.s
EndStructure

Dim Adapters.IP_INFO(10)

buffer.s = Space(1024)   ;buffer for string 
; Get and display the name of the computer. 
bufsize.l = 1024 
GetComputerName_(@buffer, @bufsize) 
Adapter$ = "Computer name: " + buffer + Chr(10) 

; Get and display the user name. 
bufsize.l = 1024 
GetUserName_(@buffer, @bufsize) 
Adapter$ + " User name: " + buffer + Chr(10) + Chr(10) 

; Get CPU Speed
mhz = CPUSpeed()&$FFFFFFFF
Adapter$ + "CPU speed is: " + Str (mhz) + " MHz" + Chr(10) + Chr(10)

; Get OS Version
OSVersion$ = GetOSVersion()
Adapter$ + "Operating System" + Chr(10) + OSVersion$ + Chr(10) + Chr(10)

; Get free disk space
Adapter$ + "Free disk space is: " + GetFreeSpace("c:\") + Chr(10) + Chr(10)

; Get IP Adapter info
GetAdaptersInfo(Total)
If Total = -1
  MessageRequester("Error","An error occured accessing adapter info",#MB_ICONERROR)
  End
Else
  MessageRequester("IP Configuration Report",Adapter$,#MB_ICONINFORMATION)
EndIf
End

Procedure GetAdaptersInfo(Total)
  Shared Total
  Shared Adapter$
  res=GetNetworkParams_(0,@FixedInfoSize.l)
  If res<>0
    If res<>#ERROR_BUFFER_OVERFLOW
      Total=-1
      ProcedureReturn Total
    EndIf
  EndIf
  Dim FixedInfoBuffer.b(FixedInfoSize-1)
  res = GetNetworkParams_(@FixedInfoBuffer(0), @FixedInfoSize)
  If res=0
    CopyMemory(@FixedInfoBuffer(0),@FixedInfo.FIXED_INFO,SizeOf(FIXED_INFO))
    Hostname$ =PeekS(@FixedInfo\Hostname)
    Adapter$ + "Host name: " + Hostname$ + Chr(10)
    Domain$  = PeekS(@FixedInfo\Domainname)
    Adapter$ = Adapter$ + " Domain name: " + Domain$ + Chr(10)
    DNSServer$=PeekS(@FixedInfo\DnsServerList\IP)
    Adapter$ + " DNS Servers: " + DNSServer$ + Chr(10)
    pAddrStr.l=PeekL(@FixedInfo\DnsServerList\Nxt)
    Repeat
      CopyMemory(pAddrStr,@Buffer.IP_ADDR_STRING,SizeOf(IP_ADDR_STRING))
      pAddrStr =Buffer\Nxt
    Until pAddrStr=0
    Select PeekL(@FixedInfo\NodeType)
    Case 1 : Adapter$ + " Node Type: Broadcast" + Chr(10)
    Case 2 : Adapter$ + " Node Type: Peer to Peer" + Chr(10)
    Case 4 : Adapter$ + " Node Type: Mixed" + Chr(10)
    Case 8 : Adapter$ + " Node Type: Hybrid" + Chr(10)
      Default: Adapter$ + " Node Type: Unknown" + Chr(10)
    EndSelect
    Select PeekL(@FixedInfo\EnableRouting)
    Case 0 : Adapter$ + " IP Routing: Not Enabled" + Chr(10)
      Default: Adapter$ + " Node Type: Enabled" + Chr(10)
    EndSelect
    Select PeekL(@FixedInfo\EnableProxy)
    Case 0 : Adapter$ + " WINS Proxy: Not enabled" + Chr(10)
      Default: Adapter$ + " WINS Proxy: Enabled" + Chr(10)
    EndSelect
    Select PeekL(@FixedInfo\EnableDNS)
    Case 0 : Adapter$ + " NetBIOS does not use DNS" + Chr(10)
      Default: Adapter$ + " NetBIOS uses DNS" + Chr(10)
    EndSelect
    Adapter$ = Adapter$ + Chr(10)
  EndIf
  AdapterInfoSize.l=0
  res=GetAdaptersInfo_(0, @AdapterInfoSize)
  If res<>0
    If res<>#ERROR_BUFFER_OVERFLOW
      Total=-1
      ProcedureReturn
    EndIf
  EndIf
  Dim AdapterInfoBuffer.b(AdapterInfoSize - 1) ;OK
  res=GetAdaptersInfo_(@AdapterInfoBuffer(0), @AdapterInfoSize.l) ;OK
  CopyMemory(@AdapterInfoBuffer(0),@AdapterInfo.IP_ADAPTER_INFO,SizeOf(IP_ADAPTER_INFO))
  pAdapt=AdapterInfo\Nxt
  
  Repeat
    CopyMemory(@AdapterInfo,@Buffer2.IP_ADAPTER_INFO,SizeOf(IP_ADAPTER_INFO))
    pAddrStr=Buffer2\IpAddressList\Nxt
    Repeat
      CopyMemory(@Buffer2\IpAddressList,@Buffer,SizeOf(IP_ADDR_STRING))
      Total=Total+1
      Adapter$ + "Adapter: " + PeekS(@Buffer2\Description) + Chr(10)
      Select Buffer2\Type
      Case  1 :Adapter$ + " Type: " + Str(Buffer2\Type) + " Ethernet Adapter" + Chr(10)
      Case  2 :Adapter$ + " Type: " + Str(Buffer2\Type) + " Token Ring Adapter" + Chr(10)
      Case  3 :Adapter$ + " Type: " + Str(Buffer2\Type) + " FDDI Adapter" + Chr(10)
      Case  4 :Adapter$ + " Type: " + Str(Buffer2\Type) + " PPP Adapter" + Chr(10)
      Case  5 :Adapter$ + " Type: " + Str(Buffer2\Type) + " Loopback Adapter" + Chr(10)
      Case  6 :Adapter$ + " Type: " + Str(Buffer2\Type) + " Slip Adapter" + Chr(10)
      Case 23 :Adapter$ + " Type: " + Str(Buffer2\Type) + " PPPoE Adapter" + Chr(10)
        Default :Adapter$ + " Type: " + Str(Buffer2\Type) + " Unknown Adapter" + Chr(10)
      EndSelect
      Adapter$ + " IP Address: " + PeekS(@Buffer\IP) + Chr(10)
      Adapter$ + " Subnet Mask: " + PeekS(@Buffer\Mask) + Chr(10)
      pAddrStr=Buffer\Nxt
      If pAddrStr<>0
        CopyMemory(pAddrStr,@Buffer2\GatewayList,SizeOf(IP_ADDR_STRING))
      EndIf
    Until pAddrStr=0
    If PeekS(@Buffer2\Gatewaylist\IP)
      Adapter$ + " Default Gateway: " +PeekS(@Buffer2\Gatewaylist\IP) + Chr(10)
    EndIf 
    
    pAdapt=Buffer2\Nxt
    If pAdapt<>0
      CopyMemory(pAdapt,@AdapterInfo,SizeOf(IP_ADAPTER_INFO))
    EndIf
    If PeekS(@Buffer2\DhcpServer\IP)
     Adapter$ + " DHCP Server: " +PeekS(@Buffer2\DhcpServer\IP) + Chr(10)
    EndIf
    If PeekS(@Buffer2\PrimaryWinsServer) 
      Adapter$ + " Primary WINS Server: " +PeekS(@Buffer2\PrimaryWinsServer) + Chr(10)
    EndIf
    If PeekS(@Buffer2\SecondaryWinsServer) 
      Adapter$ + " Secondary WINS Server: " +PeekS(@Buffer2\SecondaryWinsServer) + Chr(10)
    EndIf
    If Buffer2\LeaseObtained <> 315532800 
      Adapter$ + " Lease obtained: " + FormatDate("%mm/%dd/%yyyy %hh;%mm:%ss",Buffer2\LeaseObtained) + Chr(10)
    EndIf 
    If Buffer2\LeaseExpires <> 315532800 
      Adapter$ + " Lease expires: " + FormatDate("%mm/%dd/%yyyy %hh;%mm:%ss",Buffer2\LeaseExpires)  + Chr(10)
    EndIf 
    Mac$ = ""
    For i=0 To 5
      byte.b=PeekB(@buffer2\Adr+i)
      If byte>=0
        mac$ + RSet(Hex(byte),2,"0")
      Else
        mac$ + RSet(Hex(byte+256),2,"0")
      EndIf
      If i<5
        mac$ + ":"
      EndIf
    Next
    Adapter$ + " MAC Address: " + mac$ + Chr(10)
    Adapter$ + Chr(10)
    
  Until pAdapt=0
EndProcedure
Top
HB
New User
New User
Posts: 5
Joined: Fri Mar 11, 2005 6:30 pm
Location: Germany

Post by HB »

Thanks, it works fine with the tip from viewtopic.php?t=7347
There is an error in procedure CPUSpeed()
ulEAX_EDX is not a valid operator
I have make a comment over the procedure and the call and then it works
:)
Top
HB
New User
New User
Posts: 5
Joined: Fri Mar 11, 2005 6:30 pm
Location: Germany

Post by HB »

Another question, is there a way to change the IP and to change the username in the profiles? In Visual Basic you can change the IP with WMI like this:

Private Sub ChangeIP(ByVal strNewIP As String, _
Optional ByVal strSubNetMask As String = "255.255.255.0")

Dim lngStatus As Long
Dim strSQL As String
Dim objResult As Object
Dim objCard As Object
Dim objWMI As Object

Set objWMI = GetObject("winmgmts:")
strSQL = "SELECT * FROM win32_NetworkAdapterConfiguration WHERE IPEnabled = true"
Set objResult = objWMI.execquery(strSQL)

For Each objCard In objResult
If IsArray(objCard.IpAddress) Then
lngStatus = objCard.EnableStatic(Array(strNewIP), Array(strSubNetMask))
End If
Next
End Sub

Is there a way in PureBasic?
Top
User avatar
bingo
Enthusiast
Enthusiast
Posts: 210
Joined: Fri Apr 02, 2004 12:21 pm
Location: germany/thueringen
Contact:
Contact bingo

Post by bingo »

:) pb ... wmi-version

thanks to:
http://purebasic.hmt-forum.com/viewtopi ... hlight=wmi

view:
http://msdn.microsoft.com/library/defau ... ration.asp

list all net-adapters and mac-address

Code: Select all


#COINIT_MULTITHREAD=0
#RPC_C_AUTHN_LEVEL_CONNECT=2
#RPC_C_IMP_LEVEL_IDENTIFY=2
#EOAC_NONE=0
#RPC_C_AUTHN_WINNT=10
#RPC_C_AUTHZ_NONE=0
#RPC_C_AUTHN_LEVEL_CALL=3
#RPC_C_IMP_LEVEL_IMPERSONATE=3
#CLSCTX_INPROC_SERVER=1
#WBEM_S_NO_ERROR = 0

Structure d
  l.l
  h.l
EndStructure


Procedure.l ansi2bstr(ansi.s)
  size.l=MultiByteToWideChar_(#CP_ACP,0,ansi,-1,0,0)
  Dim unicode.w(size)
  MultiByteToWideChar_(#CP_ACP, 0, ansi, Len(ansi), unicode(), size)
  ProcedureReturn SysAllocString_(@unicode())
EndProcedure

Procedure.s unicode2ansi(mem)
  ansi.s=""
  Repeat
    a=PeekW(mem)
    ansi=ansi+Chr(a)
    mem+2
  Until a=0
  ProcedureReturn ansi
EndProcedure



; ___________________ Initialisations __________________________

; partout, hres doit être nul si pas d'erreur

CoInitializeEx_(0,#COINIT_MULTITHREAD)
hres=CoInitializeSecurity_(0, -1,0,0,#RPC_C_AUTHN_LEVEL_CONNECT,#RPC_C_IMP_LEVEL_IDENTIFY,0,#EOAC_NONE,0)
hres=CoCreateInstance_(?CLSID_WbemLocator,0,#CLSCTX_INPROC_SERVER,?IID_IWbemLocator,@loc.IWbemLocator)
hres=loc\ConnectServer(ansi2bstr("root\cimv2"),0,0,0,0,0,0,@svc.IWbemServices)
hres=svc\queryinterface(?IID_IUnknown,@pUnk.IUnknown)
hres=CoSetProxyBlanket_(svc,#RPC_C_AUTHN_WINNT,#RPC_C_AUTHZ_NONE,0,#RPC_C_AUTHN_LEVEL_CALL,#RPC_C_IMP_LEVEL_IMPERSONATE,0,#EOAC_NONE)
hres=CoSetProxyBlanket_(pUnk,#RPC_C_AUTHN_WINNT,#RPC_C_AUTHZ_NONE,0,#RPC_C_AUTHN_LEVEL_CALL,#RPC_C_IMP_LEVEL_IMPERSONATE,0,#EOAC_NONE)
pUnk\release()
hres=CoCreateInstance_(?CLSID_WbemRefresher,0,#CLSCTX_INPROC_SERVER,?IID_IWbemRefresher,@pRefresher.IWbemRefresher)
hres=pRefresher\queryinterface(?IID_IWbemConfigureRefresher,@pConfig.IWbemConfigureRefresher)
hres=pConfig\AddEnum(svc,ansi2bstr("Win32_NetworkAdapterConfiguration"),0,0,@penum.IWbemHiPerfEnum,@id)
pConfig\release()
Dim tab.IWbemObjectAccess(100)
For x=1 To 2
pRefresher\refresh(0)
hres=penum\GetObjects(0,100*SizeOf(IWbemObjectAccess),@tab(),@retour.l)
If x=1
  hres=tab(0)\GetPropertyHandle(ansi2bstr("Caption"),0,@adapter)
  hres=tab(0)\GetPropertyHandle(ansi2bstr("MACAddress"),0,@macadr)
EndIf
If x>1

*MemoryID = AllocateMemory(500)

For i=0 To retour-1

  tab(i)\Readpropertyvalue(adapter,500,@len,*MemoryID)
  Debug unicode2ansi(*MemoryID)
  ZeroMemory_(*MemoryID,500)

  tab(i)\Readpropertyvalue(macadr,500,@len,*MemoryID)
  Debug unicode2ansi(*MemoryID)
  ZeroMemory_(*MemoryID,500)

  tab(i)\release()
Next i

FreeMemory(*MemoryID)

EndIf
Delay(500)
Next
penum\release()
pRefresher\release();
svc\release()
loc\release()
CoUninitialize_()
End

;_______________ données_________________________

DataSection
CLSID_WbemLocator:
    ;4590f811-1d3a-11d0-891f-00aa004b2e24
Data.l $4590F811
Data.w $1D3A, $11D0
Data.b $89, $1F, $00, $AA, $00, $4B, $2E, $24
IID_IWbemLocator:
    ;dc12a687-737f-11cf-884d-00aa004b2e24
Data.l $DC12A687
Data.w $737F, $11CF
Data.b $88, $4D, $00, $AA, $00, $4B, $2E, $24
IID_IUnknown:
    ;00000000-0000-0000-C000-000000000046
Data.l $00000000
Data.w $0000, $0000
Data.b $C0, $00, $00, $00, $00, $00, $00, $46
IID_IWbemRefresher:
;49353c99-516b-11d1-aea6-00c04fb68820
Data.l $49353C99
Data.w $516B, $11D1
Data.b $AE, $A6, $00, $C0, $4F, $B6, $88, $20
CLSID_WbemRefresher:
;c71566f2-561E-11D1-AD87-00C04FD8FDFF
Data.l $C71566F2
Data.w $561E, $11D1
Data.b $AD,$87,$00,$C0,$4F,$D8,$FD,$FF
IID_IWbemConfigureRefresher:
;49353c92-516b-11d1-aea6-00c04fb68820
Data.l $49353C92
Data.w $516B, $11D1
Data.b $AE, $A6, $00, $C0, $4F, $B6, $88, $20
IID_IWbemObjectAccess:
;49353c9a-516b-11d1-aea6-00c04fb68820
Data.l $49353C9A
Data.w $516B, $11D1
Data.b $AE, $A6, $00, $C0, $4F, $B6, $88, $20

EndDataSection
maybe any can optimize this code ... :lol:

wmi is a easy way to find hardware-settings ! (all OS >- WinME)
["1:0>1"]
Top
TerryHough
Enthusiast
Enthusiast
Posts: 781
Joined: Fri Apr 25, 2003 6:51 pm
Location: NC, USA
Contact:
Contact TerryHough

Post by TerryHough »

HB wrote:Thanks, it works fine with the tip from viewtopic.php?t=7347
See the credits... this was based on AngelSoul's code that you referenced.
There is an error in procedure CPUSpeed()
ulEAX_EDX is not a valid operator
I have make a comment over the procedure and the call and then it works
:)
??? Works perfectly here with PB Vs 3.93 Update 2 (latest)
Make sure you haven't changed some portion of the code by accident.
Top
HB
New User
New User
Posts: 5
Joined: Fri Mar 11, 2005 6:30 pm
Location: Germany

Post by HB »

Works fine, thanks :P
Top
User avatar
Psychophanta
Always Here
Always Here
Posts: 5153
Joined: Wed Jun 11, 2003 9:33 pm
Location: Anare
Contact:
Contact Psychophanta

Post by Psychophanta »

Hi, Bingo, It doesn't work on PB4.0.
I get Invalid Mem Access error :cry:
http://www.zeitgeistmovie.com

while (world==business) world+=mafia;
Top
ABBKlaus
Addict
Addict
Posts: 1143
Joined: Sat Apr 10, 2004 1:20 pm
Location: Germany

Post by ABBKlaus »

Modified bingo´s version to work with PB4.0 :

Code: Select all

#COINIT_MULTITHREAD=0 
#RPC_C_AUTHN_LEVEL_CONNECT=2 
#RPC_C_IMP_LEVEL_IDENTIFY=2 
#EOAC_NONE=0 
#RPC_C_AUTHN_WINNT=10 
#RPC_C_AUTHZ_NONE=0 
#RPC_C_AUTHN_LEVEL_CALL=3 
#RPC_C_IMP_LEVEL_IMPERSONATE=3 
#CLSCTX_INPROC_SERVER=1 
#WBEM_S_NO_ERROR = 0 

Procedure.l ansi2bstr(ansi.s) 
  *Buf=AllocateMemory(Len(ansi)*2+2)
  PokeS(*Buf,ansi,Len(ansi),#PB_Unicode)
  ProcedureReturn *Buf
EndProcedure 

; ___________________ Initialisations __________________________ 

; partout, hres doit être nul si pas d'erreur 

CoInitializeEx_(0,#COINIT_MULTITHREAD) 
hres=CoInitializeSecurity_(0, -1,0,0,#RPC_C_AUTHN_LEVEL_CONNECT,#RPC_C_IMP_LEVEL_IDENTIFY,0,#EOAC_NONE,0) 
hres=CoCreateInstance_(?CLSID_WbemLocator,0,#CLSCTX_INPROC_SERVER,?IID_IWbemLocator,@loc.IWbemLocator) 
hres=loc\ConnectServer(ansi2bstr("root\cimv2"),0,0,0,0,0,0,@svc.IWbemServices) 
hres=svc\queryinterface(?IID_IUnknown,@pUnk.IUnknown) 
hres=CoSetProxyBlanket_(svc,#RPC_C_AUTHN_WINNT,#RPC_C_AUTHZ_NONE,0,#RPC_C_AUTHN_LEVEL_CALL,#RPC_C_IMP_LEVEL_IMPERSONATE,0,#EOAC_NONE) 
hres=CoSetProxyBlanket_(pUnk,#RPC_C_AUTHN_WINNT,#RPC_C_AUTHZ_NONE,0,#RPC_C_AUTHN_LEVEL_CALL,#RPC_C_IMP_LEVEL_IMPERSONATE,0,#EOAC_NONE) 
pUnk\release() 
hres=CoCreateInstance_(?CLSID_WbemRefresher,0,#CLSCTX_INPROC_SERVER,?IID_IWbemRefresher,@pRefresher.IWbemRefresher) 
hres=pRefresher\queryinterface(?IID_IWbemConfigureRefresher,@pConfig.IWbemConfigureRefresher) 
hres=pConfig\AddEnum(svc,ansi2bstr("Win32_NetworkAdapterConfiguration"),0,0,@penum.IWbemHiPerfEnum,@id) 
pConfig\release() 
Dim tab.IWbemObjectAccess(100) 
For x=1 To 2 
  pRefresher\refresh(0) 
  hres=penum\GetObjects(0,100*SizeOf(IWbemObjectAccess),@tab(),@retour.l) 
  If x=1 
    hres=tab(0)\GetPropertyHandle(ansi2bstr("Caption"),0,@adapter) 
    hres=tab(0)\GetPropertyHandle(ansi2bstr("MACAddress"),0,@macadr) 
  EndIf 
  If x>1 
    *MemoryID = AllocateMemory(500) 
    For i=0 To retour-1
      tab(i)\Readpropertyvalue(adapter,500,@len,*MemoryID) 
      Debug PeekS(*MemoryID,500,#PB_Unicode)
      ZeroMemory_(*MemoryID,500) 
      
      tab(i)\Readpropertyvalue(macadr,500,@len,*MemoryID) 
      Debug PeekS(*MemoryID,500,#PB_Unicode)
      ZeroMemory_(*MemoryID,500) 
      
      tab(i)\release() 
    Next i 
    
    FreeMemory(*MemoryID) 
    
  EndIf 
  ;Delay(500) 
Next 
penum\release() 
pRefresher\release()
svc\release() 
loc\release() 
CoUninitialize_() 
End 

;_______________ données_________________________ 

DataSection 
CLSID_WbemLocator: 
    ;4590f811-1d3a-11d0-891f-00aa004b2e24 
Data.l $4590F811 
Data.w $1D3A, $11D0 
Data.b $89, $1F, $00, $AA, $00, $4B, $2E, $24 
IID_IWbemLocator: 
    ;dc12a687-737f-11cf-884d-00aa004b2e24 
Data.l $DC12A687 
Data.w $737F, $11CF 
Data.b $88, $4D, $00, $AA, $00, $4B, $2E, $24 
IID_IUnknown: 
    ;00000000-0000-0000-C000-000000000046 
Data.l $00000000 
Data.w $0000, $0000 
Data.b $C0, $00, $00, $00, $00, $00, $00, $46 
IID_IWbemRefresher: 
;49353c99-516b-11d1-aea6-00c04fb68820 
Data.l $49353C99 
Data.w $516B, $11D1 
Data.b $AE, $A6, $00, $C0, $4F, $B6, $88, $20 
CLSID_WbemRefresher: 
;c71566f2-561E-11D1-AD87-00C04FD8FDFF 
Data.l $C71566F2 
Data.w $561E, $11D1 
Data.b $AD,$87,$00,$C0,$4F,$D8,$FD,$FF 
IID_IWbemConfigureRefresher: 
;49353c92-516b-11d1-aea6-00c04fb68820 
Data.l $49353C92 
Data.w $516B, $11D1 
Data.b $AE, $A6, $00, $C0, $4F, $B6, $88, $20 
IID_IWbemObjectAccess: 
;49353c9a-516b-11d1-aea6-00c04fb68820 
Data.l $49353C9A 
Data.w $516B, $11D1 
Data.b $AE, $A6, $00, $C0, $4F, $B6, $88, $20 

EndDataSection
Top
User avatar
Psychophanta
Always Here
Always Here
Posts: 5153
Joined: Wed Jun 11, 2003 9:33 pm
Location: Anare
Contact:
Contact Psychophanta

Post by Psychophanta »

Same behaviour here:
Invalid mem access error at line 26 :(
http://www.zeitgeistmovie.com

while (world==business) world+=mafia;
Top
User avatar
Psychophanta
Always Here
Always Here
Posts: 5153
Joined: Wed Jun 11, 2003 9:33 pm
Location: Anare
Contact:
Contact Psychophanta

Post by Psychophanta »

I also get the same error in the same line with the code posted by bingo and in PB3.94.
Is it a bug? :?
http://www.zeitgeistmovie.com

while (world==business) world+=mafia;
Top
ABBKlaus
Addict
Addict
Posts: 1143
Joined: Sat Apr 10, 2004 1:20 pm
Location: Germany

Post by ABBKlaus »

It runs fine here :
Image
how about the rest :?: can you confirm :!:
Top
Post Reply

Return to “General Discussion”