Форум: "Начинающим";
Текущий архив: 2008.10.05;
Скачать: [xml.tar.bz2];

Вниз

Два процесса одновременно   Найти похожие ветки 

← →
Greebanyi 2bus ©   (2008-08-25 15:16) [0]

Здрасте, помогогите пожалуйста. Надо написать прогу где будут идти два процесса одновременно. Мне необходимо сделать чтобы одновременно шло время (подскажите как его сделать) и параллельно можно было бы заниматься остальной частью программы, ну там на кнопочки нажимать и т.д.
HELP PLEASE.

---

← →
Сергей М. ©   (2008-08-25 15:18) [1]

А зачем "два процесса" ?
Одного достаточно.

---

← →
Leonid Troyanovsky ©   (2008-08-25 15:21) [2]

> Greebanyi 2bus ©   (25.08.08 15:16)  

> чтобы одновременно шло время (подскажите как его сделать)
> и параллельно можно было бы заниматься остальной частью

TTimer

--
Regards, LVT.

---

← →
Greebanyi 2bus ©   (2008-08-25 16:16) [3]

Ну если Timer поставить в это время разве можно будет еще что то делать? Он же вроде идет типа Delay в Паскале. Ну если воспользоваться Timerom то как сделать так чтобы он показывал сколько времени осталось?

---

← →
DVM ©   (2008-08-25 16:25) [4]

> Greebanyi 2bus ©   (25.08.08 16:16) [3]


unit Unit1;

interface

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

type
 TForm1 = class(TForm)
   Timer1: TTimer;
   procedure Timer1Timer(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Timer1Timer(Sender: TObject);
begin
 caption := FormatDateTime("c", Now);
end;

end.



---

← →
DVM ©   (2008-08-25 16:26) [5]

> то как сделать так чтобы он показывал сколько времени осталось?

До чего осталось? До запуска Большого Андронного Коллайдера?

---

← →
Vlad Oshin ©   (2008-08-25 16:28) [6]

он ничего не показывает, он через время Inteval выполняет единственный свой метод onTimer

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  label1.Caption:=datetimetostr(now);
end;

---

← →
{RASkov} ©   (2008-08-25 16:43) [7]

Развод какой-то, но всеж...
unit Unit1;
interface
uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, ExtCtrls, StdCtrls;

type
 TForm1 = class(TForm)
   Button1: TButton;
   Button2: TButton;
   Timer1: TTimer;
   Edit1: TEdit; //Чёб можно было "что-то" делать пока идет отсчет...
   procedure Button1Click(Sender: TObject);
   procedure Timer1Timer(Sender: TObject);
   procedure Button2Click(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var Form1: TForm1;

implementation
{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
 Timer1.Tag:=GetTickCount+60000;
 Timer1.Enabled:=True;
 Button1.Enabled:=False;
 Button2.Enabled:=True;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
 Tag:=(Timer1.Tag-GetTickCount) div 1000;
 Caption:=IntToStr(Tag);
 if Tag<=0 then begin
  Button2.Click;
  ShowMessage("Time off");
 end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
 Timer1.Tag:=0;
 Timer1.Enabled:=False;
 Button1.Enabled:=True;
 Button2.Enabled:=False;
end;

end.

---

← →
Loginov Dmitry ©   (2008-08-25 22:55) [8]

> Ну если Timer поставить в это время разве можно будет еще
> что то делать? Он же вроде идет типа Delay в Паскале.


А зачем гадать, мож лучше книжку почитать?

---

← →
Maxick ©   (2008-08-26 08:30) [9]

Даже в паскале выводили часы, которые никому не мешели (яля как в нортон командер).

---

← →
Palladin ©   (2008-08-26 09:34) [10]

> Maxick ©   (26.08.08 08:30) [9]

и что ты сказать этим хочешь?

---

← →
brother ©   (2008-08-26 12:13) [11]

> Он же вроде идет типа Delay в Паскале

жесть... а проверить то никак? Проверь, тебе понравится ;)

---

← →
+koha   (2008-08-27 01:37) [12]

Можно запустить каждый процесс в отдельном потоке и делать свои дела и при этом еще измерять время выполнения потоков через GetProcessTimes
Как - то делал для универа по предмету ТРПП (СИПФУ) пример утилиты, которая запускала несколько программ и подсчитывала время выполнения каждого просесса с изменением приоритетов. Но преподы оказались весма тупыми и нихрена не поняли в чем суть. Пришлось забросить проект в таком не доработанном виде и остался. Реализованы главные процедуры и функции - может что полезное для себя и возмешь из него. но может быть с глюками.

Вот полняя версия с утилитой (недоделанной) http://webfile.ru/2186830

unit ProcessEdit;

interface
uses windows,SysUtils,Dialogs,Classes;

Type
 PTimeRec = ^TimeRec;
 TimeRec = Record
   KernelTimeStart: FILETIME;
   UserTimeStart  : FILETIME;
 end;

Type
 PTimeInfo = ^TProcessTimeInfo;
 TProcessTimeInfo = Record
   KernelTime : TDateTime;
   UserTime   : TDateTime;
   CollapsTime : TDateTime;
   IDLTime    : TDateTime;
   FullTime   : TDateTime;
 end;

function StartProcess(FileName: String): integer;
function ProcessStatus(ProcessID: Integer): Longword;
function StopProcess(ProcessID: Integer): boolean;
function GetPriorityProcess(ProcessID: Integer): String;
Function SetPriontyProcess(ProcessID: Integer; PriorityFlag: DWORD):Boolean;
function FileTimeToDateTime(ft: TFileTime): TDateTime;
function GetProcessTimeInfo(PID: integer; Var TR: TimeRec; Var TimeInfo: TProcessTimeInfo): Boolean;
function SetStartTimeProcess(PID: Integer; Var TR: TimeRec): Boolean;

Var
 TLArray: array of TimeRec;

Const
 ABOVE_NORMAL_PRIORITY_CLASS =  32768;
 BELOW_NORMAL_PRIORITY_CLASS =  16384;
 tFormat = "HH:NN:SS.ZZZ";

implementation

Uses unit1;

{--------------------------- FileTimeToDateTime -------------------------------}
function FileTimeToDateTime(ft: TFileTime): TDateTime;
var
 ft1: TFileTime;
 st: TSystemTime;
begin
 if ft.dwLowDateTime + ft.dwHighDateTime = 0 then Result := 0
 else begin
   FileTimeToLocalFileTime(ft, ft1);
   FileTimeToSystemTime(ft1, st);
   Result := SystemTimeToDateTime(st);
 end;
end;

{--------------------------------- SetStartTimeProcess ------------------------}
function SetStartTimeProcess(PID: Integer; Var TR: TimeRec): Boolean;
Var
   //KernelTimeStart,UserTimeStart,
   CreateTime,Dummy: TFILETIME;
   HProcess: THandle;
   //Stat: LongWord;
begin

 HProcess:=OpenProcess(PROCESS_QUERY_INFORMATION,false,PID);
 if HProcess = 0 then begin
   //ShowMessage("OpenProcess = 0");
   exit;
 end;

 sleep(50);
 GetProcessTimes(HProcess,CreateTime,Dummy,TR.KernelTimeStart,TR.UserTimeStart);

 CloseHandle(HProcess);
end;

{--------------------------- GetProcessTimeInfo ------------------------------}
function GetProcessTimeInfo(PID: integer; Var TR: TimeRec; Var TimeInfo: TProcessTimeInfo): Boolean;
Var
   KernelTimeEnd,UserTimeEnd,CreatTime, Dummy: FILETIME;
   CollapseTime,UserTime,KernelTime,IDLTime: TDateTime;
   CurTime: TSystemTime;
   HProcess: THandle;
begin

 HProcess:=OpenProcess(PROCESS_QUERY_INFORMATION,false,PID);
 if HProcess = 0 then exit;

 GetProcessTimes(HProcess,CreatTime,Dummy,KernelTimeEnd,UserTimeEnd);

 KernelTime   := FileTimeToDateTime(KernelTimeEnd)-FileTimeToDateTime(TR.KernelTimeStart);
 UserTime     := FileTimeToDateTime(UserTimeEnd)-FileTimeToDateTime(TR.UserTimeStart);
 CollapseTime := UserTime + KernelTime;

 GetLocalTime(CurTime);
 IDLTime := SystemTimeToDateTime(CurTime)-FileTimeToDateTime(CreatTime)+CollapseTime;

 TimeInfo.KernelTime  := KernelTime;
 TimeInfo.UserTime    := UserTime;
 TimeInfo.CollapsTime := CollapseTime;
 TimeInfo.IDLTime     := IDLTime;
 TimeInfo.FullTime    := SystemTimeToDateTime(CurTime)-FileTimeToDateTime(CreatTime);

 CloseHandle(HProcess);
 result       := true;
end;

{----------------------------- StartProcess -----------------------------------}
function StartProcess(FileName: String): integer;
var
 StartupInfo: TStartupInfo;
 ProcessInfo: TProcessInformation;
begin
 FillChar(StartupInfo, SizeOf(StartupInfo), #0);
 StartupInfo.cb          := SizeOf(StartupInfo);
 StartupInfo.dwFlags     := STARTF_USESHOWWINDOW;
 StartupInfo.wShowWindow := SW_SHOWNORMAL;

 if Not CreateProcess(nil,
   PChar(FileName), // pointer to command line string
   nil,      // pointer to process security attributes
   nil,      // pointer to thread security attributes
   False,    // handle inheritance flag
   CREATE_NEW_CONSOLE or // creation flags
   NORMAL_PRIORITY_CLASS,
   nil, //pointer to new environment block
   nil, // pointer to current directory name
   StartupInfo, // pointer to STARTUPINFO
   ProcessInfo) then Result:=0
 else
   result:=ProcessInfo.dwProcessId;
   //CloseHandle(ProcessInfo.hProcess);
   //CloseHandle(ProcessInfo.hThread);
end;

{-------------------------------- ProcessStatus -------------------------------}
function ProcessStatus(ProcessID: Integer): Longword;
Var HProcess: THandle;
begin
 HProcess:=OpenProcess(PROCESS_QUERY_INFORMATION,false,ProcessID);
 if HProcess = 0 then exit;
 GetExitCodeProcess(HProcess, result);
 CloseHandle(HProcess);
end;

{------------------------------- StopProcess ----------------------------------}
function StopProcess(ProcessID: Integer): boolean;
Var HProcess: THandle;
   ExtCode: LongWord;
begin
 HProcess:=OpenProcess(PROCESS_ALL_ACCESS,false,ProcessID);
 if HProcess = 0 then exit;
 GetExitCodeProcess(HProcess,ExtCode);
 if ExtCode = 0 then exit;
 result:=TerminateProcess(hProcess, DWORD(-1));
 CloseHandle(HProcess);
end;

{------------------------------ GetPriorityProcess ----------------------------}
function GetPriorityProcess(ProcessID: Integer): String;
Var HProcess: THandle;
begin
 HProcess:=OpenProcess(PROCESS_ALL_ACCESS,false,ProcessID);
 if HProcess = 0 then begin
    Result:="-";
    Exit;
 end;
 try
 case GetPriorityClass(HProcess) of
   ABOVE_NORMAL_PRIORITY_CLASS : Result := "ABOVE_NORMAL"; //выше обычного
   BELOW_NORMAL_PRIORITY_CLASS : Result := "BELOW_NORMAL"; //ниже обычного
   HIGH_PRIORITY_CLASS         : Result := "HIGH";     //высший
   IDLE_PRIORITY_CLASS         : Result := "IDLE";     //простаивающий
   NORMAL_PRIORITY_CLASS       : Result := "NORMAL";   //обычный
   REALTIME_PRIORITY_CLASS     : Result := "REALTIME"; //критичный по времени
 else
   result:="PRIORITY NIL";
 end;
 finally
   CloseHandle(HProcess);
 end;
end;

{-------------------------------- SetPriontyProcess ---------------------------}
function SetPriontyProcess(ProcessID: Integer; PriorityFlag: DWORD):Boolean;
Var HProcess: THandle;
begin
 HProcess:=OpenProcess(PROCESS_ALL_ACCESS,false,ProcessID);
 if HProcess = 0 then Exit;
 result:=SetPriorityClass(HProcess,PriorityFlag);
 CloseHandle(HProcess);
end;

end.

---

← →
Maxick ©   (2008-08-27 05:17) [13]

> Palladin ©   (26.08.08 09:34) [10]

я про то, что в досе на паскале часы делали без delay, и тикали они себе в каком нить уголке и прога работала.. Пример как это можно сделать есть в любом букваре по паскалю. Вот это я и хотел сказать.. причем тут отдельный поток!? или я автора не понял..

---

← →
Palladin ©   (2008-08-27 08:54) [14]

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

ps. в досе время выводили установкой вектора прерывания таймера

---

← →
Maxick ©   (2008-08-27 12:58) [15]

> Palladin ©   (27.08.08 08:54) [14]
> так уж и в букваре?

Книга "Борланд Паскаль 7" под редакцией не помню чьей. Раздел по ООП, пример с прогой аля БД, там скользом про часики говорится. По крайней мере в приведенном листинге точно есть. И про прерывания в книге вроди как было. Когдато давно ООП в паскале баловал.

---

Страницы: 1 вся ветка

Форум: "Начинающим";
Текущий архив: 2008.10.05;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.51 MB
Время: 0.006 c