FAQ DelphiConsultez toutes les FAQ

1
2
3
4
5
6
7
8
9
10
11
function ComputerName: string; 
var 
  lpBuffer: array[0..MAX_COMPUTERNAME_LENGTH] of char; 
  nSize: dword; 
begin 
  nSize:= Length(lpBuffer); 
  if GetComputerName(lpBuffer, nSize) then 
    result:= lpBuffer 
  else 
    result:= ''; 
end;

1
2
3
4
5
6
7
8
9
10
Uses Sockets; 
  
function getIP:string; 
Begin 
  With TCustomIpClient.Create(Nil) do 
  Begin 
    Result:=LocalHostAddr; 
    Free; 
  End; 
End;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
uses winsock;  
  
function LocalIP : String;  
type  
  TArrayPInAddr = array [0..10] of PInAddr;  
  PArrayPInAddr = ^TArrayPInAddr;  
var  
  phe      : PHostEnt;  
  pptr     : PArrayPInAddr;  
  Buffer   : array [0..63] of char;  
  i        : integer;  
  GInitData: TWSADATA;  
begin  
  WSAStartup($101, GInitData);  
  result := '';  
  GetHostName(Buffer, sizeof(Buffer));  
  phe := GetHostByName(Buffer);  
  if phe=nil  
    then exit;  
  pptr := PArrayPInAddr(phe^.h_addr_list);  
  i := 0;  
  while pptr^[i]<>nil do  
  begin  
    result := StrPas(inet_ntoa(pptr^[i]^));  
    Inc(i);  
  end;  
  WSACleanup;  
end;

1
2
3
4
5
6
7
8
function getIP:string;  
Begin  
  With TPowerSock.Create(Nil) do  
  Begin  
    Result:= LocalIP;  
    Free;  
  End;  
End;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
// Renvoie les adresses IP de la machine sous forme d'un TStrings 
Procedure GetIPAdresses(Result:TStrings);  
Const  
     // Nom de la DLL IP Helper.  
     dllIPHelperName = 'IpHlpApi.dll' ;  
  
Type  
    // Ces éléments n'existent pas dans les unités standard Delphi, il faut  
    // donc tout redéclarer "manuellement".  
  
    // Structure contenant une définition d'adresse  
    TMIB_IpAddrRow = Record  
      dwAddr      : DWord ;  
      dwIndex     : DWord ;  
      dwWordMask  : DWord ;  
      dwBCastAddr : DWord ;  
      dwReasmSize : DWord ;  
      Unused1     : Word  ;  
      Unused2     : Word  ;  
    End;  
  
    // Structure remplie par la fonction GetIpAddrTable  
    PIpAddrTable = ^TIpAddrTable ;  
    TIpAddrTable = Packed Record  
      dwNumEntries : DWord ;  
      Table        : Array[Byte] Of TMIB_IpAddrRow ;  
    End;  
  
  // Définition du prototype de la fonction  
  TGetIpAddrTable  = Function ( IpTable : PIpAddrTable ; Var Long : DWORD ; Order : BOOL ) : DWORD ; stdcall ;  
  
Var  
   GetIpAddrTable : TGetIpAddrTable ;  
   Table          : PIpAddrTable    ;  
   Long           : DWORD           ;  
   I, DLLHandle   : Integer         ;  
Begin  
     Result.Clear; 
     // Chargement de la DLL IP Helper  
     GetIpAddrTable:=Nil;  
     DLLHandle:=0;  
     DLLHandle:=LoadLibrary(dllIPHelperName);  
     If (DLLHandle<>0) Then  
        GetIpAddrTable:=GetProcAddress(DLLHandle,'GetIpAddrTable') ;  
     // Tentative d'appel.  
     If Assigned(GetIpAddrTable) Then  
        Begin  
        // La fonction de récupération d'adresse IP existe, on l'utilise.  
        New(Table);  
        Long:=SizeOf(TIpAddrTable);  
        If GetIpAddrTable(Table,Long,False)=NO_ERROR Then  
           For I:=0 To (Table^.dwNumEntries-1) Do  
              Result.Add( Format('%d.%d.%d.%d', [ Table^.Table[i].dwAddr         And $FF,  
                                                 (Table^.Table[i].dwAddr Shr  8) And $FF,  
                                                 (Table^.Table[i].dwAddr Shr 16) And $FF,  
                                                 (Table^.Table[i].dwAddr Shr 24) And $FF] ) ) ;  
        Dispose(Table);  
        End;  
     // Libération de la DLL, si nécessaire.  
     If (DLLHandle<>0) Then  
        FreeLibrary(DLLHandle);  
End;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
uses  
  NB30;  
  
function GetAdapterInfo(Lana: Char): String;  
var  
  Adapter: TAdapterStatus;  
  NCB: TNCB;  
begin  
  FillChar(NCB, SizeOf(NCB), 0);  
  NCB.ncb_command := Char(NCBRESET);  
  NCB.ncb_lana_num := Lana;  
  if Netbios(@NCB) <> Char(NRC_GOODRET) then  
  begin  
    Result := 'mac not found';  
    Exit;  
  end;  
  
  FillChar(NCB, SizeOf(NCB), 0);  
  NCB.ncb_command := Char(NCBASTAT);  
  NCB.ncb_lana_num := Lana;  
  NCB.ncb_callname := '*';  
  
  FillChar(Adapter, SizeOf(Adapter), 0);  
  NCB.ncb_buffer := @Adapter;  
  NCB.ncb_length := SizeOf(Adapter);  
  if Netbios(@NCB) <> Char(NRC_GOODRET) then  
  begin  
    Result := 'mac not found';  
    Exit;  
  end;  
  Result :=  
    IntToHex(Byte(Adapter.adapter_address[0]), 2) + '-' +  
    IntToHex(Byte(Adapter.adapter_address[1]), 2) + '-' +  
    IntToHex(Byte(Adapter.adapter_address[2]), 2) + '-' +  
    IntToHex(Byte(Adapter.adapter_address[3]), 2) + '-' +  
    IntToHex(Byte(Adapter.adapter_address[4]), 2) + '-' +  
    IntToHex(Byte(Adapter.adapter_address[5]), 2);  
end;  
  
function GetMACAddress: string;  
var  
  AdapterList: TLanaEnum;  
  NCB: TNCB;  
begin  
  FillChar(NCB, SizeOf(NCB), 0);  
  NCB.ncb_command := Char(NCBENUM);  
  NCB.ncb_buffer := @AdapterList;  
  NCB.ncb_length := SizeOf(AdapterList);  
  Netbios(@NCB);  
  if Byte(AdapterList.length) > 0 then  
    Result := GetAdapterInfo(AdapterList.lana[0])  
  else  
    Result := 'mac not found';  
end;