Solved

NtSetInformationThread to suspend process

Posted on 2006-06-14
3
1,187 Views
Last Modified: 2007-12-19
sysinternal's ProcessExplorer lets me suspend and and un-suspend a process.

I'd like to be able to suspend a process (say, Trillian, Skype, Outlook) when I'm doing certain tasks (like screen recordings) during which I don't want any pop-ups or the cpu resources to be diverted.

Does any one have some D7 code that will allow me to do this?
0
Comment
Question by:tfield98
  • 2
3 Comments
 
LVL 11

Expert Comment

by:pcsentinel
ID: 16909393
0
 
LVL 11

Accepted Solution

by:
pcsentinel earned 500 total points
ID: 16910103
Ok try this

***************UNIT CODE***********************
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, tlHelp32, psapi;

const
      THREAD_SUSPEND_RESUME=2;
type
 PBA = ^TBA;
 TBA = array[0..1000000] of byte;

 PThreadInfo = ^TThreadInfo;
 TThreadInfo = record
  ftCreationTime : TFileTime;
  dwUnknown1 : dword;
  dwStartAddress : dword;
  dwOwningPID : dword;
  dwThreadID : dword;
  dwCurrentPriority : dword;
  dwBasePriority : dword;
  dwContextSwitches : dword;
  dwThreadState : dword;
  dwUnknown2 : dword;
  dwUnknown3 : dword;
  dwUnknown4 : dword;
  dwUnknown5 : dword;
  dwUnknown6 : dword;
  dwUnknown : dword;
 end;

 PProcessInfo = ^TProcessInfo;
 TProcessInfo=record
  dwOffset            : dword;
  dwThreadCount       : dword;
  dwUnkown1           : array[0..5] of dword;
  ftCreationTime      : TFileTime;
  dwUnkown2           : dword;
  dwUnkown3           : dword;
  dwUnkown4           : dword;
  dwUnkown5           : dword;
  dwUnkown6           : dword;
  pszProcessName      : PWideChar;
  dwBasePriority      : dword;
  dwProcessID         : dword;
  dwParentProcessID   : dword;
  dwHandleCount       : dword;
  dwUnkown7           : dword;
  dwUnkown8           : dword;
  dwVirtualBytesPeak  : dword;
  dwVirtualBytes      : dword;
  dwPageFaults        : dword;
  dwWorkingSetPeak    : dword;
  dwWorkingSet        : dword;
  dwUnkown9           : dword;
  dwPagedPool         : dword; // kbytes
  dwUnkown10          : dword;
  dwNonPagedPool      : dword; // kbytes
  dwPageFileBytes                  : dword;
  dwPageFileBytesPeak : dword;
  dwPrivateBytes      : dword;
  dwUnknown11         : dword;
  dwUnknown12         : dword;
  dwUnknown13         : dword;
  dwUnknown14         : dword;
  ThreadInfo : PThreadInfo; // Thread list
 end;

  TForm1 = class(TForm)
    ListBox1: TListBox;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    ListBox2: TListBox;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    function GetThreadFormProcessID(ID: DWord): DWord;
    procedure ListProcesses;
    { Private declarations }
  public
    { Public declarations }
  end;

function OpenThread(dwDesiredAccess: DWORD; bInheritHandle: BOOL;
  dwThreadId: DWORD): THandle; stdcall;

  var
  Form1: TForm1;

implementation

function NtQuerySystemInformation(dt : dword;
  buf : pointer;
  bufsize : dword;
  retlen : pointer) : dword; stdcall;external 'ntdll.dll';
function OpenThread; external kernel32 name 'OpenThread';
  {$R *.DFM}


procedure TForm1.ListProcesses;
var
 i,rl,cp : dword;
 pinfo : PProcessInfo;
 buf : PBA;
begin
      ListBox1.Items.clear;
 GetMem(buf,$10000);
 rl:=0;
 i:=NtQuerySystemInformation(5,buf,$10000,@rl);

 if i=0 then begin
  cp:=0;
  repeat
   pinfo:=PProcessInfo(@buf[cp]);
   cp:=cp+pinfo.dwOffset;
   begin
     with pinfo^ do begin
      if pszProcessName<>nil then
      begin
            try
                   ListBox1.Items.AddObject(WideCharToString(pszProcessName),pointer(dwProcessID));
       except
       end;
      end;
     end;
   end;
  until pinfo.dwOffset=0;
 end;
 FreeMem(buf);
end;

function TForm1.GetThreadFormProcessID(ID: DWord): DWord;
var
  lsnp : DWord;
  lsnt : DWord;
  lfound : Boolean;
  lTh: TThreadEntry32;
  lx: integer;
  lName: string;
begin
  Listbox2.Clear;
      Result:=0;
  lsnp := CreateToolHelp32SnapShot(TH32CS_SnapThread,0);
  lTh.dwSize := SizeOf(ThreadEntry32);
  if lsnp > 0 then
  begin
            if Thread32First(lsnp,lTh) then
    repeat
      if listbox1.iTems.indexofObject(pointer(lTh.th32OwnerProcessID))>-1 then
            Listbox2.items.add(listbox1.iTems[listbox1.iTems.indexofObject(pointer(lTh.th32OwnerProcessID))]+' - '+IntToStr(lTh.th32ThreadID));
      if lTh.th32OwnerProcessID=ID then
                  begin
        Result:=lTh.th32ThreadID;
//            break;
           end;
    until not Thread32Next(lsnp, lTh)
  end;
  CloseHandle(lsnp);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
      ListProcesses;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
      lID: DWord;
  lThread: DWord;
  lHandle: THandle;
begin
      lID:=DWord(ListBox1.Items.Objects[ListBox1.ItemIndex]);
  lThread:=GetThreadFormProcessID(lID);
  lHandle:=OpenThread(THREAD_SUSPEND_RESUME,true,lThread);
  label1.caption:=IntToStr(lThread);
  suspendthread(lHandle);
end;

procedure TForm1.Button3Click(Sender: TObject);
var
      lID: DWord;
  lThread: DWord;
  lHandle: THandle;
begin
      lID:=DWord(ListBox1.Items.Objects[ListBox1.ItemIndex]);
  lThread:=GetThreadFormProcessID(lID);
  lHandle:=OpenThread(THREAD_SUSPEND_RESUME,true,lThread);
  label1.caption:=IntToStr(lThread);
  ResumeThread(lHandle);
end;


end.


**************FORM CODE**************************
object Form1: TForm1
  Left = 215
  Top = 136
  Width = 696
  Height = 480
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object Label1: TLabel
    Left = 36
    Top = 180
    Width = 32
    Height = 13
    Caption = 'Label1'
  end
  object ListBox1: TListBox
    Left = 132
    Top = 24
    Width = 217
    Height = 385
    ItemHeight = 13
    Sorted = True
    TabOrder = 0
  end
  object Button1: TButton
    Left = 28
    Top = 24
    Width = 75
    Height = 25
    Caption = 'List'
    TabOrder = 1
    OnClick = Button1Click
  end
  object Button2: TButton
    Left = 28
    Top = 64
    Width = 75
    Height = 25
    Caption = 'Suspend'
    TabOrder = 2
    OnClick = Button2Click
  end
  object Button3: TButton
    Left = 28
    Top = 100
    Width = 75
    Height = 25
    Caption = 'Resume'
    TabOrder = 3
    OnClick = Button3Click
  end
  object Button4: TButton
    Left = 28
    Top = 132
    Width = 75
    Height = 25
    Caption = 'Kill'
    TabOrder = 4
  end
  object ListBox2: TListBox
    Left = 364
    Top = 24
    Width = 217
    Height = 385
    ItemHeight = 13
    Sorted = True
    TabOrder = 5
  end
end



******************************************
also wrote a quick test app to try this

*******************UNIT CODE********************
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    fStop: boolean;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
begin
      FStop:=false;
      while not FStop do
  begin
      label1.caption:=IntToStr(StrToInt(label1.caption)+1);
  aPplication.processmessages;
  end;

end;

procedure TForm1.Button2Click(Sender: TObject);
begin
      FStop:=true;
end;

end.

*****************FORM CODE****************************
object Form1: TForm1
  Left = 144
  Top = 189
  Width = 174
  Height = 201
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object Label1: TLabel
    Left = 20
    Top = 16
    Width = 6
    Height = 13
    Caption = '0'
  end
  object Button1: TButton
    Left = 76
    Top = 40
    Width = 75
    Height = 25
    Caption = 'Start'
    TabOrder = 0
    OnClick = Button1Click
  end
  object Button2: TButton
    Left = 76
    Top = 72
    Width = 75
    Height = 25
    Caption = 'Stop'
    TabOrder = 1
    OnClick = Button2Click
  end
end

*********************************************

consider this a work in progress as I'm looking at it for a poroject of my own

build the test project and run it from the exe, click start and the number will go up

run the suspend program select project1.exe from the left list and click suspend, the number should stop going up, then click resume and it should start again


note: needs a lot of tidying, but hope this helps


regards
0
 

Author Comment

by:tfield98
ID: 16997593
PCS:

Thanks for the code. Works great!

Now I just have to play around and see how resilent XP is to suspending processes!

It's nice to actually "play" on my machine (my boss would never pay me for this fun!) rather than actually "work."  I appreciate your jumping in to join me in the fun!

Thanks for the help!  If you further develop this, feel free to drop me a line.

tfield  and then at quickpen  and the requisite com
0

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
Activex loadlibrary and show parented form issue 6 286
Internet Explorer View Settings Question 15 106
Delphi Form ownership 4 73
Delphi: Connect to running MS Outlook 4 48
This article explains how to create forms/units independent of other forms/units object names in a delphi project. Have you ever created a form for user input in a Delphi project and then had the need to have that same form in a other Delphi proj…
In my programming career I have only very rarely run into situations where operator overloading would be of any use in my work.  Normally those situations involved math with either overly large numbers (hundreds of thousands of digits or accuracy re…
Migrating to Microsoft Office 365 is becoming increasingly popular for organizations both large and small. If you have made the leap to Microsoft’s cloud platform, you know that you will need to create a corporate email signature for your Office 365…
Learn how to create flexible layouts using relative units in CSS.  New relative units added in CSS3 include vw(viewports width), vh(viewports height), vmin(minimum of viewports height and width), and vmax (maximum of viewports height and width).

920 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

16 Experts available now in Live!

Get 1:1 Help Now