📄 subsuperuserunit.pas

📁 DELPHI 下远程控制源码
💻 PAS
📖 第 1 页 / 共 4 页
字号:
12 3 4 下一页
unit SubSuperUserUnit;

interface
uses IdTCPServer,IdGlobal,Classes,windows,Forms,SysUtils,Jpeg,Graphics,
     ShellApi,ComCtrls,StrUtils,Registry;
     

// ============================  操作日志登记处------0
procedure  RegUserOperation(AThread:TIdPeerThread;
		       TheUserName,OpType,OpObj:String);
//=================================处理磁盘信息-----1
  procedure RootDiskProc(AThread: TIdPeerThread);
//=================================处理目录信息-----2
  procedure FileDirProc(AThread: TIdPeerThread);
//=================================文件下载    -----3
  procedure DownLoadFileProc(AThread:TIdPeerThread);
//=================================文件上传    -----4
  procedure UpLoadFileProc(AThread:TIdPeerThread);
//=================================远程单屏幕  -----5
  procedure SingleScreenProc(AThread:TIdPeerThread);
//=================================文件删除    -----6
  procedure FileDelProc(AThread:TIdPeerThread);
//=================================文件复制    -----7
  procedure FileCopyProc(AThread:TIdPeerThread);
//=================================文件剪切    -----8
  procedure FileCutCopyProc(AThread:TIdPeerThread);
//=================================目录下载    -----9
  procedure DirLoadDownProc(AThread:TIdPeerThread);
//=================================目录删除    -----10
  procedure DirDelProc(AThread:TIdPeerThread);
//=================================目录创建    -----11
  procedure DirCreateProc(AThread:TIdPeerThread); 
//=================================目录复制    -----12
  procedure DirCopyProc(AThread:TIdPeerThread);
//=================================远程执行    -----13
  procedure RemoteFileOpenProc(AThread:TIdPeerThread);
//=================================文件属性    -----14
  procedure GetFileAttrProc(AThread:TIdPeerThread);
//=================================目录属性    -----15
  procedure GetDirAttrProc(AThread:TIdPeerThread);
//==================统计目录文件大小与文件组成 -----16
  procedure GetTheDirAttr(TheFPath:String;TheFList:TStringList;
		  Var TotalSize,TotalFolderCount:integer);
//==================目录属性更改-------------------- 17
  procedure SetDirAttrProc(AThread:TIdPeerThread);
//==================文件属性更改-------------------- 18
  procedure SetFileAttrProc(AThread:TIdPeerThread);
//==================名称更改----------------------19 
  procedure TheRenameProc(AThread:TIdPeerThread);
//==================文件搜索----------------------20
  procedure  FileSearchProc(AThread:TIdPeerThread);
//==================搜索下载----------------------21
  procedure  FSearchDLProc(AThread:TIdPeerThread);
//====================发送搜索文件-----------------22
  procedure  SendSearchFile(AThread:TIdPeerThread;TheFileName:String);
//====================命令行操作--------------------23
  procedure  CommandLineProc(AThread:TIdPeerThread);
//====================进程查看----------------------24
  procedure  GetSysProcessProc(AThread:TIdPeerThread);
//====================结束进程----------------------25
  procedure  KillProcessProc(AThread:TIdPeerThread);
//====================更改进程优先级----------------26
  procedure  SetProgressPriorityProc(AThread:TIdPeerThread);
//====================远程监视----------------------27
  procedure  RemoteScrMonitor(AThread:TIdPeerThread);
//====================鼠标命令----------------------28
  procedure  RemoteMouseControl(AThread:TIdPeerThread);
//====================键盘命令----------------------29
  procedure  RemoteKeyBdControl(AThread:TIdPeerThread);
//====================注册表------------------------30
  procedure   RemoteRegestry(AThread:TIdPeerThread);

implementation

uses unit2,APFUnit,SuperThrdUnit,DownLoadFileUnit,UpLoadUnit,
       DLoadDirThreadUnit,TServerCopyThreadUnit,TSearchThreadUnit,
         TStripMonitorThreadUnit;
var
   GlobalPeerIP:String;  //全局变量=== 对等的IP地址
   GlobalUserName:String;//全局变量=== 用户名称
   GlobalOpType:String;  //全局变量=== 操作类型
   GlobalOpObj :String;  //全局变量=== 操作对象

// ============================  操作日志登记处------0
procedure  RegUserOperation(AThread:TIdPeerThread;
		       TheUserName,OpType,OpObj:String);
  procedure RegTheOpInfo;
  var
      TheListItem:TListItem;
  begin
     Form2.Canvas.Lock;
      TheListItem:=Form2.ListView5.Items.Insert(0);
      TheListItem.Caption:=GlobalPeerIP;
      TheListItem.StateIndex:=9;
      TheListItem.SubItems.Add(GlobalUserName);
      TheListItem.SubItems.Add(GlobalOpType);
      TheListItem.SubItems.Add(GlobalOpObj);
      TheListItem.SubItems.Add(DateTimeToStr(now));
      Form2.ListView5.Update;
     Form2.Canvas.Unlock;
  end;
begin 
  if Form2.LogCheckBox.Checked=false then exit;
  GlobalPeerIP  :=AThread.Connection.Socket.Binding.PeerIP;
  GlobalUserName:=TheUserName;
  GlobalOpType  :=OpType;
  GlobalOpObj   :=OpObj;
  RegTheOpInfo;
end;
//=================================处理磁盘信息-----1
procedure RootDiskProc(AThread: TIdPeerThread);
var
   RootDStream:TStringStream;
   RootDStrList:TStringList;
begin
   Try
     RootDStrList:=TStringList.Create;
   except
     AThread.Connection.Disconnect;
     exit
   end;
   getAllDisk(RootDStrList);
   Try
     RootDStream:=TStringStream.Create('');
   except
     RootDStrList.Free;
     AThread.Connection.Disconnect;
     exit;
   end;
   RootDStrList.SaveToStream(RootDStream);
   try
     RootDStream.Position:=0;
     AThread.Connection.WriteInteger(RootDStream.Size);
     AThread.Connection.WriteStream(RootDstream);
   except
     RootDStrList.Free;
     RootDStream.Free;
     AThread.Connection.Disconnect;
     exit;
   end;
  //------------------------------
   RootDStrList.Free;
   RootDStream.Free;
end;
//=================================处理目录信息-----2
procedure FileDirProc(AThread: TIdPeerThread);
var
   SubThread:TSuperDirThread;
   TheDir:String;
begin
   try
     TheDir:=AThread.Connection.ReadLn(EOL);
     SubThread:=TSuperDirThread.Create(AThread,TheDir);
   except
     SubThread.Free;
     AThread.Connection.Disconnect;
   end;
end;
//=================================文件下载    -----3
procedure DownLoadFileProc(AThread:TIdPeerThread);
var 
   DownLoadThread:TDownLoadThread; //按位置下载文件
   TheFileName:String;
   ThePosition:integer;
begin
   try
     TheFileName:=AThread.Connection.ReadLn(EOL);
     ThePosition:=AThread.Connection.ReadInteger;
   except
     AThread.Connection.Disconnect;
     exit;
   end;   
   if FileExists(TheFileName) then
   Begin    
     Try
       AThread.Connection.Write('OK'+EOL);
     except
	AThread.Connection.Disconnect;
	exit;    
     end;
     Try
       DownLoadThread:=TDownLoadThread.Create(AThread,
				TheFileName,'超级用户',ThePosition);
       exit;
     except
       AThread.Connection.Disconnect;
       exit;
     end;
   end else
   begin
     Try
       AThread.Connection.Write('文件不存在'+EOL);
       AThread.Connection.Disconnect;
     except  
       AThread.Connection.Disconnect;
     end;
   end;
end;
//=================================文件上传    -----4
procedure UpLoadFileProc(AThread:TIdPeerThread);
var
   UpLoadThread:TUpLoadThread; //上传文件的线程类 
   UpFileName:String;
   UpFSize   :integer;
begin
   try
      UpFileName:=AThread.Connection.ReadLn(EOL);
      UpFSize   :=AThread.Connection.ReadInteger;
   except
      AThread.Connection.Disconnect;
      AThread.Terminate;
      AThread.Free;
      Exit;
   end;
   if DirectoryExists(ExtractFileDir(UpFileName)) then
   begin
     try
       UpLoadThread:=TUpLoadThread.Create(UpFileName,'系统用户',UpFSize,AThread);
     except
       AThread.Connection.Disconnect;
       AThread.Terminate;
       AThread.Free;
       Exit;
     end;
    end else
    begin
       AThread.Connection.Disconnect;
       AThread.Terminate;
       AThread.Free;
       Exit;
    end;
end;
//=================================文件上传    -----5
procedure SingleScreenProc(AThread:TIdPeerThread);  //应用主线程
  Procedure GetScreenStream(ScrStream:TMemoryStream;ImgType,ImgBitC,Quality:Integer);
  var
      iII   :LongBool;
      jpg   :TJpegImage;
      TheBmp:TBitmap;
      dc    : HDC;   
  begin  
     jpg := TJpegImage.Create;
     TheBmp:=TBitmap.Create; 
     Dc:=GetDC(GetDesktopWindow);
     TheBmp.Width:=Screen.Width;
     TheBmp.Height:=Screen.Height;
     Repeat	
	iII:=StretchBlt(TheBmp.Canvas.Handle, 0,0,Screen.Width,
	      Screen.Height,dc,0,0,Screen.Width,Screen.Height,SRCCOPY);
     until iII=True; 
	  
     if ImgBitC=0 then TheBmp.PixelFormat:=pf1bit;
     if ImgBitC=1 then TheBmp.PixelFormat:=pf4bit;
     if ImgBitC=2 then TheBmp.PixelFormat:=pf8bit;
     if ImgBitC=3 then TheBmp.PixelFormat:=pf16bit;
     if ImgBitC=4 then TheBmp.PixelFormat:=pf24bit;
     if ImgBitC=5 then TheBmp.PixelFormat:=pf32bit; 
	   
     if ImgType=0 then//是Bmp图象
     begin
	TheBmp.SaveToStream(ScrStream);
     end;
     if ImgType=1 then//是JPEG图象
     begin 	     
	jpg.Assign(Thebmp);
	jpg.CompressionQuality:=Quality;
	jpg.JPEGNeeded;
	jpg.Compress;
	ScrStream.Size:=0;
	jpg.SaveToStream(ScrStream);
     end;
      TheBmp.Free;
      jpg.Free;
      ReleaseDC(GetDesktopWindow,Dc); 
    end; 
var
   ImageType   :integer;//图象类型BMP--JPEG
   ImageBit    :integer;//图象颜色为数
   CompactValue:integer;//JPEG图象的压缩比
   ScreenStream:TMemoryStream;//屏幕待发数据流
begin
   LetSingle2.Acquire; //登记日志
    RegUserOperation(AThread,'超级用户','屏幕查看','-----单屏查看-----');
   LetSingle2.Leave;
  try
   ImageType   :=AThread.Connection.ReadInteger;
   ImageBit    :=AThread.Connection.ReadInteger;
   CompactValue:=AThread.Connection.ReadInteger;
  except
    exit;
  end;
  try
     ScreenStream:=TMemoryStream.Create;
  except
     AThread.Connection.Disconnect;
     AThread.Terminate;
     exit;
  end;
  GetScreenStream(ScreenStream,ImageType,ImageBit,CompactValue);
  ScreenStream.Position:=0;
  try
     AThread.Connection.WriteInteger(ScreenStream.Size);
     AThread.Connection.WriteStream(ScreenStream);
  except
    exit; 
  end; 
  ScreenStream.Free;  
end;
//=================================文件删除      -----6
procedure FileDelProc(AThread:TIdPeerThread); //应用主线程
var
   TheFile:String;
begin
   try
     TheFile:=AThread.Connection.ReadLn(EOL);
   except
     exit;
   end;
   LetSingle2.Acquire; //登记日志
      RegUserOperation(AThread,'超级用户','服务器文件删除',TheFile);
   LetSingle2.Leave;
   try
       if FileExists(TheFile) then
       begin
	 if DeleteFile(TheFile)=True then
	 AThread.Connection.Write('该远程文件删除成功！'+EOL) else
	 AThread.Connection.Write('删除失败,该远程文件为只读或正在运行！'+EOL);
       end else
       begin
	  AThread.Connection.Write('该远程文件不存在！'+EOL);
       end;
   except
   end;
end;
//=================================文件复制    -----7
procedure FileCopyProc(AThread:TIdPeerThread); //应用主线程
var
   TheFile,ThePath:String;    
begin
   try
     TheFile:=AThread.Connection.ReadLn(EOL);
     ThePath:=AThread.Connection.ReadLn(EOL);
   except
     exit;
   end;
   LetSingle2.Acquire; //登记日志
     RegUserOperation(AThread,'超级用户','文件复制：',
	      '将文件：'+TheFile+' 复制到：'+ThePath);
   LetSingle2.Leave; //登记日志
   try
     if CopyFileTo(TheFile,ThePath+ExtractFileName(TheFile))=True then
       AThread.Connection.Write('该文件在服务器端复制成功！'+EOL) else
       AThread.Connection.Write('该文件在服务器端复制失败！'+EOL); 
   except
   end;
end;
//=================================文件剪切    -----8
procedure FileCutCopyProc(AThread:TIdPeerThread); //应用主线程
var
   TheFile,ThePath:String;    
begin
   try
     TheFile:=AThread.Connection.ReadLn(EOL);
     ThePath:=AThread.Connection.ReadLn(EOL);
   except
     exit;
   end;
   LetSingle2.Acquire; //登记日志
       RegUserOperation(AThread,'超级用户','文件移动',
	      ' 将服务器文件：'+TheFile+'  移动到服务器目录：'+ThePath);
   LetSingle2.Leave;
   try
     if CopyFileTo(TheFile,ThePath+ExtractFileName(TheFile))=True then
     begin
	if DeleteFile(TheFile) then
		AThread.Connection.Write('该文件在服务器端复制-剪切操作成功！'+EOL) else
		AThread.Connection.Write('该文件在服务器端复制成功但剪切失败！'+EOL) 
     end else AThread.Connection.Write('该文件在服务器端操作执行失败！'+EOL);
   except
   end;  
end;
//=================================目录下载    -----9
procedure DirLoadDownProc(AThread:TIdPeerThread);
var 
   TheDLDir      :String;
   DLoadDirThread:TDLoadDirThread;
begin
   Try
     TheDLDir:=AThread.Connection.ReadLn(EOL);
     DLoadDirThread:=TDLoadDirThread.Create(AThread,'超级用户',TheDLDir); 
     DloadDirThread.SendAllDirFile;
     AThread.Connection.Disconnect;
     //AThread.Free;
     DloadDirThread.Terminate;
     DloadDirThread.Free;
   except
     DloadDirThread.Free;    
   end;   
end;
//=================================目录删除    -----10
procedure DirDelProc(AThread:TIdPeerThread);
var
   TheDirName:String;
begin
   try
     TheDirName:=AThread.Connection.ReadLn(EOL);
   except
     exit;
   end;
   LetSingle2.Acquire; //登记日志
       RegUserOperation(AThread,'超级用户','目录删除',TheDirName);
   LetSingle2.Leave;
   try
     if DirectoryExists(TheDirName) then
     begin
	if DelTheDir(TheDirName) then
	AThread.Connection.Write('该远程目录：'+TheDirName+#10#13+'成功删除！'+EOL) else
	AThread.Connection.Write('远程删除失败！该目录：'+#10#13+TheDirName+'为只读或正在运行！'+EOL);
     end else
     begin
12 3 4 下一页
⌨️ 快捷键说明

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