Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > Разное
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 08.02.2013, 00:28
Аватар для seeman_tm
seeman_tm seeman_tm вне форума
Новичок
 
Регистрация: 03.02.2011
Сообщения: 79
Репутация: -2306
По умолчанию Не выполняется Thread в юните без форменной программы

Собственно вот в чём заморочка.
Создал проэкт программы, в которой не используются формы (тобишь без оконное приложение) и удалил Form из Uses.
Далее объявил класс потока в юните таким образом.

Код:
unit ServerTCP;

interface

Uses Classes, Sockets, Dialogs;


Type
  TCPServerTCP = Class(TThread)
Protected
Procedure Execute; Override;
Private
Public
  End;

type
  IPData = packed record
    LocalDomainName: WideString;
    LocalHostAddr: WideString;
    LocalHostName: WideString;
    LocalHost: WideString;
    LocalPort: WideString;
    BytesReceived: Integer;
    BytesSent: Integer;
end;


implementation

{ TCPServerTCP }

procedure TCPServerTCP.Execute;
var
  IP: TIPSocket;
  IPInfo: IPData;
begin
  ShowMessage('Thread is work');
Try
    IP := TIPSocket.Create(nil);
    IPInfo.LocalHost := IP.LocalHost;
    IPInfo.LocalPort := IP.LocalPort;
Finally
    IP.Free;
End;


while Not Terminated do
Begin


End;

end;

end.

В основной программе подключил юнит.
Объявил переменную.
Код:
Uses   ServerTCP in 'ServerTCP.pas';{Все подключаемые модули приводить не стану.}
var
  Server: TThread;
 

Далее создаю поток в программе.
Код:
          if (Server = Nil) then
          Begin
          Server := TCPServerTCP.Create(False){Не важно что здесь стоит, True с последующим Server.Resume;  ли  только False};
          DataSend := 'Server to started.';
          for I := 1 to LenGth(DataSend) do Data[i-1] := Byte(MidStr(DataSend,i,1)[1]);
          SendToIP(Data, LenGth(DataSend),string(inet_ntoa(from.sin_addr)));
          End;
Поток создаётся и якобы работает.
Дык вот, так же не имеет значения сколько основная программа будет работать, сообщение 'Thread is work' не появится до тех пор, пока не вызову завершение потока вот так.
Код:
          If Not (Server = Nil) then
          Begin
          Server.Terminate;
          Server.Free;
          DataSend := 'Server to stopped.';
          for I := 1 to LenGth(DataSend) do Data[i-1] := Byte(MidStr(DataSend,i,1)[1]);
          SendToIP(Data, LenGth(DataSend),string(inet_ntoa(from.sin_addr)));
          End;

В чём беда ? Читал где то что вот якобы поток выполняется определённый системой квант времени. Но как этот квант ему дать ?
Ни кто не работал с потоками в программе без использования TForm ?

Последний раз редактировалось seeman_tm, 08.02.2013 в 03:23.
Ответить с цитированием
  #2  
Старый 08.02.2013, 07:23
Аватар для M.A.D.M.A.N.
M.A.D.M.A.N. M.A.D.M.A.N. вне форума
Sir Richard Abramson
 
Регистрация: 05.04.2008
Сообщения: 5,505
Версия Delphi: XE10
Репутация: выкл
По умолчанию

Бряк на begin в execute поставь и посмотри, попадает туда или нет.
Так-то вроде не видно ошибок .
__________________
— Как тебя понимать?
— Понимать меня не обязательно. Обязательно меня любить и кормить вовремя.


На Delphi, увы, больше не программирую.
Рекомендуемая литература по программированию
Ответить с цитированием
  #3  
Старый 08.02.2013, 08:46
Аватар для seeman_tm
seeman_tm seeman_tm вне форума
Новичок
 
Регистрация: 03.02.2011
Сообщения: 79
Репутация: -2306
По умолчанию

Цитата:
Сообщение от M.A.D.M.A.N.
Бряк на begin в execute поставь и посмотри, попадает туда или нет.
Так-то вроде не видно ошибок .

Не могу догнать, на какой бегин и чё поставить ?
Вообще то прога работает, она у меня принимает юдп пакеты, делает определённые действия и отправляет ответ о ходе выполненных действиях, в частности то что "поток будущего TCP сервера создан", "его айпи такой то", "поток будущего TCP сервера завершен" и так же откликается на завершение вообще всей программы.

Загвоздка в другом, процедура Execute у потока не выводит сообщение о том что он работает после его создания, пока не сделаешь вызов Server.Terminate.

Что самое интересное, так это то, что если в код программы поставить {$APPTYPE CONSOLE} то и поток начинает работать сразу после его создания, только вот чёрное окно MSDos'a ни к чему.
Могу выложить полный код программы и модуля если надо, секрета тут нет.

Последний раз редактировалось seeman_tm, 08.02.2013 в 08:59.
Ответить с цитированием
  #4  
Старый 08.02.2013, 09:31
Аватар для M.A.D.M.A.N.
M.A.D.M.A.N. M.A.D.M.A.N. вне форума
Sir Richard Abramson
 
Регистрация: 05.04.2008
Сообщения: 5,505
Версия Delphi: XE10
Репутация: выкл
По умолчанию

Код:
procedure TCPServerTCP.Execute;
var
  IP: TIPSocket;
  IPInfo: IPData;
begin  <<< вот сюда точку останова (клавиша F5), запустись по F9 и подожди, когда сюда отладчик прыгнет
  ShowMessage('Thread is work');
Вместо Showmessage лучше MessageBox вывести.
__________________
— Как тебя понимать?
— Понимать меня не обязательно. Обязательно меня любить и кормить вовремя.


На Delphi, увы, больше не программирую.
Рекомендуемая литература по программированию
Ответить с цитированием
  #5  
Старый 08.02.2013, 09:50
Аватар для NumLock
NumLock NumLock вне форума
Let Me Show You
 
Регистрация: 30.04.2010
Адрес: Северодвинск
Сообщения: 5,426
Версия Delphi: 7, XE5
Репутация: 59586
По умолчанию

не надо не в VCL приложении использовать TThread и VCL диалоги.

Код:
program Project1;

uses
  Windows, Messages;

function ThreadProc(Thread: Pointer): Integer;
begin
  Result:=0;
  Windows.Beep(1000, 100);
  MessageBox(0, 'MessageBox', 'ThreadProc', MB_OK);
  EndThread(0);
end;

var
  FHandle: THandle;
  FThreadID: THandle;

begin
  FHandle := BeginThread(nil, 0, @ThreadProc, nil, 0, FThreadID);
  WaitForSingleObject(FHandle, INFINITE);
  CloseHandle(FHandle);
end.
__________________
Пишу программы за еду.
__________________
Ответить с цитированием
  #6  
Старый 08.02.2013, 15:41
Аватар для seeman_tm
seeman_tm seeman_tm вне форума
Новичок
 
Регистрация: 03.02.2011
Сообщения: 79
Репутация: -2306
По умолчанию

NumLock, поменял ShowMessage на MessageBox в юните unit ServerTCP;
и всё заработало как было задумано.
Можешь объяснить такую штуку ? Почему
Цитата:
не надо не в VCL приложении использовать TThread
? Чем это чревато ?
Ответить с цитированием
  #7  
Старый 08.02.2013, 15:54
Аватар для NumLock
NumLock NumLock вне форума
Let Me Show You
 
Регистрация: 30.04.2010
Адрес: Северодвинск
Сообщения: 5,426
Версия Delphi: 7, XE5
Репутация: 59586
По умолчанию

он связан с Application. его синхронизация к примеру.
__________________
Пишу программы за еду.
__________________
Ответить с цитированием
  #8  
Старый 08.02.2013, 17:43
Аватар для seeman_tm
seeman_tm seeman_tm вне форума
Новичок
 
Регистрация: 03.02.2011
Сообщения: 79
Репутация: -2306
По умолчанию

Так мне синхронизация ни к чему.
Этот поток не будет ни коим образом, кроме создания и завершения, взаимодействовать с основной программой. Так же не будет в будущем выводить ни какие сообщения.
Цель потока, создание компонента TCPServer, обслуживание запросов подключенного пользователя.
Проще сказать, это будет подобие прокси сервера, через который будет осуществляться запрос и подключение интернет страниц.

Вот как я это вижу.
1. При запуске программы создаётся UDP сокет. Который при получение на свой порт определённого сообщения создаёт или завершает поток TCP Сервера, отвечает на запрос айпи сервера, а так же завершает программу совсем по запросу клиента. Так же через UDP оправляется ответ о выполненном действии. {Первый пункт выполнен}.

2. При создании потока TCP Сервера, поток создаёт компонент TCPServer и начинает ожидать подключения TCP клиента. После подключения клиента читает поля HTTP пакета полученного от клиента, в частности поле Host, создаёт поток другого TCP клиента и передаёт в него полученный от клиента пакет со значением Host. Ожидает получения данных от созданного потока TCP клиента.

3. Созданный поток TCP клиента в свою очередь, Подключается к серверу указанному в Host, переотправляет полученный пакет. Собирает все пакеты которыми ответил HTTP сервер и возвращает их TCP серверу.

4. После получения данных от потока TCP клиента, поток TCP Сервера переотправляет их уже подключенному к нему клиенту.

Советы по реализации какие нибудь будут ?

Последний раз редактировалось seeman_tm, 08.02.2013 в 17:46.
Ответить с цитированием
  #9  
Старый 11.02.2013, 02:01
Аватар для seeman_tm
seeman_tm seeman_tm вне форума
Новичок
 
Регистрация: 03.02.2011
Сообщения: 79
Репутация: -2306
По умолчанию

Возник вопрос по Accept модуля WinSock.
Проблема в том, что функция
Код:
sClient := Accept(sServerListen, @ClientAddr, @iSize);

Останавливает выполнение потока на себе до тех пор, пока какой нить клиент не подключится к серверу.
Как можно ограничить по времени выполнение вышеуказанной функции ?

Вот код потока ожидающего подключения клиентов.
Код:
Procedure TServerThread.Execute;
Var
   wData: WSADATA;
   sServerListen, sClient: TSOCKET;
   LocalAddr, ClientAddr: SockAddr_in;
   iSize: Integer;
   sl: TCPClientThread;
Begin
// Загрузка WinSock
if WSAStartup(MAKEWORD(1,1), wData) <> 0 then
                                        Begin
                                          MessageBox(0,'Не удалось загрузить WinSock.','Ошибка.',0);
                                          Exit;
                                        End;

// Создание сокета
sServerListen := Socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
if sServerListen = INVALID_SOCKET then
                                  Begin
                                    MessageBox(0,'Ошибка создания сокета.','Ошибка.',0);
                                    Exit;
                                  end;

// Заполнение структуры адреса
LocalAddr.sin_addr.S_addr := HTONL(INADDR_ANY);
LocalAddr.sin_family := AF_INET;
LocalAddr.sin_port := HTONS(2990);

// Связывание сокета с локальным адресом
if bind(sServerListen, LocalAddr, SizeOf(LocalAddr)) = SOCKET_ERROR then
                                       Begin
                                         TestWinSockError('Bind');
                                         Exit;
                                       End;
// Прослушивание
if TestFuncError(Listen(sServerListen,4), 'Listen') then Exit;

while not Terminated do
  Begin
     iSize := SizeOf(ClientAddr);
     // Приём нового соединения
     sClient := Accept(sServerListen, @ClientAddr, @iSize);
     if sClient = INVALID_SOCKET then
                                 Begin
                                 TestWinSockError('accept');
                                 Break;
                                 end
                                 Else
                                 Begin
     // Соединение принято, создаём поток
     sl := TCPClientThread.Create(True);
     sl.Sock := sClient;
     sl.Resume;
                                 End;
 End;
sl.Terminate;
sl.WaitFor;
FreeAndNil(sl);
CloseSocket(sServerListen);
end;
Ответить с цитированием
  #10  
Старый 11.02.2013, 07:50
Аватар для M.A.D.M.A.N.
M.A.D.M.A.N. M.A.D.M.A.N. вне форума
Sir Richard Abramson
 
Регистрация: 05.04.2008
Сообщения: 5,505
Версия Delphi: XE10
Репутация: выкл
По умолчанию

Немного не в тему, но можно вытащить ф-ю в отдельный поток, пусть его тормозит.
__________________
— Как тебя понимать?
— Понимать меня не обязательно. Обязательно меня любить и кормить вовремя.


На Delphi, увы, больше не программирую.
Рекомендуемая литература по программированию

Последний раз редактировалось M.A.D.M.A.N., 11.02.2013 в 07:53.
Ответить с цитированием
  #11  
Старый 11.02.2013, 13:49
Аватар для Bargest
Bargest Bargest вне форума
Профессионал
 
Регистрация: 19.10.2010
Адрес: Москва
Сообщения: 2,390
Версия Delphi: XE3/VS12/FASM
Репутация: 14665
По умолчанию

Цитата:
Останавливает выполнение потока на себе до тех пор, пока какой нить клиент не подключится к серверу.
Как можно ограничить по времени выполнение вышеуказанной функции ?
Неблокирующий режим сокетов, select с тайм-аутом.
__________________
jmp $ ; Happy End!
The Cake Is A Lie.
Ответить с цитированием
  #12  
Старый 11.02.2013, 21:34
Аватар для seeman_tm
seeman_tm seeman_tm вне форума
Новичок
 
Регистрация: 03.02.2011
Сообщения: 79
Репутация: -2306
По умолчанию

Цитата:
Сообщение от Bargest
Неблокирующий режим сокетов, select с тайм-аутом.

Всё бы ничего, но вот у моего сервера нет Handle, он у меня как процесс в винде сидит, без всяких визуалок. Поэтому Неблокирующий режим не подходит.
Ответить с цитированием
  #13  
Старый 11.02.2013, 21:37
Аватар для Bargest
Bargest Bargest вне форума
Профессионал
 
Регистрация: 19.10.2010
Адрес: Москва
Сообщения: 2,390
Версия Delphi: XE3/VS12/FASM
Репутация: 14665
По умолчанию

Эм. А где связь? Неблокирующий режим назначается сокету. Я сам делал неблокирующие сервера без визуалок. ioctlsocket, select. И все дела.
__________________
jmp $ ; Happy End!
The Cake Is A Lie.
Ответить с цитированием
  #14  
Старый 11.02.2013, 21:41
Аватар для seeman_tm
seeman_tm seeman_tm вне форума
Новичок
 
Регистрация: 03.02.2011
Сообщения: 79
Репутация: -2306
По умолчанию

Цитата:
Сообщение от M.A.D.M.A.N.
Немного не в тему, но можно вытащить ф-ю в отдельный поток, пусть его тормозит.

Ха, гениально. Вот тока это не поможет. Сам то работал с WinSock ?
Если сделать вход в функцию, то из неё только два выхода, 1. Подключился клиент. 2. Вывалилась ошибка.
Поток завершай не завершай, если ошибок нет, то он всё равно будет работать пока кто нить не подключится. После вызова Terminate, поток пашет до тех пор пока не подключится клиент, после чего поток сразу завершается, но ни как не раньше.
Ответить с цитированием
  #15  
Старый 11.02.2013, 21:45
Аватар для seeman_tm
seeman_tm seeman_tm вне форума
Новичок
 
Регистрация: 03.02.2011
Сообщения: 79
Репутация: -2306
По умолчанию

Вот обработчик сообщений в проге.

Код:
procedure TServerThread.WM_NetMsg(var M: TMessage);
Var
    ClientSocket: TSOCKET;
    iRet: Integer;
    sRecvBuff: Array [0..1023] Of Byte;
    sSendString, CH: String;
    I: Integer;
begin
    case M.LParam Of
    // Прибыл запрос на соединение
    FD_ACCEPT:
      Begin
         MessageBox(0,'Ошибка получения данных.','Внимание !!!',0);
        ClientSocket := Accept(M.WParam,nil, nil);
        WSAAsyncSelect(ClientSocket, Handle, WM_USER+1,
                                  FD_READ {or FD_WRITE} or FD_CLOSE);
      End;
    // Прибыли данные
    FD_READ:
      Begin
        iRet := recv(M.WParam, sRecvBuff,SizeOf(sRecvBuff),0);
        if (iRet = SOCKET_ERROR) then
          Begin
           MessageBox(0,'Ошибка получения данных.','Внимание !!!',0);
           Exit;
          End;
          for i := 0 to iRet-1 do sSendString := sSendString + chr(sRecvBuff[i]);
          if sSendString[LenGth(sSendString)] = chr($10) then
          sSendString:= Copy(sSendString,1,LenGth(sSendString)-2);
          if sSendString <> 'get' then Exit;
          sSendString := 'Command Get - OK';
          for I := 1 to LenGth(sSendString) do
              Begin
                CH := sSendString[i];
                sREcvBuff[i-1] := Byte(CH[1]);
              End;
          iRet := send(M.WParam, sRecvBuff, LenGth(sSendString),0);
          if (iRet = SOCKET_ERROR) then
            Begin
              MessageBox(0,'Ошибка передачи данных.','Внимание !!!',0);
              Exit;
            End;
      End;
      // Сокет закрыт
      FD_CLOSE:
        Begin
          CloseSocket(M.WParam);
        End;
    end;
end;
Цитата:
Сообщение от Bargest
Эм. А где связь? Неблокирующий режим назначается сокету. Я сам делал неблокирующие сервера без визуалок. ioctlsocket, select. И все дела.

Приведи пример как делал. Потому что я нашел только такое использование. Там сама винда, якобы, через Message, начинает слать в прогу события произошедшие на сокете.

Последний раз редактировалось seeman_tm, 11.02.2013 в 21:50.
Ответить с цитированием
Ответ


Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 11:59.


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2023

ВКонтакте   Facebook   Twitter