监控MSN的程序 ( 积分: 0 )

  • 主题发起人 主题发起人 LanHer
  • 开始时间 开始时间
L

LanHer

Unregistered / Unconfirmed
GUEST, unregistred user!
以下是源代码,但是编译有点问题,请帮忙看看。
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>0do

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.
 
以下是源代码,但是编译有点问题,请帮忙看看。
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>0do

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.
 

Similar threads

后退
顶部