// Способ первый
uses
  WinSock;

function SendArp(DestIP, SrcIP: ULONG; pMacAddr: Pointer; PhyAddrLen: Pointer): DWord;
  stdcall; external 'iphlpapi.dll' name 'SendARP';

// В функцию можно передавать не только IP адрес "своего" компьютера,
// но и любого устройства, находящегося в одной сети с "вашим" компьютером
function GetMacAddr(const IPAddress: string; var ErrCode: DWORD): string;
var
  MacAddr: array[0..5] of Byte;
  DestIP: ULONG;
  PhyAddrLen: ULONG;
  WSAData: TWSAData;
begin
  Result := '';
  WSAStartup($0101, WSAData);
  try
    ZeroMemory(@MacAddr, SizeOf(MacAddr));
    DestIP := inet_addr(PAnsiChar(AnsiString(IPAddress)));
    PhyAddrLen := SizeOf(MacAddr);
    ErrCode := SendArp(DestIP, 0, @MacAddr, @PhyAddrLen);
    if ErrCode = S_OK then
      Result:=Format('%2.2x-%2.2x-%2.2x-%2.2x-%2.2x-%2.2x', 
                     [MacAddr[0], MacAddr[1], MacAddr[2], MacAddr[3], MacAddr[4], MacAddr[5]]);
  finally
    WSACleanup;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Mac: string;
  Err: DWord;
begin
  Mac := GetMacAddr('10.0.7.11', Err);
  if Err = S_OK then
    ShowMessage(Mac)
  else
    ShowMessage('Ошибка: ' + IntToStr(Err) + #13 + SysErrorMessage(Err));
end;

// Способ второй
function GetPermanentEthernetAddress: string;
var
 Func: function(var guid: TGUID): Integer stdcall;
 Lib: HINST;
 R: Integer;
 Guid: TGuid;
begin
  Result := '';
  Lib := LoadLibrary('RPCRT4.DLL');
  Func := GetProcAddress(Lib, 'UuidCreateSequential');
  if Assigned(@Func) then
  begin
    R := Func(Guid);
    if R = 0 then
      for R := 2 to 7 do
      begin
        Result := Result + IntToHex(Guid.D4[R], 2);
        if R <> 7 then
          Result := Result + '-';
      end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage(GetPermanentEthernetAddress);
end;

// Способ третий
uses
  Nb30;

function GetAdapterInfo(Lana: AnsiChar): 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) <> AnsiChar(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) <> AnsiChar(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;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage(GetMACAddress);
end;

// Способ первый
uses
  {...,} ActiveX;

function NetSend(const sTo, sMessage: string): Boolean;
type
  PNetMessageBufferSend = ^TNetMessageBufferSend;
  TNetMessageBufferSend = function(
    servername: PWideChar;
    msgname: PWideChar;
    fromname: PWideChar;
    buf: PBYTE;
    buflen: DWORD
    ): Integer; stdcall;
var
  wMessage, wTo: PWideChar;
  i, hLib: Integer;
  NetMessageBufferSend: TNetMessageBufferSend;
begin
  Result := False;

  hLib := LoadLibrary('NetApi32.dll');

  if hlib > 0 then
  try
    @NetMessageBufferSend := GetProcAddress(hLib, 'NetMessageBufferSend');
    if @NetMessageBufferSend <> nil then
    begin
      wMessage := CoTaskMemAlloc((Length(sMessage) + 1) * SizeOf(WideChar));
      try
         wTo := CoTaskMemAlloc((Length(sTo) + 1) * SizeOf(WideChar));
         try
            StringToWideChar(sMessage, wMessage, Length(sMessage) + 1);
            StringToWideChar(sTo, wTo, Length(sTo) + 1);
            i := NetMessageBufferSend(nil, wTo, nil, PBYTE(wMessage),
                                      (Length(sMessage) + 1) * SizeOf(WideChar));
            Result := i = ERROR_SUCCESS;
            if not Result then
              MessageBox(GetForegroundWindow, 'Сообщение не отправленно', nil, $1010);
         finally
           CoTaskMemFree(wTo);
         end;
      finally
        CoTaskMemFree(wMessage);
      end;
    end
    else
      MessageBox(GetForegroundWindow,
                 'Функция NetMessageBufferSend не обноружина', nil, $1010);
  finally
    FreeLibrary(hLib);
  end
  else
    MessageBox(GetForegroundWindow, 'NetApi32.dll не загружена', nil, $1010);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if NetSend('LoginName', 'Your Message...') then
    MessageBox(Handle, 'LoginName', 'Your Message...', MB_ICONINFORMATION);
end;

// Способ второй
function NetSend( dest, Source, Msg: string): Longint; overload;
type
  TNetMessageBufferSendFunction = function( servername, msgname, fromname: PWideChar;
    buf: PWideChar; buflen: Cardinal): Longint; stdcall;
var
  NetMessageBufferSend: TNetMessageBufferSendFunction;
  SourceWideChar: PWideChar;
  DestWideChar: PWideChar;
  MessagetextWideChar: PWideChar;
  Handle: THandle;
begin
  Handle := LoadLibrary('NETAPI32.DLL');

  if Handle = 0 then
  begin
    Result := GetLastError;
    Exit;
  end;

  @NetMessageBufferSend := GetProcAddress(Handle, 'NetMessageBufferSend');

  if @NetMessageBufferSend = nil then
  begin
    Result := GetLastError;
    Exit;
  end;

  MessagetextWideChar := nil;
  SourceWideChar := nil;
  DestWideChar := nil;

  try
    GetMem(MessagetextWideChar, Length(Msg) * SizeOf(WideChar) + 1);
    GetMem(DestWideChar, 20 * SizeOf(WideChar) + 1);
    StringToWideChar(Msg, MessagetextWideChar, Length(Msg) * SizeOf(WideChar) + 1);
    StringToWideChar(Dest, DestWideChar, 20 * SizeOf(WideChar) + 1);

    if Source = '' then
      Result := NetMessageBufferSend(nil, DestWideChar, nil,
                                     MessagetextWideChar,
                                     Length(Msg) * SizeOf(WideChar) + 1)
    else
    begin
      GetMem(SourceWideChar, 20 * SizeOf(WideChar) + 1);
      StringToWideChar(Source, SourceWideChar, 20 * SizeOf(WideChar) + 1);
      Result := NetMessageBufferSend(nil, DestWideChar, SourceWideChar,
                                     MessagetextWideChar,
                                     Length(Msg) * SizeOf(WideChar) + 1);
      FreeMem(SourceWideChar);
    end;
  finally
    FreeMem(MessagetextWideChar);
    FreeLibrary(Handle);
  end;
end;

function NetSend(Dest, Msg: string): Longint; overload;
begin
  Result := NetSend(Dest, '', Msg);
end;

function NetSend( Msg: string ): Longint; overload;
begin
  Result := NetSend('', '', Msg);
end;

procedure TForm1.Button1Click(Sender: TObject);
const
  NERR_BASE = 2100;
  NERR_NameNotFound = NERR_BASE + 173;
  NERR_NetworkError = NERR_BASE + 36;
  NERR_Success = 0;
var
  Res: Longint;
  sMsg: string;
begin
  Res := NetSend('LoginName', 'Your Message...');
  case Res of
    ERROR_ACCESS_DENIED: sMsg := 'user does not have access to the requested information.';
    ERROR_INVALID_PARAMETER: sMsg := 'The specified parameter is invalid.';
    ERROR_NOT_SUPPORTED: sMsg := 'This network request is not supported.';
    NERR_NameNotFound: sMsg := 'The user name could not be found.';
    NERR_NetworkError: sMsg := 'A general failure occurred in the network hardware.';
    NERR_Success: sMsg := 'Message sent!';
  end;
  ShowMessage(sMsg);
end;

uses
  RegularExpressions;

function IpToLong(ip: string): Integer;
var
  Matches: TMatchCollection;
begin
  Matches := TRegEx.Matches(ip, '(\d+)');
  Result := Matches[0].Value.ToInteger shl 24 +
            Matches[1].Value.ToInteger shl 16 +
            Matches[2].Value.ToInteger shl 8 +
            Matches[3].Value.ToInteger;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage(IpToLong('64.233.165.94').ToString);
end;

function LongToIp(ip: Integer): string;
begin
  Result := ((ip shr 24) and $FF).ToString + '.' +
            ((ip shr 16) and $FF).ToString + '.' +
            ((ip shr 8) and $FF).ToString + '.' +
            (ip and $FF).ToString;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage(LongToIp(1089054046));
end;

uses
  {...,} WinInet;

// exception_sheet - список исключений
function SetSystemProxy(host: string; port: string; exception_sheet: string): Boolean;
type
  INTERNET_PER_CONN_OPTION = record
    dwOption: DWORD;
    Value: record
      case Integer of
        1: (dwValue: DWORD);
        2: (pszValue: PChar); {Unicode/ANSI}
        3: (ftValue: TFileTime);
    end;
  end;

  LPINTERNET_PER_CONN_OPTION = ^INTERNET_PER_CONN_OPTION;
  INTERNET_PER_CONN_OPTION_List = record
    dwSize: DWORD;
    pszConnection: LPTSTR;
    dwOptionCount: DWORD;
    dwOptionError: DWORD;
    intOptions: LPINTERNET_PER_CONN_OPTION;
  end;
  LPINTERNET_PER_CONN_OPTION_List = ^INTERNET_PER_CONN_OPTION_List;

const
  INTERNET_PER_CONN_FLAGS = 1;
  PROXY_TYPE_PROXY = $00000002;
  INTERNET_PER_CONN_PROXY_BYPASS = 3;
  INTERNET_PER_CONN_PROXY_SERVER = 2;
  INTERNET_OPTION_PER_CONNECTION_OPTION = 75;
  PROXY_TYPE_DIRECT = $00000001;

var
  list: INTERNET_PER_CONN_OPTION_LIST;
  dwBufSize: DWORD;
  hInternet: Pointer;
  Options: array[1..3] of INTERNET_PER_CONN_OPTION;

begin
  Result := False;
  dwBufSize := SizeOf(list);
  list.dwSize := SizeOf(list);
  list.pszConnection := nil;
  list.dwOptionCount := High(Options);

  Options[1].dwOption := INTERNET_PER_CONN_FLAGS;

  Options[2].dwOption := INTERNET_PER_CONN_PROXY_SERVER;
  if (host = '') or (port = '') then
  begin
    Options[1].Value.dwValue := PROXY_TYPE_DIRECT;
    Options[2].Value.pszValue := PChar('');
  end
  else
  begin
    Options[1].Value.dwValue := PROXY_TYPE_PROXY;
    Options[2].Value.pszValue := PChar(host + ':' + port);
  end;

  Options[3].dwOption := INTERNET_PER_CONN_PROXY_BYPASS;
  Options[3].Value.pszValue := PChar(exception_sheet);

  list.intOptions := @Options;
  hInternet := InternetOpen(PChar(''), INTERNET_OPEN_TYPE_DIRECT, nil, nil, 0);
  if hInternet <> nil then
  try
    Result := InternetSetOption(nil, INTERNET_OPTION_PER_CONNECTION_OPTION, @list, dwBufSize);
    Result := Result and InternetSetOption(nil, INTERNET_OPTION_REFRESH, nil, 0);
  finally
    InternetCloseHandle(hInternet);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  SetSystemProxy('127.0.0.1', '8090', '');
end;

type
  //WTS_CONNECTSTATE_CLASS - Session connect state
  WTS_CONNECTSTATE_CLASS = (
    WTSActive,       // User logged on to WinStation
    WTSConnected,    // WinStation connected to client
    WTSConnectQuery, // In the process of connecting to client
    WTSShadow,       // Shadowing another WinStation
    WTSDisconnected, // WinStation logged on without client
    WTSIdle,         // Waiting for client to connect
    WTSListen,       // WinStation is listening for connection
    WTSReset,        // WinStation is being reset
    WTSDown,         // WinStation is down due to error
    WTSInit);        // WinStation in initialization

  PWTS_SESSION_INFO = ^WTS_SESSION_INFO;
  WTS_SESSION_INFO = record
    SessionId: DWORD;              // session id
    pWinStationName: LPSTR;        // name of WinStation this session is connected to
    State: WTS_CONNECTSTATE_CLASS; // connection state (see enum)
  end;

  WTS_INFO_CLASS = (
    WTSInitialProgram,
    WTSApplicationName,
    WTSWorkingDirectory,
    WTSOEMId,
    WTSSessionId,
    WTSUserName,
    WTSWinStationName,
    WTSDomainName,
    WTSConnectState,
    WTSClientBuildNumber,
    WTSClientName,
    WTSClientDirectory,
    WTSClientProductId,
    WTSClientHardwareId,
    WTSClientAddress, // Returns pointer to a WTS_CLIENT_ADDRESS - structure
    WTSClientDisplay,
    WTSClientProtocolType,
    WTSIdleTime,
    WTSLogonTime,
    WTSIncomingBytes,
    WTSOutgoingBytes,
    WTSIncomingFrames,
    WTSOutgoingFrames,
    WTSClientInfo,
    WTSSessionInfo,
    WTSSessionInfoEx,
    WTSConfigInfo,
    WTSValidationInfo,
    WTSSessionAddressV4,
    WTSIsRemoteSession);

  PWTS_CLIENT_ADDRESS = ^WTS_CLIENT_ADDRESS;
  WTS_CLIENT_ADDRESS = record
    AddressFamily: DWORD;           // AF_INET, AF_IPX, AF_NETBIOS, AF_UNSPEC
    Address: array [0..19] of Byte; // client network address
  end;

  PWTSSessionInfoA = ^TWTSSessionInfoA;
  TWTSSessionInfoA = array[0..0] of WTS_SESSION_INFO;

const
  WTS_CURRENT_SERVER_HANDLE = THandle(0);

  AF_INET = 2;     // internetwork: UDP, TCP, etc.
  AF_NS = 6;       // XEROX NS protocols
  AF_IPX = AF_NS;  // IPX protocols: IPX, SPX, etc.
  AF_NETBIOS = 17; // NetBios-style addresses
  AF_UNSPEC = 0;   // unspecified

  function WTSWaitSystemEvent(hServer: THandle; EventMask: DWORD;
    var pEventFlags: DWORD): BOOL; stdcall; external 'wtsapi32.dll' name 'WTSWaitSystemEvent';

  function WTSEnumerateSessionsA(hServer: THandle; Reserved: DWORD;
    Version: DWORD; var ppSessionInfo: PWTS_SESSION_INFO;
    var pCount: DWORD): BOOL; stdcall; external 'wtsapi32.dll' name 'WTSEnumerateSessionsA';

   function WTSQuerySessionInformationA(hServer: THandle; SessionId: DWORD;
     WTSInfoClass: WTS_INFO_CLASS; var ppBuffer: Pointer; var pBytesReturned: DWORD): BOOL;
     stdcall; external 'wtsapi32.dll' name 'WTSQuerySessionInformationA';

   procedure WTSFreeMemory(pMemory: pointer); stdcall;
     external 'wtsapi32.dll' name 'WTSFreeMemory';

procedure TForm1.Button1Click(Sender: TObject);
var
  pArrSessInfo: PWTSSessionInfoA;
  iNumSess: DWORD;
  i: Integer;
  pBuf: Pointer;
  iBufSize: DWORD;
  pWTSClientAddr: PWTS_CLIENT_ADDRESS;
  sIP: string;
begin
  if WTSEnumerateSessionsA(WTS_CURRENT_SERVER_HANDLE, 0, 1,
    PWTS_SESSION_INFO(pArrSessInfo), iNumSess) then
  try
    for i := 0 to iNumSess-1 do
    begin
      if WTSQuerySessionInformationA(WTS_CURRENT_SERVER_HANDLE,
        pArrSessInfo^[i].SessionId, WTSClientAddress, pBuf, iBufSize) then
      begin
        try
          pWTSClientAddr := PWTS_CLIENT_ADDRESS(pBuf);

          sIP := '';
          if Assigned(pWTSClientAddr) then
            if pWTSClientAddr^.AddressFamily = AF_INET then
              sIP := Format('%d.%d.%d.%d',
                            [pWTSClientAddr^.Address[2],
                             pWTSClientAddr^.Address[3],
                             pWTSClientAddr^.Address[4],
                             pWTSClientAddr^.Address[5]]);
          if sIP <> '' then
            ShowMessage(sIP);
        finally
          WTSFreeMemory(pBuf);
        end;
      end;
    end
  finally
    WTSFreeMemory(pArrSessInfo);
  end;
end;

type
  //WTS_CONNECTSTATE_CLASS - Session connect state
  WTS_CONNECTSTATE_CLASS = (
    WTSActive,       // User logged on to WinStation
    WTSConnected,    // WinStation connected to client
    WTSConnectQuery, // In the process of connecting to client
    WTSShadow,       // Shadowing another WinStation
    WTSDisconnected, // WinStation logged on without client
    WTSIdle,         // Waiting for client to connect
    WTSListen,       // WinStation is listening for connection
    WTSReset,        // WinStation is being reset
    WTSDown,         // WinStation is down due to error
    WTSInit);        // WinStation in initialization

  PWTS_SESSION_INFO = ^WTS_SESSION_INFO;
  WTS_SESSION_INFO = record
    SessionId: DWORD;              // session id
    pWinStationName: LPSTR;        // name of WinStation this session is connected to
    State: WTS_CONNECTSTATE_CLASS; // connection state (see enum)
  end;

  PWTS_CLIENT_ADDRESS = ^WTS_CLIENT_ADDRESS;
  WTS_CLIENT_ADDRESS = record
    AddressFamily: DWORD;           // AF_INET, AF_IPX, AF_NETBIOS, AF_UNSPEC
    Address: array [0..19] of Byte; // client network address
  end;

  PWTSSessionInfoA = ^TWTSSessionInfoA;
  TWTSSessionInfoA = array[0..0] of WTS_SESSION_INFO;

const
  WTS_CURRENT_SERVER_HANDLE = THandle(0);

  AF_INET = 2;     // internetwork: UDP, TCP, etc.
  AF_NS = 6;       // XEROX NS protocols
  AF_IPX = AF_NS;  // IPX protocols: IPX, SPX, etc.
  AF_NETBIOS = 17; // NetBios-style addresses
  AF_UNSPEC = 0;   // unspecified

  WTSClientAddress = 14;

  function WTSWaitSystemEvent(hServer: THandle; EventMask: DWORD;
    var pEventFlags: DWORD): BOOL; stdcall; external 'wtsapi32.dll' name 'WTSWaitSystemEvent';

  function WTSEnumerateSessionsA(hServer: THandle; Reserved: DWORD;
    Version: DWORD; var ppSessionInfo: PWTS_SESSION_INFO;
    var pCount: DWORD): BOOL; stdcall; external 'wtsapi32.dll' name 'WTSEnumerateSessionsA';

   function WTSQuerySessionInformationA(hServer: THandle; SessionId: DWORD;
     WTSInfoClass: DWORD; var ppBuffer: Pointer; var pBytesReturned: DWORD): BOOL;
     stdcall; external 'wtsapi32.dll' name 'WTSQuerySessionInformationA';

   procedure WTSFreeMemory(pMemory: pointer); stdcall;
     external 'wtsapi32.dll' name 'WTSFreeMemory';

procedure TForm1.Button1Click(Sender: TObject);
var
  pBuf: Pointer;
  iBufSize: DWORD;
  pWTSClientAddr: PWTS_CLIENT_ADDRESS;
  pSessionId: DWORD;
  sIP: string;
begin
  ProcessIdToSessionId(GetCurrentProcessId, pSessionId);
  // или pSessionId := DWORD(-1);

  if WTSQuerySessionInformationA(WTS_CURRENT_SERVER_HANDLE,
    pSessionId, WTSClientAddress, pBuf, iBufSize) then
  begin
    try
      pWTSClientAddr := PWTS_CLIENT_ADDRESS(pBuf);

      sIP := '';
      if Assigned(pWTSClientAddr) then
        if pWTSClientAddr^.AddressFamily = AF_INET then
          sIP := Format('%d.%d.%d.%d',
                        [pWTSClientAddr^.Address[2],
                         pWTSClientAddr^.Address[3],
                         pWTSClientAddr^.Address[4],
                         pWTSClientAddr^.Address[5]]);
      if sIP <> '' then
        ShowMessage(sIP);
    finally
      WTSFreeMemory(pBuf);
    end;
  end;
end;