» Вопросы по Delphi (все версии) - часть 4

Dimoniusis
Ну естественно, всё зависит от многих параметров.
На собственном опыте убедился, как пропускаем. И не использую с тех пор таймер для замера периодов времени.

Нашёл на страничке tripsin: [more=Получение списка процессов с помощью Performance Data Helper.]
unit Sample3;
interface
uses Windows, Classes, SysUtils;
const
// Уровни детализации
PERF_DETAIL_NOVICE = 100; // Новичок
PERF_DETAIL_ADVANCED = 200; // Продвинутый
PERF_DETAIL_EXPERT = 300; // Эксперт
PERF_DETAIL_WIZARD = 400; // Максимальный

PDH_MORE_DATA = -2147481646; //Все данные не помещаются в
предоставленный буфер

function FillProcessesList(var slProcesses: TStringList): Boolean;
implementation
function PdhEnumObjectItems(szDataSource: PChar;
szMachineName: PChar;
szObjectName: PChar;
mszCounterList: PChar;
pcchCounterListLength: PDWORD;
mszInstanceList: PChar;
pcchInstanceListLength: PDWORD;
dwDetailLevel: DWORD;
dwFlags: DWORD
): LongInt; stdcall; external 'PDH.DLL'
name 'PdhEnumObjectItemsA';
function FillProcessesList(var slProcesses: TStringList): Boolean;
var
pdhStatus: LongInt; // Возвращаемое значение PDH-функций
sObjectName: array [0..7] of Char; // Буфер для имени объекта "Process"
pCounterList: PAnsiChar; // Буфер для списка счетчиков
CounterListLength: DWORD; // Длина буфера для списка счетчиков
pInstanceList: PAnsiChar; // Буфер для списка экземпляров (процессов), после заполнения здесь будет цепочка нультерминальных строк и в конце общий #0.
InstanceListLength: DWORD;// Длина буфера для списка экземпляров
pThisInstance: PAnsiChar; // Указатель на имя текущего экземпляра
begin
Result := False;
sObjectName := 'Process'; // Собираемся получить список процессов
CounterListLength := 0; // Обнуляем длины буферов
InstanceListLength := 0;
// В первый вызов функции вместо буферов ставим nil и получаем длины буферов
pdhStatus := PdhEnumObjectItems(nil, // информация реального времени
nil, // локальная машина
@sObjectName, // Имя объекта
nil,
@CounterListLength, // передаем 0
nil,
@InstanceListLength,// передаем 0
PERF_DETAIL_WIZARD, //Максимальная детализация
0);
// PdhEnumObjectItems должна вернуть PDH_MORE_DATA, если нет - ошибка
if pdhStatus = PDH_MORE_DATA then
begin
// Резервируем память под буферы
GetMem(pCounterList, CounterListLength);
GetMem(pInstanceList, InstanceListLength);
try
// Вторым вызовом функции получаем информацию
pdhStatus := PdhEnumObjectItems(nil, // информация реального времени
nil, // локальная машина
@sObjectName, // Имя объекта
pCounterList, // Буфер счетчиков
@CounterListLength,
pInstanceList, // Буфер имен
@InstanceListLength,
PERF_DETAIL_WIZARD,
0);
// Проверяем успешность выполнения функции PdhEnumObjectItems
if pdhStatus = ERROR_SUCCESS then
begin
// Ставим указатель на начало буфера экземпляров
pThisInstance := pInstanceList;
// Крутим цикл пока не кончатся имена (в конце буфера стоит #0)
while pThisInstance^ <> #0 do
begin
// Пропускаем экземпляр с общими данными
if pThisInstance <> '_Total' then
// Добавляем имя процесса к списку
slProcesses.Add(pThisInstance);
// Перемещаем указатель на следующее имя
inc(pThisInstance, Length(pThisInstance)+1);
end;
// Фунция сработала успешно, если досюда дошло
Result := True;
end;
finally
// В любом случае освобождаем память буферов
FreeMem(pCounterList);
FreeMem(pInstanceList);
end;
end;
end;
end.
[/more]
Также на MSDN есть пример использования pdh.dll для получения значений производительности.

Но для меня это сложно, можете упростить код, чтобы выдавал только загрузку процессора?

Victor_Dobrov
В варезнике в обменнике лежат компоненты (в исходниках) для получения значений производительности:
SvCom и Profs Performance monitoring - посмотри там.

вопрос по D 2007 .net
DataExplorer
не могу подключить OracleProvider
орет, что оракловый клиент старый, хотя на самом деле клиент 9.2
Vstudio обнаружил и установил без проблем
где можно поправить настройку? посоветуйте, что сделать?

OdesitVadim а как? Отедельный поток со Sleep?

Никогда не задумывался.
Не подскажите, как сделать так, чтобы в отладчике при нажатии F7 отладчик входил не только в функции проекта, но и в стандартные функции, функции библиотек и т.д.. Сейчас отлаживаю исходники Indy и при нажатии F7 отладчик внутрь функций Indy не проходит. Приходится копировать конкретный файл, подсоединять его к проекту - тогда все проходит. Но понятно, что это бредовый способ.
Подскажите, пожалуйста, как правильно настроить отладчик!

Dimoniusis
Зачем отдельный поток с Sleep?
Всё зависит от цели. Сообщения от таймера не все пропопускаются, так что можно в многих ситуациях в таймере проверять разницу в времени и выполнять действия.
В других случаях хорош поток с функциями с серии WaitFor*, которые сидят в цикле и помогают считать время. Хотя в нём и Sleeep можно вставить.
Без привязки к конкретной задаче рассуждения "что лучше" безсмысленны.

Добавлено:
Antananarivu
И так можно. надо в настройках включить Use Debug DCU (Project-options)

OdesitVadim
Спасибо!

не могу взять в толк как нарисовать у корневых узлов, дочерние как на картинке:

если делать так:
[more=не хватает ума нарисовать как на картинке выше...]

// примем то что пришло через Drag&Drop
procedure TfmMain.AddFile(const FileName: string);
begin

LboxSrcPath.Items.Add(FileName); // добавим-ка файл или каталог

// если это каталог
if directoryExists(FileName) then
// создадим корневой узел
begin
NewNode := VT.AddChild(VT.RootNode);
FileNode := VT.GetNodeData(NewNode);
if Assigned(FileNode) then
with FileNode^ do
begin
Name := FileName;
ImageIndex := 0 ; // номер картинки в imagelist - папка
end;
// сканируем его...
ScanDir(FileName);
end;

Procedure TfmMain.ScanDir(Dir:string);
var SearchRec:TSearchRec;
begin
if Dir<>'' then if Dir[length(Dir)]<>'\' then Dir:=Dir+'\';
if FindFirst(Dir+'*.*', faAnyFile, SearchRec)=0 then
repeat
if (SearchRec.name='.') or (SearchRec.name='..') then continue;
if (SearchRec.Attr and faDirectory)<>0 then
begin
ScanDir(Dir+SearchRec.name); //we found Directory: "Dir+SearchRec.name"
//------------
NewNode := VT.AddChild(VT.RootNode);
FileNode := VT.GetNodeData(NewNode);
if Assigned(FileNode) then
with FileNode^ do
begin
Name := Dir+SearchRec.name;
ImageIndex := 0 ; // номер картинки в imagelist - папка
end;
//------------
end
else
begin
//Showmessage(Dir+SearchRec.name); //we found File: "Dir+SearchRec.name"
// если файл то добавляем узел файла
//------------
NewNode := VT.AddChild(NewNode); // Добавляем потомка во второй уровень
//NewNode := VT.AddChild(VT.RootNode); // Добавляем потомка во второй уровень
FileNode := VT.GetNodeData(NewNode);
if Assigned(FileNode) then
with FileNode^ do
begin
Name := Dir+SearchRec.name;
ImageIndex := 1; // номер картинки в imagelist - файл
end;
//------------
end;

until FindNext(SearchRec)<>0;
FindClose(SearchRec);

NewNode := nil;
FileNode := nil;

end;
[/more]
то получается :

Erazer
Примерно [more=так]
procedure ScanDir(aRootNode: PVirtualNode; Dir:string);
var
SearchRec:TSearchRec;
NewNode, cNode: PVirtualNode;
begin
// Папка
NewNode := VT.AddChild(aRootNode);
FileNode := VT.GetNodeData(NewNode);
if Assigned(FileNode) then
with FileNode^ do
begin
Name := Dir+SearchRec.name;
ImageIndex := 0 ; // номер картинки в imagelist - папка
end;
// Сканируем содержимое
if Dir<>'' then if Dir[length(Dir)]<>'\' then Dir:=Dir+'\';
if FindFirst(Dir+'*.*', faAnyFile, SearchRec)=0 then
repeat
if (SearchRec.name='.') or (SearchRec.name='..') then continue;
if (SearchRec.Attr and faDirectory)<>0 then
ScanDir(NewNode, Dir+SearchRec.name) //we found Directory: "Dir+SearchRec.name"
else
begin
// если файл то добавляем узел файла
//------------
cNode := VT.AddChild(NewNode); // Добавляем потомка во второй уровень
FileNode := VT.GetNodeData(NewNode);
if Assigned(FileNode) then
with FileNode^ do
begin
Name := Dir+SearchRec.name;
ImageIndex := 1; // номер картинки в imagelist - файл
end;
end;
until FindNext(SearchRec)<>0;
FindClose(SearchRec);

NewNode := nil;
FileNode := nil;
end;

Вызов метода:

procedure TfmMain.AddFile(const FileName: string);
begin

LboxSrcPath.Items.Add(FileName); // добавим-ка файл или каталог
// если это каталог
if directoryExists(FileName) then
ScanDir(VT.RootNode, FileName);
end;
[/more]
Ошибка в коде

Цитата:

ScanDir(Dir+SearchRec.name); //we found Directory: "Dir+SearchRec.name"
//------------
NewNode := VT.AddChild(VT.RootNode);
FileNode := VT.GetNodeData(NewNode);
if Assigned(FileNode) then

Переменную NewNode здесь нельзя модифицировать
PS: Не проверял на компиляцию

Немного не в тему - в

хех... все так же не хватает ума нарисовать как на картинке выше...
как можно производить "навигацию" по узлам.
К примеру : есть путь "D:\Muzic\Afrodite\Afrodite\AfroditeThe Best - 2005.mp3" нарисуем все узлы ,а потом нужно нарисовать "D:\Muzic\Afrodite\Aftershock\08 - Interlude.mp3", у сторк есть общее начало "D:\Muzic\Afrodite\" но разные окончания, значит мне нужно начать рисовать узлы второй строки с середины образно коворя узлов соответствующих первой строке начиная с "Afrodite" вопрос в том как на него выйти ? как его найти ?

Добавлено:
Ramazan
к сожалению твое решение тоже работает не адекватно

мне кажется наиболее эффективным решением создать список путей с интересующими файлами и по ним выстроить структуру папок и файлов, вопрос в том как вернуться к нужному узлу, дабы продолжить строительство структуры с него ?

Erazer
посмотри например на drkb.ru
пример процедуры как получить название с путем всех файлов и диреторий с указанной директории и по ней посторой дерево

greenpc как получить список файлов с путями не есть проблема, проблема построить по ним дерево... а точнее как реализовать возврат к какому -либо произвольному узлу,чтобы начать строить от него.

Erazer
Ну да, недосмотрел...

Код:
// если файл то добавляем узел файла
//------------
cNode := VT.AddChild(NewNode); // Добавляем потомка во второй уровень
FileNode := VT.GetNodeData(cNode);
if Assigned(FileNode) then
with FileNode^ do
begin
Name := Dir+SearchRec.name;
ImageIndex := 1; // номер картинки в imagelist - файл
end;

ну да, так лучше но все равно немного корявоватые узлы получаются думаю внести некую иерархию в процесс построения,сначала stringlist с путями,а потом анализируя их строить узлы, т.к. налету как кажется невозможно построить правильно т.к. невозможно применить сортировку например.
должно быть :

а получается:

Подскажите, пожалуйста. Мне надо реализовать такую вещь. Программа написана. Надо сделать так, чтобы программу возможно было запустить только один раз. То есть, пока программа работает, второй ее запуск невозможен. Ну к примеру, как ICQ та же самая. Если не трудно ссылку на готовую реализацию, но если нет - хотя бы в какую сторону копать?
Заранее спасибо!

есть много способов. например через мютекс.
Я когда то делал по простому. При запуске программа создавала текстовый документ и писала туда свой pid. После завершения работы - удаляла
Если при запуске файл обнаруживался, то проверялся pid и потом искала процесс. если найден - переключалась на него. если нет - выводила окно с сообщением, что предыдущий раз программа была неудачно завершена. Код работал очень хорошо.

Ребята, не встречали ли вы исходные коды любого плагина для программы FreeMemory? На сайте автора глухо, как и с почтой.

Antananarivu
http://drkb.ru/ там штук пять способов наверное как минимум

Erazer
Сортировку дерева возможно произвести после его создания (см. TBaseVirtualTree.Sort в справке), например можно вставить после

Код:
FindClose(SearchRec);

Здравствуйте, граждане программисты!

Помогите мне с такой задачей, не могу понять.
Вобщем есть уже готовая, рабочая программа - менеджер закладок. То есть ссылки из браузеров импортирую и дальше уже складываю их по категориям, проверяю на существование, задаю приоритет и т.д. Эти ссылки и категории импортируются в компонент VirtualStringTree.
А теперь задача:
Нужно в программу добавить еще один VirtualStringTree, так чтобы в первом отображались только категории (папки), а во втором - только их содержимое (ссылки). Например кликаем по папке в первом VT, а во втором загружаем ее содержимое.
До этого я использовал такой метод загрузки и хранения ссылок программы: VT.LoadFromFile(), VT.SaveToFile(). Насколько я понимаю в данном случае этот метод не подходит, нужно отделить данные от какого либо VT, они должны быть общими для обоих компонентов, но каждый отображает только то что нужно.
По форумам я надыбал кое какие примеры работы VT с обьектами, базами данных, но я так и не смог понять как пихнуть в них древовидную структуру.
В общем - понятия не имею как решить эту проблему. Кто нибудь с похожими задачами встечался? Я уже неделю мучаюсь - никак.
Буду вам очень благодарен за любую помощь.

так и сделал " FindClose(SearchRec); VT.Sort(NewNode, 0, sdDescending);"
procedure TfmMain.VTCompareNodes(Sender: TBaseVirtualTree; Node1,
Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer);
var
FileNode1,FileNode2: PFileNode;
begin
FileNode1 := Sender.GetNodeData(Node1);
FileNode2 := Sender.GetNodeData(Node2);
// folder are always before files
if FileNode1.Name <> FileNode2.Name then
begin
// one of both is a folder the other a file
if DirectoryExists(FileNode1.Name) then
Result := -1
else
Result := 1;
end
else // both are of same type (folder or file)
Result := CompareText(FileNode1.Name, FileNode2.Name);
end;
возникает другая проблема файлы сотрируются как надо "A->Z", а вот папки наоборот "Z->A".
Как бы заставить их сортироваться так как на картинке только чтобы папки сортировались так же как и файлы ?

Доброе время суток уважаемые. Проблема такая... Есть куча таблиц DBF для работы используется Apollo. Как один раз открыв базу в основном модуле можно ее использовать в вызываемой DLL без повторного открытия? Буду премного благодарен за любые идеи!

Erazer
Я бы сделал так:

Код:
procedure TfmMain.VTCompareNodes(Sender: TBaseVirtualTree; Node1,
Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer);
var
FileNode1,FileNode2: PFileNode;
begin
FileNode1 := Sender.GetNodeData(Node1);
FileNode2 := Sender.GetNodeData(Node2);
case FileNode1.ImageIndex + FileNode2.ImageIndex of // Подразумевается 0-папка, 1-файл
0, 2: Result := CompareText(FileNode1.Name, FileNode2.Name);
1: if FileNode1.ImageIndex = 0 then Result := -1 else Result := 1;
end;
end;

Ramazan
А как примерно это можно реализовать?

WSWCORP
Из DLL экспортируй процедуру вида

Код:
procedure DoSomething(aDataset: TDataset); stdcall;

Цитата:

AnalogXP
А что мешает сохранять содержимое дерева категорий и содержимое дерева ссылок для каждого узла в первом дереве? (Как-то коряво звучит...) Т.е. если раньше у тебя вся инфа хранилась в одном файле, то теперь будет главный файл категорий (первое дерево) и множество файлов ссылок (по одному на каждую категорию), которые подгружаются динамически. Imho, если не заморачиваться с БД, наиболее простой способ.

Так я уже сделал. Спрятал ссылки в первом VT, и отображал только во втором. Но вот проблема:
Если я хочу редактировать, удалить ссылку (во втором VT), то изменения должны происходить в первом VT. Как работать с ссылками в первом VT через второй? Можно конечно через поиск, но это уже не дело.

Ramazan превосходный вариант, но он не решает проблемы:

Цитата:

файлы сотрируются как надо "A->Z", а вот папки почему-то "Z->A".

а хотелось бы чтобы файлы в предыдущей папке сортировались по "A->Z",и при этом располагались выше вложенных папок и сортировались и так же "A->Z".

Ramazan
Все работает прекрасно... только не с DBF из под Apollo... А от Apollo уйти нельзя, т.к. в таблицах есть индексы выражений, BDE их просто не открывает...