Solved

NtSetInformationThread to suspend process

Posted on 2006-06-14
3
1,202 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 2
3 Comments
 
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

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

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

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…
Creating an auto free TStringList The TStringList is a basic and frequently used object in Delphi. On many occasions, you may want to create a temporary list, process some items in the list and be done with the list. In such cases, you have to…
This video Micro Tutorial shows how to password-protect PDF files with free software. Many software products can do this, such as Adobe Acrobat (but not Adobe Reader), Nuance PaperPort, and Nuance Power PDF, but they are not free products. This vide…
Monitoring a network: how to monitor network services and why? Michael Kulchisky, MCSE, MCSA, MCP, VTSP, VSP, CCSP outlines the philosophy behind service monitoring and why a handshake validation is critical in network monitoring. Software utilized …

705 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