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.