unitmain.pas

远程控制软件

unit UnitMain;

interface

uses
  Windows, ShellAPI, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, ScktComp, ComCtrls, Buttons, StdCtrls, ImgList, Jpeg,
  Menus, IniFiles, IdThreadMgr, IdThreadMgrDefault, IdAntiFreezeBase,
  IdAntiFreeze, IdBaseComponent, IdComponent, IdTCPServer, UnitFormControl,
  AppEvnts;

const
  WM_ICONTRAY = WM_USER + 2; //Mensaje usado para el icono en el system tray

type
  TFormMain = class(TForm)
    StatusBar: TStatusBar;
    ImageTitulo: TImage;
    BtnEscuchar: TSpeedButton;
    MenuConexiones: TPopupMenu;
    Ping1: TMenuItem;
    Cambiarnombre1: TMenuItem;
    ImageList: TImageList;
    BtnOpciones: TSpeedButton;
    ListViewConexiones: TListView;
    ServerSocket: TIdTCPServer;
    IdAntiFreeze1: TIdAntiFreeze;
    IdThreadMgrDefault1: TIdThreadMgrDefault;
    Label1: TLabel;
    procedure BtnEscucharClick(Sender: TObject);
    procedure ListViewConexionesContextPopup(Sender: TObject;
      MousePos: TPoint; var Handled: Boolean);
    procedure Abrir1Click(Sender: TObject);
    procedure BtnOpcionesClick(Sender: TObject);
    procedure Cambiarnombre1Click(Sender: TObject);
    procedure Ping1Click(Sender: TObject);
    procedure LeerArchivoINI();
    procedure GuardarArchivoINI();
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ServerSocketConnect(AThread: TIdPeerThread);
    procedure ServerSocketExecute(AThread: TIdPeerThread);
    procedure ServerSocketDisconnect(AThread: TIdPeerThread);
    procedure ListViewConexionesColumnClick(Sender: TObject;
      Column: TListColumn);
    procedure ListViewConexionesCompare(Sender: TObject; Item1,
      Item2: TListItem; Data: Integer; var Compare: Integer);
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    ColumnaOrdenada, Columna: Integer;
    TrayIconData: TNotifyIconData; 
    procedure TrayMessage(var Msg: TMessage); message WM_ICONTRAY;
  public
    procedure MinimizeToTrayClick(Sender: TObject);
  end;

var
  FormMain: TFormMain;
  PrimeraVezQueMeMuestro: Boolean = True;

implementation

uses UnitOpciones;

{$R *.dfm}


procedure TFormMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  GuardarArchivoINI();
  if ServerSocket.Active then BtnEscuchar.Click;
end;


procedure TFormMain.BtnOpcionesClick(Sender: TObject);
begin
  FormOpciones.ShowModal();
end;

procedure TFormMain.BtnEscucharClick(Sender: TObject);
var
  h: TBitmap;
  i: integer;
  List: TList;
  Athread: TidPeerThread;
begin
  if BtnEscuchar.Caption = 'Listen' then
  begin
    try
      ServerSocket.DefaultPort := StrToInt(FormOpciones.EditPuerto.Text);
      ServerSocket.Active := True;
      FormOpciones.EditPuerto.Enabled := False;
      BtnEscuchar.Caption := 'Stop';

    except
      MessageDlg('The port ' + FormOpciones.EditPuerto.Text + ' is already in use, choose other', mtWarning, [mbok], 0);
    end;

    StatusBar.Panels[0].Text := 'Waiting for connections';
    StatusBar.Panels[1].Text := 'Port: ' + FormOpciones.EditPuerto.Text;
  end
  else
  begin
    List := ServerSocket.Threads.LockList;
    for i := 0 to List.Count - 1 do
    begin
      Athread := TidPeerThread(List.Items[i]);
      if Athread.Connection.Connected then
      begin
        Athread.Suspend;
        Athread.Connection.Disconnect;
        Athread.FreeOnTerminate := True;
        Athread.Terminate;
        List[i] := nil;
        Athread := nil;
      end;
    end;
    ServerSocket.Threads.Clear;
    ServerSocket.Threads.UnlockList;
    ServerSocket.Active := False;

    ListViewConexiones.Clear;
    FormOpciones.EditPuerto.Enabled := True;
    BtnEscuchar.Caption := 'Listen';

    StatusBar.Panels[0].Text := 'Listen Stopped';
  end;
end;



procedure TFormMain.ServerSocketConnect(AThread: TIdPeerThread);
begin
  AThread.Connection.MaxLineLength := 1024 * 1024; //Long Max linea
  AThread.Connection.WriteLn('MAININFO|' + IntToStr(Athread.Handle));
end;

procedure TFormMain.ServerSocketDisconnect(AThread: TIdPeerThread);
begin
  if Athread.Data <> nil then
  begin
    TListItem(Athread.Data).Delete;
  end;
  try
    ServerSocket.Threads.LockList.Remove(Athread);
  finally
    ServerSocket.Threads.UnlockList();
  end;
end;

procedure TFormMain.ServerSocketExecute(AThread: TIdPeerThread);
var
  Len, i, Ping: integer;
  item: TListItem;
  Buffer: AnsiString;
  Recibido, IP: string;
  SHP: HWND;
begin
  try
    Buffer := Trim(Athread.Connection.ReadLn);
  except
    Athread.Connection.Disconnect;
    exit;
  end;
  Len := Length(Buffer);

  if Buffer = 'CONNECTED?' then Exit //Lo ignoramos
  else if Buffer = 'PONG' then //Tiempo actual menos almacenado
  begin
    item := TListItem(Athread.Data);
    Ping := GetTickCount() - Cardinal(Item.SubItems.Objects[2]);
    case Ping of
      0..50: item.ImageIndex := 3; //Ping perfecto
      51..100: item.ImageIndex := 4; //Ping bueno
      101..300: item.ImageIndex := 5; //Ping regular
    else item.ImageIndex := 6; //Ping malo
    end;
    item.SubItems[4] := IntToStr(Ping);
    Exit;
  end;

  //Buscamos a que item corresponde la conexi髇
  for i := 0 to ListViewConexiones.Items.Count - 1 do
    if Athread.Handle = TIdPeerThread(ListViewConexiones.Items[i].SubItems.Objects[0]).Handle then
    begin
      item := ListViewConexiones.Items[i];
      //Enviarle la conexi髇 a la ventana de ese item, si la tiene
      if item.SubItems.Objects[1] <> nil then
      begin
        (item.SubItems.Objects[1] as TFormControl).OnRead(Buffer, Athread);
        Exit;
      end;
      exit;
    end;

  {Si llega aqu