Delphi 3. Библиотека программиста

когда дела становятся совсем плохи,


Говорят, когда дела становятся совсем плохи, главное — вовремя приготовить кофе. Я заварил целый кофейник и занялся программой, демонстрирующей работу с функциями модуля WalkStuf. На рис. 15.8 показаны результаты ее работы. Исходный текст приведен в листинге  15.8.

Рис. 15.8. Демонстрационная программа для сбора информации о системе
Листинг 15.8. Исходный текст главного модуля программы Walking Demo
{——————————} {Демонстрационная программа для сбора информации} { о системе } { WALKAMIN.PAS : Главный модуль } { Автор: Эйс Брейкпойнт, N.T.P. } { При содействии Дона Тейлора } { } { Программа демонстрирует некоторые возможности } { для сбора служебной информации в Win95. } { } { Написано для *High Performance Delphi 3 Programming* } { Copyright (c) 1997 The Coriolis Group, Inc.} { Дата последней редакции 23/4/97 } {————————} unit WalkMain; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, WalkStuf, Grids, StdCtrls, ExtCtrls; type TForm1 = class(TForm) ModuleGrid: TStringGrid; RefreshBtn: TButton; QuitBtn: TButton; ModuleRBGroup: TRadioGroup; ProcessesLabel: TLabel; ProcessListBox: TListBox; ModulesLabel: TLabel; procedure QuitBtnClick(Sender: TObject); procedure RefreshBtnClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure ModuleRBGroupClick(Sender: TObject); procedure ProcessListBoxClick(Sender: TObject); private TheList : TStringList; procedure RefreshForm; procedure DisplayProcessModules; procedure ClearModuleGrid; procedure FillProcessList; procedure FillModuleGrid; public { Public declarations } end; var Form1: TForm1; implementation {$R *.DFM} { Возвращает строку пробелов заданной длины. } function Spaces(Size : Integer) : String; begin Result := ''; while Length(Result) < Size do Result := Result + ' '; end;

{ Очищает экранные элементы, получает данные и обновляет экран. } procedure TForm1.RefreshForm; begin ClearModuleGrid; ProcessListBox.Clear; TheList := GetSystemProcessList(ws_FullPath, ws_DupesOK); FillProcessList; ProcessesLabel.Caption := 'System processes: ' + IntToStr(TheList.Count); TheList.Free; case ModuleRBGroup.ItemIndex of 0 : begin TheList := GetSystemModuleList (ws_NoDirectory, ws_Unique, ws_InstanceCount); FillModuleGrid; ModulesLabel.Caption := 'System-wide modules: ' + IntToStr(TheList.Count); TheList.Free; end; 1 : begin TheList := GetSystemModuleList (ws_NoDirectory, ws_Unique, ws_InstanceCount); if TheList.Count > 0 then begin ProcessListBox.ItemIndex := 0; DisplayProcessModules; end; end; end; { case } end; { Специальная процедура обновления экрана, которая получает сведения о модулях текущего выбранного процесса. } procedure TForm1.DisplayProcessModules; var Idx : Integer; s : String; p : Integer; begin if ProcessListBox.Items.Count > 0 then begin ClearModuleGrid; Idx := ProcessListBox.ItemIndex; TheList := GetProcessModules (ProcessListBox.Items[Idx], ws_NoDirectory, ws_InstanceCount); if TheList.Count > 0 then for Idx := 1 to TheList.Count do begin s := TheList.Strings[Idx - 1]; p := pos('<', s); ModuleGrid.Cells[0, Idx] := copy(s, 1, p - 1); delete(s, 1, p); s := Spaces(15) + s; ModuleGrid.Cells[1, Idx] := s; ModuleGrid.RowCount := ModuleGrid.RowCount + 1; end; ModulesLabel.Caption := 'Modules for this process: ' + IntToStr(TheList.Count); TheList.Free; end; end; { Очищает все строки в списке модулей и задает количество строк, равное 1. } procedure TForm1.ClearModuleGrid; var Idx : Integer; begin for Idx := 1 to ModuleGrid.RowCount - 1 do begin ModuleGrid.Cells[0, Idx] := ''; ModuleGrid.Cells[1, Idx] := ''; end; ModuleGrid.RowCount := 2; end; { Построчно заполняет список процессов из глобального списка. } procedure TForm1.FillProcessList; var Idx : Integer; begin if TheList.Count > 0 then for Idx := 0 to TheList.Count - 1 do ProcessListBox.Items.Add (TheList.Strings[Idx]); end; { Построчно заполняет список модулей из глобального списка. } procedure TForm1.FillModuleGrid; var s : String; p : Integer; Idx : Integer; begin if TheList.Count > 0 then begin for Idx := 1 to TheList.Count do begin s := TheList.Strings[Idx - 1]; p := pos('<', s); ModuleGrid.Cells[0, Idx] := copy(s, 1, p - 1); delete(s, 1, p); s := Spaces(15) + s; ModuleGrid.Cells[1, Idx] := s; ModuleGrid.RowCount := ModuleGrid.RowCount + 1; end; { for } end; end; procedure TForm1.QuitBtnClick(Sender: TObject); begin Close; end; procedure TForm1.RefreshBtnClick(Sender: TObject); begin RefreshForm; end; procedure TForm1.FormCreate(Sender: TObject); begin ModuleGrid.Colwidths[1] := ModuleGrid.Width - ModuleGrid.ColWidths[0] - 22; ModuleGrid.Cells[0, 0] := 'Name'; ModuleGrid.Cells[1, 0] := 'System instances'; ModuleRBGroup.ItemIndex := 0; end; procedure TForm1.ModuleRBGroupClick(Sender: TObject); begin RefreshForm; end; procedure TForm1.ProcessListBoxClick(Sender: TObject); begin if ModuleRBGroup.ItemIndex > 0 then DisplayProcessModules; end; end. В этом листинге нет ничего особенного. В верхнем списке всегда перечисляются все активные процессы. При установке переключателя System-wide в нижнем поле появляется список всех модулей, показывающий и количество экземпляров каждого из них. Если установлен переключатель Selected Process only, в нижнем поле выводятся только модули процесса, выделенного в верхнем списке. Кнопка Refresh делает новый «снимок» и обновляет экран. Главное, что необходимо запомнить, — при вызове любой функции, возвращающей список строк, создается новый объект; позднее его необходимо уничтожить, причем ровно один раз.
Все это было весьма поучительно и к тому же занятно. Однако мое расследование было весьма поверхностным, и предстояло еще многое узнать. В частности, я обнаружил, что функции ToolHelp работают только в Win95, но не вNT (по крайней мере в настоящее время).
У меня сложилось совершенно четкое впечатление, что я смогу воспользо ваться полученными знаниями в приложениях. Конечно, при первой возможности я вернусь к этой теме и расследую ее более подробно.
Конец записи (28 марта).
Когда Эйс и Хелен прибыли в контору, результаты экспертизы ДНК еще не поступили. Эйс достал бутылку и сдул пыль с двух стаканов, найденных в шкафу. Он плеснул в них немного виски и передал один стакан Хелен, но стоило ему поднести стакан к губам, как в дверь громко постучали.
Это была Мардж Рейнольдс. Во время обычного обмена любезностями с Хелен в ее голосе сквозило необычное оживление. Мардж быстро перешла к делу.
— Я знаю, что вы расследуете ограбление, которое произошло вчера вечером, — начала она. — Я видела, как вы сегодня днем копались в грязи на стоянке. Но я тоже держала глаза открытыми и следила за всем подозрительным.
Она сделала паузу, глядя на Эйса и ожидая проявлений интереса.
— Продолжай, — взмолился он.
— Сегодня вечером я проходила мимо телефонной будки на той стороне двора — ну, знаешь, там, куда выходят окна твоей кухни, — и нашла в кустах клочок бумаги, застрявший примерно в футе над землей.
Мардж порылась в кармане мешковатого вязаного свитера.
— Он должен быть где-то здесь. Я его положила… ага, вот он, — сказала она, извлекая бумажку лавандового цвета. — Похоже, почерк женский. Здесь записаны твое имя и номер телефона, и еще два слова — «похищенная наследница». Тебе это о чем-нибудь говорит?




Содержание раздела