Форум программистов [Powered by Invision Power Board]

Код


uses
  WinSock;

function GetLocalIP: String;
const WSVer = $101;
var
  wsaData: TWSAData;
  P: PHostEnt;
  Buf: array [0..127] of Char;
begin
  Result := '';
  if WSAStartup(WSVer, wsaData) = 0 then begin
    if GetHostName(@Buf, 128) = 0 then begin
      P := GetHostByName(@Buf);
      if P <> nil then Result := iNet_ntoa(PInAddr(p^.h_addr_list^)^);
    end;
    WSACleanup;
  end;
end;

Цитата(Competitor @ 24.8.2005, 16:17

)

узнать IP-адрес локальной машины

Цитата(Competitor @ 24.8.2005, 16:17

)

Какие компоненты при этом надо использовать?

Код


uses Registry; 
function TCPIPInstalled: boolean; 
var  
  Reg:   TRegistry;  
  RKeys: TStrings;  
begin  
 Result:=False;  
 try  
  Reg := TRegistry.Create;  
  RKeys := TStringList.Create;  
  Reg.RootKey:=HKEY_LOCAL_MACHINE;  
  if Reg.OpenKey('\Enum\Network\MSTCP', False) Then  
   begin  
     reg.GetKeyNames(RKeys);  
     Result := RKeys.Count > 0;  
   end;  
 finally  
  Reg.free;  
  RKeys.free;  
 end;

Код


var 
  WSAData: TWSAData; 
  SockAddrIn: TSockAddrIn; 
  Host: PHostEnt; 
  // Эти переменные объявлены в Winsock.pas
begin 
  if WSAStartup($101, WSAData) = 0 then begin 
    Host := GetHostByName(@Localname[1]); 
    if Host<>nil then begin 
      SockAddrIn.sin_addr.S_addr:= longint(plongint(Host^.h_addr_list^)^); 
      LocalIP := inet_ntoa(SockAddrIn.sin_addr); 
    end; 
    WSACleanUp; 
  end; 
end;

Код


Функции GetTcpTable, GetUdpTable. 

Импорт GetTcpTable: 

unit TcpTable;
interface
type
  PDWord = ^Longword;
  PMIB_TCPROW = ^TMIB_TCPROW;
  TMIB_TCPROW = record
    dwState: LongWord;
    dwLocalAddr: LongWord;
    dwLocalPort: LongWord;
    dwRemoteAddr: LongWord;
    dwRemotePort: LongWord;
  end;
  PMIB_TCPTABLE = ^TMIB_TCPTABLE;
  TMIB_TCPTABLE = record
    dwNumEntries: LongWord;
    table: array[0..0] of TMIB_TCPROW;
  end;

function GetTcpTable(var TcpTable: PMIB_TCPTABLE;
  var Size: PDWord; bOrder: Boolean): LongWord; stdcall

implementation

function GetTcpTable; external 'Iphlpapi.dll' name 'GetTcpTable';

end.
Вызов GetTcpTable: 

{$R-}
Entries := 16;
Sz := SizeOf(TMIB_TCPTABLE) + SizeOf(TMIB_TCPROW) * (Entries - 1);
pMibTable := nil;
try
  repeat
    ReallocMem(pMibTable, Sz);
    Res := GetTcpTable(pMibTable^, Sz, False);
  until Res <> ERROR_INSUFFICIENT_BUFFER;
  if Res <> NO_ERROR then
  begin
    ShowMessage(SysErrorMessage(Res));
    exit;
  end;
  for Entries := 0 to pMibTable.dwNumEntries - 1 do
  begin
    < Делать что - то >
  end;
finally
  FreeMem(pMibTable);
end;
{$R+}