unittunnel.pas

不错的远程控制程序

unit UnitTunnel;

interface

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

type
  TTunnel = class(TForm)
    CheckBox1: TCheckBox;
    GroupBox1: TGroupBox;
    StatusBar1: TStatusBar;
    Label4: TLabel;
    Label5: TLabel;
    Edit1: TEdit;
    Edit2: TEdit;
    Label3: TLabel;
    Label1: TLabel;
    Label2: TLabel;
    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 FormCanResize(Sender: TObject; var NewWidth,
      NewHeight: Integer; var Resize: Boolean);
  private
    { Private declarations }
    DataSocket: TCustomWinSocket;
    Connected: Boolean;
    ConnectNotifyInfo: TNotifyInfo;
    ReadNotifyInfo: TNotifyInfo;
    DisconnectNotifyInfo: TNotifyInfo;
    ServerSocket: TServerSocket;
    DataIn, DataOut: dword;
    procedure ClientConnect(Sender: TObject; ClientSocket: TCustomWinSocket);
    procedure ClientRead(Sender: TObject; ClientSocket: TCustomWinSocket);
    procedure ClientDisconnect(Sender: TObject; ClientSocket: TCustomWinSocket);
    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;
  end;

implementation

{$R *.dfm}

uses
  UnitMain;

const
  TUN_TYPE = 14;
  TUN_START = 1;
  TUN_STOP = 2;
  TUN_CONNECT = 3;
  TUN_DATA = 4;
  TUN_DISCONNECT = 5;

function TTunnel.SocketConnected: Boolean;
begin
  if ((Connected) and (DataSocket <> nil)) then
  begin
    Connected := DataSocket.Connected;
    if not Connected then StatusBar1.Panels[0].Text := ' 断开连接';
  end;
  Result := Connected;
end;

procedure TTunnel.ClientConnect(Sender: TObject; ClientSocket: TCustomWinSocket);
var
  CommandFrame: TCommandFrame;
  ReplyStream: TMemoryStream;
  Port: dword;
begin
  if not SocketConnected then Exit;
  Label3.Caption := '连接数: ' + IntToStr(ServerSocket.Socket.ActiveConnections);
  ClientSocket.Data := nil;
  CommandFrame.len := 4;
  CommandFrame.Command := TUN_CONNECT;
  CommandFrame.ID := FRAME_ID;
  ReplyStream := TMemoryStream.Create;
  ReplyStream.WriteBuffer(CommandFrame, SizeOf(TCommandFrame));
  Port := ClientSocket.RemotePort;
  ReplyStream.WriteBuffer(Port, 4);
  Main.SendStream(DataSocket, ReplyStream);
end;

procedure TTunnel.ClientRead(Sender: TObject; ClientSocket: TCustomWinSocket);
var
  CommandFrame: TCommandFrame;
  ReplyStream: TMemoryStream;
  Port: dword;
  Buffer: Pointer;
begin
  if not SocketConnected then Exit;
  if ClientSocket.Data = nil then
  begin
    ClientSocket.ReceiveBuf(Port, 0);
    Exit;
  end;
  Inc(DataOut, ClientSocket.ReceiveLength);
  Label2.Caption := '发送字节: ' + IntToStr(DataOut);
  Application.ProcessMessages;
  CommandFrame.len := ClientSocket.ReceiveLength;
  CommandFrame.Command := TUN_DATA;
  CommandFrame.ID := FRAME_ID;
  GetMem(Buffer, CommandFrame.len);
  try
    CommandFrame.len := ClientSocket.ReceiveBuf(Buffer^, CommandFrame.len) + 4;
    ReplyStream := TMemoryStream.Create;
    ReplyStream.WriteBuffer(CommandFrame, SizeOf(TCommandFrame));
    Port := ClientSocket.RemotePort;
    ReplyStream.WriteBuffer(Port, 4);
    ReplyStream.WriteBuffer(Buffer^, CommandFrame.len - 4);
    if not Main.SendStream(DataSocket, ReplyStream) then ShowMessage('');
  finally
    FreeMem(Buffer);
  end;
end;

procedure TTunnel.ClientDisconnect(Sender: TObject; ClientSocket: TCustomWinSocket);
var
  CommandFrame: TCommandFrame;
  ReplyStream: TMemoryStream;
  Port: dword;
begin
  if not SocketConnected then Exit;
  Label3.Caption := '连接数: ' + IntToStr(ServerSocket.Socket.ActiveConnections);
  if DataSocket = nil then Exit;
  if not DataSocket.Connected then Exit;
  CommandFrame.len := 4;
  CommandFrame.Command := TUN_DISCONNECT;
  CommandFrame.ID := FRAME_ID;
  ReplyStream := TMemoryStream.Create;
  ReplyStream.WriteBuffer(CommandFrame, SizeOf(TCommandFrame));
  Port := ClientSocket.RemotePort;
  ReplyStream.WriteBuffer(Port, 4);
  Main.SendStream(DataSocket, ReplyStream);
end;

procedure TTunnel.Connect(var Socket: TCustomWinSocket; Data: Pointer);
var
  Tunnel: TTunnel;
  ConnectionInfo: TConnectionInfo;
begin
  Tunnel := TTunnel(Data);
  if TStreamRecord(Socket.Data).LocalAddress <> Tunnel.RemoteAddress then Exit;
  if Tunnel.DataSocket = nil then Tunnel.DataSocket := Socket else Exit;
  ConnectionInfo.ConnectionType := TUN_TYPE;
  Socket.SendBuf(ConnectionInfo, SizeOf(TConnectionInfo));
  Tunnel.Connected := True;
  Tunnel.StatusBar1.Panels.Items[0].Text := ' 已连接: ' + Socket.RemoteAddress;
  Tunnel.CheckBox1.Enabled := True;
  Socket := nil;
end;

procedure TTunnel.Read(var Socket: TCustomWinSocket; CommandFrame: TCommandFrame; Stream: TMemoryStream; Data: Pointer);
var
  Tunnel: TTunnel;
  ClientLoop: Integer;
  Port: Integer;
begin
  Tunnel := TTunnel(Data);
  if Tunnel.DataSocket = Socket then
  begin
    case CommandFrame.Command of
      TUN_DATA:
        begin
          Stream.ReadBuffer(Port, 4);
          for ClientLoop := 0 to Tunnel.ServerSocket.Socket.ActiveConnections - 1 do
          begin
            if Tunnel.ServerSocket.Socket.Connections[ClientLoop].RemotePort = Port then
            begin
              Tunnel.ServerSocket.Socket.Connections[ClientLoop].SendBuf(Pointer(dword(Stream.Memory) + 4)^, Stream.Size - 4);
              Inc(Tunnel.DataIn, Stream.Size - 4);
              Tunnel.Label1.Caption := '接收字节: ' + IntToStr(Tunnel.DataIn);
              Break;
            end;
          end;
        end;
      TUN_CONNECT:
        begin
          Stream.ReadBuffer(Port, 4);
          for ClientLoop := 0 to Tunnel.ServerSocket.Socket.ActiveConnections - 1 do
          begin
            if Tunnel.ServerSocket.Socket.Connections[ClientLoop].RemotePort = Port then
            begin
              Tunnel.ServerSocket.Socket.Connections[ClientLoop].Data := Pointer(1);
              Break;
            end;
          end;
        end;
      TUN_DISCONNECT:
        begin
          Stream.ReadBuffer(Port, 4);
          for ClientLoop := 0 to Tunnel.ServerSocket.Socket.ActiveConnections - 1 do
          begin
            if Tunnel.ServerSocket.Socket.Connections[ClientLoop].RemotePort = Port then
            begin
              Tunnel.ServerSocket.Socket.Connections[ClientLoop].Close;
              Tunnel.Label3.Caption := '连接数: ' + IntToStr(Tunnel.ServerSocket.Socket.ActiveConnections);
              Break;
            end;
          end;
        end;
    end;
    Socket := nil;
  end;
end;

procedure TTunnel.Disconnect(var Socket: TCustomWinSocket; Data: Pointer);
var
  Tunnel: TTunnel;
begin
  Tunnel := TTunnel(Data);
  if Tunnel.DataSocket = Socket then
  begin
    Tunnel.Connected := False;
    Tunnel.StatusBar1.Panels[0].Text := ' 断开连接';
    Tunnel.CheckBox1.Checked := False;
    Tunnel.CheckBox1.Enabled := False;
    Socket := nil;
    Tunnel.DataSocket := nil;
  end;
end;

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

procedure TTunnel.CheckBox1Click(Sender: TObject);
var
  CommandFrame: TCommandFrame;
  ReplyStream: TMemoryStream;
  Port: dword;
begin
  if not SocketConnected then Exit;
  if CheckBox1.Checked then
  begin
    if ((Length(Edit1.Text) = 0) or (Length(Edit2.Text) = 0)) then
    begin
      CheckBox1.Checked := False;
      Exit;
    end;
    Edit1.Enabled := False;
    Edit2.Enabled := False;
    if Assigned(ServerSocket) then ServerSocket.Free;
    ServerSocket := TServerSocket.Create;
    ServerSocket.OnClientConnect := ClientConnect;
    ServerSocket.OnClientRead := ClientRead;
    ServerSocket.OnClientDisconnect := ClientDisconnect;
    ServerSocket.Port := StrToInt(Edit2.Text);
    ServerSocket.Active := True;
    if DataSocket = nil then Exit;
    if not DataSocket.Connected then Exit;
    CommandFrame.len := 4;
    CommandFrame.Command := TUN_START;
    CommandFrame.ID := FRAME_ID;
    ReplyStream := TMemoryStream.Create;
    ReplyStream.WriteBuffer(CommandFrame, SizeOf(TCommandFrame));
    Port := StrToInt(Edit1.Text);
    ReplyStream.WriteBuffer(Port, 4);
    Main.SendStream(DataSocket, ReplyStream);
  end
  else
  begin
    if not Assigned(ServerSocket) then Exit;
    Edit1.Enabled := True;
    Edit2.Enabled := True;
    try
      ServerSocket.Active := False;
    except
    end;
    DataIn := 0;
    DataOut := 0;
    Label3.Caption := '连接数: ' + IntToStr(ServerSocket.Socket.ActiveConnections);
    CommandFrame.len := 0;
    CommandFrame.Command := TUN_STOP;
    CommandFrame.ID := FRAME_ID;
    ReplyStream := TMemoryStream.Create;
    ReplyStream.WriteBuffer(CommandFrame, SizeOf(TCommandFrame));
    Main.SendStream(DataSocket, ReplyStream);
  end;
end;

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

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

procedure TTunnel.FormCanResize(Sender: TObject; var NewWidth,
  NewHeight: Integer; var Resize: Boolean);
begin
  Resize := False;
end;

end.