首页  编辑  

进程工具单元

Tags: /超级猛料/User.自定义类、函数单元/   Date Created:

unit enumStuff;

//  Delphi 4,5 enumeration implementation of several win32 APIs

//  Dragon PC

interface

uses windows;

type TACardinal   = array [0..maxInt shr 2-1] of cardinal;

    TPACardinal  = ^TACardinal;

    TDACardinal  = array of cardinal;

type TOperatingSystem = (osUnknown, osWin311, osWin95, osWin95osr2, osWin98, osWinNT3, osWinNT4, osWinNT4SP4, osWinNT5);

function GetOperatingSystem : TOperatingSystem;

// Tests which system is running...

type TExeType = (etUnknown, etDos, etWin16, etConsole, etWin32);

function GetExeType(exefile: string) : TExeType;

// Determines the type of the executable.

type TWindowList         = array of record

                                     pid       : cardinal;

                                     tid       : cardinal;

                                     window    : cardinal;

                                     parent    : cardinal;

                                     owner     : cardinal;

                                     visible   : boolean;

                                     enabled   : boolean;

                                     inTaskbar : boolean;

                                     rect      : TRect;

                                     title     : string;

                                     className : string;

                                   end;

    TThreadList         = array of record

                                     pid       : cardinal;

                                     tid       : cardinal;

                                     windows   : TWindowList;

                                   end;

    TProcessList        = array of record

                                     pid       : cardinal;

                                     name      : string;

                                     exeType   : TExeType;

                                     threads   : TThreadList;

                                   end;

    TDesktopList        = array of record

                                     name      : string;

                                     windows   : TWindowList;

                                   end;

    TWindowStationList  = array of record

                                     name      : string;

                                     desktops  : TDesktopList;

                                   end;

    TCachedPasswordList = array of record

                                     resource  : string;

                                     password  : string;

                                     resType   : byte;

                                   end;

function GetProcessList (threadsToo: boolean = false; windowsToo: boolean = false) : TProcessList;

// Lists the currently running processes.

function GetThreadList (pid: cardinal = 0; windowsToo: boolean = false) : TThreadList;

// Lists the currently running threads of the process "pid" or of all processes.

function GetWindowList (pid: cardinal = 0; tid: cardinal = 0; onlyThoseInTaskbar: boolean = false) : TWindowList;

// Lists the currently existing top level windows of the process "pid" or of all

// processes and of the thread "tid" or of all threads.

function GetChildWindowList (window: cardinal) : TWindowList;

// Lists the the child windows of "window".

function GetWindowStationList (desktopsToo: boolean = false; windowsToo: boolean = false) : TWindowStationList;

// Lists the currently existing window stations.  (works only under winNT)

function GetDesktopList (ws: cardinal = 0; windowsToo: boolean = false) : TDesktopList;

// Lists the currently existing desktops.  (works only under winNT)

function GetDesktopWindowList (dt: cardinal = 0) : TWindowList;

// Lists the currently existing windows of the current desktop.  (works only under winNT)

function GetCachedPasswords : TCachedPasswordList;

// Lists all cached passwords of the currently logged in user.  (works only under win95/98)

implementation

uses ShellAPI, sysUtils;

type TPThreadList        = ^TThreadList;

    TPProcessList       = ^TProcessList;

var OS      : TOperatingSystem;

   OSReady : boolean = false;

function GetOperatingSystem : TOperatingSystem;

var os1 : TOSVersionInfo;

begin

 if not OSReady then begin

   OSReady:=true;

   os1.dwOSVersionInfoSize:=sizeOf(os1); GetVersionEx(os1);

   case os1.dwPlatformID of

     VER_PLATFORM_WIN32s        : OS:=osWin311;

     VER_PLATFORM_WIN32_WINDOWS : if (os1.dwMajorVersion=4) and (os1.dwMinorVersion=0) then begin

                                    if os1.dwBuildNumber>1000 then OS:=osWin95osr2 else OS:=osWin95;

                                  end else if (os1.dwMajorVersion=4) and (os1.dwMinorVersion=10) then

                                    OS:=osWin98

                                  else OS:=osUnknown;

     VER_PLATFORM_WIN32_NT      : case os1.dwMajorVersion of

                                    0..3 : OS:=osWinNT3;

                                    4    : if string(os1.szCSDVersion)='Service Pack 4' then OS:=osWinNT4SP4

                                           else                                              OS:=osWinNT4;

                                    5    : OS:=osWinNT5;

                                  end;

     else                         OS:=osUnknown;

   end;

 end;

 result:=OS;

end;

const MAX_MODULE_NAME32 = 255;

type

 TProcessEntry32 = record

                     dwSize              : DWORD;

                     cntUsage            : DWORD;

                     th32ProcessID       : DWORD;          // this process

                     th32DefaultHeapID   : DWORD;

                     th32ModuleID        : DWORD;          // associated exe

                     cntThreads          : DWORD;

                     th32ParentProcessID : DWORD;        // this process's parent process

                     pcPriClassBase      : integer;      // Base priority of process's threads

                     dwFlags             : DWORD;

                     szExeFile           : array [0..MAX_PATH-1] of char;    // Path

                   end;

 TThreadEntry32  = record

                     dwSize              : DWORD;

                     cntUsage            : DWORD;

                     th32ThreadID        : DWORD;          // this thread

                     th32OwnerProcessID  : DWORD;        // Process this thread is associated with

                     tpBasePri           : integer;

                     tpDeltaPri          : integer;

                     dwFlags             : DWORD;

                   end;

 TModuleEntry32  = record

                     dwSize              : DWORD;

                     th32ModuleID        : DWORD;        // This module

                     th32ProcessID       : DWORD;        // owning process

                     GlblcntUsage        : DWORD;        // Global usage count on the module

                     ProccntUsage        : DWORD;        // Module usage count in th32ProcessID's context

                     modBaseAddr         : pointer;      // Base address of module in th32ProcessID's context

                     modBaseSize         : DWORD;        // Size in bytes of module starting at modBaseAddr

                     hModule             : HMODULE;      // The hModule of this module in th32ProcessID's context

                     szModule            : array [0..MAX_MODULE_NAME32] of char;

                     szExePath           : array [0..MAX_PATH-1] of char;

                   end;

const TH32CS_SnapProcess = 2;

     TH32CS_SnapThread  = 4;

     TH32CS_SnapModule  = 8;

var   //PsApiHandle    : cardinal = 0;

     CreateToolhelp32Snapshot :

       function (dwFlags,th32ProcessID: cardinal) : cardinal; stdcall

       = nil;

     Process32First :

       function (hSnapshot: cardinal; var lppe: TProcessEntry32) : bool; stdcall

       = nil;

     Process32Next :

       function (hSnapshot: cardinal; var lppe: TProcessEntry32) : bool; stdcall

       = nil;

     Thread32First :

       function (hSnapshot: cardinal; var lpte: TThreadEntry32) : bool; stdcall

       = nil;

     Thread32Next :

       function (hSnapshot: cardinal; var lpte: TThreadEntry32) : bool; stdcall

       = nil;

     Module32First :

       function (hSnapshot: cardinal; var lpme: TModuleEntry32) : bool; stdcall

       = nil;

     Module32Next :

       function (hSnapshot: cardinal; var lpme: TModuleEntry32) : bool; stdcall

       = nil;

     EnumProcesses :

       function (idProcess: TPACardinal; cb: cardinal; var cbNeeded: cardinal) : bool; stdcall

       = nil;

     EnumProcessModules :

       function (hProcess: cardinal; var hModule: cardinal; cb: cardinal; var cbNeeded: cardinal) : bool; stdcall

       = nil;

     GetModuleFileNameEx :

       function (hProcess,hModule: cardinal; fileName: PChar; nSize: cardinal) : cardinal; stdcall

       = nil;

function TestToolhelpFunctions : boolean;

var c1 : cardinal;

begin

 c1:=GetModuleHandle('kernel32');

 @CreateToolhelp32Snapshot:=GetProcAddress(c1,'CreateToolhelp32Snapshot');

 @Process32First          :=GetProcAddress(c1,'Process32First'          );

 @Process32Next           :=GetProcAddress(c1,'Process32Next'           );

 @Thread32First           :=GetProcAddress(c1,'Thread32First'           );

 @Thread32Next            :=GetProcAddress(c1,'Thread32Next'            );

 @Module32First           :=GetProcAddress(c1,'Module32First'           );

 @Module32Next            :=GetProcAddress(c1,'Module32Next'            );

 result:=(@CreateToolhelp32Snapshot<>nil) and

         (@Process32First<>nil) and (@Process32Next<>nil) and

         (@Thread32First<>nil) and (@Thread32Next<>nil) and

         (@Module32First<>nil) and (@Module32Next<>nil);

end;

{function TestPsApi : boolean;

begin

 if PsApiHandle=0 then begin

   PsApiHandle:=LoadLibrary('psapi');

   result:=PsApiHandle<>0;

   if result then begin

     @EnumProcesses      :=GetProcAddress(PsApiHandle,'EnumProcesses'       );

     @EnumProcessModules :=GetProcAddress(PsApiHandle,'EnumProcessModules'  );

     @GetModuleFileNameEx:=GetProcAddress(PsApiHandle,'GetModuleFileNameExA');

     result:=(@EnumProcesses<>nil) and (@EnumProcessModules<>nil) and (@GetModuleFileNameEx<>nil);

   end;

 end else result:=true;

end;}

function GetExeType(exefile: string) : TExeType;

var c1  : cardinal;

   sfi : TSHFileInfo;

   s1  : string;

begin

 c1:=SHGetFileInfo(pchar(exefile),0,sfi,SizeOf(sfi),SHGFI_EXETYPE);

 s1:=chr(c1 and $ff)+chr((c1 and $ff00) shr 8);

 if       s1='MZ'                                                                             then result:=etDos

 else if  s1='NE'                                                                             then result:=etWin16

 else if (s1='PE') and (hiWord(c1)=0)                                                         then result:=etConsole

 else if (s1='PE') and (hiWord(c1)>0)                                                         then result:=etWin32

 else if CompareText(AnsiUpperCase(ExtractFileName(exefile)),AnsiUpperCase('winoa386.mod'))=0 then result:=etDos

 else                                                                                              result:=etUnknown;

end;

function NT4_EnumProcessesAndThreads(pl: TPProcessList; tl: TPThreadList; windowsToo: boolean) : boolean;

type TPerfDataBlock           = packed record

                                 signature              : array [0..3] of wchar;

                                 littleEndian           : cardinal;

                                 version                : cardinal;

                                 revision               : cardinal;

                                 totalByteLength        : cardinal;

                                 headerLength           : cardinal;

                                 numObjectTypes         : cardinal;

                                 defaultObject          : cardinal;

                                 systemTime             : TSystemTime;

                                 perfTime               : comp;

                                 perfFreq               : comp;

                                 perfTime100nSec        : comp;

                                 systemNameLength       : cardinal;

                                 systemnameOffset       : cardinal;

                               end;

    TPPerfDataBlock          = ^TPerfDataBlock;

    TPerfObjectType          = packed record

                                 totalByteLength        : cardinal;

                                 definitionLength       : cardinal;

                                 headerLength           : cardinal;

                                 objectNameTitleIndex   : cardinal;

                                 objectNameTitle        : PWideChar;

                                 objectHelpTitleIndex   : cardinal;

                                 objectHelpTitle        : PWideChar;

                                 detailLevel            : cardinal;

                                 numCounters            : cardinal;

                                 defaultCounter         : integer;

                                 numInstances           : integer;

                                 codePage               : cardinal;

                                 perfTime               : comp;

                                 perfFreq               : comp;

                               end;

    TPPerfObjectType         = ^TPerfObjectType;

    TPerfCounterDefinition   = packed record

                                 byteLength             : cardinal;

                                 counterNameTitleIndex  : cardinal;

                                 counterNameTitle       : PWideChar;

                                 counterHelpTitleIndex  : cardinal;

                                 counterHelpTitle       : PWideChar;

                                 defaultScale           : integer;

                                 defaultLevel           : cardinal;

                                 counterType            : cardinal;

                                 counterSize            : cardinal;

                                 counterOffset          : cardinal;

                               end;

    TPPerfCounterDefinition  = ^TPerfCounterDefinition;

    TPerfInstanceDefinition  = packed record

                                 byteLength             : cardinal;

                                 parentObjectTitleIndex : cardinal;

                                 parentObjectInstance   : cardinal;

                                 uniqueID               : integer;

                                 nameOffset             : cardinal;

                                 nameLength             : cardinal;

                               end;

    TPPerfInstanceDefinition = ^TPerfInstanceDefinition;

    TAPChar                  = array [0..maxInt div 4-1] of pchar;

    TPCardinal               = ^cardinal;

var  i1,i2,i3,i4              : integer;

    b1,b2,b3,b4              : boolean;

    bt,bp                    : boolean;

    c1                       : cardinal;

    pCard                    : TPCardinal;

    perfDataBlock            : TPPerfDataBlock;

    perfObjectType           : TPPerfObjectType;

    perfCounterDef           : TPPerfCounterDefinition;

    perfInstanceDef          : TPPerfInstanceDefinition;

begin

 result:=false;

 bt:=tl=nil; if not bt then tl^:=nil; bp:=pl=nil; if not bp then pl^:=nil;

 if bt and bp then exit;

 perfDataBlock:=nil;

 try

   i1:=$10000;

   repeat

     ReallocMem(perfDataBlock,i1); i2:=i1;

     i4:=RegQueryValueEx(HKEY_PERFORMANCE_DATA,'230 232',nil,@i3,pointer(perfDataBlock),@i2);

     if i4=ERROR_MORE_DATA then i1:=i1*2;

   until (i4<>ERROR_MORE_DATA);

   if i4<>ERROR_SUCCESS then exit;

   perfObjectType:=pointer(cardinal(perfDataBlock)+perfDataBlock^.headerLength);

   for i1:=0 to integer(perfDataBlock^.numObjectTypes)-1 do begin

     b1:=             (pl<>nil) and (perfObjectType^.objectNameTitleIndex=230);   // 230 -> "Process"

     b2:=(not b1) and (tl<>nil) and (perfObjectType^.objectNameTitleIndex=232);   // 232 -> "Thread"

     if b1 or b2 then begin

       perfCounterDef:=pointer(cardinal(perfObjectType)+perfObjectType^.headerLength);

       for i2:=0 to perfObjectType^.numCounters-1 do begin

         b3:=              perfCounterDef^.counterNameTitleIndex=784;    // 784 -> "ID Process"

         b4:=(not b3) and (perfCounterDef^.counterNameTitleIndex=804);   // 804 -> "ID Thread"

         if b3 or b4 then begin

           perfInstanceDef:=pointer(cardinal(perfObjectType)+perfObjectType^.definitionLength);

           if b1 then SetLength(pl^,perfObjectType^.numInstances-1)

           else       SetLength(tl^,perfObjectType^.numInstances-1);

           for i3:=0 to perfObjectType^.numInstances-2 do begin

             c1:=TPCardinal(cardinal(perfInstanceDef)+perfInstanceDef^.byteLength+perfCounterDef^.counterOffset)^;

             if b1 then begin

               pl^[i3].pid:=c1;

               if c1<>0 then begin

                 pl^[i3].name:=wideString(PWideChar(cardinal(perfInstanceDef)+perfInstanceDef.nameOffset));

                 if pl^[i3].name<>'System' then pl^[i3].name:=pl^[i3].name+'.exe';

               end else pl^[i3].name:='[System Process]';

             end else if b3 then tl^[i3].pid:=c1 else tl^[i3].tid:=c1;

             pCard:=pointer(cardinal(perfInstanceDef)+perfInstanceDef^.byteLength);

             perfInstanceDef:=pointer(cardinal(pCard)+pCard^);

           end;

         end;

         inc(perfCounterDef);

       end;

       bt:=bt or b2; bp:=bp or b1; if bt and bp then break;

     end;

     perfObjectType:=pointer(cardinal(perfObjectType)+perfObjectType^.totalByteLength);

   end;

   result:=((pl<>nil) and (pl^<>nil)) or ((tl<>nil) and (tl^<>nil));

   if (tl<>nil) and windowsToo then

     if windowsToo then

       for i1:=0 to high(tl^) do

         if (tl^[i1].pid<>0) then

           tl^[i1].windows:=GetWindowList(tl^[i1].pid,tl^[i1].tid);

 finally FreeMem(perfDataBlock) end;

end;

function GetProcessList(threadsToo: boolean = false; windowsToo: boolean = false) : TProcessList;

var c1          : cardinal;

   i1,i2,i3,i4 : integer;

   tl          : TThreadList;

   pe          : TProcessEntry32;

begin

 result:=nil;

 if GetOperatingSystem in [osWin95,osWin95osr2,osWin98,osWinNT5] then begin

   if not TestToolhelpFunctions then begin

     MessageBox(0,'Toolhelp functions not available.','Error...',0);

     exit;

   end;

   c1:=CreateToolHelp32Snapshot(TH32CS_SnapProcess,0);

   try

     i1:=0;

     pe.dwSize:=sizeOf(pe);

     if Process32First(c1,pe) then

       repeat

         SetLength(result,i1+1);

         result[i1].pid:=pe.th32ProcessID; result[i1].name:=pe.szExeFile;

         result[i1].exeType:=GetExeType(result[i1].name);

         inc(i1);

       until not Process32Next(c1,pe);

   finally CloseHandle(c1) end;

   if threadsToo then tl:=GetThreadList(0,windowsToo);

 end else if GetOperatingSystem in [osWinNT3,osWinNT4,osWinNT4SP4] then

   if (     threadsToo  and (not NT4_EnumProcessesAndThreads(@result,@tl,windowsToo))) or  

      ((not threadsToo) and (not NT4_EnumProcessesAndThreads(@result,nil,false     ))) then

     MessageBox(0,'Error reading Performace Data.','Error...',0);

{    if not TestPsApi then begin

     MessageBox(0,'"PsApi.dll" not found.','Error...',0);

     exit;

   end;

   SetLength(s1,MAX_PATH+1);

   SetLength(s1,GetModuleFileName(psApiHandle,pchar(s1),MAX_PATH));

   c1:=100; SetLength(ac,c1);

   if EnumProcesses(pointer(ac),4*c1,c2) then begin

     while 4*c1=c2 do begin

       inc(c1,100); SetLength(ac,c1); EnumProcesses(pointer(ac),4*c1,c2);

     end;

     SetLength(result,c2 div 4);

   end;

   for i1:=0 to high(result) do begin

     result[i1].pid:=ac[i1];

     c1:=OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ,false,ac[i1]);

     if c1<>0 then

       try

         if EnumProcessModules(c1,c2,4,c3) then begin

           SetLength(result[i1].name,MAX_PATH+1);

           if GetModuleFileNameEx(c1,c2,PChar(result[i1].name),length(result[i1].name))<>0 then begin

             result[i1].name:=string(PChar(result[i1].name));

             result[i1].exeType:=GetExeType(result[i1].name);

           end else begin result[i1].name:=''; result[i1].exeType:=etUnknown end;

         end;

       finally CloseHandle(c1) end;

   end;

 end; }

 i4:=high(tl);

 if i4>0 then

   for i1:=0 to i4 do

     for i2:=high(result) downto 0 do

       if tl[i1].pid=result[i2].pid then begin

         i3:=length(result[i2].threads); setLength(result[i2].threads,i3+1); result[i2].threads[i3]:=tl[i1];

       end;

end;

function GetThreadList(pid: cardinal = 0; windowsToo: boolean = false) : TThreadList;

var c1 : cardinal;

   i1 : integer;

   te : TThreadEntry32;

begin

 result:=nil;

 if GetOperatingSystem in [osWin95,osWin95osr2,osWin98,osWinNT5] then begin

   if not TestToolhelpFunctions then begin

     MessageBox(0,'Toolhelp functions not available.','Error...',0);

     exit;

   end;

   c1:=CreateToolHelp32Snapshot(TH32CS_SnapThread,0);

   try

     i1:=0;

     te.dwSize:=sizeOf(te);

     if Thread32First(c1,te) then

       repeat

         if (pid=0) or (pid=te.th32OwnerProcessID) then begin

           SetLength(result,i1+1);

           result[i1].tid:=te.th32ThreadID; result[i1].pid:=te.th32OwnerProcessID;

           inc(i1);

         end;

       until not Thread32Next(c1,te);

   finally CloseHandle(c1) end;

   if windowsToo then

     for i1:=0 to high(result) do

       if (result[i1].pid<>0) then

         result[i1].windows:=GetWindowList(result[i1].pid,result[i1].tid);

 end else if GetOperatingSystem in [osWinNT3,osWinNT4,osWinNT4SP4] then

   if not NT4_EnumProcessesAndThreads(nil,@result,windowsToo) then

     MessageBox(0,'Error reading Performace Data.','Error...',0);

end;

var ew_pid, ew_tid        : cardinal;

   ew_onlyThoseInTaskbar : boolean;

function EnumWindowsProc(hwnd: cardinal; lParam: integer) : LongBool; stdcall;

var pwl       : ^TWindowList;

   i1        : integer;

   cpid,ctid : cardinal;

   cpar,cown : cardinal;

   bvis,btsk : boolean;

begin

 result:=true;

 ctid:=GetWindowThreadProcessID(hwnd,@cpid);

 if ((ew_pid=0) or (ew_pid=cpid)) and ((ew_tid=0) or (ew_tid=ctid)) then begin

   bvis:=IsWindowVisible(hwnd);

   cown:=GetWindow(hwnd,GW_OWNER); cpar:=GetParent(hwnd);

   btsk:=(cown=0) and (cpar=0) and bvis and (GetWindowLong(hwnd,GWL_EXSTYLE) and WS_EX_TOOLWINDOW=0);

   if (not ew_onlyThoseInTaskbar) or btsk then begin

     pwl:=pointer(lParam);

     i1:=length(pwl^);

     SetLength(pwl^,i1+1);

     with pwl^[i1] do begin

       window:=hwnd;

       parent:=cpar; owner:=cown;

       visible:=bvis; enabled:=IsWindowEnabled(hwnd);

       inTaskbar:=btsk;

       GetWindowRect(hwnd,rect);

       SetLength(title,MAX_PATH);

       SetLength(title,GetWindowText(hwnd,pchar(title),MAX_PATH));

       SetLength(className,MAX_PATH);

       SetLength(className,GetClassName(hwnd,pchar(className),MAX_PATH));

       pid:=cpid; tid:=ctid;

     end;

   end;

 end;

end;

function GetWindowList(pid: cardinal = 0; tid: cardinal = 0; onlyThoseInTaskbar: boolean = false) : TWindowList;

begin

 result:=nil;

 ew_pid:=pid; ew_tid:=tid; ew_onlyThoseInTaskbar:=onlyThoseInTaskbar;

 if ew_tid=0 then EnumWindows      (       @EnumWindowsProc,integer(@result))

 else             EnumThreadWindows(ew_tid,@EnumWindowsProc,integer(@result));

end;

function GetChildWindowList(window: cardinal) : TWindowList;

begin

 result:=nil;

 ew_pid:=0; ew_tid:=0; ew_onlyThoseInTaskbar:=false;

 EnumChildWindows(window,@EnumWindowsProc,integer(@result));

end;

function EnumWindowStationsProc(windowStationName: pchar; lParam: integer) : LongBool; stdcall;

var i1   : integer;

   pwsl : ^TWindowStationList;

begin

 result:=true;

 pwsl:=pointer(lParam);

 i1:=length(pwsl^);

 SetLength(pwsl^,i1+1);

 pwsl^[i1].name:=windowStationName;

end;

function GetWindowStationList(desktopsToo: boolean = false; windowsToo: boolean = false) : TWindowStationList;

var c1 : cardinal;

   i1 : integer;

begin

 result:=nil;

 EnumWindowStations(@EnumWindowStationsProc,integer(@result));

 if desktopsToo then

   for i1:=0 to high(result) do begin

     c1:=OpenWindowStation(pchar(result[i1].name),false,WINSTA_ENUMDESKTOPS);

     if c1>0 then

       try

         result[i1].desktops:=GetDesktopList(c1,windowsToo);

       finally CloseWindowStation(c1) end;

   end;

end;

function EnumDesktopsProc(desktopName: pchar; lParam: integer) : LongBool; stdcall;

var i1  : integer;

   pdl : ^TDesktopList;

begin

 result:=true;

 pdl:=pointer(lParam);

 i1:=length(pdl^);

 SetLength(pdl^,i1+1);

 pdl^[i1].name:=desktopName;

end;

function GetDesktopList(ws: cardinal = 0; windowsToo: boolean = false) : TDesktopList;

var c1 : cardinal;

   i1 : integer;

begin

 result:=nil;

 if ws=0 then ws:=GetProcessWindowStation;

 EnumDesktops(ws,@EnumDesktopsProc,integer(@result));

 if windowsToo then

   for i1:=0 to high(result) do begin

     c1:=OpenDesktop(pchar(result[i1].name),0,false,DESKTOP_READOBJECTS);

     if c1>0 then

       try

         result[i1].windows:=GetDesktopWindowList(c1);

       finally CloseDesktop(c1) end;

   end;

end;

function GetDesktopWindowList(dt: cardinal = 0) : TWindowList;

begin

 result:=nil;

 if dt=0 then dt:=GetThreadDesktop(GetCurrentThreadID);

 ew_pid:=0; ew_tid:=0; ew_onlyThoseInTaskbar:=false;

 EnumDesktopWindows(dt,@EnumWindowsProc,integer(@result));

end;

{Button The class for a button.

ComboBox The class for a combo box.

Edit The class for an edit control.

ListBox The class for a list box.

MDIClient The class for an MDI client window.

ScrollBar The class for a scroll bar.

Static The class for a static control.

The following table describes the system classes that are available only for use by the system. They are listed here for completeness sake.

Class Description

ComboLBox The class for the list box contained in a combo box.

DDEMLEvent Windows NT: The class for DDEML events.

Message Windows NT 5.0 and later: The class for a message-only window.

#32768 The class for a menu.

#32769 The class for the desktop window.

#32770 The class for a dialog box.

#32771 The class for the task switch window.

#32772 Windows NT: The class for icon titles.  }

type TPasswordCacheEntry  = packed record

                             entry       : word;   // size of this entry, in bytes

                             resourceLen : word;   // size of resource name, in bytes

                             passwordLen : word;   // size of password, in bytes

                             entryIndex  : byte;   // entry index

                             entryType   : byte;   // type of entry

                             resource    : array [0..$FFFFFFF] of char;

                                                   // start of resource name

                                                   // password immediately follows resource name

                           end;

    TPPasswordCacheEntry = ^TPasswordCacheEntry;

function EnumPasswordCallbackProc(pce: TPPasswordCacheEntry; lParam: cardinal) : LongBool; stdcall;

var i1   : integer;

   ppcl : ^TCachedPasswordList;

begin

 result:=true;

 ppcl:=pointer(lParam);

 i1:=length(ppcl^);

 SetLength(ppcl^,i1+1);

 SetLength(ppcl^[i1].resource,pce^.resourceLen);

 Move(pce^.resource[0],pointer(ppcl^[i1].resource)^,pce^.resourceLen);

 ppcl^[i1].resource:=pchar(ppcl^[i1].resource);

 SetLength(ppcl^[i1].password,pce^.passwordLen);

 Move(pce^.resource[pce^.resourceLen],pointer(ppcl^[i1].password)^,pce^.passwordLen);

 ppcl^[i1].password:=pchar(ppcl^[i1].password);

 ppcl^[i1].resType:=pce^.entryType;

end;

var WNetEnumCachedPasswords : function (ps: pchar; pw: word; pb: byte; proc: pointer; lParam: cardinal) : word; stdcall

                             = nil;

   mpr                     : cardinal = 0;

function GetCachedPasswords : TCachedPasswordList;

begin

 result:=nil;

 if mpr=0 then begin

   mpr:=LoadLibrary('mpr');

   if mpr=0 then exit;

 end;

 if @WNetEnumCachedPasswords=nil then begin

   WNetEnumCachedPasswords:=GetProcAddress(mpr,'WNetEnumCachedPasswords');

   if @WNetEnumCachedPasswords=nil then exit;

 end;

 WNetEnumCachedPasswords(nil,0,$FF,@EnumPasswordCallbackProc,cardinal(@result));

end;

initialization

finalization

 if mpr        <>0 then FreeLibrary(mpr        );

//  if psApiHandle<>0 then FreeLibrary(psApiHandle);

end.