📄 unit1useunit.pas

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

interface
uses
   IdTCPClient,IdGlobal,windows,Forms,StrUtils,Classes,SysUtils;

//==========================================================================
procedure DelRemoteFile(TheFile:String;TheTCP:TidTCPClient);//删除远程文件1
	  //远程到远程的复制操作 2
procedure RemoteCopy(TheFile,ThePath:String;TheTcp:TidTcpClient);
	  //远程到远程的剪切操作
procedure RemoteCutCopy(TheFile,ThePath:String;TheTcp:TidTcpClient);
	 //设置菜单和按纽的状态 3
procedure SetMenuBtnState;
	 //删除该目录下的所有子目录和文件 4
Function  DelTheDir(ThePath:String):boolean;
	 //获取指定目录下的所有文件名 5
Function GetFileList(ThePath:String;TheList:TStrings):int64;
	 //本地文件目录的复制 6
procedure LocalDirCopy(SDir,TDir:String);
	 //本地文件目录的剪切 7
procedure LocalDirXCopy(SDir,TDir:String);
	 //从远程下载目录文件  8
procedure RemoteDirCopyDown(SDir,TDir:String);
	//删除远程主机上的目录及文件  9
procedure DelRemoteDir(TheDirName:String;TheTCP:TIdTcpClient);
	 //从远程移动目录文件  10
procedure RemoteDirMoveDown(SDir,TDir:String);
	 //在远程主机上创建子文件夹 11
procedure RemoteDirCreate(TheDir:String;TheTcp:TIdTcpClient);
	 //控制远程主机的文件复制  12 
procedure AtRemoteDirCopy(SDir,TDir:String);
	 //控制远程主机的文件剪切或目录移动  13 
procedure AtRemoteDirXCopy(SDir,TDir:String);
	 //目录状态设置和相关菜单按纽的设置  14
procedure SetDirButtonState;
	 //远程文件执行或打开                15
procedure RemoteFileOpen(TheFile:String;TheTcp:TIdTcpClient);
	 //获取本地文件或文件夹的属性        16
procedure GetLocalFileAttr(TheDFile:String;isDir:boolean); 
	 //查看远程的文件或目录属性          17
procedure GetRemoteFileAttr(TheDFile:String;isDirName:boolean);
	 //更改远程文件或目录的名称          18
procedure RenameRemoteName(TheOldName,TheNewName:String;TheTcp:TIdTcpClient);
	 

Var
   TheGFDirSize:int64;//用于标记返回目录尺寸的大小
   TheFolderCount:integer;//统计子文件夹的数目
implementation
uses unit1,FDirCopyUnit,FDirXCopyUnit,RemoteDirDLUnit,RemoteDirMDLUnit,
     AtRemoteCopyUnit,AtRemoteXCopyUnit,FileTypeUnit,DirTypeUnit,ShowDelUnit;


//获取指定目录下的所有文件名并返回大小
Function GetFileList(ThePath:String;TheList:TStrings):int64;
Var
    sr: TSearchRec;
begin
    if FindFirst(ThePath+'*.*',faAnyFile, sr) = 0 then
    begin
      repeat 
	if (Sr.Attr<16) then
	     begin
		  TheList.Add(ThePath+Sr.Name);
		  TheGFDirSize:=TheGFDirSize+Sr.Size;
	     end;
	if (Sr.Attr>=32) then
	  if (sr.Attr<48) then
	     begin
		  TheList.Add(ThePath+Sr.Name);
		  TheGFDirSize:=TheGFDirSize+Sr.Size;
	     end;
	if (Sr.Attr<32) and (Sr.Attr>=16) then
	begin
	   if (Sr.Name<>'.') then 
	    if (Sr.Name<>'..') then
	     begin
	       TheFolderCount:=TheFolderCount+1;
	       GetfileList(ThePath+Sr.Name+'\',TheList);
	     end;
	end;	
	if (Sr.Attr>=48) then
	begin
	   if (Sr.Name<>'.') then 
	    if (Sr.Name<>'..') then
	     begin
	       TheFolderCount:=TheFolderCount+1;
	       GetfileList(ThePath+Sr.Name+'\',TheList);
	     end;
	end;
      until FindNext(sr) <> 0;
      FindClose(sr);
    end;
end;
	 
Function DelTheDir(ThePath:String):boolean;//删除该目录下的所有子目录和文件
var
  TheState  : integer;
  SearchRec : TSearchRec;
begin
  TheState := FindFirst(ThePath+'*.*', faAnyFile - faDirectory, SearchRec);
  while TheState = 0 do  //先删除文件-----
  begin
      if not DeleteFile (ThePath + SearchRec.name) then
      begin
       FileSetAttr (ThePath + SearchRec.name, 0); { reset all flags }
       DeleteFile (ThePath + SearchRec.name);       
      end;
   TheState := FindNext(SearchRec);
  end;
  FindClose(SearchRec);   
  TheState := FindFirst(ThePath + '*.*',faDirectory, SearchRec);
  while TheState = 0 do //再删除目录-----
  begin
    if (SearchRec.name <> '.') and (SearchRec.name <> '..') then
    begin 
     if not RemoveDir(ThePath + SearchRec.name) then
     begin
       FileSetAttr (ThePath + SearchRec.name, faDirectory);
       DelTheDir(ThePath + SearchRec.name+'\');      
       RemoveDir(ThePath + SearchRec.name);     
     end;
    end;
    TheState := FindNext(SearchRec);
  end;
  FindClose(SearchRec);
  if RemoveDir(LeftStr(ThePath,length(ThePath)-1)) then
  DelTheDir:=True else DelTheDir:=False;
end; 
		     //删除远程主机上的目录及文件
procedure DelRemoteDir(TheDirName:String;TheTCP:TIdTcpClient);
var
   TheRetStr:String;
begin
  Try
    TheTCP.Write('目录删除'+EOL);
    TheTCP.Write(TheDirName+EOL);
    TheRetStr:=TheTCP.ReadLn(EOL);
  except
    Application.MessageBox('由于网络的原因，操作可能不成功，'+
		    #10#13+'请网络恢复后仔细检查操作的结果。',				 
		'网络失败',
			 MB_OK+MB_ICONSTOP);
    exit;
  end;
  Application.MessageBox(PChar(TheRetStr),'远程信息反馈：',
			 MB_OK+MB_ICONINFORMATION);
  
end;

procedure DelRemoteFile(TheFile:String;TheTCP:TidTCPClient);//删除远程文件
var
   TheRetStr:String;
begin
  Try
    TheTCP.Write('文件删除'+EOL);
    TheTCP.Write(TheFile+EOL);
    TheRetStr:=TheTCP.ReadLn(EOL);
  except
    Application.MessageBox('由于网络的原因，操作可能不成功，'+
		    #10#13+'请网络恢复后仔细检查操作的结果。',				 
		'网络失败',
			 MB_OK+MB_ICONSTOP);
    exit;
  end;
    ShowDelFm.Panel1.Caption:=ExtractFileName(TheFile);
    ShowDelFm.Caption:=TheRetStr;
    if  ShowDelFm.Panel1.Tag<>10 then
        Application.MessageBox(PChar(TheRetStr),				 
		'远程删除信息反馈：',
			 MB_OK+MB_ICONINFORMATION); 
end;
	  //-----------------------远程到远程的复制操作
procedure RemoteCopy(TheFile,ThePath:String;TheTcp:TidTcpClient);
var
   TheRetStr:String;
begin
  Try
    TheTCP.Write('文件复制'+EOL);
    TheTCP.Write(TheFile+EOL);
    TheTCP.Write(ThePath+EOL);
    TheRetStr:=TheTCP.ReadLn(EOL);
  except
    Application.MessageBox('由于网络的原因，操作可能不成功，'+
		    #10#13+'请网络恢复后仔细检查操作的结果。',				 
		'网络失败',MB_OK+MB_ICONSTOP); 			 
    exit;
  end;
  Application.MessageBox(PChar(TheRetStr),'远程信息反馈：',
		   MB_OK+MB_ICONINFORMATION);   
end;
	  //-----------------------远程到远程的剪切操作
procedure RemoteCutCopy(TheFile,ThePath:String;TheTcp:TidTcpClient);
var
   TheRetStr:String;
begin
  Try
    TheTCP.Write('文件剪切'+EOL);
    TheTCP.Write(TheFile+EOL);
    TheTCP.Write(ThePath+EOL);
    TheRetStr:=TheTCP.ReadLn(EOL);
  except
    Application.MessageBox('由于网络的原因，操作可能不成功，'+
		    #10#13+'请网络恢复后仔细检查操作的结果。',				 
		'网络失败',MB_OK+MB_ICONSTOP);			 
    exit;
  end;
  Application.MessageBox(PChar(TheRetStr),'远程信息反馈：',
                            MB_OK+MB_ICONINFORMATION);   
end;
procedure SetMenuBtnState;
begin
  With Form1 do
  begin
     //远程导航管理
    if isRemoteStat then
    begin
       ToolButton26.Enabled:=False;//向前导航
       ToolButton37.Enabled:=False;//向后导航        
    end else
    begin
       ToolButton26.Enabled:=True;//向前导航
       ToolButton37.Enabled:=True;//向后导航
    end;
    //远程目录管理
    if (IdFTCPClient.Connected and isRemoteStat) then//connected remote host state
    begin 
       ToolButton35.Enabled:=True;//上传        
       ToolButton41.Enabled:=True;//搜索       
       ToolButton42.Enabled:=True;//下载       
       ToolButton43.Enabled:=True;//屏幕
       N38.Enabled:=True;         //download
       N40.Enabled:=True;         //upload
       N120.Enabled:=True;         //远程搜索---设置---能 ---菜单
       N112.Enabled:=True;         //远程搜索---设置---能 ---目录菜单
    end else//disconnected state
    begin
       ToolButton35.Enabled:=False;//上传        
       ToolButton41.Enabled:=False;//搜索       
       ToolButton42.Enabled:=False;//下载       
       ToolButton43.Enabled:=False;//屏幕
	N120.Enabled:=False;         //远程搜索---设置---否
	N112.Enabled:=False;         //远程搜索---设置---否---目录菜单
       N38.Enabled:=False;         //download
       N40.Enabled:=False;         //upload
    end;
    //根据具体文件类型管理
    if ListView1.Selected=nil then //select none
    begin
      if ComboBox1.text='' then  //---新建----文件夹--按纽设置
	  ToolButton32.Enabled:=False else
	  ToolButton32.Enabled:=True;
	  
      if ComboBox1.text='' then  //新建文件夹--菜单设置
	  N22.Enabled:=False else //新建文件夹
	  N22.Enabled:=True;
		  
      ToolButton33.Enabled:=False;//复制到.......
      ToolButton34.Enabled:=False;//移动到.......      
      
      N102.Enabled:=False; //复制到.......
      N111.Enabled:=False; //移动到.......
     
      ToolButton28.Enabled:=False;//复制
      ToolButton27.Enabled:=False;//剪切
      ToolButton30.Enabled:=False;//删除
      
      N38.Enabled:=False;         //download
      ToolButton42.Enabled:=False;//下载
    end else // exist select
    begin    
      
      ToolButton28.Enabled:=True;//复制
      ToolButton27.Enabled:=True;//剪切
      ToolButton30.Enabled:=True;//删除
      
      if StrUtils.LeftStr(ListView1.Selected.SubItems[1],6)<>'文件夹' then
      begin //not is folder 
	
	if ComboBox1.text='' then  //新建文件夹
	  ToolButton32.Enabled:=False else
	  ToolButton32.Enabled:=True; 
	if ComboBox1.text='' then  //新建文件夹
	  N22.Enabled:=False  else //新建文件夹
	  N22.Enabled:=True;
	  
	ToolButton33.Enabled:=False;//复制到.......
	ToolButton34.Enabled:=False;//移动到.......
	
	N102.Enabled:=False; //复制到.......
	N111.Enabled:=False; //移动到....... 
	
	if (IdFTCPClient.Connected and isRemoteStat) then //远程文件
	begin
	   ToolButton42.Enabled:=True;//下载	  
	   N38.Enabled:=True;         //download
	   if ComboBox1.Text<>'' then  //upload
	      N40.Enabled:=True else N40.Enabled:=False;     
	end;
      end else
      begin // filefolder 
	ToolButton28.Enabled:=True;//复制
	ToolButton27.Enabled:=True;//剪切
	ToolButton30.Enabled:=True;//删除

	if ComboBox1.text='' then  //新建文件夹
	  ToolButton32.Enabled:=False else
	  ToolButton32.Enabled:=True;
	if ComboBox1.text='' then  //新建文件夹
	  N22.Enabled:=False else //新建文件夹
12 下一页
⌨️ 快捷键说明

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