[네트웍/인터넷] 설치된 Network Protocol 목록 구하기 (Winsock2)

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComObj, WinSock2;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function ByteOrderToString(O: DWORD): string;
begin
  case O of
    BIGENDIAN: Result := 'Big Endian';
    LITTLEENDIAN: Result := 'Little Endian';
  else
    Result := 'Unknown';
  end;
end;

function SocketTypeToString(T: DWORD): string;
begin
  case T of
    SOCK_STREAM: Result := 'Stream';
    SOCK_DGRAM: Result := 'Datagram';
  else
    Result := 'Unknown';
  end;
end;

function AddressFamilyToString(F: DWORD): string;
begin
  case F of
    AF_UNIX: Result := 'local to host (pipes, portals';
    AF_INET: Result := 'internetwork: UDP, TCP, etc.';
    AF_IMPLINK: Result := 'arpanet imp addresses';
    AF_PUP: Result := 'pup protocols: e.g. BSP';
    AF_CHAOS: Result := 'mit CHAOS protocols';
    AF_NS: Result := 'XEROX NS protocols';
    // AF_IPX: Result := 'IPX protocols: IPX, SPX, etc.';
    AF_ISO: Result := 'ISO protocols';
    // AF_OSI: Result := 'OSI is ISO';
    AF_ECMA: Result := 'european computer manufacturers';
    AF_DATAKIT: Result := 'datakit protocols';
    AF_CCITT: Result := 'CCITT protocols, X.25 etc';
    AF_SNA: Result := 'IBM SNA';
    AF_DECnet: Result := 'DECnet';
    AF_DLI: Result := 'Direct data link interface';
    AF_LAT: Result := 'LAT';
    AF_HYLINK: Result := 'NSC Hyperchannel';
    AF_APPLETALK: Result := 'AppleTalk';
    AF_NETBIOS: Result := 'NetBios-style addresses';
    AF_VOICEVIEW: Result := 'VoiceView';
    AF_FIREFOX: Result := 'Protocols from Firefox';
    AF_UNKNOWN1: Result := 'Somebody is using this!';
    AF_BAN: Result := 'Banyan';
    AF_ATM: Result := 'Native ATM Services';
    AF_INET6: Result := 'Internetwork Version 6';
    AF_CLUSTER: Result := 'Microsoft Wolfpack';
    AF_12844: Result := 'IEEE 1284.4 WG AF';
    AF_IRDA: Result := 'IrDA';
    AF_NETDES: Result := 'Network Designers OSI & gateway enabled protocols';
  else
    Result := 'Unknown';
  end;
end;

procedure DisplayProtocolInfo(memo: TStrings; const Info: PWSAProtocol_InfoA);
var
  I: Integer;
begin
  memo.add(Info^.szProtocol);
  memo.add('Protocol Version:     ' + IntToStr(Info^.iVersion));
  memo.add('Address Family:       ' + AddressFamilyToString(Info^.iAddressFamily));
  //memo.add('Provider:             ' + GUIDToString(Info^.ProviderId));
  memo.add('Service Flags1:       ' + IntToHex(Info^.dwServiceFlags1, 8)); // TODO ToString
  memo.add('Service Flags2:       ' + IntToHex(Info^.dwServiceFlags2, 8));
  memo.add('Service Flags3:       ' + IntToHex(Info^.dwServiceFlags3, 8));
  memo.add('Service Flags4:       ' + IntToHex(Info^.dwServiceFlags4, 8));
  memo.add('Provider Flags:       ' + IntToHex(Info^.dwProviderFlags, 8));
  if Info^.dwProviderFlags and PFL_MULTIPLE_PROTO_ENTRIES <> 0 then
    memo.add('  PFL_MULTIPLE_PROTO_ENTRIES');
  if Info^.dwProviderFlags and PFL_RECOMMENDED_PROTO_ENTRY <> 0 then
    memo.add('  PFL_RECOMMENDED_PROTO_ENTRY');
  if Info^.dwProviderFlags and PFL_HIDDEN <> 0 then memo.add('  PFL_HIDDEN');
  if Info^.dwProviderFlags and PFL_MATCHES_PROTOCOL_ZERO <> 0 then memo.add('PFL_MATCHES_PROTOCOL_ZERO');
  memo.add('Catalog Entry:        ' + IntToStr(Info^.dwCatalogEntryId));
  memo.add('Maximum Message Size: ' + IntToHex(Info^.dwMessageSize, 8));
  memo.add('Security Scheme:      ' + IntToStr(Info^.iSecurityScheme));
  memo.add('Byte Order:           ' + ByteOrderToString(Info^.iNetworkByteOrder));
  memo.add('Protocol:             ' + IntToStr(Info^.iProtocol));
  memo.add('Protocol MaxOffset:   ' + IntToStr(Info^.iProtocolMaxOffset));
  memo.add('Min Socket Address:   ' + IntToStr(Info^.iMinSockAddr));
  memo.add('Max Socket Address:   ' + IntToStr(Info^.iMaxSockAddr));
  memo.add('Socket Type:          ' + SocketTypeToString(Info^.iSocketType));
  memo.add('Protocol Chain:');
  for I := 0 to Info^.ProtocolChain.ChainLen - 1 do
    memo.add(#9+IntToStr(Info^.ProtocolChain.ChainEntries[I]) + ' ');
  memo.add('');
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  WSAData: TWSAData;
  BufferLength: DWORD;
  Buffer, Info: PWSAProtocol_InfoA;
  I, Count: Integer;
begin
    if WSAStartUp($0202, WSAData) = 0 then
  try
    Assert(WSAData.wHighVersion >= 2);
    BufferLength := 0;
    if (WSAEnumProtocols(nil, nil, BufferLength) = SOCKET_ERROR) and (WSAGetLastError = WSAENOBUFS) then
    begin
      Buffer := AllocMem(BufferLength);
      try
        Count := WSAEnumProtocols(nil, Buffer, BufferLength);
        if Count <> SOCKET_ERROR then
        begin
          Info := Buffer;
          for I := 0 to Count - 1 do
          begin
            Assert(not IsBadReadPtr(Info, SizeOf(TWSAProtocol_InfoA)));
            DisplayProtocolInfo(Memo1.Lines, Info);
            Memo1.Lines.add('');
            Inc(Info);
          end;
        end
        else
          Memo1.Lines.add('Failed to retrieve protocol information.');
      finally
        FreeMem(Buffer);
      end;
    end
    else
    begin
      Memo1.Lines.add('Unable to enumerate protocols.');
      Memo1.Lines.add('Error code: ' + IntToStr(WSAGetLastError));
      Memo1.Lines.add('Error message: ' + SysErrorMessage(WSAGetLastError));
    end;
  finally
    WSACleanUp;
  end
  else Memo1.Lines.add('Windows Sockets ver 2 initialization failed.');
  
end;

end.