监听网内msn聊天内容

unit Main;

interface

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

const
  WM_Socket = WM_User + 1;

type
  TMainForm = class(TForm)
    ListBox: TListBox;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
    s: TSocket;
    procedure WMSocket(var Msg: TMessage); message WM_Socket;
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

const
  SIO_RCVALL = IOC_IN or IOC_VENDOR or 1;

type
  PIPv4_HDR = ^TIPv4_HDR;
  TIPv4_HDR = record
    VerLen: Byte;
    TOS: Byte;
    TotalLength: Word;
    ID: Word;
    Offset: Word;
    TTL: Byte;
    Protocol: Byte;
    CheckSum: Word;
    SrcAddr: Cardinal;
    DestAddr: Cardinal
  end;

  PTCP_HDR = ^TTCP_HDR;
  TTCP_HDR = record
    SrcPort: Word;
    DestPort: Word;
    SEQ: Cardinal;
    ACK: Cardinal;
    LenFlag: Word;
    WinSize: Word;
    CheckSum: Word;
    URG: Word
  end;

{$R *.dfm}

procedure Prepare(var s: PChar);
var
  p: Integer;
begin
  p:=Pos(#13#10, s);
  while p>0 do
  begin
    Inc(s, p+1);
    p:=Pos(#13#10, s)
  end
end;

procedure TMainForm.FormCreate(Sender: TObject);
var
  WSAData: TWSAData;
  ServerAddr: TSockAddrIn;
  OptVal: Integer;
  OptRet: DWord;
  Ret: Integer;
begin
  Ret:=WSAStartup($202, WSAData);
  if Ret<>0 then
  begin
    ShowMessage('WSAStartup failed with error '+IntToStr(Ret));
    Exit
  end;

  s:=WSASocket(AF_INET, SOCK_RAW, IPPROTO_IP, nil, 0, WSA_FLAG_OVERLAPPED);
  if s=INVALID_SOCKET then
  begin
    ShowMessage('WSASocket failed with error '+IntToStr(WSAGetLastError));
    Exit
  end;

  ServerAddr.sin_family:=AF_INET;
  ServerAddr.sin_port:=htons(0);
  ServerAddr.sin_addr.S_addr:=inet_addr('192.168.0.208');  //换成你的IP
  if bind(s, @ServerAddr, SizeOf(ServerAddr))=SOCKET_ERROR then
  begin
    ShowMessage('bind failed with error '+IntToStr(WSAGetLastError));
    Exit
  end;

  OptVal:=1;
  if WSAIoctl(s, SIO_RCVALL, @OptVal, SizeOf(OptVal), nil, 0, @OptRet, nil, nil)=SOCKET_ERROR then
  begin
    ShowMessage('WSAIoctl failed with error '+IntToStr(WSAGetLastError));
    Exit
  end;

  if WSAAsyncSelect(s, Handle, WM_Socket, FD_READ)=SOCKET_ERROR then
    ShowMessage('WSAAsyncSelect failed with error '+IntToStr(WSAGetLastError))
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
  if closesocket(s)=SOCKET_ERROR then
    ShowMessage('closesocket failed with error '+IntToStr(WSAGetLastError));

  if WSACleanup=SOCKET_ERROR then
    ShowMessage('WSACleanup failed with error '+IntToStr(WSAGetLastError))
end;

procedure TMainForm.WMSocket(var Msg: TMessage);
const
  BufSize = 65535;
var
  Buf: array [0..BufSize] of Char;
  IPHeader: PIPv4_HDR;
  IPHeaderLen: Byte;
  TCPHeader: PTCP_HDR;
  TCPHeaderLen: Byte;
  Data: PChar;
  Ret: Integer;
begin
  ZeroMemory(@Buf, BufSize);
  Ret:=recv(s, Buf, BufSize, 0);
  if Ret=SOCKET_ERROR then
  begin
    ShowMessage('recv failed with error '+IntToStr(WSAGetLastError));
    Exit
  end;

  IPHeader:=PIPv4_HDR(@Buf[0]);
  if IPHeader.Protocol=IPPROTO_TCP then
  begin
    IPHeaderLen:=(IPHeader.VerLen and $F)*4;
    TCPHeader:=PTCP_HDR(@Buf[IPHeaderLen]);
    if (ntohs(TCPHeader.SrcPort)=1863) or (ntohs(TCPHeader.DestPort)=1863) then
    begin
      TCPHeaderLen:=(ntohs(TCPHeader.LenFlag) shr 12)*4;
      Data:=@Buf[IPHeaderLen+TCPHeaderLen];
      if (Pos('MSG', Data)=1) and (Pos('text/plain', Data)>0) then
      begin
        Prepare(Data);
        ListBox.Items.Append(UTF8ToAnsi(Data))
      end
    end
  end
end;

end.