Solved

NtSetInformationThread to suspend process

Posted on 2006-06-14
3
1,180 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
Comment Utility
0
 
LVL 11

Accepted Solution

by:
pcsentinel earned 500 total points
Comment Utility
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
Comment Utility
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

Top 6 Sources for Identifying Threat Actor TTPs

Understanding your enemy is essential. These six sources will help you identify the most popular threat actor tactics, techniques, and procedures (TTPs).

Join & Write a Comment

The uses clause is one of those things that just tends to grow and grow. Most of the time this is in the main form, as it's from this form that all others are called. If you have a big application (including many forms), the uses clause in the in…
In this tutorial I will show you how to use the Windows Speech API in Delphi. I will only cover basic functions such as text to speech and controlling the speed of the speech. SAPI Installation First you need to install the SAPI type library, th…
This video discusses moving either the default database or any database to a new volume.
Here's a very brief overview of the methods PRTG Network Monitor (https://www.paessler.com/prtg) offers for monitoring bandwidth, to help you decide which methods you´d like to investigate in more detail.  The methods are covered in more detail in o…

743 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

15 Experts available now in Live!

Get 1:1 Help Now