Console 2 Win32

[Den7656]

Приветствую Вас. Хотелось бы получить помощь по такому вопросу. Переписал одно CONSOLE приложение под форму, вроде все WriteLN переделан на отправку в мемо результата, и что-то перестало работать, при запуске основной процедуры форма виснет до тех пор, пока не открыл любой из файлов. Это еще ладно, после того она просто вылетает с ошибкой, не записывая ничего в Memo. Хотя в консольном варианте компилится нормально и работает, прада только при первом запуске сливает в лог PID процесса а дальше уже не реагирует на запуски других программ... Ума не приложу в чем может быть проблема . Бился с ней долгое время, но к сожалению пока не одолел. PLS, мне хотя бы с первой траблой помогите разобраться.
Всем ответившим спасибо за помощь.

[Den7656]

Вот код:

PHP код:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, tintlist, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;


  type
  NTStatus = cardinal;
  PVOID    = pointer;
  USHORT = WORD;
  UCHAR = byte;
  PWSTR = PWideChar;

CONST  //Статус константы

  STATUS_SUCCESS              = NTStatus($00000000);
  STATUS_ACCESS_DENIED        = NTStatus($C0000022);
  STATUS_INFO_LENGTH_MISMATCH = NTStatus($C0000004);

const SystemProcessesAndThreadsInformation = 5;

type
PClientID = ^TClientID;
TClientID = packed record

 UniqueProcess:cardinal;
 UniqueThread:cardinal;
end;

PUnicodeString = ^TUnicodeString;
  TUnicodeString = packed record
    Length: Word;
    MaximumLength: Word;
    Buffer: PWideChar;
end;

PVM_COUNTERS = ^VM_COUNTERS;
VM_COUNTERS = packed record
   PeakVirtualSize,
   VirtualSize,
   PageFaultCount,
   PeakWorkingSetSize,
   WorkingSetSize,
   QuotaPeakPagedPoolUsage,
   QuotaPagedPoolUsage,
   QuotaPeakNonPagedPoolUsage,
   QuotaNonPagedPoolUsage,
   PagefileUsage,
   PeakPagefileUsage: dword;
  end;

PIO_COUNTERS = ^IO_COUNTERS;
IO_COUNTERS = packed record

   ReadOperationCount,
   WriteOperationCount,
   OtherOperationCount,
   ReadTransferCount,
   WriteTransferCount,
   OtherTransferCount: LARGE_INTEGER;
  end;

PSYSTEM_THREADS = ^SYSTEM_THREADS;
SYSTEM_THREADS = packed record
  KernelTime,
  UserTime,
  CreateTime: LARGE_INTEGER;
  WaitTime: dword;
  StartAddress: pointer;
  ClientId: TClientId;
  Priority,
  BasePriority,
  ContextSwitchCount: dword;
  State: dword;
  WaitReason: dword;
 end;

PSYSTEM_PROCESSES = ^SYSTEM_PROCESSES;
SYSTEM_PROCESSES = packed record
   NextEntryDelta,
   ThreadCount: dword;
   Reserved1 : array [0..5] of dword;
   CreateTime,
   UserTime,
   KernelTime: LARGE_INTEGER;
   ProcessName: TUnicodeString;
   BasePriority: dword;
   ProcessId,
   InheritedFromProcessId,
   HandleCount: dword;
   Reserved2: array [0..1] of dword;
   VmCounters: VM_COUNTERS;
   IoCounters: IO_COUNTERS;

   Threads: array [0..0] of SYSTEM_THREADS;
  end;

  var info, info2: PSystem_Processes;
    i, j, k: integer;
    t, t1: LARGE_INTEGER;
    process_id: tintegerlist;




implementation

{$R *.dfm}

Function ZwQuerySystemInformation(ASystemInformationClass: dword;
                                  ASystemInformation: Pointer;
                                  ASystemInformationLength: dword;
                                  AReturnLength:PCardinal): NTStatus;
                                  stdcall;external 'ntdll.dll';
Function GetInfoTable(ATableType:dword):Pointer;
var
 mSize: dword;
 mPtr: pointer;
 St: NTStatus;
begin
 Result := nil;
 mSize := $4000;

 repeat
   mPtr := VirtualAlloc(nil, mSize, MEM_COMMIT or MEM_RESERVE, PAGE_READWRITE);
   if mPtr = nil then Exit;
   St := ZwQuerySystemInformation(ATableType, mPtr, mSize, nil);
   if St = STATUS_INFO_LENGTH_MISMATCH then

      begin //надо больше памяти
        VirtualFree(mPtr, 0, MEM_RELEASE);
        mSize := mSize * 2;
      end;
 until St <> STATUS_INFO_LENGTH_MISMATCH;
 if St = STATUS_SUCCESS
   then Result := mPtr
   else VirtualFree(mPtr, 0, MEM_RELEASE);

end;



procedure TForm1.Button1Click(Sender: TObject);
begin
  process_id := TIntegerList.Create;
    info := GetInfoTable(SystemProcessesAndThreadsInformation);
    info2 := info;


     while (info2^.NextEntryDelta <> 0) do

     begin
     if (process_id.IndexOf(info2^.ProcessId)=-1)
        then process_id.Add(info2^.ProcessId);

       info2 := Pointer(dword(info2)+info2.NextEntryDelta);
    end;   

    VirtualFree(info, 0, MEM_RELEASE);

    //А теперь смотрим что добавилось

  while true do
 begin
    Sleep(200);
    info := GetInfoTable(SystemProcessesAndThreadsInformation);
    info2 := info;

    while (info2^.NextEntryDelta <> 0) do   

    begin
      if (process_id.IndexOf(info2^.ProcessId)=-1)
        then
          begin
          memo1.Lines.Add(string(info2^.ProcessId)+' - created');
          process_id.Add(info2^.ProcessId);
          end;
      info2 := Pointer(dword(info2)+info2^.NextEntryDelta);
    end;
    VirtualFree(info, 0, MEM_RELEASE);
  end;  end;



end. 


[notHaker]

while true do
begin
Sleep(200);
info := GetInfoTable(SystemProcessesAndThre adsInformation);
info2 := info;

while (info2^.NextEntryDelta <> 0) do

begin
if (process_id.IndexOf(info2^.ProcessI d)=-1)
then
begin
memo1.Lines.Add(string(info2^.Proce ssId)+' - created');
process_id.Add(info2^.ProcessId);
end;
info2 := Pointer(dword(info2)+info2^.NextEnt ryDelta);
end;
VirtualFree(info, 0, MEM_RELEASE);
end; end;

А это что за мазафака? Сразу бросилось в глаза. Вы фактически зацикливаете до бесконечности этот кусок кода без вариантов выхода из цикла. В таком виде вам придётся аварийно завершать программу в любом случае. Если в консольном варианте ещё может что-то выводиться, то в GDI варианте этому же процессу надо прорисовывать окно.

while true do
 begin
    Sleep(200);
    info := GetInfoTable(SystemProcessesAndThreadsInformation);
    info2 := info;

    while (info2^.NextEntryDelta <> 0) do   

    begin
      if (process_id.IndexOf(info2^.ProcessId)=-1)
        then
          begin
          Application.ProcessMessages;
          memo1.Lines.Add(string(info2^.ProcessId)+' - created');
          process_id.Add(info2^.ProcessId);
          end;
      info2 := Pointer(dword(info2)+info2^.NextEntryDelta);
    end;
    VirtualFree(info, 0, MEM_RELEASE);
  end;  end;

В таком варианте memo1 прорисуется, но код перепиливать надо серавно. Предусмотрите условие выхода из цикла.

while true do Sleep(200);

Это здесь вообще ни к чему. Из-за Sleep программа будет подвисать, а цикл "наматывает" этот кусок кода на бесконечность, да и практического смысла здесь в них нет.

[Den7656]

Добавил Application.ProcessMessages, на счет sleep так и не понял, нужен же интервал для сверки списка PID'ов. Попробовал так как вы написали, запуститься - запустилось, после ButtonClick все ок, но при попытке открытия любого файла все равно появляется ErrorMessage и в memo ничего (((
Спасибо за ответ, а я буду ковыряться дальше...

[Den7656]

всем спасибо, вопрос решен.