ソースダウンロード20040502PacketDump.zip(33,019bytes)
こちらは記念に保存。
[BlueLeaf1336]> PROBLEMS> WinSock>
| history | TOP |
2004/05/02:作成
2004/05/05:スレッド停止時に shutdown() 関数で送受信処理を中断するように修正。ログ出力方法を変更。従来の簡略ダンプに加えてフルダンプを可能に。
2004/05/06:このプログラムでパケットをモニタするとパケットおかしくなるような...
| reference | TOP |
| comment | TOP |
まあ、動いてます。それだけです。本当に大丈夫か? と思ってます。WSARecv とか Delphi のサンプルがどこにもない!
WinSock2.2 からこのような処理が可能になったということで、WinSock2.pas をもらってきてます。これが再配布可能かどうかは疑問ですが多分大丈夫かと。オリジナルの圧縮ファイルに含まれてたすべてのファイルを一切触らずに同梱してますし。
今回もお約束、信じないように。(もちろん参考にさせていただいたサイトのことではありません。Delphiに翻訳したこのページの以下のコードを、です。)
(2004/05/05)基本的な処理は全然変わってないので、HTML化したコードは以前のままですが、ダウンロード用のコードは修正しています。ただし以前のコード(HTML化したものに対応するもの)もダウンロードできるようにしています。
これを使って、完敗した ICMP ページのリベンジに役立てたいというか...。
| code | TOP |
unit Main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, WinSock2;
type
TForm1 = class(TForm)
Panel1: TPanel;
Button1: TButton;
ComboBox1: TComboBox;
Memo1: TMemo;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
public
wsd: TWSAData;
sock: TSocket;
hThread: TThread;
ThreadId: DWORD;
function ListAdapter(): Boolean;
function InitAdapter(): Boolean;
procedure Print(const buf: array of Byte; const len: integer);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
const
Protocol: array[0..99] of string =
(
'Reserved', // 0
'ICMP', // 1
'IGMP', // 2
'GGP', // 3
'IP', // 4
'ST', // 5
'TCP', // 6
'UCL', // 7
'EGP', // 8
'IGP', // 9
'BBN-RCC-MON', // 10
'NVP-II', // 11
'PUP', // 12
'ARGUS', // 13
'EMCON', // 14
'XNET', // 15
'CHAOS', // 16
'UDP', // 17
'MUX', // 18
'DCN-MEAS', // 19
'HMP', // 20
'PRM', // 21
'XNS-IDP', // 22
'TRUNK-1', // 23
'TRUNK-2', // 24
'LEAF-1', // 25
'LEAF-2', // 26
'RDP', // 27
'IRTP', // 28
'ISO-TP4', // 29
'NETBLT', // 30
'MFE-NSP', // 31
'MERIT-INP', // 32
'SEP', // 33
'3PC', // 34
'IDPR', // 35
'XTP', // 36
'DDP', // 37
'IDPR-CMTP', // 38
'TP++', // 39
'IL', // 40
'SIP', // 41
'SDRP', // 42
'SIP-SR', // 43
'SIP-FRAG', // 44
'IDRP', // 45
'RSVP', // 46
'GRE', // 47
'MHRP', // 48
'BNA', // 49
'SIPP-ESP', // 50
'SIPP-AH', // 51
'I-NLSP', // 52
'SWIPE', // 53
'NHRP', // 54
'unknown', // 55
'unknown', // 56
'unknown', // 57
'unknown', // 58
'unknown', // 59
'unknown', // 60
'unknown', // 61
'CFTP', // 62
'unknown', // 63
'SAT-EXPAK', // 64
'KRYPTOLAN', // 65
'RVD', // 66
'IPPC', // 67
'unknown', // 68
'SAT-MON', // 69
'VISA', // 70
'IPCV', // 71
'CPNX', // 72
'CPHB', // 73
'WSN', // 74
'PVP', // 75
'BR-SAT-MON', // 76
'SUN-ND', // 77
'WB-MON', // 78
'WB-EXPAK', // 79
'ISO-IP', // 80
'VMTP', // 81
'SECURE-VMTP', // 82
'VINES', // 83
'TTP', // 84
'NSFNET-IGP', // 85
'DGP', // 86
'TCF', // 87
'IGRP', // 88
'OSPFIGP', // 89
'Sprite-RPC', // 90
'LARP', // 91
'MTP', // 92
'AX.25', // 93
'IPIP', // 94
'MICP', // 95
'SCC-SP', // 96
'ETHERIP', // 97
'ENCAP', // 98
// 'unknown', // 98(?)
'GMTP' // 99
);
SIO_RCVALL = $98000001;
MAX_IP_SIZE = 65535;
LIST_SIZE = 4096;
// ---------------------------------------------------------------------------
// アダプタ一覧
function TForm1.ListAdapter(): Boolean;
var
Temp: string;
slist: LPSOCKET_ADDRESS_LIST;
d: DWORD;
s: TSocket;
i, ret: integer;
begin
ComboBox1.Clear;
Result := false;
// ソケット作成
s := WSASocket(AF_INET, SOCK_RAW, IPPROTO_IP, nil, 0, WSA_FLAG_OVERLAPPED);
// 失敗
if (INVALID_SOCKET = s) then
begin
Temp := Format('WSASocket(AF_INET,SOCK_RAW) failed', []);
Memo1.Lines.Add(Temp);
end
// 成功
else
begin
// メモリ確保
GetMem(slist, LIST_SIZE);
try
// WSAIoctl失敗
ret := WSAIoctl(s, SIO_ADDRESS_LIST_QUERY, nil, 0, slist, LIST_SIZE, @d, nil, nil);
if (SOCKET_ERROR = ret) then
begin
Temp := Format('WSAIoctl(SIO_ADDRESS_LIST_QUERY) faild.', []);
Memo1.Lines.Add(Temp);
end
// 成功
else
begin
// 列挙
for i := 0 to slist.iAddressCount - 1 do
begin
Temp := Format('%d. (%s)', [i, inet_ntoa((slist.Address[i].lpSockaddr).sin_addr)]);
ComboBox1.Items.Add(Temp);
end;
// ここまで来たら
Result := true;
end;
finally
// メモリ解放
FreeMem(slist, LIST_SIZE);
// ソケット破棄
closesocket(s);
end;
end;
if (ComboBox1.Items.Count > 0) then ComboBox1.ItemIndex := 0;
end;
// ---------------------------------------------------------------------------
// アダプタの初期化
function TForm1.InitAdapter(): Boolean;
var
Temp: string;
ret: integer;
optval: integer;
d: DWORD;
slist: LPSOCKET_ADDRESS_LIST;
addr_in: TSockAddrIn;
begin
Result := false;
// SOCKETの生成
sock := WSASocket(AF_INET, SOCK_RAW, IPPROTO_IP, nil, 0, WSA_FLAG_OVERLAPPED);
if (INVALID_SOCKET = sock) then
begin
Temp := Format('WSASocket(AF_INET,SOCK_RAW) failed', []);
Memo1.Lines.Add(Temp);
end
else
begin
// メモリ確保
GetMem(slist, LIST_SIZE);
try
// アダプタのリスト取得
ret := WSAIoctl(sock, SIO_ADDRESS_LIST_QUERY, nil, 0, slist, LIST_SIZE, @d, nil, nil);
if (SOCKET_ERROR = ret) then
begin
Temp := Format('WSAIoctl(SIO_ADDRESS_LIST_QUERY) faild.', []);
Memo1.Lines.Add(Temp);
end
else
begin
// SOCKET のデータセット
FillChar(addr_in, SizeOf(addr_in), 0);
addr_in.sin_addr.S_addr := slist.Address[ComboBox1.ItemIndex].lpSockaddr.sin_addr.S_addr;
addr_in.sin_family := AF_INET;
addr_in.sin_port := htons(0);
// bind
ret := bind(sock, @addr_in, SizeOf(addr_in));
if (SOCKET_ERROR = ret) then
begin
Temp := Format('bind failed', []);
Memo1.Lines.Add(Temp);
end
else
begin
optval := 1;
ret := WSAIoctl(sock, SIO_RCVALL, @optval, sizeof(optval), nil, 0, @d, nil, nil);
if (SOCKET_ERROR = ret) then
begin
Temp := Format('WSAIoCtl(SIO_RCVALL) failed', []);
Memo1.Lines.Add(Temp);
end
else
begin
Result := true;
end;
end;
end;
finally
// メモリ解放
FreeMem(slist, LIST_SIZE);
end;
end;
end;
// ---------------------------------------------------------------------------
// ダンプ
procedure TForm1.Print(const buf: array of Byte; const len: integer);
// c's isprint
function IsPrint(const c: Char): Boolean;
begin
Result := (c in [#$20..#$7E]);
end;
var
t: SYSTEMTIME;
Tmp: string;
i, j: integer;
d: integer;
c: char;
begin
GetLocalTime(t);
Tmp := '-----------------------------------------------------------';
Memo1.Lines.Add(Tmp);
// 時刻
Tmp := Format('%2.2d/%2.2d/%2.2d %2.2d:%2.2d:%2.2d Protocol: %s',
[t.wYear, t.wMonth, t.wDay, t.wHour, t.wMinute, t.wSecond, Protocol[buf[9]]]);
Memo1.Lines.Add(Tmp);
// 送信元アドレス
Tmp := Format('Source Address: %d.%d.%d.%d',
[buf[12], buf[13], buf[14], buf[15]]);
Memo1.Lines.Add(Tmp);
// 送信先アドレス
Tmp := Format('Destination Address: %d.%d.%d.%d',
[buf[16], buf[17], buf[18], buf[19]]);
Memo1.Lines.Add(Tmp);
// ポート
Tmp := Format('Source Port: %d Destination Port: %d',
[buf[20] * 256 + buf[21], buf[22] * 256 + buf[23]]);
Memo1.Lines.Add(Tmp);
Memo1.Lines.Add('-- dump --');
// 16進ダンプ
for i := 0 to 3 - 1 do
begin
d := len - i * 16;
if (d > 16) then d := 16;
if (d <= 0) then break;
// バイナリ表示
Tmp := Format('%8.8x : ', [i]);
for j := 0 to d - 1 do
begin
Tmp := Tmp + Format('%2.2x ', [buf[i * 16 + j]]);
end;
for j := d to 16 - 1 do Tmp := Tmp + ' ';
// 文字列表示
for j := 0 to d - 1 do
begin
c := Chr(buf[i * 16 + j]);
if not IsPrint(c) then c := '.';
Tmp := Tmp + Format('%s ', [c]);
end;
Memo1.Lines.Add(Tmp);
if (d <> 16) then break;
end;
end;
// ---------------------------------------------------------------------------
// コンストラクタ
procedure TForm1.FormCreate(Sender: TObject);
begin
// Ver2.2 でWinSockを初期化する
WSAStartup(MAKEWORD(2, 2), wsd);
hThread := nil;
//アダプタのリストをコンボボックに取得
ListAdapter();
end;
// ---------------------------------------------------------------------------
// デストラクタ
procedure TForm1.FormDestroy(Sender: TObject);
begin
// キャプチャスレッドが走行中の場合ストップする
if (hThread <> nil) then
begin
hThread.Terminate;
hThread.Free;
hThread := nil;
end;
// WinSockの終了処理
WSACleanup();
end;
// ---------------------------------------------------------------------------
// キャプチャスレッド
type
TCaputureThread = class(TThread)
private
Msg: string;
Buf: array[0..MAX_IP_SIZE - 1] of Byte;
Len: Cardinal;
procedure DoError();
procedure DoPrint();
protected
procedure Execute; override;
end;
// ---------------------------------------------------------------------------
procedure TCaputureThread.DoError();
begin
Form1.Memo1.Lines.Add(Msg);
end;
// ---------------------------------------------------------------------------
procedure TCaputureThread.DoPrint();
begin
Form1.Print(Buf, Len);
end;
// ---------------------------------------------------------------------------
// キャプチャスレッド本体
procedure TCaputureThread.Execute;
var
wsb: PWSABUF;
ret: integer;
Flags: Cardinal;
begin
// メモリ確保
New(wsb);
wsb.buf := @Buf;
wsb.len := MAX_IP_SIZE;
while not Terminated do
begin
Sleep(1);
Application.ProcessMessages();
FillChar(Buf, SizeOf(Buf), 0);
Flags := 0;
// パケット取得
ret := WSARecv(Form1.sock, wsb, 1, Len, Flags, nil, nil);
if (SOCKET_ERROR = ret) then
begin
Msg := Format('WSARecv failed. Code %d', [WSAGetLastError(), Form1.sock]);
if not Terminated then Synchronize(DoError);
continue;
end;
// パケット表示
if not Terminated then Synchronize(DoPrint);
end;
// メモリ解放
Dispose(wsb);
end;
// ---------------------------------------------------------------------------
// キャプチャ開始・終了（キャプチャスレッドの生成・破棄）
procedure TForm1.Button1Click(Sender: TObject);
begin
// キャプチャ開始処理
if (hThread = nil) then
begin
if (InitAdapter()) then
begin
// キャプチャスレッド生成
hThread := TCaputureThread.Create(true);
hThread.Resume;
Button1.Caption := 'Stop';
end;
end
// キャプチャ終了処理
else
begin
// ひとこと
ShowMessage('Stop に切り替わらない場合は、WSARecv で処理がとまってます'
+ #13#10'何か通信すればとまります'
+ #13#10'ブラウザを開いてどこかのサイトを見るとか...');
// キャプチャスレッドの破棄
hThread.Terminate;
hThread.Free;
hThread := nil;
Button1.Caption := 'Start';
end;
end;
end.
| screenshot & download | TOP |
ソースダウンロード
20040502PacketDump.zip(33,019bytes)
こちらは記念に保存。
ソースダウンロード
20040505PacketDump.zip(205,143bytes)
| EOF | TOP |