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

📄 loopscrunit.pas

📁 DELPHI 下远程控制源码
💻 PAS
字号:
🔍 
unit LoopScrUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Grids, DBGrids, Buttons, StdCtrls, ExtCtrls, dbcgrids, Spin,
  DBCtrls, DB, DBClient, Mask, ExtDlgs,APFUnit, ComCtrls, FileCtrl;

type
  TLoopScrFm = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    DBCtrlGrid1: TDBCtrlGrid;
    ClientDataSet1: TClientDataSet;
    DataSource1: TDataSource;
    Panel3: TPanel;
    ClientDataSet1HostIP: TStringField;
    ClientDataSet1RecTime: TStringField;
    ClientDataSet1ScrPicture: TGraphicField;
    Splitter1: TSplitter;
    Panel4: TPanel;
    DBImage1: TDBImage;
    LoopMCDS: TClientDataSet;
    LoopMCDSHostName: TStringField;
    LoopMCDSHostIP: TStringField;
    LoopMCDSUserName: TStringField;
    LoopMCDSPassword: TStringField;
    LoopMCDSHostPort: TIntegerField;
    DataSource2: TDataSource;
    ClientDataSet1States: TStringField;
    LoopMCDSPictureID: TIntegerField;
    LoopMCDSColorID: TIntegerField;
    LoopMCDSCompressRatio: TIntegerField;
    Panel5: TPanel;
    DBText1: TDBText;
    Panel8: TPanel;
    SavePictureDialog1: TSavePictureDialog;
    Timer1: TTimer;
    Timer2: TTimer;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    Panel13: TPanel;
    DBGrid2: TDBGrid;
    Panel15: TPanel;
    SpeedButton5: TSpeedButton;
    SpeedButton10: TSpeedButton;
    SpeedButton12: TSpeedButton;
    Label3: TLabel;
    SpeedButton13: TSpeedButton;
    SpeedButton9: TSpeedButton;
    SpeedButton1: TSpeedButton;
    DBEdit1: TDBEdit;
    SpinEdit3: TSpinEdit;
    GroupBox1: TGroupBox;
    Panel11: TPanel;
    SpeedButton2: TSpeedButton;
    SpeedButton6: TSpeedButton;
    SpeedButton3: TSpeedButton;
    SpeedButton4: TSpeedButton;
    SpeedButton8: TSpeedButton;
    SpeedButton11: TSpeedButton;
    SpeedButton14: TSpeedButton;
    SpinEdit4: TSpinEdit;
    DBGrid1: TDBGrid;
    GroupBox2: TGroupBox;
    Panel14: TPanel;
    SpeedButton16: TSpeedButton;
    SpeedButton17: TSpeedButton;
    SpeedButton18: TSpeedButton;
    SpeedButton19: TSpeedButton;
    DBGrid4: TDBGrid;
    ClientDataSet2: TClientDataSet;
    DataSource3: TDataSource;
    ClientDataSet2HostIP: TStringField;
    ClientDataSet2RecTime: TStringField;
    ClientDataSet2ScrPicture: TGraphicField;
    ClientDataSet2States: TStringField;
    Splitter4: TSplitter;
    Splitter6: TSplitter;
    Panel12: TPanel;
    DBImage2: TDBImage;
    Panel6: TPanel;
    Panel10: TPanel;
    FileListBox1: TFileListBox;
    Panel17: TPanel;
    SpeedButton7: TSpeedButton;
    Splitter5: TSplitter;
    DBGrid3: TDBGrid;
    SpinEdit1: TSpinEdit;
    Label1: TLabel;
    SpinEdit2: TSpinEdit;
    Label2: TLabel;
    procedure SpinEdit1Change(Sender: TObject);
    procedure SpinEdit2Change(Sender: TObject);
    procedure DBImage1DblClick(Sender: TObject);
    procedure ClientDataSet1BeforeClose(DataSet: TDataSet);
    procedure LoopMCDSBeforeClose(DataSet: TDataSet);
    procedure LoopMCDSAfterDelete(DataSet: TDataSet);
    procedure DBGrid2DblClick(Sender: TObject);
    procedure DBGrid1DblClick(Sender: TObject);
    procedure DBImage2DblClick(Sender: TObject);
    procedure SpeedButton4Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure SpeedButton5Click(Sender: TObject);
    procedure SpeedButton13Click(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton6Click(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
    procedure SpeedButton11Click(Sender: TObject);
    procedure SpinEdit3Change(Sender: TObject);
    procedure SpeedButton10Click(Sender: TObject);
    procedure SpeedButton12Click(Sender: TObject);
    procedure SpeedButton8Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure SpeedButton14Click(Sender: TObject);
    procedure SpeedButton9Click(Sender: TObject);
    procedure SpinEdit4Change(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
    procedure DBGrid1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormShow(Sender: TObject);
    procedure SpeedButton17Click(Sender: TObject);
    procedure PageControl1Change(Sender: TObject);
    procedure FileListBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure SpeedButton16Click(Sender: TObject);
    procedure FileListBox1DblClick(Sender: TObject);
    procedure SpeedButton7Click(Sender: TObject);
    procedure DBGrid3DblClick(Sender: TObject);
    procedure DBGrid4DblClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  LoopScrFm: TLoopScrFm;

implementation

uses FullScrUnit,unit1,TScreenCaptureUnit, SetScrTimeUnit;

{$R *.dfm}

procedure TLoopScrFm.SpinEdit1Change(Sender: TObject);
begin
  DBCtrlGrid1.ColCount:=SpinEdit1.Value;
  DBCtrlGrid1.RowCount:=SpinEdit2.Value;
end;

procedure TLoopScrFm.SpinEdit2Change(Sender: TObject);
begin
  DBCtrlGrid1.ColCount:=SpinEdit1.Value;
  DBCtrlGrid1.RowCount:=SpinEdit2.Value;
end;

procedure TLoopScrFm.DBImage1DblClick(Sender: TObject);
begin
   Form3.Image1.Picture.Bitmap.Assign(DBImage1.Picture.Bitmap);
   Form3.ShowModal;
end;

procedure TLoopScrFm.ClientDataSet1BeforeClose(DataSet: TDataSet);
begin
   if ClientDataSet1.UpdateStatus = usUnModified then
			       ClientDataSet1.RefreshRecord;
end;

procedure TLoopScrFm.LoopMCDSBeforeClose(DataSet: TDataSet);
begin
   LoopMCDS.SaveToFile(TheLoopMHostFile);
end;

procedure TLoopScrFm.LoopMCDSAfterDelete(DataSet: TDataSet);
begin
   LoopMCDS.SaveToFile(TheLoopMHostFile);
end;

procedure TLoopScrFm.DBGrid2DblClick(Sender: TObject);
var
   ThePath:String;
begin
   LoopMCDS.Open;
   ThePath:=ExtractFilePath(TheLoopMHostFile)+'History\'; 
   FileListBox1.Directory:='c:\';   
   FileListBox1.Directory:=ThePath;
   DBImage2.DataSource:=DataSource1;
end;

procedure TLoopScrFm.DBGrid1DblClick(Sender: TObject);
begin
   ClientDataSet1.Open;
   DBImage2.DataSource:=DataSource1;
end;

procedure TLoopScrFm.DBImage2DblClick(Sender: TObject);
begin
   Form3.Image1.Picture.Bitmap.Assign(DBImage2.Picture.Bitmap);
   Form3.ShowModal;
end;

procedure TLoopScrFm.SpeedButton4Click(Sender: TObject);
begin
  if SpeedButton4.Down then
	    DBCtrlGrid1.DataSource:=DataSource1 else
            DBCtrlGrid1.DataSource:=nil;
end;

procedure TLoopScrFm.SpeedButton2Click(Sender: TObject);
begin
  if ClientDataSet1.RecordCount<1 then exit;
  if ClientDataSet1.Active then
	   ClientDataSet1.Delete; 	
end;

procedure TLoopScrFm.SpeedButton5Click(Sender: TObject);
begin
  LoopMCDS.SaveToFile(TheLoopMHostFile);
end;

procedure TLoopScrFm.SpeedButton13Click(Sender: TObject);
begin
  if LoopMCDS.RecordCount<1 then exit;
  if LoopMCDS.Active then
       LoopMCDS.Delete;
end;

procedure TLoopScrFm.SpeedButton1Click(Sender: TObject);
begin
   if LoopMCDS.Active then
        LoopMCDS.EmptyDataSet;
end;

procedure TLoopScrFm.SpeedButton6Click(Sender: TObject);
begin
   if ClientDataSet1.Active then
	   ClientDataSet1.EmptyDataSet;
   ClientDataSet1.SaveToFile(TheLoopMonitorFile);
end;

procedure TLoopScrFm.SpeedButton3Click(Sender: TObject);
begin
   if not ClientDataSet1.Active then exit;
   if SavePictureDialog1.Execute then
       DBImage2.Picture.SaveToFile(SavePictureDialog1.FileName);
end;

procedure TLoopScrFm.SpeedButton11Click(Sender: TObject);
begin
   ClientDataSet2.MasterSource:=DataSource2;
   ClientDataSet2.MasterFields:='HostIP';
end;

procedure TLoopScrFm.SpinEdit3Change(Sender: TObject);
begin
  Timer1.Interval:=SpinEdit3.Value*1000;
end;

procedure TLoopScrFm.SpeedButton10Click(Sender: TObject);
begin
   Timer1.Interval:=SpinEdit3.Value*1000;
   Timer1.Enabled:=True;
   Timer2.Interval:=SpinEdit4.Value*1000;
   Timer2.Enabled:=True;
end;

procedure TLoopScrFm.SpeedButton12Click(Sender: TObject);
begin 
  Timer1.Enabled:=False;
  self.Caption:='暂停循环监视！';
  Timer2.Enabled:=False;
end;

procedure TLoopScrFm.SpeedButton8Click(Sender: TObject);
begin
   ClientDataSet2.MasterSource:=nil;
end;

procedure TLoopScrFm.Timer1Timer(Sender: TObject);
var
   TheScrCapture:TScreenCaptureThread;
   TheCRec      :TConnectRec;
   TheOpt       :TConnectOpt;
   PictureValue   :integer;
   ColorValue     :integer;
   CompressValue  :integer;
   TheRecPos:TBookMark;
begin  
  Self.Caption:='当前共发出：'+IntToStr(Form1.LMThreadCount)+'个监视线程'; 
  if Form1.LMThreadCount<Form1.LMThreadMax then
  begin
    if LoopMCDS.Active=false then LoopMCDS.Open;
    LoopMCDS.DisableControls;
    TheRecPos:=LoopMCDS.GetBookmark;      
    LoopMCDS.First;    
    Repeat  
	TheCRec.ConHost:=LoopMCDS.FieldByName('HostIP').AsString; 	   
	TheCRec.ConPort:=LoopMCDS.FieldByName('HostPort').AsInteger;
	TheCRec.UserName:=LoopMCDS.FieldByName('UserName').AsString;
	TheCRec.Password:=LoopMCDS.FieldByName('Password').AsString;
	
	PictureValue:=LoopMCDS.FieldByName('PictureID').AsInteger;
	ColorValue  :=LoopMCDS.FieldByName('ColorID').AsInteger;
	CompressValue:=LoopMCDS.FieldByName('CompressRatio').AsInteger;
	
	TheScrCapture:=TScreenCaptureThread.Create(TheCRec,TheOpt,
				   PictureValue,ColorValue,CompressValue);
	TheScrCapture.Resume;
	LoopMCDS.Next;
    until (LoopMCDS.EOF or (Form1.LMThreadCount>Form1.LMThreadMax)); 
    LoopMCDS.GotoBookmark(TheRecPos);
    LoopMCDS.FreeBookmark(TheRecPos);
    LoopMCDS.EnableControls;  
  end;
end;  

procedure TLoopScrFm.SpeedButton14Click(Sender: TObject);
var
   TheSTime:TSystemTime;
   ThePath :String;
   TheFileName:String;    
begin
   ThePath:=ExtractFilePath(TheLoopMHostFile)+'History\';    
   DateTimeToSystemTime(Now,TheSTime);
   TheFileName:=IntToStr(TheSTime.wYear)+'-'+IntToStr(TheSTime.wDay)+'-'
		   +IntToStr(TheSTime.wHour)+'-'+IntToStr(TheSTime.wMinute)
		    +'-'+IntToStr(TheSTime.wSecond);
   ClientDataSet1.SaveToFile(ThePath+TheFileName+'.cds');
   ClientDataSet1.EmptyDataSet;
   if ClientDataSet1.UpdateStatus = usUnModified then
			       ClientDataSet1.RefreshRecord;
end;  
procedure TLoopScrFm.SpeedButton9Click(Sender: TObject);
begin
   SetScrTimeFm.ShowModal;
end;

procedure TLoopScrFm.SpinEdit4Change(Sender: TObject);
begin
   Timer2.Enabled:=True;
   Timer2.Interval:=SpinEdit4.Value*1000;
end;

procedure TLoopScrFm.Timer2Timer(Sender: TObject);
var
   TheSTime:TSystemTime;
   ThePath :String;
   TheFileName:String;    
begin
   ThePath:=ExtractFilePath(TheLoopMHostFile)+'History\';    
   DateTimeToSystemTime(Now,TheSTime);
      TheFileName:=IntToStr(TheSTime.wYear)+'-'+IntToStr(TheSTime.wDay)+'-'
		   +IntToStr(TheSTime.wHour)+'-'+IntToStr(TheSTime.wMinute)
		    +'-'+IntToStr(TheSTime.wSecond);
   ClientDataSet1.SaveToFile(ThePath+TheFileName+'.cds');
   ClientDataSet1.EmptyDataSet;
end;

procedure TLoopScrFm.DBGrid1MouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
begin 
   if ClientDataSet1.Active=false then exit;  
   DBGrid1.Hint:='当前共有监视记录：'
       +IntToStr(ClientDataSet1.RecordCount)+'条';
end;

procedure TLoopScrFm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
   DBCtrlGrid1.DataSource:=nil;
end;

procedure TLoopScrFm.FormShow(Sender: TObject);
var
   ThePath:String;
begin
   ThePath:=ExtractFilePath(TheLoopMHostFile)+'History\';
   if Not DirectoryExists(ThePath) then   
				ForceDirectories(ThePath);
   FileListBox1.Directory:=ThePath;
   ClientDataSet1.Open;
end;

procedure TLoopScrFm.SpeedButton17Click(Sender: TObject);
begin
    if SpeedButton17.Down then
	    DBCtrlGrid1.DataSource:=DataSource3 else
	    DBCtrlGrid1.DataSource:=nil;
end;

procedure TLoopScrFm.PageControl1Change(Sender: TObject);
begin
    DBCtrlGrid1.DataSource:=nil;
end;

procedure TLoopScrFm.FileListBox1MouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
   FileListBox1.Hint:='当前共有：'+IntToStr(FilelistBox1.Items.Count)+'个历史记录文件';
end;

procedure TLoopScrFm.SpeedButton16Click(Sender: TObject);
begin
   if not ClientDataSet2.Active then exit;
   if SavePictureDialog1.Execute then
       DBImage2.Picture.SaveToFile(SavePictureDialog1.FileName);
end;

procedure TLoopScrFm.FileListBox1DblClick(Sender: TObject);
begin    
    ClientDataSet2.Close;
    ClientDataSet2.FileName:=FileListBox1.FileName;
    ClientDataSet2.MasterSource:=DataSource2;
    ClientDataSet2.MasterFields:='HostIP';
    DBImage2.DataSource:=DataSource3;
    ClientDataSet2.Open;
    Panel14.Caption:=FileListBox1.FileName;     
end;

procedure TLoopScrFm.SpeedButton7Click(Sender: TObject);
var
   i:integer;
begin
  if FileListBox1.SelCount>0 then
  begin
     For i:=FileListBox1.Items.Count-1 DownTo 0 do
     begin
       if FileListBox1.Selected[i] then
       begin
	    DeleteFile(FileListBox1.Items[i]); 	   
       end;
     end;
     FileListBox1.DeleteSelected;
  end;
end;

procedure TLoopScrFm.DBGrid3DblClick(Sender: TObject);
var
   ThePath:String;
begin
   LoopMCDS.Open;
   ThePath:=ExtractFilePath(TheLoopMHostFile)+'History\'; 
   FileListBox1.Directory:='c:\';   
   FileListBox1.Directory:=ThePath;
   DBImage2.DataSource:=DataSource3;
end;

procedure TLoopScrFm.DBGrid4DblClick(Sender: TObject);
begin
   ClientDataSet1.Open;
   DBImage2.DataSource:=DataSource3;
end;

end.

⌨️ 快捷键说明

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