카테고리 없음
[네트웍/인터넷] Network Packet Capture (Winsock2)
쇼핑스크래퍼3
2023. 8. 31. 16:42
// 아래 소스를 컴파일 하려면 Jedi 사이트에서 Winsock2.pas 파일을 다운받아야 합니다
// ftp://delphi-jedi.org/api/Winsock2.zip
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, WinSock2;
type
TForm1 = class(TForm)
Button1: TButton;
ComboBox1: TComboBox;
Memo1: TMemo;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
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
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;
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
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);
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 --');
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
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;
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
hThread.Terminate;
hThread.Free;
hThread := nil;
Button1.Caption := 'Start';
end;
end;
end.