Переделал тестовый вариант так как вы советовали. Не заработало 🙁
Тестирую у себя локально на компе. По http запрашиваю адрес 10.10.10.17
{$APPTYPE CONSOLE}
uses
SysUtils,
Windows,
Winsock,
winpkf,
iphlp;
var
iIndex : DWORD;
hFilt : THANDLE;
Adapts : TCP_AdapterList;
AdapterMode : ADAPTER_MODE;
Buffer : INTERMEDIATE_BUFFER;
ReadRequest : ETH_REQUEST;
hEvent : THANDLE;
hAdapter : THANDLE;
pEtherHeader : TEtherHeaderPtr;
pIPHeader : TIPHeaderPtr;
pTcpHeader : TTCPHeaderPtr;
aaLen, testSum : dword;
RecalcChecksum : boolean;
function IPAddrToName(IPAddr : string) : string;
var
SockAddrIn : TSockAddrIn;
HostEnt : PHostEnt;
WSAData : TWSAData;
begin
WSAStartup($101, WSAData);
SockAddrIn.sin_addr.s_addr := inet_addr(PChar(IPAddr));
HostEnt := gethostbyaddr(@SockAddrIn.sin_addr.S_addr, 4, AF_INET);
if HostEnt <> nil then
begin
result := StrPas(Hostent^.h_name)
end
else
begin
result := '';
end;
end;
// Calculate TCP checkcum
function RecalculateTCPChecksum(aLen: Integer; aSrcAddr, aDstAddr: Cardinal; buff: PByteArray): Word;
var
w16,padd: word;
i,sum: ulong;
sIP,dIP: in_addr;
begin
padd := 0;
sum := 0;
if (aLen div 2) * 2 <> aLen then begin
padd := 1;
buff[aLen] := 0;
end;
i := 0;
while i < aLen+padd do begin
w16 := ((buff shl 8)and $FF00) + (buff[i+1]and $FF);
sum := sum + dword(w16);
i := i + 2;
end;
//add IP length
sIP := in_addr(aSrcAddr);
dIP := in_addr(aDstAddr);
sum := sum + ntohs(sIP.S_un_w.s_w1) + ntohs(sIP.S_un_w.s_w2);
sum := sum + ntohs(dIP.S_un_w.s_w1) + ntohs(dIP.S_un_w.s_w2);
sum := sum + IPPROTO_TCP + word(aLen);
while (sum shr 16)>0 do
sum := (sum and $FFFF)+(sum shr 16);
sum := not sum;
sum := htons(sum);
Result := sum;
end;
function Checksum(p: PWORD; Size: word): WORD;
var
i: Integer;
Sum: DWORD;
begin
Sum := 0;
for i := 0 to Size - 1 do
begin
Sum := Sum + ntohs(p^);
inc(p);
end;
while (Sum shr 16) > 0 do
Sum := (Sum and $FFFF) + (Sum shr 16);
Sum := not Sum;
Result := Sum;
end;
procedure ReleaseInterface();
begin
// Restore default mode
AdapterMode.dwFlags := 0;
AdapterMode.hAdapterHandle := hAdapter;
SetAdapterMode(hFilt, @AdapterMode);
// Set NULL event to release previously set event object
SetPacketEvent(hFilt, hAdapter, 0);
// Close Event
if hEvent <> 0 then
CloseHandle(hEvent);
// Close driver object
CloseFilterDriver(hFilt);
// Release NDISAPI
FreeNDISAPI();
end;
begin
// Check the number of parameters
if ParamCount() < 2 then
begin
Writeln('Command line syntax:');
Writeln(' PassThru.exe index num');
Writeln(' index - network interface index.');
Writeln(' num - number or packets to filter');
Writeln('You can use ListAdapters to determine correct index.');
// Exit;
end;
// Initialize NDISAPI
InitNDISAPI();
// Create driver object
hFilt := OpenFilterDriver('NDISRD');
if IsDriverLoaded(hFilt) then
begin
// Get parameters from command line
//iIndex := StrToInt(ParamStr(1));
//counter := StrToInt(ParamStr(2));
iIndex := 2;
// Set exit procedure
ExitProcessProc := ReleaseInterface;
// Get TCP/IP bound interfaces
GetTcpipBoundAdaptersInfo(hFilt, @Adapts);
// Check paramer values
if iIndex > Adapts.m_nAdapterCount then
begin
Writeln('There is no network interface with such index on this system.');
Exit;
end;
hAdapter := Adapts.m_nAdapterHandle[iIndex];
AdapterMode.dwFlags := MSTCP_FLAG_SENT_TUNNEL or MSTCP_FLAG_RECV_TUNNEL ;
AdapterMode.hAdapterHandle := hAdapter;
// Create notification event
hEvent := CreateEvent(nil, TRUE, FALSE, nil);
if hEvent <> 0 then
if SetPacketEvent(hFilt, hAdapter, hEvent) <> 0 then
begin
// Initialize request
ReadRequest.EthPacket.Buffer := @Buffer;
ReadRequest.hAdapterHandle := hAdapter;
SetAdapterMode(hFilt, @AdapterMode);
while true do
begin
WaitForSingleObject(hEvent, INFINITE);
while ReadPacket(hFilt, @ReadRequest) <> 0 do
begin
pEtherHeader := TEtherHeaderPtr(@Buffer.m_IBuffer);
if ntohs(pEtherHeader.h_proto) = ETH_P_IP then
begin
pIPHeader := TIPHeaderPtr(Dword(pEtherHeader)+SizeOf(TEtherHeader));
if pIPHeader.Protocol = IPPROTO_TCP then
begin
RecalcChecksum:=false;
pTcpHeader := TTCPHeaderPtr(Dword(pIPHeader)+(pIPHeader.VerLen and $F) * 4);
if pIPHeader.DestIp=(inet_addr('10.10.10.17')) then
begin
RecalcChecksum:=true;
pIPHeader.DestIp := (inet_addr('10.11.11.71'));
end;
if (pIPHeader.SourceIp=(inet_addr('10.11.11.71')))then
begin
RecalcChecksum:=true;
pIPHeader.SourceIp := (inet_addr('10.10.10.17'));
end;
if RecalcChecksum then
begin
aaLen := ntohs(pIPHeader.TotalLen) - ((pIPHeader.VerLen and $F)*4);
pTCPHeader.Checksum := 0;
testSum := RecalculateTCPChecksum(aaLen, pIPHeader.SourceIp, pIPHeader.DestIp, PByteArray(pTCPHeader));
pTCPHeader.Checksum := testSum;
pIPHeader.Checksum := 00;
pIPHeader.Checksum := htons(Checksum(Pword(pIPHeader), ((pIPHeader.VerLen and $F) * 4) div 2));
end;
end;
end;
// if ntohsn(pEtherHeader.h_proto) = ETH_P_RARP then
// Writeln(' Reverse Addr Res packet');
// if ntohsn(pEtherHeader.h_proto) = ETH_P_ARP then
// Writeln(' Address Resolution packet');
//Writeln('__');
if Buffer.m_dwDeviceFlags = PACKET_FLAG_ON_SEND then
// Place packet on the network interface
SendPacketToAdapter(hFilt, @ReadRequest)
else
// Indicate packet to MSTCP
SendPacketToMstcp(hFilt, @ReadRequest);
end;
ResetEvent(hEvent);
end;
end;
end;
end.