进程高手！如何得某个进程的一些详细信息，如占内存大小、包括的dll文件等？？在线等(200分)

dzy983 · 2003-04-26

操作系统2000, 问题1：我得到当前所有进程中，代码如下： var     handles:Thandle;  //进程名柄     ppro:TProcessEntry32; //进程记录结构     //ppro1:Tmoduleentry32;     bl:bool;     ls_Str:string; begin    handles:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0);     //new(ppro);     ppro.dwsize:=sizeof(Tprocessentry32);     //ppro1.dwSize :=sizeof(Tmoduleentry32);     bl:= process32first(handles,ppro);     while bl do       begin         //if module32first(handles,ppro1) then ls_str:=ppro1.szExePath ;         with listview1.items.add do          begin            caption:=(ppro.szexefile);// ls_str;            subitems.add(inttostr(ppro.pcPriClassBase));            subitems.add(inttostr(ppro.th32ProcessID));          end;         bl:=process32next(handles,ppro);       end; end;  但是ppro.szexefile得到进程文件名中没有包括路径。 问题2：   当知道某一进程后如何得到该进程的所有模块，也就是它包括的所有dll文件及每个dll文件的基地址、占内存大小、入口地址。 问题3:   当知道某一进程后如何得到该进程的优先级别、占内存大小以及此进程的版本信息（公司名称等）、内存信息（页面地址、类型、映射文件等）。 进程高手指教，最好给出源代码或例子。分不够再加！在线等待！！！高手帮助！

dzy983 · 2003-04-26

难道大富翁里都没人知道吗？哎！

dzy983 · 2003-04-26

哎，没想到大富翁里也没人知道啊！没办法啦！

52free · 2003-04-26

到delphi5程序员指南中去找例程

爱元元的哥哥 · 2003-04-26

{==============================================================================| | Project : PE Viewer                                              000.005.000 | |==============================================================================| | Content:  PE resources classes                                               | |==============================================================================| | The contents of this file are subject to the Mozilla Public License Ver. 1.0 | | (the "License"); you may not use this file except in compliance with the     | | License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ | |                                                                              | | Software distributed under the License is distributed on an "AS IS" basis,   | | WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for | | the specific language governing rights and limitations under the License.    | |==============================================================================| | The Original Code is Petr Vones.                                             | |==============================================================================| | The Initial Developer of the Original Code is Petr Vones, petr.v@mujmail.cz  | | Portions created by Petr Vones are Copyright (C) 2000.                       | | All Rights Reserved.                                                         | |==============================================================================| | Contributor(s):                                                              | |==============================================================================} unit PeResource; {$I JCL.INC} interface uses   Windows, Messages, Classes, SysUtils, Graphics, ComCtrls,   {$IFDEF DELPHI5_UP}   Contnrs,   {$ENDIF}   JclBase, JclFileUtils, JclPeImage, JclStrings; type   PAccelTableEntry = ^TAccelTableEntry;   ACCELTABLEENTRY = packed record     fFlags: Word;     wAnsi: Word;     wId: Word;     padding: Word;   end;     {$EXTERNALSYM ACCELTABLEENTRY}   TAccelTableEntry = ACCELTABLEENTRY;   PCursorDir = ^TCursorDir;   CURSORDIR = packed record     Width: Word;     Height: Word;   end;   {$EXTERNALSYM CURSORDIR}   TCursorDir = CURSORDIR;   PCursorShape = ^TCursorShape;   _CURSORSHAPE = packed record     xHotSpot: Integer;     yHotSpot: Integer;     cx: Integer;     cy: Integer;     cbWidth: Integer;     Planes: Byte;     BitsPixel: Byte;   end;   {$EXTERNALSYM _CURSORSHAPE}   TCursorShape = _CURSORSHAPE;   CURSORSHAPE = _CURSORSHAPE;   {$EXTERNALSYM CURSORSHAPE}   PLocalHeader = ^TLocalHeader;   _LOCALHEADER = packed record     xHotSpot: Word;     yHotSpot: Word;   end;   {$EXTERNALSYM _LOCALHEADER}   TLocalHeader = _LOCALHEADER;   LOCALHEADER = _LOCALHEADER;   {$EXTERNALSYM LOCALHEADER}   PNewHeader = ^TNewHeader;   _NEWHEADER = packed record     Reserved: Word;     ResType: Word;     ResCount: Word;   end;   {$EXTERNALSYM _NEWHEADER}   TNewHeader = _NEWHEADER;   NEWHEADER = _NEWHEADER;   {$EXTERNALSYM NEWHEADER}   PIconResdir = ^TIconResdir;   ICONRESDIR = packed record     Width: Byte;     Height: Byte;     ColorCount: Byte;     Reserved: Byte;   end;   {$EXTERNALSYM ICONRESDIR}   TIconResdir = ICONRESDIR;   TResInfo = packed record     case Integer of       0: (Icon: TIconResdir);       1: (Cursor: TCursorDir);   end;   {$NODEFINE TResInfo}   PResDir = ^TResDir;   _RESDIR = packed record     ResInfo: TResInfo;     Planes: Word;     BitCount: Word;     BytesInRes: DWORD;     IconCursorId: Word;   end;   {$EXTERNALSYM _RESDIR}   TResDir = _RESDIR;   RESDIR = _RESDIR;   {$EXTERNALSYM RESDIR}   PDlgTemplate = ^TDlgTemplate;   DLGTEMPLATE = packed record     style: DWORD;     dwExtendedStyle: DWORD;     cdit: Word;     x: ShortInt; // short     y: ShortInt;     cx: ShortInt;     cy: ShortInt;   end;   {$EXTERNALSYM DLGTEMPLATE}   TDlgTemplate = DLGTEMPLATE;   PDlgItemTemplate = ^TDlgItemTemplate;   DLGITEMTEMPLATE = packed record     style: DWORD;     dwExtendedStyle: DWORD;     x: ShortInt;     y: ShortInt;     cx: ShortInt;     cy: ShortInt;     id: Word;   end;   {$EXTERNALSYM DLGITEMTEMPLATE}   TDlgItemTemplate = DLGITEMTEMPLATE;   PMenuHeader = ^TMenuHeader;   MENUHEADER = packed record     wVersion: Word;     cbHeaderSize: Word;   end;   {$EXTERNALSYM MENUHEADER}   TMenuHeader = MENUHEADER;   PMenuHelpID = ^TMenuHelpID;   MENUHELPID = packed record     helpID: DWORD;   end;   {$EXTERNALSYM MENUHELPID}   TMenuHelpID = MENUHELPID;   PNormalMenuItem = ^TNormalMenuItem;   NORMALMENUITEM = packed record     resInfo: WORD;     menuText: Pointer; // szOrOrd   end;   {$EXTERNALSYM NORMALMENUITEM}   TNormalMenuItem = NORMALMENUITEM;   PPopupMenuItem = ^TPopupMenuItem;   POPUPMENUITEM = packed record     type_: DWORD;     state: DWORD;     id: DWORD;     resInfo: Word;     menuText: Pointer; // szOrOrd   end;   {$EXTERNALSYM POPUPMENUITEM}   TPopupMenuItem = POPUPMENUITEM;   PMenuExTemplateHeader = ^TMenuExTemplateHeader;   MENUEX_TEMPLATE_HEADER = packed record     wVersion: Word;     wOffset: Word;     dwHelpId: DWORD;   end;   {$EXTERNALSYM MENUEX_TEMPLATE_HEADER}   TMenuExTemplateHeader = MENUEX_TEMPLATE_HEADER;   PMenuExTemplateItem = ^TMenuExTemplateItem;   MENUEX_TEMPLATE_ITEM = packed record     dwType: DWORD;     dwState: DWORD;     uId: UINT;     bResInfo: Word;     szText: array[0..0] of WideChar;     dwHelpId: DWORD;   end;   {$EXTERNALSYM MENUEX_TEMPLATE_ITEM}   TMenuExTemplateItem = MENUEX_TEMPLATE_ITEM;   PMessageResourceBlock = ^TMessageResourceBlock;   _MESSAGE_RESOURCE_BLOCK = packed record     LowId: ULONG;     HighId: ULONG;     OffsetToEntries: ULONG;   end;   {$EXTERNALSYM _MESSAGE_RESOURCE_BLOCK}   TMessageResourceBlock = _MESSAGE_RESOURCE_BLOCK;   MESSAGE_RESOURCE_BLOCK = _MESSAGE_RESOURCE_BLOCK;   {$EXTERNALSYM MESSAGE_RESOURCE_BLOCK}   PMessageResourceData = ^TMessageResourceData;   _MESSAGE_RESOURCE_DATA = packed record     NumberOfBlocks: ULONG;     // Blocks: array[0..0] of TMessageResourceBlock;   end;   {$EXTERNALSYM _MESSAGE_RESOURCE_DATA}   TMessageResourceData = _MESSAGE_RESOURCE_DATA;   MESSAGE_RESOURCE_DATA = _MESSAGE_RESOURCE_DATA;   {$EXTERNALSYM MESSAGE_RESOURCE_DATA}   PMessageResourceEntry = ^TMessageResourceEntry;   _MESSAGE_RESOURCE_ENTRY = packed record     Length: Word;     Flags: Word;     // Text: array[0..0] of Char;   end;   {$EXTERNALSYM _MESSAGE_RESOURCE_ENTRY}   TMessageResourceEntry = _MESSAGE_RESOURCE_ENTRY;   MESSAGE_RESOURCE_ENTRY = _MESSAGE_RESOURCE_ENTRY;   {$EXTERNALSYM MESSAGE_RESOURCE_ENTRY} (* Value Meaning 0x0080 Button 0x0081 Edit 0x0082 Static 0x0083 List box 0x0084 Scroll bar 0x0085 Combo box}   PDlgTemplateEx = ^TDlgTemplateEx;   DLGTEMPLATEEX = packed record     dlgVer: WORD;     signature: WORD;     helpID: DWORD;     exStyle: DWORD;     style: DWORD;     cDlgItems: WORD;     x: short;     y: short;     cx: short;     cy: short;     sz_Or_Ord menu;         // name or ordinal of a menu resource     sz_Or_Ord windowClass;  // name or ordinal of a window class     WCHAR  title[titleLen]; // title string of the dialog box     short  pointsize;       // if DS_SETFONT or DS_SHELLFONT is set     short  weight;          // if DS_SETFONT or DS_SHELLFONT is set     short  bItalic;         // if DS_SETFONT or DS_SHELLFONT is set     WCHAR  font[fontLen];   // if DS_SETFONT or DS_SHELLFONT is set } DLGTEMPLATEEX;  typedef struct {     DWORD  helpID;     DWORD  exStyle;     DWORD  style;     short  x;     short  y;     short  cx;     short  cy;     WORD   id;     sz_Or_Ord windowClass; // name or ordinal of a window class     sz_Or_Ord title;       // title string or ordinal of a resource     WORD   extraCount;     // bytes of following creation data } DLGITEMTEMPLATEEX; struct FONTDIRENTRY {     WORD dfVersion;     DWORD dfSize;     char dfCopyright[60];     WORD dfType;     WORD dfPoints;     WORD dfVertRes;     WORD dfHorizRes;     WORD dfAscent;     WORD dfInternalLeading;     WORD dfExternalLeading;     BYTE dfItalic;     BYTE dfUnderline;     BYTE dfStrikeOut;     WORD dfWeight;     BYTE dfCharSet;     WORD dfPixWidth;     WORD dfPixHeight;     BYTE dfPitchAndFamily;     WORD dfAvgWidth;     WORD dfMaxWidth;     BYTE dfFirstChar;     BYTE dfLastChar;     BYTE dfDefaultChar;     BYTE dfBreakChar;     WORD dfWidthBytes;     DWORD dfDevice;     DWORD dfFace;     DWORD dfReserved;     char szDeviceName[];     char szFaceName[]; }; struct FONTGROUPHDR {     WORD NumberOfFonts;     DIRENTRY  DE [1]; }; *) type   TPeResKind = (rkAccelerator, rkAvi, rkBitmap, rkCursor, rkData, rkDialog,     rkHTML, rkIcon, rkMenu, rkMessageTable, rkString, rkVersion, rkUnknown);   TPeResImage = class;   TPeResItem = class;   TPeResItem = class(TPersistent)   private     FKind: TPeResKind;     FList: TObjectList;     FResImage: TPeResImage;     FResourceItem: TJclPeResourceItem;     FStream: TJclPeResourceRawStream;     function GetItems(Index: Integer): TPeResItem;     function GetItemCount: Integer;     function GetStream: TJclPeResourceRawStream;   protected     procedure CreateList; virtual;   public     constructor Create(AResImage: TPeResImage; AResourceItem: TJclPeResourceItem); virtual;     destructor Destroy; override;     function IsList: Boolean; virtual;     function Offset: Integer;     function RawData: Pointer;     function ResName: string; virtual;     function ResType: TJclPeResourceKind;     procedure SaveToStream(Stream: TStream); virtual;     function Size: Integer;     property ItemCount: Integer read GetItemCount;     property Items[Index: Integer]: TPeResItem read GetItems; default;     property Kind: TPeResKind read FKind;     property ResourceItem: TJclPeResourceItem read FResourceItem;     property Stream: TJclPeResourceRawStream read GetStream;   end;   TJclReResItemClass = class of TPeResItem;   TPeResUnknown = class(TPeResItem)   public     function FileExt: string; dynamic;     function IsList: Boolean; override;     function ResName: string; override;   end;   TPeGraphicProperties = record     Width, Height, BitsPerPixel: Integer;   end;   TPeResUnkGraphic = class(TPeResUnknown)   public     function GraphicProperties: TPeGraphicProperties; virtual; abstract;   end;   TPeResUnkStrings = class(TPeResUnknown)   protected     procedure AssignTo(Dest: TPersistent); override;   public     function FileExt: string; override;     procedure FillStrings(Strings: TStrings; StripCrLf: Boolean = False); virtual; abstract;   end;   TPeResAccelerator = class(TPeResUnkStrings)   public     procedure FillStrings(Strings: TStrings; StripCrLf: Boolean = False); override;   end;   TPeResAvi = class(TPeResUnknown)   protected     procedure AssignTo(Dest: TPersistent); override;   public     function FileExt: string; override;   end;   TPeResBitmap = class(TPeResUnkGraphic)   protected     procedure AssignTo(Dest: TPersistent); override;   public     function GraphicProperties: TPeGraphicProperties; override;     function FileExt: string; override;     procedure SaveToStream(Stream: TStream); override;   end;   TPeResCursorItem = class(TPeResUnkGraphic)   private     FResInfo: PResDir;   protected     procedure AssignTo(Dest: TPersistent); override;   public     function FileExt: string; override;     function GraphicProperties: TPeGraphicProperties; override;     function ResName: string; override;     procedure SaveToStream(Stream: TStream); override;   end;   TPeResCursor = class(TPeResUnknown)   private     function GetItems(Index: Integer): TPeResCursorItem;   protected     procedure CreateList; override;   public     function IsList: Boolean; override;     property Items[Index: Integer]: TPeResCursorItem read GetItems; default;   end;   TPeResDialog = class(TPeResUnknown)   public     function CanShowDialog: Boolean;     function ShowDialog(ParentWnd: HWND): Integer;   end;   TPeResDataKind = (dkUnknown, dkDFM, dkPackageDescription, dkPackageInfo);   TPeResRCData = class(TPeResUnknown)   private     FDataKind: TPeResDataKind;   protected     procedure AssignTo(Dest: TPersistent); override;     procedure CheckFormat;     procedure DFMToStrings(Strings: TStrings);     procedure PackageInfoToStrings(Strings: TStrings);   public     constructor Create(AResImage: TPeResImage; AResourceItem: TJclPeResourceItem); override;     function FileExt: string; override;     property DataKind: TPeResDataKind read FDataKind;   end;   TPeResHTML = class(TPeResUnknown)   public     function FileExt: string; override;     function ResPath: string;   end;   TPeResIconItem = class(TPeResCursorItem)   public     function FileExt: string; override;     function GraphicProperties: TPeGraphicProperties; override;   end;   TPeResIcon = class(TPeResCursor)   private     function GetItems(Index: Integer): TPeResIconItem;   public     property Items[Index: Integer]: TPeResIconItem read GetItems; default;   end;   TPeResMenu = class(TPeResUnknown)   end;   TPeMessageTable = class(TPeResUnkStrings)   public     procedure FillStrings(Strings: TStrings; StripCrLf: Boolean = False); override;   end;   TPeResString = class(TPeResUnkStrings)   public     procedure FillStrings(Strings: TStrings; StripCrLf: Boolean = False); override;   end;   TPeResVersion = class(TPeResUnkStrings)   public     procedure FillStrings(Strings: TStrings; StripCrLf: Boolean = False); override;   end;   TPeResImage = class(TObjectList)   private     FCursorEntry: TJclPeResourceList;     FIconEntry: TJclPeResourceList;     FImageAttached: Boolean;     FLibHandle: THandle;     FPeImage: TJclPeImage;     function GetFileName: TFileName;     procedure SetFileName(const Value: TFileName);     procedure SetPeImage(const Value: TJclPeImage);     function GetItems(Index: Integer): TPeResItem;     function GetLibHandle: THandle;   protected     procedure CreateList;     procedure UnloadLib;   public     constructor Create;     destructor Destroy; override;     procedure Clear; override;     property ImageAttached: Boolean read FImageAttached;     property Items[Index: Integer]: TPeResItem read GetItems; default;     property LibHandle: THandle read GetLibHandle;     property FileName: TFileName read GetFileName write SetFileName;     property PeImage: TJclPeImage read FPeImage write SetPeImage;   end;   function LangNameFromName(const Name: string; ShortName: Boolean = False): string; implementation uses   Consts, JclLocales, JclSysUtils, JclWin32; resourcestring   RsPeResAccelerator = 'Accel table';   RsPeResAVI = 'AVI';   RsPeResBitmap = 'Bitmap';   RsPeResCursor = 'Cursor';   RsPeResData = 'RCData';   RsPeResDialog = 'Dialog';   RsPeResHTML = 'HTML';   RsPeResIcon = 'Icon';   RsPeResMenu = 'Menu';   RsPeResMessageTable = 'Message table';   RsPeResString = 'String';   RsPeResVersion = 'Version';   RsNeutralLang = '[Neutral]';   RsUnknownLang = '[Unknown]';   RsTranslations = 'Translations:'; var   JclLocalesList: TJclLocalesList; function VirtualKeyNameFromCode(KeyCode: Byte): string; const   KN002F: array[$00..$2F] of PChar = (     nil,     'LBUTTON',     'RBUTTON',     'CANCEL',     'MBUTTON',     nil, nil, nil, // 05..07     'BACK',     'TAB',     nil, nil, // 0A..0B     'CLEAR',     'RETURN',     nil, nil, // 0E..0F     'SHIFT ',     'CONTROL',     'MENU',     'PAUSE',     'CAPITAL',     'KANA',     'HANGUL',     'JUNJA',     'FINAL',     'HANJA',     'KANJI',     'ESCAPE',     'CONVERT',     'NONCONVERT',     'ACCEPT',     'MODECHANGE',     'SPACE',     'PRIOR',     'NEXT',     'END',     'HOME',     'LEFT',     'UP',     'RIGHT',     'DOWN',     'SELECT',     'PRINT',     'EXECUTE',     'SNAPSHOT',     'INSERT',     'DELETE',     'HELP'     );   KN5B5D: array[$5B..$5D] of PChar = (     'LWIN',     'RWIN',     'APPS'     );   KN6A6F: array[$6A..$6F] of PChar = (     'MULTIPLY',     'ADD',     'SEPARATOR',     'SUBTRACT',     'DECIMAL',     'DIVIDE'     );   KNA0A5: array[$A0..$A5] of PChar = (     'LSHIFT',     'RSHIFT',     'LCONTROL',     'RCONTROL',     'LMENU',     'RMENU'     );   KNF6FE: array[$F6..$FE] of PChar = (     'ATTN',     'CRSEL',     'EXSEL',     'EREOF',     'PLAY',     'ZOOM',     'NONAME',     'PA1',     'OEM_CLEAR'     ); begin   case KeyCode of     $00..$2F:       Result := KN002F[KeyCode];     $30..$39, $41..$5A:       Result := Chr(KeyCode);     $5B..$5D:       Result := KN5B5D[KeyCode];     $60..$69:       Result := Format('NUMPAD%d', [KeyCode - $60]);     $6A..$6F:       Result := KN6A6F[KeyCode];     $70..$87:       Result := Format('F%d', [KeyCode - $6F]);     $90:       Result := 'NUMLOCK';     $91:       Result := 'SCROLL';     $A0..$A5:       Result := KNA0A5[KeyCode];     $E5:       Result := 'PROCESSKEY';     $F6..$FE:       Result := KNF6FE[KeyCode];   else     Result := '';   end;   if Result <> '' then Result := 'VK_' + Result; end; function LangNameFromName(const Name: string; ShortName: Boolean): string; var   LangID: Word;   Locale: TJclLocaleInfo; begin   LangID := PRIMARYLANGID(StrToIntDef(Name, 0));   if LangID = LANG_NEUTRAL then     if ShortName then Result := '' else Result := RsNeutralLang   else   begin     Locale := JclLocalesList.ItemFromLangIDPrimary[LangID];     if Locale <> nil then       with Locale do if ShortName then         Result := AbbreviatedLangName else Result := EnglishLangName     else       Result := RsUnknownLang;   end; end; function GetResItemKind(Item: TJclPeResourceItem; var Kind: TPeResKind): Boolean; begin   Result := True;   Kind := rkUnknown;   with Item do     case ResourceType of       rtAccelerators:         Kind := rkAccelerator;       rtCursorEntry, rtIconEntry, rtFont:         Result := False;       rtUserDefined:         begin           if Name = 'AVI' then Kind := rkAvi;           if Name = '2110' then Kind := rkHTML;         end;       rtBitmap:         Kind := rkBitmap;       rtMenu:         Kind := rkMenu;       rtDialog:         Kind := rkDialog;       rtString:         Kind := rkString;       rtRCData:         Kind := rkData;       rtMessageTable:         Kind := rkMessageTable;       rtCursor:         Kind := rkCursor;       rtIcon:         Kind := rkIcon;       rtVersion:         Kind := rkVersion;       rtHmtl:         Kind := rkHTML;     end; end; const   ResItemClasses: array [TPeResKind] of TJclReResItemClass = (     TPeResAccelerator,     TPeResAvi,     TPeResBitmap,     TPeResCursor,     TPeResRCData,     TPeResDialog,     TPeResHTML,     TPeResIcon,     TPeResMenu,     TPeMessageTable,     TPeResString,     TPeResVersion,     TPeResUnknown     ); function WideCharToStr(WStr: PWChar; Len: Integer): string; begin   if Len = 0 then Len := -1;   Len := WideCharToMultiByte(CP_ACP, 0, WStr, Len, nil, 0, nil, nil);   SetLength(Result, Len);   WideCharToMultiByte(CP_ACP, 0, WStr, Len, PChar(Result), Len, nil, nil); end; { TPeResItem } constructor TPeResItem.Create(AResImage: TPeResImage; AResourceItem: TJclPeResourceItem); begin   FList := TObjectList.Create(True);   FResImage := AResImage;   FResourceItem := AResourceItem; end; procedure TPeResItem.CreateList; var   I, J: Integer;   Item: TPeResItem;   ResItem: TJclPeResourceItem; begin   with FResourceItem.List do     for I := 0 to Count - 1 do     begin       ResItem := Items;       for J := 0 to ResItem.List.Count - 1 do       begin         Item := ResItemClasses[Self.FKind].Create(FResImage, ResItem.List[J]);         Item.FKind := Self.FKind;         FList.Add(Item);       end;     end; end; destructor TPeResItem.Destroy; begin   FreeAndNil(FList);   FreeAndNil(FStream);   inherited; end; function TPeResItem.GetItemCount: Integer; begin   if IsList then   begin     if FList.Count = 0 then CreateList;     Result := FList.Count;   end else     Result := -1; end; function TPeResItem.GetItems(Index: Integer): TPeResItem; begin   Result := TPeResItem(FList[Index]); end; function TPeResItem.GetStream: TJclPeResourceRawStream; begin   if not Assigned(FStream) then     FStream := TJclPeResourceRawStream.Create(FResourceItem);   Result := FStream; end; function TPeResItem.IsList: Boolean; begin   Result := FResourceItem.IsDirectory; end; function TPeResItem.Offset: Integer; begin   if IsList then     Result := FResourceItem.Entry^.OffsetToData and not (IMAGE_RESOURCE_DATA_IS_DIRECTORY)   else     Result := FResourceItem.DataEntry^.OffsetToData end; function TPeResItem.RawData: Pointer; begin   Result := FResourceItem.RawEntryData; end; function TPeResItem.ResName: string; const   ResNames: array [TPeResKind] of PResStringRec = (     @RsPeResAccelerator,     @RsPeResAVI,     @RsPeResBitmap,     @RsPeResCursor,     @RsPeResData,     @RsPeResDialog,     @RsPeResHTML,     @RsPeResIcon,     @RsPeResMenu,     @RsPeResMessageTable,     @RsPeResString,     @RsPeResVersion,     nil     ); begin   if FKind = rkUnknown then     Result := FResourceItem.ResourceTypeStr   else     Result := LoadResString(ResNames[FKind]); end; function TPeResItem.ResType: TJclPeResourceKind; begin   Result := FResourceItem.ResourceType; end; procedure TPeResItem.SaveToStream(Stream: TStream); begin   if not IsList then     Stream.WriteBuffer(RawData^, Size); end; function TPeResItem.Size: Integer; begin   if IsList then     Result := 0   else     Result := FResourceItem.DataEntry^.Size; end; { TPeResUnknown } function TPeResUnknown.FileExt: string; begin   Result := 'bin'; end; function TPeResUnknown.IsList: Boolean; begin   Result := False; end; function TPeResUnknown.ResName: string; begin   if StrToIntDef(FResourceItem.Name, 0) = LANG_NEUTRAL then     Result := FResourceItem.ParentItem.Name   else     Result := Format('%s > %s', [FResourceItem.ParentItem.Name, LangNameFromName(FResourceItem.Name)]); end; { TPeResUnkStrings } procedure TPeResUnkStrings.AssignTo(Dest: TPersistent); begin   if (Dest is TStrings) then     with TStrings(Dest) do     begin       BeginUpdate;       try         Clear;         FillStrings(TStrings(Dest));       finally         EndUpdate;       end;     end   else     inherited; end; function TPeResUnkStrings.FileExt: string; begin   Result := 'txt'; end; { TPeResAccelTable } procedure TPeResAccelerator.FillStrings(Strings: TStrings; StripCrLf: Boolean); var   TableEntry: PAccelTableEntry;   IsLast: Boolean;   S: string;   function AnsiToChar(A: Word): string;   begin     if A >= 32 then Result := Chr(A) else Result := '';   end; begin   Strings.BeginUpdate;   try     TableEntry := RawData;     repeat       with TableEntry^ do       begin         IsLast := fFlags and $80 <> 0;         if fFlags and FVIRTKEY <> 0 then         begin           S := Format('Virtual Key: %.2u "%s" ', [wAnsi, VirtualKeyNameFromCode(wAnsi)]);           if fFlags and FSHIFT <> 0 then S := S + 'SHIFT ';           if fFlags and FCONTROL <> 0 then S := S + 'CTRL ';           if fFlags and FALT <> 0 then S := S + 'ALT ';         end else           S := Format('ANSI character: %.2u "%s" ', [wAnsi, AnsiToChar(wAnsi)]);         if fFlags and FNOINVERT <> 0 then S := S + 'NOINVERT';       end;       Strings.Add(TrimRight(S));       Inc(TableEntry);     until IsLast;   finally     Strings.EndUpdate;   end;     end; { TPeResAvi } {$HINTS OFF} type   TDirtyComponent = class(TPersistent)   private     FOwner: TComponent;     FName: TComponentName;     FTag: Longint;     FComponents: TList;     FFreeNotifies: TList;     FDesignInfo: Longint;     FVCLComObject: Pointer;     FComponentState: TComponentState;   end; {$HINTS ON} procedure TPeResAvi.AssignTo(Dest: TPersistent); begin   if Dest is TAnimate then   begin     Include(TDirtyComponent(Dest).FComponentState, csLoading);     TAnimate(Dest).ResHandle := FResImage.LibHandle;     TAnimate(Dest).ResName := FResourceItem.ParentItem.ParameterName;     Exclude(TDirtyComponent(Dest).FComponentState, csLoading);     TAnimate(Dest).Reset;   end   else     inherited; end; function TPeResAvi.FileExt: string; begin   Result := 'avi'; end; { TPeResBitmap } procedure TPeResBitmap.AssignTo(Dest: TPersistent); var   MemStream: TMemoryStream;   BitMap: TBitMap; begin   if Dest is TPicture then   begin     BitMap := TPicture(Dest).Bitmap;     MemStream := TMemoryStream.Create;     try       SaveToStream(MemStream);       MemStream.Seek(0, soFromBeginning);       BitMap.LoadFromStream(MemStream);     finally       MemStream.Free;     end   end   else     inherited; end; function TPeResBitmap.FileExt: string; begin   Result := 'bmp'; end; function TPeResBitmap.GraphicProperties: TPeGraphicProperties; var   BI: PBitmapInfoHeader;   BC: PBitmapCoreHeader; begin   BI := PBitmapInfoHeader(RawData);   if BI.biSize = SizeOf(TBitmapInfoHeader) then   begin     Result.Width := BI.biWidth;     Result.Height := BI.biHeight;     Result.BitsPerPixel := BI.biPlanes * BI.biBitCount;   end else   begin     BC := PBitmapCoreHeader(RawData);     Result.Width := BC.bcWidth;     Result.Height := BC.bcHeight;     Result.BitsPerPixel := BC.bcPlanes * BC.bcBitCount;   end; end; procedure TPeResBitmap.SaveToStream(Stream: TStream);   function GetDInColors(BitCount: Word): Integer;   begin     case BitCount of       1, 4, 8: Result := 1 shl BitCount;     else       Result := 0;     end;   end; var   BH: TBitmapFileHeader;   BI: PBitmapInfoHeader;   BC: PBitmapCoreHeader;   ClrUsed: Integer; begin   FillChar(BH, sizeof(BH), #0);   BH.bfType := $4D42;   BH.bfSize := Size + SizeOf(BH);   BI := PBitmapInfoHeader(RawData);   if BI.biSize = SizeOf(TBitmapInfoHeader) then   begin     ClrUsed := BI.biClrUsed;     if ClrUsed = 0 then ClrUsed := GetDInColors(BI.biBitCount);     BH.bfOffBits :=  ClrUsed * SizeOf(TRgbQuad) + SizeOf(TBitmapInfoHeader) + SizeOf(BH);   end   else   begin     BC := PBitmapCoreHeader(RawData);     ClrUsed := GetDInColors(BC.bcBitCount);     BH.bfOffBits :=  ClrUsed * SizeOf(TRGBTriple) + SizeOf(TBitmapCoreHeader) + SizeOf(BH);   end;   Stream.Write(BH, SizeOf(BH));   Stream.Write(RawData^, Size); end; { TPeResCursorItem } procedure TPeResCursorItem.AssignTo(Dest: TPersistent); begin   if Dest is TPicture then     TPicture(Dest).Icon.Handle := CreateIconFromResource(RawData, Size, ResType = rtIconEntry, $30000)   else     inherited; end; function TPeResCursorItem.FileExt: string; begin   Result := 'cur'; end; function TPeResCursorItem.GraphicProperties: TPeGraphicProperties; begin   with FResInfo^ do   begin     Result.Width := ResInfo.Cursor.Width;     Result.Height := ResInfo.Cursor.Height;     Result.BitsPerPixel := BitCount * Planes;   end; end; function TPeResCursorItem.ResName: string; begin   if FResInfo <> nil then     with GraphicProperties do       Result := Format('%d X %d %d bpp', [Width, Height, BitsPerPixel])   else     Result := ''; end; procedure TPeResCursorItem.SaveToStream(Stream: TStream); begin   with TIcon.Create do   try     Handle := CreateIconFromResource(RawData, Self.Size, ResType = rtIconEntry, $30000);     SaveToStream(Stream);   finally     Free;   end; end; { TODO : Saving monochrome icons and cursors doesn't work } { TPeResCursor } procedure TPeResCursor.CreateList; var   Item: TPeResItem;   I, J, Cnt: Integer;   ResData: PResDir;   ResOrd: DWORD;   ResList: TJclPeResourceList;   ItemClass: TJclReResItemClass; begin   if ResType = rtCursor then   begin     ResList := FResImage.FCursorEntry;     ItemClass := TPeResCursorItem;   end else   begin     ResList := FResImage.FIconEntry;     ItemClass := TPeResIconItem;   end;   ResData := RawData;   Cnt := PNewHeader(ResData)^.ResCount;   Inc(PNewHeader(ResData));   for I := 1 to Cnt do   begin     ResOrd := ResData^.IconCursorId;     for J := 0 to ResList.Count - 1 do       if ResOrd = ResList[J].Entry^.Name then       begin         Item := ItemClass.Create(FResImage, ResList[J].List[0]);         Item.FKind := Self.FKind;         TPeResCursorItem(Item).FResInfo := ResData;         FList.Add(Item);       end;     Inc(ResData);   end; end; function TPeResCursor.GetItems(Index: Integer): TPeResCursorItem; begin   Result := TPeResCursorItem(FList[Index]); end; function TPeResCursor.IsList: Boolean; begin   Result := True; end; { TPeResRCData } procedure TPeResRCData.AssignTo(Dest: TPersistent); begin   if Dest is TStrings then     with TStrings(Dest) do     begin       BeginUpdate;       try         Clear;         case FDataKind of           dkDFM:             DFMToStrings(TStrings(Dest));           dkPackageDescription:             Add(PWideChar(RawData));           dkPackageInfo:             PackageInfoToStrings(TStrings(Dest));         end;           finally         EndUpdate;       end;   end else     inherited; end; procedure TPeResRCData.CheckFormat; begin   FDataKind := dkUnknown;   if ResName = 'DESCRIPTION' then     FDataKind := dkPackageDescription   else   if ResName = 'PACKAGEINFO' then     FDataKind := dkPackageInfo   else     begin     Stream.Seek(0, soFromBeginning);     if TestStreamFormat(Stream) = sofBinary then       FDataKind := dkDFM;   end; end; constructor TPeResRCData.Create(AResImage: TPeResImage;   AResourceItem: TJclPeResourceItem); begin   inherited;   CheckFormat; end; procedure TPeResRCData.DFMToStrings(Strings: TStrings); var   MemStream: TMemoryStream; begin   MemStream := TMemoryStream.Create;   try     Stream.Seek(0, soFromBeginning);     ObjectBinaryToText(Stream, MemStream);     MemStream.Seek(0, soFromBeginning);     Strings.LoadFromStream(MemStream);   finally     MemStream.Free;   end; end; function TPeResRCData.FileExt: string; begin   if DataKind = dkDFM then     Result := 'dfm'   else     Result := inherited FileExt; end; procedure TPeResRCData.PackageInfoToStrings(Strings: TStrings); var   I: Integer; begin   with TJclPePackageInfo.Create(FResImage.LibHandle) do   try     Strings.Add('Contains');     Strings.Add(StringOfChar('-', 80));     for I := 0 to ContainsCount - 1 do       Strings.Add(Format('  %s [%s]', [ContainsNames, UnitInfoFlagsToString(ContainsFlags)]));     if RequiresCount > 0 then     begin       Strings.Add('');       Strings.Add('Requires');       Strings.Add(StringOfChar('-', 80));       for I := 0 to RequiresCount - 1 do         Strings.Add(Format('  %s', [RequiresNames]));     end;         Strings.Add('');     Strings.Add('Package Info flags');     Strings.Add(StringOfChar('-', 80));     Strings.Add(Format('Options    : %s', [PackageOptionsToString(Flags)]));     Strings.Add(Format('Module type: %s', [PackageModuleTypeToString(Flags)]));     Strings.Add(Format('Producer   : %s', [ProducerToString(Flags)]));   finally     Free;   end; end; { TPeResDialog } function TPeResDialog.CanShowDialog: Boolean; begin   Result := Windows.PDlgTemplate(RawData)^.style and DS_CONTROL = 0; end; function TPeResDialog.ShowDialog(ParentWnd: HWND): Integer; var   LastFocus: HWND;   MemHandle: THandle;   P: Windows.PDlgTemplate;   function DialogProc(hwndDlg: HWND; uMsg: UINT; W: WPARAM; L: LPARAM): BOOL; stdcall;   begin     Result := False;     case uMsg of       WM_INITDIALOG:          Result := True;       WM_LBUTTONDBLCLK:         EndDialog(hwndDlg, 0);       WM_RBUTTONUP:         EndDialog(hwndDlg, 1);       WM_SYSCOMMAND:         if W and $FFF0 = SC_CLOSE then           EndDialog(hwndDlg, 0);     end;   end; begin   LastFocus := GetFocus;   MemHandle := GlobalAlloc(GMEM_ZEROINIT, Size);   P := GlobalLock(MemHandle);   Move(RawData^, P^, Size);   GlobalUnlock(MemHandle);   Result := DialogBoxIndirect(hinstance, Windows.PDlgTemplate(MemHandle)^,     ParentWnd, @DialogProc);   GlobalFree(MemHandle);   SetFocus(LastFocus); end; { TPeResHTML } function TPeResHTML.FileExt: string; begin   Result := Copy(ExtractFileExt(FResourceItem.ParentItem.ParameterName), 2, 20); end; function TPeResHTML.ResPath: string; begin   Result := Format('res://%s/%s', [FResImage.FileName, FResourceItem.ParentItem.ParameterName]); end; { TPeResIconItem } function TPeResIconItem.FileExt: string; begin   Result := 'ico'; end; function TPeResIconItem.GraphicProperties: TPeGraphicProperties; begin   with FResInfo^ do   begin     Result.Width := ResInfo.Icon.Width;     Result.Height := ResInfo.Icon.Height;     Result.BitsPerPixel := BitCount * Planes;   end; end; { TPeResIcon } function TPeResIcon.GetItems(Index: Integer): TPeResIconItem; begin   Result := TPeResIconItem(FList[Index]); end; { TPeMessageTable } procedure TPeMessageTable.FillStrings(Strings: TStrings; StripCrLf: Boolean); var   Count, I: Integer;   E: DWORD;   Block: PMessageResourceBlock;   Entry: PMessageResourceEntry;   S: string;   Text: PChar;   Data: Pointer; begin   Data := RawData;   Count := PMessageResourceData(Data)^.NumberOfBlocks;   Block := Data;   Inc(PMessageResourceData(Block));   for I := 1 to Count do   begin     Entry := PMessageResourceEntry(DWORD(Data) + Block^.OffsetToEntries);     for E := Block^.LowId to Block^.HighId do     begin       with Entry^ do       begin         Text := PChar(Entry) + Sizeof(TMessageResourceEntry);         if Flags = 1 then           S := WideCharToStr(PWideChar(Text), lstrlenW(PWideChar(Text)))         else           SetString(S, PAnsiChar(Text), StrLen(Text));         if StripCrLf then S := StrRemoveChars(S, [AnsiCarriageReturn, AnsiLineFeed]);         Strings.AddObject(S, Pointer(E));       end;       Entry := Pointer(PChar(Entry) + Entry^.Length);     end;     Inc(Block);   end; end; { TPeResString } procedure TPeResString.FillStrings(Strings: TStrings; StripCrLf: Boolean); var   P: PWChar;   ID: Integer;   Cnt: Cardinal;   Len: Word;   S: string; begin   P := RawData;   Cnt := 0;   while Cnt < 16 do   begin     Len := Word(P^);     if Len > 0 then     begin       Inc(P);       ID := ((FResourceItem.ParentItem.Entry^.Name - 1) shl 4) + Cnt;       S := WideCharToStr(P, Len);       if StripCrLf then S := StrRemoveChars(S, [AnsiCarriageReturn, AnsiLineFeed]);       Strings.AddObject(S, Pointer(ID));       Inc(P, Len);     end else       Inc(P);     Inc(Cnt);   end; end; { TPeResVersion } procedure TPeResVersion.FillStrings(Strings: TStrings; StripCrLf: Boolean); var   I: Integer; begin   Strings.Clear;   with TJclFileVersionInfo.Attach(RawData, Size) do   try     for I := 0 to LanguageCount - 1 do     begin       LanguageIndex := I;       Strings.Add(Format('[%s] %s', [LanguageIds, LanguageNames]));       Strings.Add(StringOfChar('-', 80));       Strings.AddStrings(Items);       Strings.Add(BinFileVersion);       Strings.Add(OSIdentToString(FileOS));       Strings.Add(OSFileTypeToString(FileType, FileSubType));       Strings.Add('');     end;     Strings.Add(RsTranslations);     for I := 0 to TranslationCount - 1 do       Strings.Add(VersionLanguageId(Translations));   finally     Free;   end; end; { TPeResImage } procedure TPeResImage.Clear; begin   inherited;   if Assigned(FPeImage) then   begin     if not FImageAttached then FreeAndNil(FPeImage) else FPeImage := nil;   end; end; constructor TPeResImage.Create; begin   inherited Create(True); end; procedure TPeResImage.CreateList; var   I: Integer;   Kind: TPeResKind;   Item: TJclPeResourceItem;   ResItem: TPeResItem; begin   with FPeImage.ResourceList do     for I := 0 to Count - 1 do     begin       Item := Items;       if GetResItemKind(Item, Kind) then       begin         ResItem := TPeResItem.Create(Self, Item);         ResItem.FKind := Kind;         Self.Add(ResItem);       end else       case Item.ResourceType of         rtCursorEntry:           FCursorEntry := Item.List;         rtIconEntry:           FIconEntry := Item.List;       end;     end;   end; destructor TPeResImage.Destroy; begin   UnloadLib;   inherited; end; function TPeResImage.GetFileName: TFileName; begin   if Assigned(FPeImage) then Result := FPeImage.FileName else Result := ''; end; function TPeResImage.GetItems(Index: Integer): TPeResItem; begin   Result := TPeResItem(inherited Items[Index]); end; function TPeResImage.GetLibHandle: THandle; begin   if FLibHandle = 0 then   begin     FLibHandle := LoadLibraryEx(PChar(FileName), 0, LOAD_LIBRARY_AS_DATAFILE);     if FLibHandle = 0 then RaiseLastWin32Error;   end;     Result := FLibHandle; end; procedure TPeResImage.SetFileName(const Value: TFileName); begin   if FileName <> Value then   begin     Clear;     FImageAttached := False;     FPeImage := TJclPeImage.Create;     FPeImage.FileName := Value;     CreateList;   end; end; procedure TPeResImage.SetPeImage(const Value: TJclPeImage); begin   Clear;   FPeImage := Value;   FImageAttached := True;   CreateList; end; procedure TPeResImage.UnloadLib; begin   if FLibHandle <> 0 then   begin     FreeLibrary(FLibHandle);     FLibHandle := 0;   end; end; initialization   JclLocalesList := TJclLocalesList.Create; finalization   FreeAndNil(JclLocalesList); end.

NowCan · 2003-04-28

用PSAPI！但我只有一个简单的BCB的例子。

独帅 · 2003-04-28

1、 function GetModulesofProcess(const ProcessID: DWORD): String; var   lpme: TModuleEntry32;   SsHandle: THandle;   FoundAProc: Boolean; begin   lpme.dwSize := SizeOf(lpme);   ssHandle := CreateToolHelp32SnapShot(TH32CS_SNAPMODULE, ProcessID);   FoundAProc := Module32First(SsHandle, lpme);   if FoundAProc then   begin     Result := lpme.szExePath;   end   else Result := '';   CloseHandle(SsHandle); end; var     handles:Thandle;  //进程名柄     ppro:TProcessEntry32; //进程记录结构     //ppro1:Tmoduleentry32;     bl:bool;     ls_Str:string; begin    handles:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0);     ppro.dwsize:=sizeof(Tprocessentry32);     bl:= process32first(handles,ppro);     while bl do       begin         with listview1.items.add do          begin            caption:=(ppro.szexefile);//如果在98下，这里的szexefile包含了路径            //如果在2000/XP下，可以这样获得其全路径：            GetModulesofProcess(ppro.th32ProcessID);            subitems.add(inttostr(ppro.pcPriClassBase));            subitems.add(inttostr(ppro.th32ProcessID));          end;         bl:=process32next(handles,ppro);       end;     CloseHandle(handles); end;

ifeng · 2003-05-09

关注

delphiandoracle · 2003-05-11

昏倒

kcahcn · 2003-05-12

winnt、win2k、winxp下可以用未公开的native api。 win9x 查看msdn help 有很多函数。

进程高手！如何得某个进程的一些详细信息，如占内存大小、包括的dll文件等？？在线等(200分)

dzy983

Unregistered / Unconfirmed

dzy983

Unregistered / Unconfirmed

dzy983

Unregistered / Unconfirmed

52free

Unregistered / Unconfirmed

爱元元的哥哥

Unregistered / Unconfirmed

NowCan

Unregistered / Unconfirmed

独帅

Unregistered / Unconfirmed

ifeng

Unregistered / Unconfirmed

delphiandoracle

Unregistered / Unconfirmed

kcahcn

Unregistered / Unconfirmed

Similar threads