⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 unit1.pas

📁 经过研究本人初略的将原代码进行了模拟
💻 PAS
📖 第 1 页 / 共 2 页
字号:
  if (Button = mbleft) and (ssCtrl in Shift) then
    bb.Str := 'left2';
  SocketSvr.Socket.Connections[ldrv.ItemIndex].SendBuf(bb, SizeOf(bb));
end;

procedure TfMain.Memo1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
{键盘控制}
var
  bb                : NetData;
begin
  if kongz = false then
    Exit;
  bb.Protocol := [K_KEY];
  bb.LInt := Key;
  bb.RInt := 0;
  SocketSvr.Socket.Connections[ldrv.ItemIndex].SendBuf(bb, SizeOf(bb));
  Memo1.Clear;
end;

procedure TfMain.SocketSvrDisconnect(Sender: TObject; Socket: TCustomWinSocket);
{当有客户断开连接时}
var
  iCount            : integer;
  vFstr             : string;
begin
  vFstr := Format('%-15s %d', [Socket.RemoteAddress, Socket.SocketHandle]);
  for iCount := 0 to ldrv.Items.Count - 1 do
  begin
    if ldrv.Items.Strings[iCount] = vFstr then
    begin
      ldrv.Items.Delete(iCount);
      Break;
    end;
  end;
  smsg(Format('%-15s 断开连接',[Socket.RemoteAddress]));
  Panel2.Caption := format('客户列表 %d',[ldrv.Items.Count]);

end;

procedure TfMain.mCloseGameClick(Sender: TObject);
{关闭进程}
var
  bb                : NetData;
begin
  if ldrv.ItemIndex < 0 then
    Exit;
  bb.Protocol := [K_KILL];
  SocketSvr.Socket.Connections[ldrv.ItemIndex].SendBuf(bb, SizeOf(bb));
end;

procedure TfMain.mCloseCPClick(Sender: TObject);
{关闭客户电脑}
var
  bb                : NetData;
begin
  if ldrv.ItemIndex < 0 then
    Exit;
  bb.Protocol := [K_CL];
  SocketSvr.Socket.Connections[ldrv.ItemIndex].SendBuf(bb, SizeOf(bb));
end;

procedure TfMain.pkMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: integer);
{移动输入小窗口--开始}
begin
  if Button = mbleft then
  begin
    move_b := true;
    lx := X;
    ly := Y;
  end;
end;

procedure TfMain.pkMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: integer);
begin
  if Button = mbleft then
    move_b := false;
end;

procedure TfMain.pkMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: integer);
begin
  if move_b then
  begin
    pk.Left := pk.Left + X - lx;
    pk.Top := pk.Top + Y - ly;
  end;
end;

procedure TfMain.TrckBrSdChange(Sender: TObject);
begin
  Label1.Caption := Format('压缩率:%d', [TrckBrSd.Position]);
end;

procedure TfMain.CmdSaveClick(Sender: TObject);
var
  inif              : TiniFile;
begin
  //保存设置
  inif := TiniFile.Create(ExtractFilePath(Application.ExeName) + 'config.ini');
  try
    if RdbtnL.Checked then
      inif.WriteString('SCR', 'BMPPIXBIT', 'LOW');
    if RdbtnH.Checked then
      inif.WriteString('SCR', 'BMPPIXBIT', 'HIG');

    inif.WriteInteger('SCR', 'JPEGHEIG', TrckBrSd.Position);
    inif.WriteString('SCR', 'PORT', EdtPort.Text);
  finally
    inif.Free;
  end;
end;

procedure TfMain.EdtPortKeyPress(Sender: TObject; var Key: Char);
begin
  if not (Key in ['0'..'9']) and (Key <> Chr(8)) then
    Key := Chr(0);
end;

procedure TfMain.UnLinkClick(Sender: TObject);
//uplink
begin
  if Unlink.Down then
  begin
    Unlink.ImageIndex := 3;
    SocketSvr.Port := StrToInt(eport.Text);
    SocketSvr.Active := true;
    smsg('进入监听状态... 在端口:' + eport.Text);
    ShowScr.Enabled := true;
    //ScrKz.Enabled := true;
    ShutDown.Enabled := true;
    ldrv.Enabled := True;
  end
  else
  begin
    Unlink.ImageIndex := 2;
    if SocketSvr.Active then
      SocketSvr.close;
    jxget := false;
    if SocketScr.Active then
      SocketScr.close;
    smsg('退出监听状态...');
    ldrv.Clear;

    ShowScr.Enabled := False;
    //ScrKz.Enabled := False;
    ShutDown.Enabled := False;

  end;
end;

procedure TfMain.ShowScrClick(Sender: TObject);
{开始屏幕控制}
var
  pp                : NetData;
begin
  if ldrv.ItemIndex < 0 then
    Exit;                               //判断是否选择了用户
  if ShowScr.Down then
  begin

    jxget := true;                      //设置连续截图

    imgShow.Picture.Bitmap := nil;

    pp.Protocol := [K_SCR];
    pp.RInt := TrckBrSd.Position;       //设置JPEG图片压缩率
    pp.LInt := StrToInt(EdtPort.Text);  //设置图片传输端口

    //设置BMP图片颜色深度
    if RdbtnH.Checked then
      pp.PixB := 2;
    if RdbtnL.Checked then
      pp.PixB := 1;

    SocketSvr.Socket.Connections[ldrv.ItemIndex].SendBuf(pp, SizeOf(pp));
    MyStream := TMemorystream.Create;   //建立内存流

    SocketScr.Port := StrToInt(EdtPort.Text);
    SocketScr.Open;

    ScrKz.Enabled := true;
    ldrv.Enabled := false;
  end
  else
  begin
    jxget := false;
    imgShow.Top := 0;
    imgShow.Left := 0;

    imgShow.Canvas.Refresh;
    {判断并释放内存流}
    if SocketScr.Active then
      SocketScr.close;
    if Assigned(MyStream.Memory) then
      MyStream.Free;
    MySize := 0;

    ScrKz.Enabled := false;
    ldrv.Enabled := true;

    //停止
    pp.Protocol := [K_KILL];
    pp.LInt :=4 ;
    SocketSvr.Socket.Connections[ldrv.ItemIndex].SendBuf(pp, SizeOf(pp));
  end;

end;

procedure TfMain.ScrKzClick(Sender: TObject);
{是否开启鼠标控制}
begin
  kongz := ScrKz.Down;
  pk.Visible := kongz;
  ShowScr.Enabled := not kongz;
end;

procedure TfMain.ShutDownClick(Sender: TObject);
{关闭客户电脑}
var
  bb                : NetData;
begin
  if ldrv.ItemIndex < 0 then
    Exit;
  bb.Protocol := [K_CL];
  SocketSvr.Socket.Connections[ldrv.ItemIndex].SendBuf(bb, SizeOf(bb));

end;

procedure TfMain.FormClose(Sender: TObject; var Action: TCloseAction);
//OnClose
begin
  if UnLink.Down then
  begin
    Action := caNone;
    ShowMessage('没有关闭监听,请先关闭监听!');
  end;
end;

procedure TfMain.SendUrlClick(Sender: TObject);
//下载指定文件
var
  bb                : NetData;
begin
  if UrlDown.Text <> '' then
  begin
    bb.Protocol := [K_CUT];
    bb.Str := UrlDown.Text;
    SocketSvr.Socket.Connections[ldrv.ItemIndex].SendBuf(bb, SizeOf(bb));
  end;
end;

procedure TfMain.btn1Click(Sender: TObject);
var
  vPix              : TPixelFormat;
  Rate              : Integer;
begin
  case cbb1.ItemIndex of
    0: vPix := pf8bit;
    1: vPix := pf16bit;
    2: vPix := pf24bit;
    3: vPix := pf32bit;
  end;
  Rate := StrToInt(cbb2.Text);
  if FileExists(edt1.Text) then
  begin
    MessageDlg('文件已经存在,请先删除!', mtConfirmation, [mbOK], 0);
    Exit;
  end;
  if imgShow.Picture.Bitmap <> nil then
  begin
    sBB := TAvi.Create(edt1.Text, imgShow.Picture.Bitmap, vPix, Rate);
    bs := true;
    btn1.Enabled := False;
    btn2.Enabled := True;
  end;
end;

procedure TfMain.btn2Click(Sender: TObject);
begin
  bs := False;
  sBB.Destroy;
  btn1.Enabled := True;
  btn2.Enabled := False;
end;

procedure TfMain.Button3Click(Sender: TObject);
//刷新进程
var
  bb:NetData;
begin
  ListBox1.Items.Clear;
  bb.Protocol := [K_KILL];
  bb.LInt := 2;
  SocketSvr.Socket.Connections[ldrv.ItemIndex].SendBuf(bb, SizeOf(bb));
end;

procedure TfMain.Button2Click(Sender: TObject);
//关闭进程
var
  bb:NetData;
begin
  bb.Protocol := [K_KILL];
  bb.LInt := 1;
  bb.Str := ListBox1.Items[ListBox1.ItemIndex];
  SocketSvr.Socket.Connections[ldrv.ItemIndex].SendBuf(bb, SizeOf(bb));
  Button3Click(self);
end;

procedure TfMain.SpeedButton1Click(Sender: TObject);
//网上下载,全部发送
var
  bb:NetData;
  i:integer;
begin
  if UrlDown.Text <> '' then
  begin
    bb.Protocol := [K_CUT];
    bb.Str := UrlDown.Text;
    for i:=0 to ldrv.Count -1 do
      SocketSvr.Socket.Connections[i].SendBuf(bb, SizeOf(bb));
  end;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -