Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате
Форум программистов > Delphi: WinAPI и системное программирование > заставить прогу всё время работать


Автор: h2o 26.10.2005, 13:18
Есть прога. Она состоит из одной формы. При запуске системы моя прога запускается свёрнутой в трэй, и висит там пока я не нажму "ВЫХОД".
А как заставить в это время прогу работать??? Нужно событие и действие типа..
Код

program Project1;

uses
  Forms,
  Unit1 in 'Unit1.pas' {Form1};

{$R *.res}

begin
  Application.Initialize; 
  Application.Title := 'Proga';
  Application.CreateForm(TForm1, Form1);
  Application.Run;
  while Application_is_running do
    begin
    ...
    ...
    end;
end.

В форме все настройки и процедуры описаны... и при событии "Пока прога запущена, всё время делать то-то". И вот я в цикле, тока буду запускать процедуры и функции из формы, с настройками из формы!
Как такое замутить?

З.Ы. Про Api вариант знаю... но вроде он тут не подходит... вот он:
Код

program Project1;
uses Windows;
var
Msg: TMsg;
Begin
//Сюда можешь добавлять свой код
// Дальше идет код, который заставит прогу висеть в 
// памяти вечно и не будет сильно грузить систему.
while GetMessage( Msg, HInstance, 0, 0) do
begin
TranslateMessage(msg);
DispatchMessage(msg);
end;
end.

Автор: Romikgy 26.10.2005, 13:54
Создай таймер и засунь туда , все что хошь и пускай се вертится smile

Автор: h2o 26.10.2005, 14:05
не, не вариант!и какой я ему счёт поставлю??? неужели нет ничё такого.....

Автор: _hunter 26.10.2005, 14:26
ничего не понял. если ты сделал GUI приложение оно и так работает ( отлавливает и обрабатывает сообщения )
если тебе нужно чтобы постоянно выполнялось какое-то действие -- запусти его во потоке...

короче, объясняй подробнее...

Автор: h2o 26.10.2005, 14:51
_hunter да я вроде и так подробно обьяснил... ну вообщем ещё раз... попробую!

1 прога. 1 форма. Прога при запуске создаётся в трэе. ну да, всё правильно-прога и так висит в памяти и работает, пока её сам не закроеш....дак вот, чтобы запустить операцию... нужно нажать на кнопку, так? да так! а у меня там кнопок нет. я делаю жалкое подобие службы!!!
и мне надо чтобы - конкретно:
1. от старта проги и до выхода из проги, она у меня выполняла действия, без нажатий на клавиши... просто запустил прогу, форма появилась, ты с формой работаешь, меняешь настройки, а в это время прога ничего тебе не говоря, сама на заднем плане что-то делает...
2. что делает прога:
Код

//Project1
program Project1;
uses
  Forms,
  Unit1 in 'Unit1.pas' {Form1};
{$R *.res}
begin
  Application.Initialize; 
  Application.Title := 'Proga';
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

//Unit1.pas
unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs;
type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
var
  Form1: TForm1;
implementation
 {$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
...
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
...
end;
procedure TForm1.MyBackDoorProcedure;
var ...
begin
...
end;

//и вот где-то там в проге как-то нужно сделать
while Моя_программа_работает do
 begin
  Date:=получить системное время;
  Date2UserDate:=27.10.05;
  if Date2UserDate>=Date 
   then MyBackDoorProcedure
   else wait(6 часов);
  end;
// если дата указанная пользователем больше или равна системному времени, то запустить процедуру MyBackDoorProcedure, если нет, то подождать 6 часов, а потом опять проверять условие. И если дата Date2UserDate назначена на срок через неделю, то прога должна висеть всю неделю и проверять условие и ждать своего числа...
end.


вот так. как это реализовать?

Автор: _hunter 26.10.2005, 15:14
ааа... ну тогда, как я уже говорил, в TForm1.FormCreate просто создавай поток и в нем эти действия выполняй.

Автор: h2o 26.10.2005, 15:17
_hunter smile

я вообще далёк от понятия про потоки! я сам не смогу разобраться буз примера, если не влом, писани.... спасибо!

Автор: Romikgy 26.10.2005, 16:06
ИМХО здесь поток не нужен, хотя смотря что будет делаться в
Цитата(h2o @ 26.10.2005, 14:51)
MyBackDoorProcedure

если действий не сильно много, т.е. нет больших ресурсоемких расчетов, то проще юзать таймер,
да ожидание на 6 часов проще делать через него smile

Автор: _hunter 26.10.2005, 16:07
идеш файл, нью, озер, треад обджект.
как-то обзываеш, как-то сохраняеш. в его методе Execute пишеш свои действия.
в главной форме создаеш ( как-то так TMyThread.Create(false) ) все.
( не забываем подключить модуль )

Автор: h2o 27.10.2005, 07:57
а чё в методе Execute указывать?
1.сначало, нужно указать чтобы поток висел всегда в памяти? и код всех действий вбить?
Для этого вот это?
Код

procedure TThread.Execute;
var Msg: TMsg;
begin
  SetName;
  { Place thread code here }
 //Сюда можешь добавлять свой код
// Дальше идет код, который заставит прогу висеть в 
// памяти вечно и не будет сильно грузить систему.
while GetMessage( Msg, HInstance, 0, 0) do
begin
TranslateMessage(msg);
DispatchMessage(msg);
end;
end;

2. TMyThread.Create(false) - это в OnCreate главной формы можно указать или где?
3. Поток вообще сможет работать с компонентами, чекитами, едитами из главной формы?
Добавлено @ 08:02
ввобще мне надо сравнить время системы и указанное мной время и запустить процедуру в главной форме описанную. это возможно? или надо и эту процедуру в поток переносить?

Автор: Alexeis 27.10.2005, 09:05
Цитата
TMyThread.Create(false)

пишется где угодно но перед вызовом execute
Для работы с VCL необходимы защищенные секции - читай статью Петовича в разделе важных тем smile

Автор: h2o 27.10.2005, 09:07
ничё не получается! вот я так сделал:
Код

unit StartingMyNewThread;
interface
uses
  SysUtils, Unit1, Classes {$IFDEF MSWINDOWS} , Windows {$ENDIF};
type
  MyNewThread= class(TThread)
  private
    procedure SetName;
  protected
    procedure Execute; override;
  end;
implementation
{$IFDEF MSWINDOWS}
type
  TThreadNameInfo = record
    FType: LongWord;     // must be 0x1000
    FName: PChar;        // pointer to name (in user address space)
    FThreadID: LongWord; // thread ID (-1 indicates caller thread)
    FFlags: LongWord;    // reserved for future use, must be zero
  end;
{$ENDIF}
{ ArcThread }
procedure ArcThread.SetName;
{$IFDEF MSWINDOWS}
var
  ThreadNameInfo: TThreadNameInfo;
{$ENDIF}
begin
{$IFDEF MSWINDOWS}
  ThreadNameInfo.FType := $1000;
  ThreadNameInfo.FName := 'MyNewThread';
  ThreadNameInfo.FThreadID := $FFFFFFFF;
  ThreadNameInfo.FFlags := 0;
  try
    RaiseException( $406D1388, 0, sizeof(ThreadNameInfo) div sizeof(LongWord), @ThreadNameInfo );
  except
  end;
{$ENDIF}
end;

procedure ArcThread.Execute;
var Msg: TMsg; NowDate, ArcDate:TDateTime;
begin
  SetName;
  NowDate:=StrToDate(Date);  //1
  MyDateForBeginProc:=SettingsMenu.DateTimePicker1.DateTime; //2
  if NowDate>=MyDateForBeginProc then  SettingsMenu.StartingMyBackDoorProcedure; //3
  wait(10000);
while GetMessage( Msg, HInstance, 0, 0) do //чтобы в памяти всегда висела!
begin
TranslateMessage(msg);
DispatchMessage(msg);
end;
end;
end.


Чёто не так! как сделать чтобы поток всегда висел в памяти и //1 //2 //3 выполнялись всё время.
Тоесть я запустил поток. а дальше он пока работает быдет выполнять //1 //2 потом условие //3 и если условие не верно, то он подождёт wait(10000) а потом опять //1 //2 //3. и если уже верно то он запустит мою процедуру из другой формы... после выполнения процедуры, он опять будет висеть в памяти и выполнять как и прежде //1 //2 //3.
Вот как это сделать...

а да, я ещё выше там вопросов понаписал! ответьтте плиз и на них кто-нибудь!!!
Добавлено @ 09:08
а да, ещё фигня... у меня поток не показывает ХР диспетчер задачь, а вот показывает что прога грузит проц - 90%! это чё- нормально? написано же
Код

// Дальше идет код, который заставит прогу висеть в 
// памяти вечно и не будет сильно грузить систему.
while GetMessage( Msg, HInstance, 0, 0) do
begin
TranslateMessage(msg);
DispatchMessage(msg);
end;


90% - это не сильно????

Автор: Alexeis 27.10.2005, 09:20
Поток выполняется пока работает execute

Автор: Romikgy 27.10.2005, 09:21
Код

procedure ArcThread.Execute;    
var Msg: TMsg; NowDate, ArcDate:TDateTime;    
begin    
while true do
begin  
SetName;    
  NowDate:=StrToDate(Date);  //1    
  MyDateForBeginProc:=SettingsMenu.DateTimePicker1.DateTime; //2    
  if NowDate>=MyDateForBeginProc then  SettingsMenu.StartingMyBackDoorProcedure; //3    
  wait(10000);    
end;
end;

Автор: h2o 27.10.2005, 09:22
дак как мне сделать?
Добавлено @ 09:23
Romikgy блин не увидел... шас гляну!
Добавлено @ 09:25
Romikgy
а чё он так будет в памяти висеть... и постоянно через интервал проверять и проверять?

Автор: Alexeis 27.10.2005, 09:31
Цитата
while true

лучше не while true , а while not terminated
тогда будет коректное завершение

Автор: Romikgy 27.10.2005, 09:36
Для общения с VCL необходимо юзать Synchronize (если не ошибся в написании smile ) , ну и почитать нуно про потоки , раз уж хош через них делать.
Зы у тя есть
Цитата(h2o @ 27.10.2005, 09:07)
wait(10000);

и это очень похоже на таймер smile только загрузка проца в твоем случае будет близка к максимальной , при использовании таймера будет минимальной, ИМХО .

Автор: Alexeis 27.10.2005, 09:36
Цитата
а чё он так будет в памяти висеть... и постоянно через интервал проверять и проверять?

через каждые 10 секунд.
лучше wait(10000) заменить на sleep(10000)

Автор: Romikgy 27.10.2005, 09:38
Цитата(alexeis1 @ 27.10.2005, 09:31)
лучше не while true , а while not terminated
тогда будет коректное завершение

ИМХО разница будет не велика, при суспенде или терминейте поток будет тормозится/убиватся в любом случае.

Автор: h2o 27.10.2005, 09:41
Romikgy чё то не работает! загрузка проца моей прогой 0-1%. видимо поток не висит в памяти а 1 раз выполнился!

я так сделал, добавил ещё while not terminated пробую...

alexeis1 while not terminated - указал. а как теперь терминате проток сделать. если я его из главной формы вызываю. и в главной форме делаю close; то и поток будет terminated автоматом?

Автор: Alexeis 27.10.2005, 09:43
Цитата
ИМХО разница будет не велика, при суспенде или терминейте поток будет тормозится/убиватся в любом случае.

вызов terminate приводит только к установке флага terminated
в true а не к убиванию потока smile

Автор: h2o 27.10.2005, 09:48
Код

procedure ArcThread.Execute;
var Msg: TMsg; NowDate, ArcDate:TDateTime;
begin
  SetName;
  while not terminated do
  begin
   NowDate:=StrToDate(Date);
   ArcDate:=SettingsMenu.g1DateArc.DateTime;
   if NowDate>=ArcDate then  SettingsMenu.ProcArchive1CBase;
   sleep(1000);
  end;
end;


вот так работает!!!

вот тока если форм клозе сделать, выдается ошибка acsess violation и адреса 00000

Добавлено @ 09:50
как это победить?

да и ещё, у меня стоит условие if NowDate>=ArcDate then , а работает тока если NowDate>ArcDate, почему-то при= не работает!!!

Автор: Alexeis 27.10.2005, 09:51
Цитата
если я его из главной формы вызываю. и в главной форме делаю close; то и поток будет terminated автоматом?

нет нужно в onclose формы вызвать mythead.terminate;
waitforsingleobject(mythead, infinity);

ошибся smile
mythead.waitfor;

Автор: Romikgy 27.10.2005, 09:55
Цитата(h2o @ 27.10.2005, 09:22)
а чё он так будет в памяти висеть... и постоянно через интервал проверять и проверять?

Аха smile
Добавлено @ 10:00
Я могу и ошибатся , но mythead это класс потока, какое он имеет отношение к событиям??? smile

Цитата(alexeis1 @ 27.10.2005, 09:51)
waitforsingleobject(mythead, infinity);

Я не совсем понял smile

Автор: Alexeis 27.10.2005, 10:06
как раз в waitforsingleobject(mythead, infinity); я и ошибся
верно mythead.waitfor
приложение подождет пока поток не завершится затем
вызовет
mythead.free;
и затем завершит работу

поправлено

Цитата
mythead это класс потока, какое он имеет отношение к событиям???

никакого события нет

код VCl


Код

property Terminated: Boolean read FTerminated;

procedure TThread.DoTerminate;
begin
  if Assigned(FOnTerminate) then Synchronize(CallOnTerminate);
end;

procedure TThread.Terminate;
begin
  FTerminated := True;
end;

procedure TThread.CallOnTerminate;
begin
  if Assigned(FOnTerminate) then FOnTerminate(Self);
end;

Автор: RideX 27.10.2005, 12:05
h2o, думаю ты это хотел?
Код

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

const
  Year : WORD = 2005;
  Month: WORD = 10;
  Day  : WORD = 27;

var
  hThread : THandle;
  ThreadID: DWORD;

  stm: TSYSTEMTIME;
  IsDone: Boolean = False;


procedure MyProc;
begin
  if IsDone = True then
    Exit;
  MessageBox(0, 'Моя функция', 'MyProc', MB_ICONINFORMATION);
  IsDone := True;
end;

procedure ThreadProc;stdcall;
begin
  while True do
    asm
      push 1
      call Sleep

      push offset stm
      call GetLocalTime

      xor eax,eax
      mov ax,stm.wYear
      cmp ax,Year
      jb @exit

      mov ax,stm.wMonth
      cmp ax,Month
      jb @exit

      mov ax,stm.wDay
      cmp ax,Day
      jb @exit

      call MyProc;
    @exit:
    end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  hThread := CreateThread(nil, 0, @ThreadProc, nil, 0, ThreadID);
  if hThread = 0 then begin
    MessageBox(Handle, PChar(SysErrorMessage(GetLastError)), 'Error', MB_ICONERROR);
    Exit;
  end;
  SetThreadPriority(hThread, THREAD_PRIORITY_LOWEST);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  TerminateThread(hThread, DWORD(-1));
end;

end.

Автор: h2o 27.10.2005, 13:27
RideX Ну нифига ты замутил! с асмом ваше не понятно.
procedure ThreadProc;stdcall; - чё тутхоть делается то?

Автор: Guest 27.10.2005, 14:20
RideX, разобрался! спасибо. всё понятно кроме:
Код

procedure ThreadProc;stdcall;
begin
  while True do
    asm
      push 1 //куда-то заталкиваем 1, куда?
      call Sleep //спим, скока? стока скока затолкали перед этим? типа 1 секунду???

      push offset stm //???
      call GetLocalTime //вызываем получить время
...


а аналога на делфи нет? а то прото все операции со временем и условия, сравнения мне удобнее делать на делфи!!! я в асме мало что понимаю, а у меня стоко операций сравнения времени, которые берутся из TDateTimePiker'ов, едитов и т.д.

на делфи то есть аналогичная функция или средствами делфи этого не сделать?

Автор: Гость_h2o 27.10.2005, 14:21
можно так? :
Код

procedure ThreadProc;stdcall;
var NowDate, ArcDate:TDateTime;
begin
  while True do
   begin
    NowDate:=StrToDate(Date);
    ArcDate:=SettingsMenu.g1DateArc.DateTime;
    if NowDate<ArcDate then asm @exit;
    asm
      call MyProc;
    @exit:
    end;
   end;
end;

а всё остальное такое-же.

или как???

Автор: Romikgy 27.10.2005, 14:29
Код

procedure ThreadProc;stdcall;    
var NowDate, ArcDate:TDateTime;    
begin    
  while True do    
   begin    
    NowDate:=StrToDate(Date);    
    ArcDate:=SettingsMenu.g1DateArc.DateTime;    
    if NowDate>ArcDate then 
    MyProc;    
    end;    
end;

Можно так smile
Добавлено @ 14:31
Хотя .... неизвестно что делается в
Цитата
MyProc;

и что есть
Цитата
SettingsMenu.g1DateArc.DateTime;

?
VCL в потоках лучше не использовать!!!

Автор: h2o 27.10.2005, 14:55
hThread := CreateThread(nil, 0, @ThreadProc, nil, 0, ThreadID);
________________ругается вот тут_______^
[Error] Unit1.pas(600): Variable required

Автор: Romikgy 27.10.2005, 15:06
А так
CreateThread(nil, 0, @ThreadProc, 0, 0, ThreadID);

Автор: h2o 27.10.2005, 15:07
тоже самое
Добавлено @ 15:14
всё, разобрался! я тормоз! smile

Автор: Romikgy 27.10.2005, 15:15
Цитата(h2o @ 27.10.2005, 15:07)
всё, разобрался!

Эт хорошо...

Автор: h2o 27.10.2005, 15:38
стоко ошибок при работе с потоками!!! я уже немогу. если кнопкой запускать главную процедуру, то всё работает, а вот если через это грёбаное "расписание" которое в потоке проверяется, стоко ошибок!!!

неужели нет другого способа, буз потоков и таймера. как-то ведь виндовый планировщик работает!!!

smile

Автор: _hunter 27.10.2005, 15:48
нету.
а планировщик работает по тамеру

Автор: RideX 27.10.2005, 16:59
Sleep(1) не нужно отсюда выбрасывать, это неправильно! И чем меньше преобразований и привидений типов, тем лучше.

Автор: h2o 28.10.2005, 08:30
это вопрос скорее к RideX
Код

procedure TSettingsMenu.ThreadProc;stdcall;
var NowDate, ArcDate:TDateTime;
begin
  while True do    
   begin    
    NowDate:=StrToDate(Date);    
    ArcDate:=SettingsMenu.g1DateArc.DateTime;
    if NowDate>ArcDate then ProcArchive1CBase;

а вот почему так, если при запуске проги NowDate<ArcDate, а потом я захожу в SettingsMenu, нахожу поле g1DateArc (это TDateTimePiker), меняю время так, что NowDate>ArcDate, у меня выполняется условие и запускается процедура ProcArchive1CBase; и всё нормально!!!

а вот если при запуске проги сразу NowDate>ArcDate, то процедура тоже выполняется ProcArchive1CBase правильно, но вот тока прога у меня зависает! и к форме SettingsMenu не обратиться, прогу не закрыть, а поток работает...

чё такое?

Автор: Alexeis 28.10.2005, 09:04
Хорошо бы посмотреть что делается в ProcArchive1CBase

Если в ProcArchive1CBase есть обращение к данным общим с програмным потоком то результат будет непредсказуемым.

Автор: h2o 28.10.2005, 09:23
alexeis1 там слишком динный код, связанный с получением параметров из разных компонентов...

я думаю, может это из-за того что я поток в FormCreate запускаю. Может его надо запускать после Application.run а не при создании формы???

Автор: h2o 28.10.2005, 09:42
а может надо синхронизацию делать?

Автор: Alexeis 28.10.2005, 09:48
Очень вероятно
Сделай в Form activate
(проверь запускается ли Form.activate в первый раз)

Автор: h2o 28.10.2005, 10:40
странно, всё заработало! теперь другая фигня.... при выходе из проги, выдаётся ошибка! поток запускаю и завершаю, как писал RideX. может для этого сделать синхронизацию, или как??? чё делать то?

Автор: Alexeis 28.10.2005, 10:55
Приведи текст ошибки smile

Автор: RideX 28.10.2005, 11:16
h2o, попробуйте упростить задачу и постепенно усложняя ищите что вызывает ошибки, а то методом научного тыка как-то ненадёжно smile Это, например, работает нормально и без разницы какая дата при запуске программы и на какую меняется при работе:
Код

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    DateTimePicker1: TDateTimePicker;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

const
  strDate: String = '27.10.2005';

var
  hThread : THandle;
  ThreadID: DWORD;

procedure ProcArchive1CBase;
begin
  Form1.Caption := 'ProcArchive1CBase';
end;

procedure MyProc;
var
  ArcDate: TDateTime;
begin
  ArcDate := Form1.DateTimePicker1.Date;
  if Date > ArcDate then
    ProcArchive1CBase
  else
    Form1.Caption := DateTimeToStr(Now);
end;

procedure ThreadProc;stdcall;
begin
  while True do begin
    Sleep(1);
    MyProc;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  DateTimePicker1.Date := StrToDate(strDate);

  hThread := CreateThread(nil, 0, @ThreadProc, nil, 0, ThreadID);
  if hThread = 0 then begin
    MessageBox(Handle, PChar(SysErrorMessage(GetLastError)), 'Error', MB_ICONERROR);
    Exit;
  end;
  SetThreadPriority(hThread, THREAD_PRIORITY_LOWEST);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  TerminateThread(hThread, DWORD(-1));
end;

end.

Автор: Romikgy 28.10.2005, 12:39
В потоках не рекомендуется напрямую обращатся к VCL , можно доигратся до краха проги, имхо.

Автор: h2o 28.10.2005, 13:24
а как тогда быть?

Автор: Romikgy 28.10.2005, 13:34
Почитай это
http://forum.vingrad.ru/index.php?showtopic=60076
там много описано по потокам,
и здесь тоже есть
http://www.drkb.ru/

Автор: _hunter 28.10.2005, 13:43
не рекомендуется ( хотя я таких "нерекомендаций" не слышал ) но и не запрещается smile
можно Synchronize() использовать

Автор: h2o 28.10.2005, 14:13
http://forum.vingrad.ru/index.php?showtopic=60076 я это уже читал, но ещё раз перечитал! и ещё больше мне стало непонятно!

с синхронизацией вообще не понимаю... она вообще мне нафига нужна? у меня на форму из потока ничего не передаётся, тока - Form1.StringList.Items.Add есть. туда из TZipTV7 инфа передаётся.... а так, у меня с формы берутся настройки. нужна мне синхронизация?

я вот думаю, я запускаю в потоке процедуру, которая проверяет условие, если условие выполняется, то из этого потока, из этой процедуры запускается ещё одна процедура, в которой берутся все настройки с формы, идёт работа с Windows и запускается создание архива с помощью TZipTV7. а ведь он свои потоки ещё создаёт вроде или FileStream или что-то такое.

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

вообщем как быть?

Автор: Romikgy 28.10.2005, 15:00

Цитата(_hunter @ 28.10.2005, 13:43)
не запрещается

А не кто и не говорил чтозапрещается smile

Цитата(h2o @ 28.10.2005, 14:13)
нужна мне синхронизация?

Можно и без... но имхо самый безопасный способ использовать поток от борланда (т.е. класс тред) , и использовать синхронизацию при вызове
Цитата(h2o @ 28.10.2005, 14:13)
Form1.StringList.Items.Add

хотя наверное в синхро... было бы неплохо засунуть все где есть обращение к VCL

ЗЫ а вообще наааамного проще сделать таймер и засунуть в него все что хошь, никаких синхронизаций и др. вещей связаных с потоками, плюс прямой доступ безопасный к VCL и гемору меньше, хотя это твое личное дело....

Автор: h2o 28.10.2005, 15:23
а при таймере мне ведь будет главная моя форма недоступна? у меня в таймере будут цыклы, цыклы и т.д. и к главной форме будет не обратиться, она на вермя действия таймера повиснет?

Автор: Romikgy 28.10.2005, 15:51
Нет .... из таймера можно обращатся к любой форме, только правильно прописать обращение, и при таймере как раз и убирается загрузка проца, если конечно твои действия в таймере не долгоиграющие( забирают много времени и ресурсов машины) , тогда без потоков точно не обойтись smile
А так таймер лучшая альтернатива, чем поток ИМХО.

Автор: RideX 28.10.2005, 21:22
Цитата(Romikgy @ 28.10.2005, 15:39)
В потоках не рекомендуется напрямую обращатся к VCL , можно доигратся до краха проги, имхо.

Примерчик не сложный можно, интересно посмотреть как грохается прога %)

Цитата(Romikgy @ 28.10.2005, 18:51)
и при таймере как раз и убирается загрузка проца

А что, поток загружает процессор больше чем таймер? smile

Автор: Romikgy 31.10.2005, 09:54
Цитата(RideX @ 28.10.2005, 21:22)
Примерчик не сложный можно, интересно посмотреть как грохается прога

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

Цитата(RideX @ 28.10.2005, 21:22)
что, поток загружает процессор больше чем таймер?

Смотря что в потоке .... ожидание какого либо события будет постоянно есть ресурс проца в потоке, в таймере будет только на момент срабатывания его.

Автор: RideX 1.11.2005, 19:11
Цитата(Romikgy @ 31.10.2005, 12:54)
Примерчика нет, но подумай сам , существуют 2 и более потока , и если каждый попытается поменять заголовок у формы, че будет?

Ну, это уж у кого как smile Вот мой примерчик по твоему вопросу, здесь абсолютно не к чему придраться, не так ли?
Код

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

const
  szFmtTime: PChar = '%02hu:%02hu:%02hu';
  szFmtDate: PChar = '%02hu.%02hu.%04hu';

var
  hMainWnd     : HWND;

  hThreadTime  : THandle;
  ThreadTimeID : DWORD;

  hThreadDate  : THandle;
  ThreadDateID : DWORD;
  StopThreads  : Boolean = False;

  CriticalSection: RTL_CRITICAL_SECTION;
  szCaption: array[0..11] of Char;
  stm: SYSTEMTIME;

procedure MyProc01;
asm
  pushad
  push offset CriticalSection
  call EnterCriticalSection

  push offset stm
  call GetLocalTime
  xor eax,eax
  mov ax,stm.wSecond
  push eax
  mov ax,stm.wMinute
  push eax
  mov ax,stm.wHour
  push eax
  push dword ptr[szFmtTime]
  push offset szCaption
  call wsprintf
  add esp,5*4

  push offset szCaption
  push 0
  push WM_SETTEXT
  push hMainWnd
  call SendMessage

  push offset CriticalSection
  call LeaveCriticalSection
  popad
end;

procedure MyProc02;
asm
  pushad
  push offset CriticalSection
  call EnterCriticalSection

  push offset stm
  call GetLocalTime
  xor eax,eax
  mov ax,stm.wYear
  push eax
  mov ax,stm.wMonth
  push eax
  mov ax,stm.wDay
  push eax
  push dword ptr[szFmtDate]
  push offset szCaption
  call wsprintf
  add esp,5*4

  push offset szCaption
  push 0
  push WM_SETTEXT
  push hMainWnd
  call SendMessage

  push offset CriticalSection
  call LeaveCriticalSection
  popad
end;

procedure ThreadTimeProc;stdcall;
asm
@m0:
  push 500
  call Sleep
  call MyProc01
  cmp byte ptr[StopThreads],True
  jne @m0

  push 0
  call ExitThread
end;

procedure ThreadDateProc;stdcall;
asm
@m0:
  push 500
  call Sleep
  call MyProc02
  cmp byte ptr[StopThreads],True
  jne @m0

  push 0
  call ExitThread
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  InitializeCriticalSectionAndSpinCount(CriticalSection, $00001000);

  hMainWnd := Handle;

  hThreadTime := CreateThread(nil, 0, @ThreadTimeProc, nil, 0, ThreadTimeID);
  if hThreadTime = 0 then begin
    MessageBox(Handle, PChar(SysErrorMessage(GetLastError)), nil, MB_ICONERROR);
    Exit;
  end;
  SetThreadPriority(hThreadTime, THREAD_PRIORITY_LOWEST);

  hThreadDate := CreateThread(nil, 0, @ThreadDateProc, nil, 0, ThreadDateID);
  if hThreadDate = 0 then begin
    MessageBox(Handle, PChar(SysErrorMessage(GetLastError)), nil, MB_ICONERROR);
    Exit;
  end;
  SetThreadPriority(hThreadDate, THREAD_PRIORITY_LOWEST);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
  dwExitCode: DWORD;
begin
  StopThreads := True;

  SetWindowText(hMainWnd, 'Threads finalization, waiting...');
  Sleep(1000);

  GetExitCodeThread(hThreadTime, dwExitCode);
  if dwExitCode <> 0 then
    TerminateThread(hThreadTime, DWORD(-1));
  CloseHandle(hThreadTime);

  GetExitCodeThread(hThreadDate, dwExitCode);
  if dwExitCode <> 0 then
    TerminateThread(hThreadDate, DWORD(-1));
  CloseHandle(hThreadDate);

  DeleteCriticalSection(CriticalSection);
end;


end.



Цитата(Romikgy @ 31.10.2005, 12:54)
ожидание какого либо события будет постоянно есть ресурс проца в потоке, в таймере будет только на момент срабатывания его.

В потоках будет тоже только на "момент срабатывания".

Автор: Romikgy 2.11.2005, 10:09
Цитата(RideX @ 1.11.2005, 19:11)
EnterCriticalSection

Естественно если это использовать то проблем нет, а я говорил о прямом доступе без критических секций, почему я и советовал почитать по потокам!!!!!!!!

Цитата(RideX @ 1.11.2005, 19:11)
В потоках будет тоже только на "момент срабатывания".

Еще раз повторюсь ВСЁ зависит от внутриностей потока

ЗЫ и давай завязывать, не продуктивный спор стал!

Автор: ФЫГ 3.11.2005, 09:35
Код

while true do begin
Application.ProcessMessages;
...
end;

цикл будет выполняться параллельно с другими потоками и пока прога не вырубится.

Powered by Invision Power Board (http://www.invisionboard.com)
© Invision Power Services (http://www.invisionpower.com)