Topic: процедура по таймеру

процедуры по таумеру тормозят программу
как с этим справиться?

procedure timerklient (Sender: TObject);
var
list:TStringList;
i,c,timeer:integer;
begin
list:=TStringList.Create;
list.Text:= SQLExecute( 'SELECT group_concat(id, char(13) || char(10)) FROM users WHERE online=1' );
c:=list.Count-1;
if SQLExecute('SELECT count(id) FROM users')='0' then SQLExecute('UPDATE users SET driver="1" WHERE id='+ userIDs);
if SQLExecute('SELECT driver FROM users WHERE id='+ userIDs)='1' then begin
for i:=0 to c do
  begin
  if (SQLExecute('SELECT IFNULL(onDate,0) FROM users WHERE id='+list[i])<> '0') then begin
    timeer:= StrToInt (SQLExecute('SELECT  strftime(''%M%S'',''now'') - strftime(''%M%S'',onDate) FROM users WHERE id='+list[i]));
      if (timeer >= 60) OR (timeer < 0) then SQLExecute('UPDATE users SET online="0" WHERE id='+list[i]);
  end else SQLExecute('UPDATE users SET online="0" WHERE id='+list[i]);
  end;
end else begin
   ShowMessage(SQLExecute('SELECT onDate FROM users WHERE id=1'));
   timeer:= StrToInt (SQLExecute('SELECT  strftime(''%M%S'',''now'') - strftime(''%M%S'',onDate) FROM users WHERE driver=1'));
   if (timeer >= 60) OR (timeer < 0) then SQLExecute('UPDATE users SET driver="0" WHERE driver=1');
end;
list.Free;
end;

procedure  timerserveroff (Sender: TObject);
begin
if SQLExecute('SELECT count(id) FROM users WHERE driver=1')='0' then SQLExecute('UPDATE users SET driver="1" WHERE id='+userIDs);
if SQLExecute('SELECT online FROM users WHERE id='+userIDs)='1' then begin
 if SQLExecute('SELECT online FROM users WHERE id=1')='0' then
 begin
 if IDOK = MessageBox ('Ошибка подключения, программа будет закрыта.','Ошибка подключения!',MB_OK+MB_ICONINFORMATION)then
      begin
        frmLogin.Close;
      end;
   end;
if (SQLExecute('SELECT count(id) FROM blocip WHERE ip='''+ipuser+'''')<>'0')then
  begin
   if IDOK = MessageBox ('Ваш IP заблакирован, программа будет закрыта.','Ошибка подключения!',MB_OK+MB_ICONINFORMATION)then
      begin
        frmLogin.Close;
      end;
   end;
if (SQLExecute('SELECT count(id) FROM bloclogin WHERE login=''' +frmLogin.cbStatus.Text+'''')<>'0')then
  begin
   if IDOK = MessageBox ('Ваш логин заблакирован, программа будет закрыта.','Ошибка подключения!',MB_OK+MB_ICONINFORMATION)then
      begin
        frmLogin.Close;
      end;
   end;
    SQLExecute('UPDATE users SET onDate=datetime(''now'') WHERE id='+userIDs);
end else begin
 IF IDOK = MessageBox('Приграмма будет закрыта','Ошибка соединения ', MB_OK+MB_ICONINFORMATION)then frmLogin.Close;
end;
frmAdmin.tgUsersl.dbUpdate;
frmAdmin.tgLog.dbUpdate;
end;

Re: процедура по таймеру

я так понимаю мне нужно это
http://www.delphi-manual.ru/threads.php
но MyThread не поддерживается

Re: процедура по таймеру

Увы никак, действительно необходим отдельный поток.


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

Dmitry.

4 (edited by sibprogsistem 2019-11-07 11:34:26)

Re: процедура по таймеру

DriveSoft wrote:

Увы никак, действительно необходим отдельный поток.


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

тоесть использовать OLEObject
загрузить в него второй проект

Re: процедура по таймеру

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


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

Dmitry.