main.pas

一个SNOOP控件,各位看看可以对网络包进行分析.

unit Main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, Menus, ActnList, ComCtrls, ToolWin, IniFiles, ShellAPI,
  Common, ImgList, WinSock, Snoop, SnoopMemory, Global, SnoopTrace;

type
  TMainForm = class(TForm)
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    miSave: TMenuItem;
    miSaveAs: TMenuItem;
    N1: TMenuItem;
    miExit: TMenuItem;
    Panel1: TPanel;
    Edit: TMenuItem;
    miOpen: TMenuItem;
    miClose: TMenuItem;
    Help1: TMenuItem;
    miAbout: TMenuItem;
	miHomePage: TMenuItem;
    ActionList1: TActionList;
    ActionSave: TAction;
    ActionSaveAs: TAction;
	ActionExit: TAction;
    ActionOpen: TAction;
    ActionClose: TAction;
    ActionAbout: TAction;
    ActionHomePage: TAction;
    ToolBar1: TToolBar;
    tbOpen: TToolButton;
    tbClose: TToolButton;
	tbClear: TToolButton;
    View1: TMenuItem;
    ActionOption: TAction;
	miOption: TMenuItem;
    ImageList1: TImageList;
	ActionClear: TAction;
	Snoop1: TSnoop;
    Splitter1: TSplitter;
    mmData: TMemo;
    pcView: TPageControl;
	tsEthernet: TTabSheet;
	tsIP: TTabSheet;
	tsARP: TTabSheet;
	tsICMP: TTabSheet;
	lvEthernet: TListView;
	tsTCP: TTabSheet;
	tsTCPData: TTabSheet;
	tsUDPData: TTabSheet;
	tsUDP: TTabSheet;
	lvIP: TListView;
	lvARP: TListView;
    lvICMP: TListView;
    lvTCP: TListView;
    lvUDP: TListView;
    lvTCPData: TListView;
	lvUDPData: TListView;
	StatusBar1: TStatusBar;
    ActionOpenFile: TAction;
    miOpenFile: TMenuItem;
    pmPacketField: TPopupMenu;
    miPacketField: TMenuItem;
    ActionPacketField: TAction;
    chkViewHexa: TCheckBox;
    PacketField1: TMenuItem;
    odFile: TOpenDialog;
    sdFile: TSaveDialog;
	procedure FormCreate(Sender: TObject);
	procedure FormShow(Sender: TObject);
	procedure FormClose(Sender: TObject; var Action: TCloseAction);
	procedure ActionOpenExecute(Sender: TObject);
	procedure ActionCloseExecute(Sender: TObject);
	procedure ActionClearExecute(Sender: TObject);
	procedure ActionOptionExecute(Sender: TObject);
	procedure ActionOpenFileExecute(Sender: TObject);
	procedure ActionSaveExecute(Sender: TObject);
	procedure ActionSaveAsExecute(Sender: TObject);
	procedure ActionExitExecute(Sender: TObject);
	procedure ActionAboutExecute(Sender: TObject);
	procedure ActionHomePageExecute(Sender: TObject);
	procedure Snoop1GetRemoteAdapterInfo(Sender: TObject; AdapterNames,
	  AdapterDescriptions: TStringList; var AdapterIndex: Integer);
	procedure pcViewChange(Sender: TObject);
	procedure ActionPacketFieldExecute(Sender: TObject);
	procedure lvDataChange(Sender: TObject; Item: TListItem;
	  Change: TItemChange);
	procedure chkViewHexaClick(Sender: TObject);
	procedure Snoop1Capture(Sender: TObject; PacketHeader: PPCAP_PKTHDR;
	  EthernetHeader: PETHERNET_HDR);
	procedure lvEthernetData(Sender: TObject; Item: TListItem);
	procedure lvIPData(Sender: TObject; Item: TListItem);
	procedure lvARPData(Sender: TObject; Item: TListItem);
	procedure lvICMPData(Sender: TObject; Item: TListItem);
	procedure lvTCPData1(Sender: TObject; Item: TListItem);
	procedure lvUDPData1(Sender: TObject; Item: TListItem);
	procedure lvTCPDataData(Sender: TObject; Item: TListItem);
	procedure lvUDPDataData(Sender: TObject; Item: TListItem);
  private
	ActiveListViewIndex: Integer;
	function GetActiveListView: TListView;
	function GetActiveList: TList;
  protected
	// for Capture Memory Management;
	SnoopMemory: TSnoopMemory;
	EthernetList: TList;
	IPList: TList;
	ARPList: TList;
	ICMPList: TList;
	TCPList: TList;
	UDPList: TList;
	TCPDataList: TList;
	UDPDataList: TList;
	procedure CreateAllList;
	procedure ClearAllList;
	procedure FreeAllList;
	procedure SynchronizeListWithListView;
  protected
	// for File Save
	SnoopDump: TSnoopDump;
	ExistingFileName: String;
	NewFileName: String;
	IsNeedToSave: Boolean;
	procedure ProcessTempFile;
  protected
	// for View Data in mmData.
	LastListItem: TListItem;
	class function IsNormalChar(ch: Char): Boolean;
	procedure ViewHexa(Data: PChar; Length: Integer);	
	procedure ViewData;
	{ Public declarations }
  public
	procedure LoadControl;
	procedure SaveControl;
	procedure SetControl;
	procedure InitializeListView;
	procedure ViewPacket;
  end;

var
  MainForm: TMainForm;

implementation

uses Option, RemoteAdapter, Open, About, PacketField, Capturing;

{$R *.DFM}

procedure TMainForm.FormCreate(Sender: TObject);
begin
	mmData.Align := alClient;
	InitializeListView;
	mmData.Lines.Clear;

	SnoopMemory := nil;
	CreateAllList;
	SnoopDump := nil;
	ExistingFileName := '';
	NewFileName := '';
	IsNeedToSave := false;
end;

procedure TMainForm.FormShow(Sender: TObject);
begin
	Common.LoadListColumnWidth(Self, _Global.IniFileName);
	LoadControl;
	SetControl;
	LastListItem := nil;
end;

procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
	ActionClose.Execute;
	SaveControl;
	Common.SaveListColumnWidth(Self, _Global.IniFileName);

	if SnoopMemory <> nil then
	begin
		SnoopMemory.Free;
		SnoopMemory := nil;
	end;
	FreeAllList;
	if SnoopDump <> nil then
	begin
		SnoopDump.Free;
		SnoopDump := nil;
	end;
	ProcessTempFile;
end;

function TMainForm.GetActiveListView: TListView;
begin
	Result := nil;
	case ActiveListViewIndex of
		0: Result := lvEthernet;
		1: Result := lvIP;
		2: Result := lvARP;
		3: Result := lvICMP;
		4: Result := lvTCP;
		5: Result := lvUDP;
		6: Result := lvTCPData;
		7: Result := lvUDPData;
	end;
end;

function TMainForm.GetActiveList: TList;
begin
	Result := nil;
	case ActiveListViewIndex of
		0: Result := EthernetList;
		1: Result := IPList;
		2: Result := ARPList;
		3: Result := ICMPList;
		4: Result := TCPList;
		5: Result := UDPList;
		6: Result := TCPDataList;
		7: Result := UDPDataList;
	end;
end;

procedure TMainForm.CreateAllList;
begin
	if EthernetList = nil then EthernetList := TList.Create;
	if IPList = nil then IPList := TList.Create;
	if ARPList = nil then ARPList := TList.Create;
	if ICMPList = nil then ICMPList := TList.Create;
	if TCPList = nil then TCPList := TList.Create;
	if UDPList = nil then UDPList := TList.Create;
	if TCPDataList = nil then TCPDataList := TList.Create;
	if UDPDataList = nil then UDPDataList := TList.Create;
end;

procedure TMainForm.ClearAllList;
begin
	EthernetList.Clear;
	IPList.Clear;
	ARPList.Clear;
	ICMPList.Clear;
	TCPList.Clear;
	UDPList.Clear;
	TCPDataList.Clear;
	UDPDataList.Clear;
end;

procedure TMainForm.FreeAllList;
begin
	if EthernetList <> nil then
	begin
		EthernetList.Free;
		EthernetList := nil;
	end;
	if IPList <> nil then
	begin
		IPList.Free;
		IPList := nil;
	end;
	if ARPList <> nil then
	begin
		ARPList.Free;
		ARPList := nil;
	end;
	if ICMPList <> nil then
	begin
		ICMPList.Free;
		ICMPList := nil;
	end;
	if TCPList <> nil then
	begin
		TCPList.Free;
		TCPList := nil;
	end;
	if UDPList <> nil then
	begin
		UDPList.Free;
		UDPList := nil;
	end;
	if TCPDataList <> nil then
	begin
		TCPDataList.Free;
		TCPDataList := nil;
	end;
	if UDPDataList <> nil then
	begin
		UDPDataList.Free;
		UDPDataList := nil;
	end;
end;

procedure TMainForm.SynchronizeListWithListView;
begin
	lvEthernet.Items.Count := EthernetList.Count;
	lvIP.Items.Count := IPList.Count;
	lvARP.Items.Count := ARPList.Count;
	lvICMP.Items.Count := ICMPList.Count;
	lvTCP.Items.Count := TCPList.Count;
	lvUDP.Items.Count := UDPList.Count;
	lvTCPData.Items.Count := TCPDataList.Count;
	lvUDPData.Items.Count := UDPDataList.Count;
end;

procedure TMainForm.ProcessTempFile;
begin
	if ExtractFileExt(ExistingFileName) = '.$$$' then
		if FileExists(ExistingFileName) then
			DeleteFile(ExistingFileName);
end;

class function TMainForm.IsNormalChar(ch: Char): Boolean;
begin
	Result := true;
	if (Ord(ch) < 31) or (Ord(ch) >= 128) then Result := false;
end;

procedure TMainForm.ViewHexa(Data: PChar; Length: Integer);
const
	LINE_WIDTH = 16;
var
	i: Integer;
	Ascii, Hexa: String;
	Strings: TStringList;
begin
	Strings := TStringList.Create;
	while Length > 0 do
	begin
		Ascii := '';
		Hexa := ' ';
		for i := 0 to LINE_WIDTH - 1 do
		begin
			if (i <> 0) and (i mod 4 = 0) then
				Hexa := Hexa + '| ';
			Hexa := Hexa + Format('%2x ', [Ord(Data^)]);

			if IsNormalChar(Data^) then
				Ascii := Ascii + Data^
			else
				Ascii := Ascii + '.';
			dec(Length);
			inc(Data);
			if Length <= 0 then break;
		end;
		Ascii := Copy(Ascii + '               ', 1, LINE_WIDTH);
		Strings.Add(Ascii + ' [' + Hexa+ ']');
	end;
	mmData.Lines := Strings;
	Strings.Clear;
end;


procedure TMainForm.ViewData;
var
	ListView: TListView;
	List: TList;
	ListItem: TListItem;
	i: Integer;
	Node: PSnoopMemoryNode;

	EthernetHeader: PETHERNET_HDR;
	IPHeader: PIP_HDR;
	TCPHeader: PTCP_HDR;
	UDPHeader: PUDP_HDR;
	Data: PChar;
	Length: Integer;

	s: String;
begin
	ListView := GetActiveListView;
	if ListView = nil then exit;
	List := GetActiveList;
	if List = nil then exit;
	ListItem := ListView.Selected;
	if ListItem = nil then exit;
	i := ListItem.Index;
	Data := nil;
	Length := 0;
	Node := PSnoopMemoryNode(List.Items[i]);
	EthernetHeader := @Node^.Data[0];
	if (List = TCPList) or (List = TCPDataList) then
	begin
		snoopIsIP(EthernetHeader, @IPHeader);
		snoopIsTCP(IPHeader, @TCPHeader);
		snoopIsTCPData(IPHeader, TCPHeader, @Data, @Length);
	end else
	if (List = UDPList) or (List = UDPDataList) then
	begin
		snoopIsIP(EthernetHeader, @IPHeader);
		snoopIsUDP(IPHeader, @UDPHeader);
		snoopIsUDPData(IPHeader, UDPHeader, @Data, @Length);
	end;
	if (Data = nil) or (Length = 0) then
	begin
		mmData.Lines.Clear; // gilgil temp 2003.08.16
		exit;
	end;

	if not chkViewHexa.Checked then
	begin
		s := '';
		for i := 0 to Length - 1 do
		begin
			s := s + Data^;
			inc(Data);
		end;
		mmData.Lines.Text := s;
	end else
		ViewHexa(Data, Length);
	LastListItem := ListItem;
end;

procedure TMainForm.LoadControl;
begin
	_Global.Load;
	// Coordination
	Left := _Global.Left;
	Top := _Global.Top;
	Width := _Global.Width;
	Height := _Global.Height;
	WindowState :=  TWindowState(_Global.WindowState);
	pcView.Height := _Global.ListViewHeight;
	// ViewHexa
	chkViewHexa.Checked := _Global.ViewHexa;
	// ListView
	ActiveListViewIndex := _Global.ActiveListViewIndex;
	pcView.ActivePageIndex := ActiveListViewIndex;
end;

procedure TMainForm.SaveControl;
begin
	// Coordination
	_Global.Left :=  Left;
	_Global.Top := Top;
	_Global.Width := Width;
	_Global.Height := Height;
	_Global.WindowState := Integer(WindowState);	
	_Global.ListViewHeight := pcView.Height;
	_Global.ActiveListViewIndex := pcView.ActivePageIndex;
	// ViewHexa
	_Global.ViewHexa := chkViewHexa.Checked;

	_Global.Save;
end;

procedure TMainForm.SetControl;
var
	Active: Boolean;
begin
	Active := Snoop1.Active;
	ActionOpen.Enabled := not Active;
	ActionClose.Enabled := Active;
	ActionClear.Enabled := true;
	ActionOption.Enabled := not Active;
	ActionOpen.Enabled := not Active;
	ActionOpen.Enabled := not Active;
	ActionOpenFile.Enabled := not Active;
	ActionSave.Enabled := not Active and IsNeedToSave;
	ActionSaveAs.Enabled := not Active;
	ActionExit.Enabled := not Active;
	ActionAbout.Enabled := true;
	ActionHomePage.Enabled := true;
	ActionPacketField.Enabled := true;
end;

procedure TMainForm.InitializeListView;
var
	i: Integer;
	ListView: TListView;
begin
	for i := 0 to ComponentCount - 1 do
	begin
		if Components[i] is TListView then
		begin
			ListView := Components[i] as TListView;
			ListView.RowSelect := true;
			ListView.ViewStyle := vsReport;
			ListView.Align := alClient;
			ListView.OwnerData := true;
		end;
	end;
	// Ethernet
	Common.AddListViewField(lvEthernet, ETHERNET_FIELD, HEADER_FIELD);
	Common.AddListViewField(lvEthernet, ETHERNET_FIELD, ETHERNET_FIELD);
	// IP
	Common.AddListViewField(lvIP, IP_FIELD, HEADER_FIELD);
	Common.AddListViewField(lvIP, IP_FIELD, ETHERNET_FIELD);
	Common.AddListViewField(lvIP, IP_FIELD, IP_FIELD);
	// ARP
	Common.AddListViewField(lvARP, ARP_FIELD, HEADER_FIELD);
	Common.AddListViewField(lvARP, ARP_FIELD, ETHERNET_FIELD);
	Common.AddListViewField(lvARP, ARP_FIELD, ARP_FIELD);
	// ICMP
	Common.AddListViewField(lvICMP, ICMP_FIELD, HEADER_FIELD);
	Common.AddListViewField(lvICMP, ICMP_FIELD, ETHERNET_FIELD);
	Common.AddListViewField(lvICMP, ICMP_FIELD, IP_FIELD);
	Common.AddListViewField(lvICMP, ICMP_FIELD, ICMP_FIELD);
	// TCP
	Common.AddListViewField(lvTCP, TCP_FIELD, HEADER_FIELD);
	Common.AddListViewField(lvTCP, TCP_FIELD, ETHERNET_FIELD);
	Common.AddListViewField(lvTCP, TCP_FIELD, IP_FIELD);
	Common.AddListViewField(lvTCP, TCP_FIELD, TCP_FIELD);
	Common.AddListViewField(lvTCP, TCP_FIELD, TCPDATA_FIELD);
	// UDP
	Common.AddListViewField(lvUDP, UDP_FIELD, HEADER_FIELD);
	Common.AddListViewField(lvUDP, UDP_FIELD, ETHERNET_FIELD);
	Common.AddListViewField(lvUDP, UDP_FIELD, IP_FIELD);
	Common.AddListViewField(lvUDP, UDP_FIELD, UDP_FIELD);
	Common.AddListViewField(lvUDP, UDP_FIELD, UDPDATA_FIELD);