Want to win a PS4? Go Premium and enter to win our High-Tech Treats giveaway. Enter to Win

x
?
Solved

NtSetInformationThread to suspend process

Posted on 2006-06-14
3
Medium Priority
?
1,236 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 2000 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

Keep up with what's happening at Experts Exchange!

Sign up to receive Decoded, a new monthly digest with product updates, feature release info, continuing education opportunities, and more.

Question has a verified solution.

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

Objective: - This article will help user in how to convert their numeric value become words. How to use 1. You can copy this code in your Unit as function 2. than you can perform your function by type this code The Code   (CODE) The Im…
Introduction Raise your hands if you were as upset with FireMonkey as I was when I discovered that there was no TListview.  I use TListView in almost all of my applications I've written, and I was not going to compromise by resorting to TStringGrid…
In this video, Percona Director of Solution Engineering Jon Tobin discusses the function and features of Percona Server for MongoDB. How Percona can help Percona can help you determine if Percona Server for MongoDB is the right solution for …
In this video, Percona Solutions Engineer Barrett Chambers discusses some of the basic syntax differences between MySQL and MongoDB. To learn more check out our webinar on MongoDB administration for MySQL DBA: https://www.percona.com/resources/we…
Suggested Courses

609 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