0 / 0 / 0
Регистрация: 14.07.2015
Сообщений: 34

Delphi XE8 параллельные потоки

19.07.2015, 18:38. Показов 6413. Ответов 42
Метки нет (Все метки)

Студворк — интернет-сервис помощи студентам
Добрый день!

У меня есть две процедуры, первая
Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
Procedure TForm1.BConnectClick(Sender: TObject);
var
i, e, cnt, LastNewsWorking : integer;
EF : TXLSFile;
Archivesg:TStringGrid;
key, FileToOpen : string;
begin
  isi.Host:=LES.Text;
  isi.Port:=2000;
  isi.Destination:=isi.Host+':2000';
  sb.Panels.Items[0].Text:='';
  sb.Panels.Items[4].Text:='';
  for i := 0 to 5 do sg.Cols[i].Clear;
  if KeepAliveHelo.Enabled=true then KeepAliveHelo.Enabled:=false;
  if GetDataTimer.Enabled=true then GetDataTimer.Enabled:=false;
  cnt:=strtoint(LEdit.Text);
  SetFormat(sg);  //готовим SG
  ToConnect('rus', 120);
  GetHISN(cnt);  // получаем заголовки;
  sb.Panels.Items[0].Text:='Соединение активно, режим ожидания';
  FileToOpen := BasePath + '\' + copy(AnsiReplaceText(sg.Cells[3,1],'/','.'),4,7) + '.xls';
  if FileExists(FileToOpen) = true then LoadMessageFileOrServer(FileToOpen)
    else begin
      FileToOpen := BasePath + '\' + copy(AnsiReplaceText(sg.Cells[3,sg.RowCount-1],'/','.'),4,7) + '.xls';
      if FileExists(FileToOpen) then LoadMessageFileOrServer(FileToOpen)
         else LoadAllBodyNewsFromServer(sg, cnt);
    end;
  // проверяем поле емайл, если пустое, обрабатываем сообщение
{******************************************************************************}
  TaskSendEmail := TTask.Create(procedure()
                   var i : integer;
                   begin
                     for i := 1 to cnt do begin
                        if sg.Cells[6,i] = '' then begin
                          if (AnsiPos('NT: *', sg.Cells[4,i])>0) or
                             ((AnsiPos('NT: News:', sg.Cells[4,i])>0) and
                             (AnsiPos(UpperCase('microsoft'), UpperCase(sg.Cells[5,i])) > 0)) then begin
                             sg.Cells[6, i] := SendTransport('email@email.ru', sg.Cells[1,i] + ' - ' + sg.Cells[4,i],
                             '<div align="right">' + sg.Cells[1,i] + '</div>' +
                             sg.Cells[3,i] + '  ' + sg.Cells[2,i] + '<br><br>' +
                             '<b>' + sg.Cells[4,i] + '</b><br>' +
                             '<div align="justify">' + sg.Cells[5,i] + '</div>');
                          end else sg.Cells[6, i] := 'обработанно';
                        end;
                     end;
                   end);
  TaskSendEmail.Start;
{******************************************************************************}
  LEFPath.EditLabel.Caption:='Загрузка успешно выполненна';
  if TimerForProgressBar.Enabled=false then TimerForProgressBar.Enabled:=true;
  if KeepAliveHelo.Enabled=false then KeepAliveHelo.Enabled:=true;
  if GetDataTimer.Enabled=false then GetDataTimer.Enabled:=true;
end;
TaskSendEmail объявленна глобально как TaskSendEmail: ITask; Первая процедура создает при определенных условиях параллельный поток, результаты выполнения этого потока в программе нигде не жду, поток просто отправляет письма на емаил и все

Во второй процедуре (ниже) я проверяю состояние этого потока, строку выделил, в этой строке если поток не выполняется мне нужно выполнить указанные действия
Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
procedure TForm1.ReadOnlineData();
var
sss:string;
i, cnt:integer;
begin
  try
    repeat
      sss:=isi.ReadLn(#13#10,IndyTextEncoding_OSDefault);
      if (sss<>'') and (Pos('TC:', sss)=0) then ListNews.Add(sss);
    until sss<>'';
{******************************************************************************}
    if TaskSendEmail.Status <> TTaskStatus.Running then begin
{******************************************************************************}
      sb.Panels.Items[0].Text:='Получение данных';
        if listnews.Count>0 then begin
        isi.writeln('STOP');
        isi.Readln(#13#10);
        cnt:=ListNews.Count-1;
          for i:=0 to cnt do begin
          InsertFirstRow(sg,RebrendNews(ListNews[i],1),0);
          if sg.Cells[1,1]<>'' then isi.writeln('GET '+sg.Cells[1,1])
            else showmessage('Пустой номер сообщения. Строка = 1, Столбец = 1. Метод GET невозможен');                      //запрашиваем
          sss:=isi.Readln(inttostr(strtoint64(sg.Cells[1,1]))+#13#10);
          if pos('BAD ',sss)>0 then showmessage('Сервер сообщил об ошибке в запрос GET. Запрос GET '+sg.Cells[1,1] + '; Ответ: ' + sss);
          sss:=isi.Readln('.'+#13#10,IndyTextEncoding_OSDefault);
          sss:=AnsiReplaceText(sss,Chr(13)+Chr(10),'');  //удаляем первые две пустые строки
          sss:=AnsiReplaceText(AnsiReplaceText(AnsiReplaceText(sss,'\r\n\r\n','\r\n'), '\r',Chr(13)),'\n',Chr(10));//меняем \r\n на новую строку (№13№10)
          sg.Cells[5,1]:=sss;
          GetNewsForEmail(sg, 1);
          end;
          ListNews.Clear;
          isi.writeln('STAR');
          isi.Readln(#13#10);
          isi.WriteLn('HELO');  //-
          isi.ReadLn(#13#10);  //-
          sb.Panels.Items[0].Text:='Соединение активно, режим ожидания';
        end;
    end;
  except
    ListNews.Clear;
    sb.Panels.Items[4].Text:='Ошибка';
    sb.Panels.Items[0].Text:='Соединение прекращенно';
    if isi.connected=true then isi.Close;
    if ilf.Active then ilf.Active:=false;
    for i:= 1 to sg.RowCount-1 do if sg.Cells[1,i]='' then delrow(sg,i);
    ToConnect('rus',120);
  end;
end;
Проблема в том, что не зависимо от того выполняется поток или нет, я никогда не попадаю во второй процедуре в код после жирной строки. Подскажите что не так?
0
cpp_developer
Эксперт
20123 / 5690 / 1417
Регистрация: 09.04.2010
Сообщений: 22,546
Блог
19.07.2015, 18:38
Ответы с готовыми решениями:

Параллельные потоки с параметром Delphi
Есть задача: Есть 3 потока. Есть параметр k. Когда поток получает параметр, он начинает заполнять progressbar, до тех пор пока другой поток...

ОС на Delphi XE8
Всем привет! У меня есть вопрос! Могу ли я, если могу то как, сделать ОС на Delphi XE8! Позырил кучу форумов! Кто-то говорит можно,...

Delphi xe8 моргает
Подскажите, из-за чего может моргать изображение при repaint? И моргает именно на ноутбуке, на стационарах (достаточно старых) не моргает...

42
пофигист широкого профиля
4770 / 3207 / 862
Регистрация: 15.07.2013
Сообщений: 18,615
14.09.2015, 00:46
Студворк — интернет-сервис помощи студентам
Цитата Сообщение от mister88888 Посмотреть сообщение
А как уничтожать через TheTHWork.Destroy или FreeAndNil(TheTHWork) ?
FreeAndNil
Явно вызывать метод Destroy просто некошерно.
0
61 / 51 / 25
Регистрация: 17.12.2013
Сообщений: 258
14.09.2015, 03:53
Если я присвою значение переменной А переменной Б, то они конечно же будут равны. НО! ЭТО ВСЕРАВНО БУДУТ РАЗНЫЕ СУЩНОСТИ ПРОГРАММЫ. Если я после этого инкреминирую переменную А, то они перестанут быть равными.

А в случае работы с классами дельфи все работает несколько по другому. Если я объявляю переменную А с типом МойКласс, то эта переменная содержит нил до инициализации этого экземпляра класса конструктором.
После этого Переменная А по сути содержит указатель на экземпляр класса МойКласс.
Если я после этого присваиваю значение переменной А переменной Б, то присваивается указатель.
И переменные А и Б по сути будут ссылаться на одну и ту же сущность программы, на один и тот же экземпляр класса МойКласс.

Так доступно?
1
3530 / 2270 / 279
Регистрация: 24.12.2010
Сообщений: 13,723
14.09.2015, 08:19
по барабану как..
но по феньшую TheTHWork.Free или FreeAndNil(TheTHWork), в зависимости от контекста использования переменной TheTHWork
1
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
raxper
Эксперт
30234 / 6612 / 1498
Регистрация: 28.12.2010
Сообщений: 21,154
Блог
14.09.2015, 08:19

Как активировать Delphi xe8?
Запуск от имени администратора не помогает(

Не открывается проект в Delphi XE8
Ребята, вот есть готовый проект. На ранних версиях XE работает. На XE5 и выше не работает. Не знаю уже даже что и делать. Кто опытнее...

Возможности и преимущества среды delphi xe8
Кто нибудь может рассказать об delphi xe8, о его особенностях и возможностях , или ссылки на ресурсы , желательно русскоязычные.

Не могу установить ZLibExGZ Delphi XE8
В общем проблема в шапке, может кто помочь ?. Лучше если есть у кого-то мануал по установке.

CodeSite в Delphi XE8, не работает CodeSiteLogging
Скажите, почему при подключении модуля CodeSiteLogging, Delphi его не находит?


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
43
Ответ Создать тему
Опции темы

Новые блоги и статьи
Программа опроса у.з. расходомера SLS-720F
Argus19 02.09.2026
Программа опроса у. з. расходомера SLS-720F Программа опрашивает один раз в минуту три ультразвуковых расходомера SLS-720F через интерфейс RS-485 по протоколу Modbus RTU. Опрашиваются регистры. . .
Hyper-V: Компьютер должен поддерживать доверенный платформенный модуль 2.0.
Maks 31.08.2026
При установке Windows 11 на виртуальную машину Hyper-V 2-го поколения вылезла такая ошибка: Решение: в параметрах виртуальной машины, в разделе "Безопасность" (Security) активировать флаг. . .
Архитектура биовида Стива в Майнкрафте: Зачем бонобо кубический каннибализм
anaschu 30.08.2026
Кубический Вагинокапитализм в Minecraft: Математический инвариант ОДУ и рок Стивов-бонобо Главная задача разработанной «Модели Всего» — наглядно продемонстрировать наличие системной «судьбы». . .
Оттачиваю умение писать js программы.
russiannick 30.08.2026
Проектом выходного дня стало написание Книги шифров Виженера. Итогом стала версия 200, синий туман. Синий туман назван так, потому что замораживает текст под собой. Нажатие синих кнопок управляют. . .
мат медиц модель 30. презентация проекта
anaschu 27.08.2026
хоп хоп хоп хидахоп, а я кладую))
Как у меня протекала болезнь
zorxor 27.08.2026
Здравствуйте, друзья! Эта запись блога предназначена именно для вас - для моих дорогих друзей, которые знали меня лично. Чтобы ответить на вопрос - а что же со мной произошло на самом деле? Я учился. . .
Нашел вот забавное видео о измерениях. Лучшее что я видел на эту тему
kumehtar 26.08.2026
ILETXiw9bMQ Основная суть и тезисы по измерениям: 0D (Нулевое измерение): точка, не имеющая длины, ширины, высоты или объема. Объект не может перемещаться в 0D. 1D (Первое измерение):. . .
[EasyBuilder Pro] Памятка по разработке для панелей Weintek
ФедосеевПавел 26.08.2026
Памятка по разработке для панелей Weintek ВВЕДЕНИЕ Ранее, при реализации проектов основное внимание уделял разработке управляющей программы для контроллера, а панели оператора доставалось время. . .
КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin
Copyright ©2000 - 2026, CyberForum.ru