this slowpoke moves

Get Threads from any Process

Unit AuxStr.pas 
{$B-,V-}
{$IFDEF VER80}
  {$DEFINE USES_SYSUTILS}
{$ENDIF}
{$IFDEF WIN32}
  {$DEFINE USES_SYSUTILS}
{$ENDIF}
unit AuxStr;   
interface
type
  CString=array[0..255] of Char;     
function UpString(X:String):String;  
function LoString(X:String):String;  
function LTrim(X:String):String;     
function RTrim(X:String):String;     
function Trim(X:String):String;      
function GetString(var X:String;Index:Integer;Count:Integer):String; 
function ReplStr(X:String;Count:Integer):String; 
function ReplSpace(Count:Integer):String;  
function LStr(X:String;Count:Integer):String;  
function RStr(X:String;Count:Integer):String;  
function RevStr(X:String):String;  
{$IFNDEF WIN32}
procedure SetLength(var S: string; NewLength: Integer);
{$ENDIF}
{$IFNDEF USES_SYSUTILS}
function StrToTime(S: string; var Hour, Min, Sec: Word): Integer;
function TimeToStr(Hour, Min, Sec: Word): string;
function StrToDate(S: string; var Day, Month, Year: Word): Integer;
function DateToStr(Day, Month, Year: Word): string;
const
  TimeFormat: string[30]='%2d:%02d:%02d';
  DateFormat: string[30]='%2d.%2d.%4d';
{$ENDIF}
function StrToNum(S: string): LongInt;
function NumToHexStr(L: LongInt): string;  
function NumToStr(L: LongInt): string;
function NumToHexStrI(L: LongInt; N: Integer): string;  
function NumToStrI(L: LongInt; N: Integer): string;
function Bin2Hex(const S: string): string;
function Hex2Bin(const S: string): string;
function StripDecimals(S: string): string; 
function StripExponent(S: string): string; 
const
  HexPrefix: Char='$';
{$IFNDEF USES_SYSUTILS}
  {$IFNDEF USES_DRIVERS}
procedure FormatStr(var Result: String; {$IFNDEF VER60} const {$ENDIF} Format: String; var Params);
  {$ENDIF}
{$ENDIF}
implementation
{$IFDEF USES_DRIVERS}
uses
  Drivers;
{$ENDIF}
function UpString;
var
  I: Integer;
  Y:String;
begin
Y:='';
for I:=1 to Length(X) do Y:=Y+UpCase(X[I]);
UpString:=Y;
end;
function LoString;
var
  I: Integer;
  Y:String;
begin
Y:=X;
for I:=1 to Length(X) do
  if (Y[I]>='A')and(Y[I]<='Z') then
    Y[I]:=Char(Byte(Y[I])-Byte('A')+Byte('a'));
LoString:=Y;
end;
function LTrim;
var
  I: Integer;
begin
I:=1;
while (I<=Length(X))and(X[I]=' ') do
  Inc(I);
Delete(X,1,I-1);
LTrim:=X;
end;
function RTrim;
var
  I: Integer;
begin
I:=Length(X);
while (I>0)and(X[I]=' ') do Dec(I);
RTrim:=Copy(X,1,I)
end;
function Trim;
begin
Trim:=LTrim(RTrim(X));
end;
function GetString;
begin
  GetString:=Copy(X,Index,Count);
  Delete(X,Index,Count);
end;
function ReplStr;
var
  Y:String;
begin
Y:='';
while (Count>0)and(Length(Y)<SizeOf(String)-1) do
  begin
  Y:=Y+X;
  Dec(Count);
  end;
ReplStr:=Y;
end;
function ReplSpace;
var
  Y:String;
begin
  SetLength(Y, Count);
  FillChar(Y[1],Count,' ');
  ReplSpace:=Y;
end;
function LStr;
begin
LStr:=Copy(X,1,Count)+ReplSpace(Byte(Length(X)<Count)*(Count-Length(X)));;
end;
function RStr;
begin
RStr:=ReplSpace(Byte(Length(X)<Count)*(Count-Length(X)))+
      Copy(X,Byte(Length(X)-Count>=0)*(Length(X)-Count)+1,Count);
end;
function RevStr;
var
  I:Integer;
  Y:String;
begin
SetLength(Y, Length(X));
for I:=1 to Length(X) do Y[I]:=X[Length(X)-I+1];
RevStr:=Y;
end;
{$IFNDEF USES_SYSUTILS}
function StrToTime;
var
  Err: Integer;
label 1;
begin
Val(Trim(Copy(S,1,2)),Hour,Err);
if Err<>0 then GoTo 1;
Val(Trim(Copy(S,4,2)),Min,Err);
if Err<>0 then GoTo 1;
Val(Trim(Copy(S,7,2)),Sec,Err);
1:
StrToTime:=Err;
end;
function TimeToStr;
var
  _A:record Hour,Min,Sec:LongInt; end;
  S: string;
begin
_A.Hour:=Hour; _A.Min:=Min; _A.Sec:=Sec;
{$V-}
FormatStr(S,TimeFormat,_A);
TimeToStr:=S;
end;
function StrToDate;
var
  Err: Integer;
label 1;
begin
Val(Trim(Copy(S,1,2)),Day,Err);
if Err<>0 then GoTo 1;
Val(Trim(Copy(S,4,2)),Month,Err);
if Err<>0 then GoTo 1;
Val(Trim(Copy(S,7,4)),Year,Err);
1:
StrToDate:=Err;
end;
function DateToStr;
var
  _A:record Day, Month, Year:LongInt; end;
  S: string;
begin
_A.Day:=Day; _A.Month:=Month; _A.Year:=Year;
{$V-}
FormatStr(S, DateFormat,_A);
DateToStr:=S;
end;
{$ENDIF}
function StrToNum;
var
  L: LongInt;
  Err: Integer;
  I, N: Integer;
label
  1;
begin
L:=0;
S:=Trim(S);
while (S<>'') and (S[1]='0') do Delete(S,1,1);
if S<>'' then
  begin
  if S[1]=HexPrefix then
    begin
    S:=UpString(S);
    for I:=2 to Length(S) do
      if not (S[I] in ['0'..'9','A'..'F']) then GoTo 1;
    N:=0;
    for I:=Length(S) downto 2 do
      begin
      if S[I] in ['0'..'9'] then Inc(L, LongInt( Byte(S[I])-Ord('0')) shl N )
                            else Inc(L, LongInt( Byte(S[I])-Ord('A')+10) shl N );
      Inc(N, 4);
      end;
    end else Val(S, L, Err);
  end;
1:
StrToNum:=L;
end;
function NumToHexStr;
var
  S: string[8];
  I: Integer;
const
  Digits : array[0..$F] of Char = '0123456789ABCDEF';
begin
I:=8; S[0]:=Char(SizeOf(S)-1);
repeat
  S[I]:=Digits[L and $0000000F];
  L:=L shr 4;
  S[I-1]:=Digits[L and $0000000F];
  L:=L shr 4;
  Dec(I,2);
until I<=0;
while (S[1]='0') and (S<>'') do
  Delete(S, 1, 1);
if S='' then S:='0' else
if Odd(Length(S)) then S:='0'+S;
NumToHexStr:=HexPrefix+S;
end;
function NumToStr;
var
  S: string;
begin
Str(L,S);
NumToStr:=S;
end;
function NumToStrI;
var
  S: string;
begin
S:= NumToStr(L);
if N > Length(S) then
  S:= ReplStr('0', N-Length(S))+S;
NumToStrI:= S;
end;
function NumToHexStrI;
var
  S: string;
begin
S:= NumToHexStr(L);
if N > Length(S)-1 then
  Insert(ReplStr('0', N-Length(S)+1), S, 2);
NumToHexStrI:= S;
end;
function Bin2Hex(const S: string): string;
var
  I: Integer;
  _Result: string;
begin
  _Result:= '';
  for I:= 1 to Length(S) do
    _Result:= _Result+ Copy(NumToHexStrI(Byte(S[I]), 2), 2, 2);
  Bin2Hex:= _Result;
end;
function Hex2Bin(const S: string): string;
var
  I: Integer;
  B: Integer;
  _Result: string;
begin
  _Result:= '';
  I:= 1;
  while I <= Length(S) do
  begin
    B:= StrToNum(HexPrefix+Copy(S, I, 2));
    _Result:= _Result + Chr(B);
    Inc(I, 2);
  end;
  Hex2Bin:= _Result;
end;
function StripDecimals; 
var
  I, J: Integer;
label
  _Break;
begin
I:= Pos('.', S);
if I<>0 then
  begin
  J:= Pos('E', UpString(S));
  if J = 0 then J:= Length(S)
           else Dec(J);
  while J >= I do
    if S[J] in ['0','.'] then begin
                              Delete(S, J, 1);
                              Dec(J);
                              end
                         else goto _Break;
  end;
_Break:
StripDecimals:= S;
end;
function StripExponent; 
var
  I: Integer;
label
  _Break;
begin
I:= Pos('E', UpString(S));
if I<>0 then
  begin
  while (I+2 <= Length(S)) and (S[I+2] = '0') do
    Delete(S, I+2, 1);
  while Length(S) >= I do
    if S[Length(S)] in ['E','e','+','-'] then SetLength(S, Length(S)-1)
                                         else goto _Break;
  end;
_Break:
StripExponent:= S;
end;
{$IFNDEF WIN32}
procedure SetLength;
begin
  S[0]:= Char(NewLength);
end;
{$ENDIF}
{$IFNDEF USES_SYSUTILS}
  {$IFNDEF USES_DRIVERS}
{$L FORMAT.OBJ}
procedure FormatStr; external ;
  {$ENDIF}
{$ENDIF}
end.
Unit1 : 
uses Tlhelp32, Grids, AuxStr

const
  whProcess = 1;
  whThread = 2;
  whModule = 3;
  
public
    { Public declarations }
    procedure MakeProcessList;
    procedure MakeThreadList;
    procedure MakeModuleList;
    
resourcestring
  sPS = 'Processess, Threads, Modules - %s';
  sPL = 'processes';
  sML = 'modules';
  sTL = 'threads';
  sAbout = 'PS Copyright (c) 2002 by MandysSoft';
  
//

procedure TForm1.MakeProcessList;
var
  H: THandle;
  pe: TProcessEntry32;
  B: Boolean;
  R: Integer;
begin
  What:= whProcess;
  Caption:= Format(sPS, [sPL]);
  R:= StringGrid1.Row;
  StringGrid1.ColCount:= 8;
  StringGrid1.DefaultColWidth:= 64;
  StringGrid1.ColWidths[0]:= 250;
  StringGrid1.RowCount:= 2;
  StringGrid1.Cells[0,0]:= 'Exe';
  StringGrid1.Cells[1,0]:= 'PId';
  StringGrid1.Cells[2,0]:= 'Usage';
  StringGrid1.Cells[3,0]:= 'ModuleId';
  StringGrid1.Cells[4,0]:= 'HeapId';
  StringGrid1.Cells[5,0]:= '#Threads';
  StringGrid1.Cells[6,0]:= 'PPId';
  StringGrid1.Cells[7,0]:= 'PriClassBase';
  H:= CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0);
  try
    pe.dwSize:= SizeOf(pe);
    B:= Process32First(H, pe);
    while B do
    begin
      StringGrid1.Cells[0,StringGrid1.RowCount-1]:= StrPas(pe.szExeFile);
      StringGrid1.Cells[1,StringGrid1.RowCount-1]:= NumToHexStrI(pe.th32ProcessId, 8);
      StringGrid1.Cells[2,StringGrid1.RowCount-1]:= IntToStr(pe.cntUsage);
      StringGrid1.Cells[3,StringGrid1.RowCount-1]:= NumToHexStrI(pe.th32ModuleId, 8);
      StringGrid1.Cells[4,StringGrid1.RowCount-1]:= NumToHexStrI(pe.th32DefaultHeapId, 8);
      StringGrid1.Cells[5,StringGrid1.RowCount-1]:= IntToStr(pe.cntThreads);
      StringGrid1.Cells[6,StringGrid1.RowCount-1]:= NumToHexStrI(pe.th32ParentProcessId, 8);
      StringGrid1.Cells[7,StringGrid1.RowCount-1]:= IntToStr(pe.pcPriClassBase);

      B:= Process32Next(H, pe);
      if B then
        StringGrid1.RowCount:= StringGrid1.RowCount+1;
    end;
  finally
    CloseHandle(H);
  end;
  if StringGrid1.RowCount > R then
    StringGrid1.Row:= R;
  Button4.Enabled:= True;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  MakeProcessList;
end;

procedure TForm1.MakeModuleList;
var
  H: THandle;
  pe: TModuleEntry32;
  B: Boolean;
  R: Integer;
begin
  What:= whModule;
  Caption:= Format(sPS, [sML]);
  R:= StringGrid1.Row;
  StringGrid1.ColCount:= 7;
  StringGrid1.DefaultColWidth:= 64;
  StringGrid1.ColWidths[0]:= 100;
  StringGrid1.ColWidths[1]:= 250;
  StringGrid1.RowCount:= 2;
  StringGrid1.Cells[0,0]:= 'Name';
  StringGrid1.Cells[1,0]:= 'Path';
  StringGrid1.Cells[2,0]:= 'MId';
  StringGrid1.Cells[3,0]:= 'PId';
  StringGrid1.Cells[4,0]:= 'GUsage';
  StringGrid1.Cells[5,0]:= 'PUsage';
  StringGrid1.Cells[6,0]:= 'HModule';
  H:= CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0);
  try
    pe.dwSize:= SizeOf(pe);
    B:= Module32First(H, pe);
    while B do
    begin
      StringGrid1.Cells[0,StringGrid1.RowCount-1]:= StrPas(pe.szModule);
      StringGrid1.Cells[1,StringGrid1.RowCount-1]:= StrPas(pe.szExePath);
      StringGrid1.Cells[2,StringGrid1.RowCount-1]:= NumToHexStrI(pe.th32ModuleId, 8);
      StringGrid1.Cells[3,StringGrid1.RowCount-1]:= NumToHexStrI(pe.th32ProcessId, 8);
      StringGrid1.Cells[4,StringGrid1.RowCount-1]:= IntToStr(pe.GlblcntUsage);
      StringGrid1.Cells[5,StringGrid1.RowCount-1]:= IntToStr(pe.ProccntUsage);
      StringGrid1.Cells[6,StringGrid1.RowCount-1]:= NumToHexStrI(pe.hModule, 8);

      B:= Module32Next(H, pe);
      if B then
        StringGrid1.RowCount:= StringGrid1.RowCount+1;
    end;
  finally
    CloseHandle(H);
  end;
  if StringGrid1.RowCount > R then
    StringGrid1.Row:= R;
  Button4.Enabled:= False;
end;

procedure TForm1.MakeThreadList;
var
  H: THandle;
  pe: TThreadEntry32;
  B: Boolean;
  R: Integer;
begin
  What:= whThread;
  Caption:= Format(sPS, [sTL]);
  R:= StringGrid1.Row;
  StringGrid1.ColCount:= 5;
  StringGrid1.DefaultColWidth:= 64;
  StringGrid1.RowCount:= 2;
  StringGrid1.Cells[0,0]:= 'TId';
  StringGrid1.Cells[1,0]:= 'Usage';
  StringGrid1.Cells[2,0]:= 'PId';
  StringGrid1.Cells[3,0]:= 'BasePri';
  StringGrid1.Cells[4,0]:= 'DeltaPri';
  H:= CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0);
  try
    pe.dwSize:= SizeOf(pe);
    B:= Thread32First(H, pe);
    while B do
    begin
      StringGrid1.Cells[0,StringGrid1.RowCount-1]:= NumToHexStrI(pe.th32ThreadId, 8);
      StringGrid1.Cells[1,StringGrid1.RowCount-1]:= IntToStr(pe.cntUsage);
      StringGrid1.Cells[2,StringGrid1.RowCount-1]:= NumToHexStrI(pe.th32OwnerProcessId, 8);
      StringGrid1.Cells[3,StringGrid1.RowCount-1]:= IntToStr(pe.tpBasePri);
      StringGrid1.Cells[4,StringGrid1.RowCount-1]:= IntToStr(pe.tpDeltaPri);

      B:= Thread32Next(H, pe);
      if B then
        StringGrid1.RowCount:= StringGrid1.RowCount+1;
    end;
  finally
    CloseHandle(H);
  end;
  if StringGrid1.RowCount > R then
    StringGrid1.Row:= R;
  Button4.Enabled:= False;
end;
Beispiele : 
// Aktualisieren
procedure TForm1.Button1Click(Sender: TObject);
begin
  MakeProcessList;
end;

// Module laden
procedure TForm1.Button2Click(Sender: TObject);
begin
  MakeModuleList;
end;

// Threads  laden
procedure TForm1.Button3Click(Sender: TObject);
begin
  MakeThreadList;
end;

// Prozesse schließen
procedure TForm1.Button4Click(Sender: TObject);
var
  Id: Integer;
  H: THandle;
  P: PChar;
  Fl: Boolean;
begin
  Fl:= True;
  case What of
    whProcess:
      begin
        Id:= StrToNum(StringGrid1.Cells[1, StringGrid1.Row]);
        H:= OpenProcess(PROCESS_ALL_ACCESS, True, Id);
        Fl:= TerminateProcess(H, 0);
        CloseHandle(H);
        MakeProcessList;
      end;
    whThread:
      begin
//        Id:= StrToNum(Grid.Cells[0, Grid.Row]);
//        Fl:= TerminateThread(H, 0);
      end;
  end;
  if not Fl then
  begin
    FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER or FORMAT_MESSAGE_FROM_SYSTEM, nil, GetLastError(), 0, @P, 0, nil);
    ShowMessage(StrPas(P));
  end;
end;

Keine Kommentare:

Kommentar veröffentlichen

Abonnieren Posts (Atom)

Beliebte Posts

  • Network Source Code Update
    Network Source Code Update Source Code Network Update :  https://asciigen.blogspot.com/p/network.html Send Message 1.0 Source Server Client ...
  • Windows Key Sniffer
      Windows Key Sniffer  0.82 - Update 08/2024 Der Windows Key Sniffer hat mir im Laufe der Zeit viel Arbeit erspart und unterstützt, viele Wi...
  • Windows Defender Bypass
      Windows Defender Bypass  Version 0.75 - Update 11/2024 Den Windows 10-eigenen Virenschutz Defender kann man auf mehreren Wegen abschalten,...
  • ASCii Gif Animator
     ASCii GIF Animator Update Version 0.68 (32 bit) - 11/2024 Bei dieser überarbeiteten Version ist die Kompatibilität zu den verschiedenen GIF...
  • MD5 Hacker
      MD5 Hacker v.0.26 - Update 08.2024 MD5 Hashs sollten eigentlich nicht entschlüsselt werden können. Jedoch gibt es Tools, mit welchen auch ...
  • Host Editor
    Host Editor Version 0.64 - Update 11/2024 Hosts File Editor allows for the easy editing of host files and backup creation. Create your own h...
  • Dir Sniffer
        Dir Sniffer Version 0.08 - Update 08/2024 Dir Sniffer ist ein kleines aber nützliches Tool um herauszufinden, was ihr Programm auf ihrem...
  • Oldskool Font Generator
        Oldskool Font Generator v.0.29 - Update 11/2023 Das Tool stell 508 Bitmap Fonts zu Verfügung. Eigene Fonts können integriert werden, sie...
  • ASCii Text Creator
     ASCii Text Creator v.0.24 - Update 11.2023 * Add BugFix Gui Move Message Send * Add 447 Figlet Font Pack * Fixed Invert Unicode Function * ...

Translate