NIC MAC Nummer

uses NB30;

Function GetMACAdress:String;
Var
  NCB  : PNCB;
  Adapter :PAdapterStatus;

  URetCode :Pchar;
  RetCode  :char;
  I : Integer;
  Lenum  : PlanaEnum;
  _SystemID :String;
  TMPSTR :String;
Begin
  Result:=\'\';
  _SystemID:=\'\';
  Getmem(NCB,sizeof(TNCB));
  Fillchar(NCB^,Sizeof(TNCB),0);

  Getmem(Lenum,sizeof(TLanaEnum));
  Fillchar(Lenum^,Sizeof(TLanaEnum),0);

  Getmem(Adapter,sizeof(TAdapterStatus));
  Fillchar(Adapter^,Sizeof(TAdapterStatus),0);

  Lenum.Length:=chr(0);
  NCB.ncb_command:=chr(NCBENUM);
  NCB.ncb_buffer:=pointer(Lenum);
  NCB.ncb_length:=sizeof(Lenum);
  RetCode:=Netbios(NCB);

  i:=0;
  Repeat
    Fillchar(NCB^,Sizeof(TNCB),0);
    Ncb.ncb_command:= chr(NCBRESET);
    Ncb.ncb_lana_num:=lenum.lana[I];
    RetCode:= Netbios(Ncb);

    Fillchar(NCB^,Sizeof(TNCB),0);
    Ncb.ncb_command:= chr(NCBASTAT);
    Ncb.ncb_lana_num:= lenum.lana[I];
    // Must be 16
    Ncb.ncb_callname:=\'*              \';

    Ncb.ncb_buffer:=pointer(Adapter);

    Ncb.ncb_length:=sizeof(TAdapterStatus);
    RetCode:= Netbios(Ncb);
    //---- calc _systemId from mac-address[2-5] XOR mac-address[1]...
    if (RetCode=chr(0)) or (RetCode=chr(6)) then
      Begin
        _SystemId:=inttohex(ord(Adapter.adapter_address[0]),2)+\'-\'+
                    inttohex(ord(Adapter.adapter_address[1]),2)+\'-\'+
                    inttohex(ord(Adapter.adapter_address[2]),2)+\'-\'+
                    inttohex(ord(Adapter.adapter_address[3]),2)+\'-\'+
                    inttohex(ord(Adapter.adapter_address[4]),2)+\'-\'+
                    inttohex(ord(Adapter.adapter_address[5]),2);

      End;
      inc(i);
  until (I>=ord(Lenum.length)) or (_SystemID<>\'00-00-00-00-00-00\');
  FreeMem(NCB);
  FreeMem(Adapter);
  FreeMem(Lenum);
  GetMacAdress:=_SystemID;
End;



procedure TForm1.Button1Click(Sender: TObject);
begin
  Label1.Caption := GetMACAdress;
end;

Stoney

stoney: Prøv lige og smid den kode der ind i et Console Application ! ;)

Snowball

snowball>>

Jeg har ikke lige delphi på denne PC, men hvad er
problemet

Stoney

Prøv den her ... Den virker OGSÅ i DOS :
program IPHelperDemo;


{$Apptype Console}

uses
  Windows, SYSUtils;
Const
  MAX_HOSTNAME_LEN              = 128; { from IPTYPES.H }
  MAX_DOMAIN_NAME_LEN            = 128;
  MAX_SCOPE_ID_LEN              = 256;
  MAX_ADAPTER_NAME_LENGTH        = 256;
  MAX_ADAPTER_DESCRIPTION_LENGTH = 128;
  MAX_ADAPTER_ADDRESS_LENGTH    = 8;

Type
  TIPAddressString = Array[0..4*4-1] of Char;

  PIPAddrString = ^TIPAddrString;
  TIPAddrString = Record
    Next      : PIPAddrString;
    IPAddress : TIPAddressString;
    IPMask    : TIPAddressString;
    Context  : Integer;
  End;

  PFixedInfo = ^TFixedInfo;
  TFixedInfo = Record { FIXED_INFO }
    HostName        : Array[0..MAX_HOSTNAME_LEN+3] of Char;
    DomainName      : Array[0..MAX_DOMAIN_NAME_LEN+3] of Char;
    CurrentDNSServer : PIPAddrString;
    DNSServerList    : TIPAddrString;
    NodeType        : Integer;
    ScopeId          : Array[0..MAX_SCOPE_ID_LEN+3] of Char;
    EnableRouting    : Integer;
    EnableProxy      : Integer;
    EnableDNS        : Integer;
  End;

  PIPAdapterInfo = ^TIPAdapterInfo;
  TIPAdapterInfo = Record { IP_ADAPTER_INFO }
    Next                : PIPAdapterInfo;
    ComboIndex          : Integer;
    AdapterName        : Array[0..MAX_ADAPTER_NAME_LENGTH+3] of Char;
    Description        : Array[0..MAX_ADAPTER_DESCRIPTION_LENGTH+3] of Char;
    AddressLength      : Integer;
    Address            : Array[1..MAX_ADAPTER_ADDRESS_LENGTH] of Byte;
    Index              : Integer;
    _Type              : Integer;
    DHCPEnabled        : Integer;
    CurrentIPAddress    : PIPAddrString;
    IPAddressList      : TIPAddrString;
    GatewayList        : TIPAddrString;
    DHCPServer          : TIPAddrString;
    HaveWINS            : Bool;
    PrimaryWINSServer  : TIPAddrString;
    SecondaryWINSServer : TIPAddrString;
    LeaseObtained      : Integer;
    LeaseExpires        : Integer;
  End;

Function GetNetworkParams(FI : PFixedInfo; Var BufLen : Integer) : Integer; StdCall; External \'iphlpapi.dll\' Name \'GetNetworkParams\';
Function GetAdaptersInfo(AI : PIPAdapterInfo; Var BufLen : Integer) : Integer; StdCall; External \'iphlpapi.dll\' Name \'GetAdaptersInfo\';

{$R *.RES}


procedure GetAdapterInformation;
Var
  AI,Work : PIPAdapterInfo;
  Size    : Integer;
  Res    : Integer;
  I      : Integer;

  Function MACToStr(ByteArr : PByte; Len : Integer) : String;
  Begin
    Result := \'\';
    While (Len > 0) do Begin
      Result := Result+IntToHex(ByteArr^,2)+\'-\';
      ByteArr := Pointer(Integer(ByteArr)+SizeOf(Byte));
      Dec(Len);
    End;
    SetLength(Result,Length(Result)-1); { remove last dash }
  End;

  Function GetAddrString(Addr : PIPAddrString) : String;
  Begin
    Result := \'\';
    While (Addr <> nil) do Begin
      Result := Result+\'A: \'+Addr^.IPAddress+\' M: \'+Addr^.IPMask+#13;
      Addr := Addr^.Next;
    End;
  End;

  Function TimeTToDateTimeStr(TimeT : Integer) : String;
  Const UnixDateDelta = 25569; { days between 12/31/1899 and 1/1/1970 }
  Var
    DT  : TDateTime;
    TZ  : TTimeZoneInformation;
    Res : DWord;

  Begin
    If (TimeT = 0) Then Result := \'\'
    Else Begin
      { Unix TIME_T is secs since 1/1/1970 }
      DT := UnixDateDelta+(TimeT / (24*60*60)); { in UTC }
      { calculate bias }
      Res := GetTimeZoneInformation(TZ);

      If (Res = TIME_ZONE_ID_INVALID) Then
        RaiseLastOSError;

      If (Res = TIME_ZONE_ID_STANDARD) Then
      Begin
        DT := DT-((TZ.Bias+TZ.StandardBias) / (24*60));
        Result := DateTimeToStr(DT)+\' \'+WideCharToString(TZ.StandardName);
      End
      Else
      Begin { daylight saving time }
        DT := DT-((TZ.Bias+TZ.DaylightBias) / (24*60));
        Result := DateTimeToStr(DT)+\' \'+WideCharToString(TZ.DaylightName);
      End;
    End;
  End;

begin
  Size := 5120;
  GetMem(AI,Size);
  Res := GetAdaptersInfo(AI,Size);

  If (Res <> ERROR_SUCCESS) Then
  Begin
    SetLastError(Res);
    RaiseLastOSError;
  End;

  Begin
    Work := AI;
    I := 1;
    Repeat
      WriteLN(\'\');
      WriteLN(\'Adapter \'            +IntToStr(I));
      WriteLN(\'  ComboIndex: \'      +IntToStr(Work^.ComboIndex));
      WriteLN(\'  Adapter name: \'    +Work^.AdapterName);
      WriteLN(\'  Description: \'    +Work^.Description);
      WriteLN(\'  Adapter Address: \' +MACToStr(@Work^.Address,Work^.AddressLength));
      WriteLN(\'  Index: \'          +IntToStr(Work^.Index));
      WriteLN(\'  Type: \'            +IntToStr(Work^._Type));
      WriteLN(\'  DHCP: \'            +IntToStr(Work^.DHCPEnabled));
      WriteLN(\'  Current IP: \'      +GetAddrString(Work^.CurrentIPAddress));
      WriteLN(\'  IP Addresses: \'    +GetAddrString(@Work^.IPAddressList));
      WriteLN(\'  Gateways: \'        +GetAddrString(@Work^.GatewayList));
      WriteLN(\'  DHCP servers: \'    +GetAddrString(@Work^.DHCPServer));
      WriteLN(\'  Has WINS: \'        +IntToStr(Integer(Work^.HaveWINS)));
      WriteLN(\'  Primary WINS: \'    +GetAddrString(@Work^.PrimaryWINSServer));
      WriteLN(\'  Secondary WINS: \'  +GetAddrString(@Work^.SecondaryWINSServer));
      WriteLN(\'  Lease obtained: \'  +TimeTToDateTimeStr(Work^.LeaseObtained));
      WriteLN(\'  Lease expires: \'  +TimeTToDateTimeStr(Work^.LeaseExpires));
      Inc(I);
      Work := Work^.Next;
    Until (Work = nil);
  End;
  FreeMem(AI);
end;

procedure GetNetworkParameters;
Var
  FI  : PFixedInfo;
  Size : Integer;
  Res  : Integer;
  I    : Integer;
  DNS  : PIPAddrString;

begin
  Size := 1024;
  GetMem(FI,Size);
  Res := GetNetworkParams(FI,Size);
  If (Res <> ERROR_SUCCESS) Then
  Begin
    SetLastError(Res);
    RaiseLastOSError;
  End;

  Begin
    WriteLN(\'Host name: \'+FI^.HostName);
    WriteLN(\'Domain name: \'+FI^.DomainName);

    If (FI^.CurrentDNSServer <> nil) Then
      WriteLN(\'Current DNS Server: \'+FI^.CurrentDNSServer^.IPAddress)
    Else
      WriteLN(\'Current DNS Server: (none)\');

    I := 1;

    DNS := @FI^.DNSServerList;
    Repeat
      WriteLN(\'DNS \'+IntToStr(I)+\': \'+DNS^.IPAddress);
      Inc(I);
      DNS := DNS^.Next;
    Until (DNS = nil);

    WriteLN(\'Scope ID: \'+FI^.ScopeId);
    WriteLN(\'Routing: \'+IntToStr(FI^.EnableRouting));
    WriteLN(\'Proxy: \'+IntToStr(FI^.EnableProxy));
    WriteLN(\'DNS: \'+IntToStr(FI^.EnableDNS));
  End;
  FreeMem(FI);
end;


begin
  GetNetworkParameters;
  GetAdapterInformation;
end.


Jens B

Perfekt .... specielt at denne kode også virker i DOS. Jeg er glad for, at der også kom et mere velovervejet bud (no offence stoney) der tager dette i betragtning.

MIN løsning virker IKKE på win95 og WinNT4 !!!

Jens B