apfunit.pas

DELPHI 下远程控制源码

unit APFUnit;  //双方公用单元

interface

uses SysUtils,Classes,windows,StrUtils,Tlhelp32,IdSocks,IdSSLOpenSSL;
type
  TConnectRec=record //对TTCPClientSocket的主机-端口-用户的设置
     ConHost:String;
     ConPort:Integer;
     UserName:String;
     Password:string;
  end;
  TOpFile=record //文件复制与拷贝的设置
      isLocal:boolean;
      isCut  :boolean;
      TheFile:String;
  end;
  TOpDir=record //目录的复制与拷贝的设置
      isLocal   :boolean;
      isCut     :boolean;
      TheDirName:String;
  end;
  TConnectOpt=record // 对TTCPClientSocket的--代理服务---加密信息的设置
      UseNagle:boolean;    //算法是否启动
      UseProxy:boolean;
      ProxyHost:String;
      ProxyPort:Integer;
      PUseAuth :TSocksAuthentication;
      PUserID  :String;
      PPassWD  :String;
      PVersion :TSocksVersion;
      UseIntercept:boolean;
      SSLOpt_CF:String;
      SSLOpt_KF:String;
      SSLOpt_Method:byte;
      SSLOpt_Mode  :byte;
      SSLOpt_RCF:String;
      SSLOpt_VfyDepth:byte;
      SSLOpt_VfyMode:TIdSSLVerifyModeSet;
  end;
//-------------------------------------------------------------1
Procedure InfoSwap(const SeedStr:String;var SwapStream:TMemoryStream;
					    var Suc:boolean);
	  //数据流加密，SeedStr是加密的因子，SwapStream是加密转换的数据流
//-------------------------------------------------------------2
Procedure StrInfoswap(const SeedStr:String;var SwapStream:TStringStream;
                                            var Suc:boolean);
	  //数据流加密，SeedStr是加密的因子，SwapStream是加密转换的数据流
//-------------------------------------------------------------3
procedure GetFilesStream(const ThePath:String;var OutStream:TStringStream);
	  //获取文件目录列表，ThePath是指定的路径，OutStream是输出流；
//-------------------------------------------------------------4
procedure getAllDisk(var DiskList:TStringList);
	  //获取所有的磁盘信息
//-------------------------------------------------------------5
Function DelTheDir(ThePath:String):boolean;
       //删除该目录下的所有子目录和文件
//-------------------------------------------------------------6
procedure GetProcessList(TheList:TStrings);
	 //获取进程列表
//-------------------------------------------------------------7

Function SetProcessPriority(ProcessID,ThePriority:Cardinal):boolean;
	 //设置进程的优先级
//-------------------------------------------------------------8
Function KillProcess(ProcessID:Cardinal):boolean;
	//杀死进程(根据进程号)
//-------------------------------------------------------------9
Function KillProcess2(TheProcName:String):boolean;
	//杀死进程(根据进程名）


implementation
Procedure StrInfoSwap(const SeedStr:String;var SwapStream:TStringStream;
                                               var Suc:boolean);
//数据流加密，SeedStr是加密的因子，SwapStream是加密转换的数据流
var
  i,j        :integer;
  iReadCount :integer;
  readBuf    :array[1..8192] of byte;
  TempStream :TStringStream;
begin
    SwapStream.Position:=0;
    Try
      TempStream:=TStringStream.Create('');
    except
      Suc:=False;
      exit;
    end;
    Repeat
       j:=1;
       iReadCount:=SwapStream.Read(readBuf,8192);
       For i:=1 to iReadCount do
       begin
         j:=j+1;
         readBuf[i]:=(ord(SeedStr[j]) xor readBuf[i]);
         if j=Length(SeedStr)-1 then j:=2;
       end;
       if iReadCount<>TempStream.Write(readBuf,iReadCount) then
       begin
         Tempstream.Free;
         Suc:=False;
         exit;
       end;
    until SwapStream.Position=SwapStream.Size;
    SwapStream.Size:=0;
    try
      SwapStream.CopyFrom(TempStream,0);
    except
      Tempstream.Free;
      Suc:=False;
      exit;
    end;
    TempStream.Free;
    Suc:=True;
end;
Procedure InfoSwap(const SeedStr:String;var SwapStream:TMemoryStream;
                                               var Suc:boolean);
//数据流加密，SeedStr是加密的因子，SwapStream是加密转换的数据流
var
  i,j        :integer;
  iReadCount :integer;
  readBuf    :array[1..8192] of byte;
  TempStream :TMemoryStream;
begin
    SwapStream.Position:=0;
    Try
      TempStream:=TMemoryStream.Create;
    except
      Suc:=False;
      exit;
    end;
    Repeat
       j:=1;
       iReadCount:=SwapStream.Read(readBuf,8192);
       For i:=1 to iReadCount-1 do
       begin
         j:=j+1;
         readBuf[i]:=(ord(SeedStr[j]) xor readBuf[i]);
         if j=Length(SeedStr)-2 then j:=2;
       end;
       if iReadCount<>TempStream.Write(readBuf,iReadCount) then
       begin
         Tempstream.Free;
         Suc:=False;
         exit;
       end;
    until SwapStream.Position=SwapStream.Size;
    SwapStream.Size:=0;
    try
      SwapStream.CopyFrom(TempStream,0);
    except
      Tempstream.Free;
      Suc:=False;
      exit;
    end;
    TempStream.Free;
    Suc:=True;
end;
procedure GetFilesStream(const ThePath:String;var OutStream:TStringStream);
var
  sr: TSearchRec;
  FileAttrs: Integer;
  FilesList: TStringList;
begin
  try
    FilesList:=TStringList.Create;
  except
    exit;
  end;
  FileAttrs :=faAnyFile;
  try
    if FindFirst(ThePath, FileAttrs, sr) = 0 then
    begin
      repeat
        if (sr.Attr and FileAttrs) = sr.Attr then
        begin
           FilesList.Add(sr.Name);
           FilesList.Add(IntToStr(sr.Size));           
           FilesList.Add(IntToStr(sr.Attr));
           FilesList.add(DateTimeToStr(FileDateToDateTime(sr.Time)));
        end;
      until FindNext(sr) <> 0;
      try
	FilesList.SaveToStream(OutStream);
      except
	FilesList.Free;
	SysUtils.FindClose(sr);
	exit;
      end;
   end;
  except
  end;
   SysUtils.FindClose(sr);
   FilesList.Clear;
   FilesList.Free;   
end;
procedure getAllDisk(var DiskList:TStringList);
  function IsNT: Boolean ;
  var
     OSVersionInfo: TOSVersionInfo;
  begin
     OSVersionInfo.dwOSVersionInfoSize := SizeOf(OSVersionInfo);
     GetVersionEx(OSVersionInfo);
     if OSVersionInfo.dwPlatformId = VER_PLATFORM_WIN32_NT then
       Result := True
     else
      Result := False;
  end;
var
  i:byte;
  j:integer;
  drv:PChar;
  AChar:array[1..3] of char;
begin
  if isNT then
  begin
   For i:=1 to 26 do
   begin
      AChar[1]:=Chr(64+i);
      AChar[2]:=':';
      AChar[3]:=#0;  
      drv:=@AChar;
      J:=GetDriveType(drv);
      if J=DRIVE_REMOVABLE then
	DiskList.Add(Chr(64+i)+':(软盘)'); 
      if J=DRIVE_FIXED then
	 if DiskSize(i)<>-1 then DiskList.Add(Chr(64+i)+':(硬盘'
		   +IntToStr(DiskSize(i) div 1024 div 1024)+'M/剩'
		    +IntToStr(DiskFree(i) div 1024 div 1024)+'M)');
      if J=DRIVE_REMOTE then
	DiskList.Add(Chr(64+i)+':(网络映射)');
      if J=DRIVE_CDROM then
       DiskList.Add(Chr(64+i)+':(光盘)');
      if J=DRIVE_RAMDISK then
       DiskList.Add(Chr(64+i)+':(虚拟盘)');
    end;
  end;
  if not isNT then
  begin
   For i:=1 to 26 do
   begin
      AChar[1]:=Chr(64+i);
      AChar[2]:=':';
      AChar[3]:=#0;  
      drv:=@AChar;
      J:=GetDriveType(drv);
      if J=DRIVE_REMOVABLE then
	DiskList.Add(Chr(64+i)+':(软盘)'); 
      if ((J=DRIVE_FIXED) or (i=3)) then
	 if DiskSize(i)<>-1 then DiskList.Add(Chr(64+i)+':(硬盘'
		   +IntToStr(DiskSize(i) div 1024 div 1024)+'M/剩'
		    +IntToStr(DiskFree(i) div 1024 div 1024)+'M)');		    
      if J=DRIVE_REMOTE then
	DiskList.Add(Chr(64+i)+':(网络映射)');
      if J=DRIVE_CDROM then
       DiskList.Add(Chr(64+i)+':(光盘)');
      if J=DRIVE_RAMDISK then
       DiskList.Add(Chr(64+i)+':(虚拟盘)');
    end;
  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(PChar(ThePath + SearchRec.name)) then
      begin
       FileSetAttr (ThePath + SearchRec.name, 0); { reset all flags }
       DeleteFile (PChar(ThePath + SearchRec.name));       
      end;
   TheState := FindNext(SearchRec);
  end;
  SysUtils.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;
  SysUtils.FindClose(SearchRec);
  if ThePath[Length(ThePath)]='\' then 
  begin
   if RemoveDir(LeftStr(ThePath,length(ThePath)-1)) then
   DelTheDir:=True else DelTheDir:=False;   
  end;
  if ThePath[Length(ThePath)]<>'\' then 
  begin
   if RemoveDir(ThePath) then
   DelTheDir:=True else DelTheDir:=False;
  end;
end;
procedure GetProcessList(TheList:TStrings);//获取进程列表
  function IsNT: Boolean ;
  var
     OSVersionInfo: TOSVersionInfo;
  begin
     OSVersionInfo.dwOSVersionInfoSize := SizeOf(OSVersionInfo);
     GetVersionEx(OSVersionInfo);
     if OSVersionInfo.dwPlatformId = VER_PLATFORM_WIN32_NT then
       Result := True
     else
      Result := False;
  end;
var  
    isOK:Boolean;
    ProcessHandle:Thandle;
    ProcessStruct:TProcessEntry32;
begin
     ProcessHandle:=createtoolhelp32snapshot(Th32cs_snapprocess,0);
     processStruct.dwSize:=sizeof(ProcessStruct);
     isOK:=process32first(ProcessHandle,ProcessStruct);
     while isOK do
     begin 	 
	 TheList.Add(ProcessStruct.szExeFile);//进程名-------------------1
         if isNt then
         begin
	   TheList.Add(IntToStr(ProcessStruct.th32ProcessID));//进程ID-----2
	   TheList.Add(IntToStr(ProcessStruct.cntThreads));//线程数--------3 	 
	   TheList.Add(IntToStr(ProcessStruct.pcPriClassBase));//优先级-4
	   TheList.Add(IntToStr(ProcessStruct.th32ParentProcessID));//父进程ID-5
         end else
         begin
	   TheList.Add('0');//进程ID-----2
	   TheList.Add('0');//线程数--------3 	 
	   TheList.Add('0');//优先级-4
	   TheList.Add('0');//父进程ID-5
         end;
	 isOK:=process32next(ProcessHandle,ProcessStruct);
     end;
     CloseHandle(ProcessHandle);
end;
	//设置进程的优先级
Function SetProcessPriority(ProcessID,ThePriority:Cardinal):boolean;
var
   H:THandle;
begin  
   H:=openProcess(Process_All_Access, true,ProcessID);  
   Result:=SetPriorityClass(H,ThePriority);
end;

Function KillProcess(ProcessID:Cardinal):boolean;//杀死进程(根据进程号)
var
   H:THandle;
begin  
   H:=OpenProcess(Process_All_Access, true,ProcessID);
   Result:=TerminateProcess(H,0);
end;

Function KillProcess2(TheProcName:String):boolean; //杀死进程(根据进程名）
var  
    isOK:Boolean;
    ProcessHandle:Thandle;
    ProcessStruct:TProcessEntry32;
begin
     ProcessHandle:=createtoolhelp32snapshot(Th32cs_snapprocess,0);
     processStruct.dwSize:=sizeof(ProcessStruct);
     isOK:=process32first(ProcessHandle,ProcessStruct);
     while isOK do
     begin 	 
	 if TheProcName=ProcessStruct.szExeFile then
         begin
            Result:=KillProcess(ProcessStruct.th32ProcessID);
            CloseHandle(ProcessHandle);
            exit;
         end;	 
	 isOK:=process32next(ProcessHandle,ProcessStruct);
     end;
     CloseHandle(ProcessHandle);
end; 
end.