[seeman_tm]

Собственно вот в чём заморочка.
Создал проэкт программы, в которой не используются формы (тобишь без оконное приложение) и удалил 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 ?

[M.A.D.M.A.N.]

Бряк на begin в execute поставь и посмотри, попадает туда или нет.
Так-то вроде не видно ошибок .

[seeman_tm]

Сообщение от M.A.D.M.A.N.

Бряк на begin в execute поставь и посмотри, попадает туда или нет.
Так-то вроде не видно ошибок .

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

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

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

[M.A.D.M.A.N.]

Код:

procedure TCPServerTCP.Execute;
var
  IP: TIPSocket;
  IPInfo: IPData;
begin  <<< вот сюда точку останова (клавиша F5), запустись по F9 и подожди, когда сюда отладчик прыгнет
  ShowMessage('Thread is work');

Вместо Showmessage лучше MessageBox вывести.

[NumLock]

не надо не в 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.

[seeman_tm]

NumLock, поменял ShowMessage на MessageBox в юните unit ServerTCP;
и всё заработало как было задумано.
Можешь объяснить такую штуку ? Почему

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

? Чем это чревато ?

[NumLock]

он связан с Application. его синхронизация к примеру.

[seeman_tm]

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

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

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

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

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

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

[seeman_tm]

Возник вопрос по 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;

[M.A.D.M.A.N.]

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

[Bargest]

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

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

[seeman_tm]

Сообщение от Bargest

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

Всё бы ничего, но вот у моего сервера нет Handle, он у меня как процесс в винде сидит, без всяких визуалок. Поэтому Неблокирующий режим не подходит.

[Bargest]

Эм. А где связь? Неблокирующий режим назначается сокету. Я сам делал неблокирующие сервера без визуалок. ioctlsocket, select. И все дела.

[seeman_tm]

Сообщение от M.A.D.M.A.N.

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

Ха, гениально. Вот тока это не поможет. Сам то работал с WinSock ?
Если сделать вход в функцию, то из неё только два выхода, 1. Подключился клиент. 2. Вывалилась ошибка.
Поток завершай не завершай, если ошибок нет, то он всё равно будет работать пока кто нить не подключится. После вызова Terminate, поток пашет до тех пор пока не подключится клиент, после чего поток сразу завершается, но ни как не раньше.

[seeman_tm]

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

Код:

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, начинает слать в прогу события произошедшие на сокете.