TclientSocket в приложении, не имеющей ни одной формы

← →
LEONardo (2004-07-02 12:01) [0]

Как сделать так, чтобы в приложении, не имеющей ни одной формы(Tform) у компонента, создаваемого динамически (TclientSocket) вызывались соответсвующие методы, например, OnSocketErrorEvent,Onconnection и т.п.
Заранее благодарен!

← →
Reindeer Moss Eater © (2004-07-02 12:05) [1]

не методы а события.
А вызываются они только если свойства OnSomething <> nil;

← →
Reindeer Moss Eater © (2004-07-02 12:06) [2]

Чтобы был вызван обработчик (сгененрировалось событие) свойство OnСобытие не должно быть равно nil.

← →
LEONardo (2004-07-02 12:09) [3]

Ок.
Но в конмольном приложении вообщее накакое собітие не візівается!

← →
Reindeer Moss Eater © (2004-07-02 12:10) [4]

Потому что смотри пункт 2

← →
LEONardo (2004-07-02 12:12) [5]

Да на OnError:=socError;
где SocError:TSocketErrorEvent;

procedure SocError(..);
begin
ErrorCode:=0;
end;

Все равно ниче не вызывается

← →
LEONardo (2004-07-02 12:14) [6]

Повторюсь, это приложение БЕЗ ФОРМ
Я не обрабатываю сообщения Tapplication.ProcessMessages
Да и он не чего не дает, пробовал

← →
Iraizor © (2004-07-02 12:15) [7]

самый тупой способ - бесконечный цикл с поочередной проверкой всех событий.Может даже сработает =)

← →
Reindeer Moss Eater © (2004-07-02 12:16) [8]

А ему окно не нужно, этому tclientsocket?

← →
LEONardo (2004-07-02 12:19) [9]

Во первых, в цикл ставил
while Connect in [true,false] do
if connect then
ProcessMessages else
Client.open;

Ни чего только гимморой с весом файла (uses FORMS)

Окна вроде нет

← →
Iraizor © (2004-07-02 12:32) [10]

Я имел ввиду что-то вроде этого
while true do begin if onconnect <>nil then Proc1; if OnRead<>nil then Proc2; etc... end;

← →
Reindeer Moss Eater © (2004-07-02 12:34) [11]

А зачем вообще использовать событийную модель в консольном приложении?

Блокирующий режим и процедурный подход.
Зачем извраты?

← →
LEONardo (2004-07-02 12:37) [12]

Подскажите как обойти этот ИЗВРАТ

← →
Reindeer Moss Eater © (2004-07-02 12:37) [13]

Блокирующий режим сокета и процедурный подход.

← →
Digitman © (2004-07-02 12:39) [14]

> LEONardo (02.07.04 12:19) [9]
> Окна вроде нет

если ClientType = ctNonBlocking, окно есть .. причем вне зависимости от того, видишь ты его или не видишь

а раз есть окно. то и цикл ожидания/выборки/диспетчеризации оконных сообщений должен быть реализован .. поскольку ты отказываешься от модуля forms, ты должен организовать этот цикл "ручками"

← →
LEONardo (2004-07-02 12:41) [15]

Чтото тут не так
ну ладно, спасибо..
Загляните пожалуйста в мое второе сообщение,
ЖДУ

← →
Digitman © (2004-07-02 12:44) [16]

> Чтото тут не так

ЧТО не так ?

← →
Григорьев Антон © (2004-07-03 07:37) [17]

Событие вызывается через оконную процедуру. Оконная процедура связана с определённым окном и вызывается через петлю сообщений. Класс TClientSocket создаёт невидимое окно с подходящей оконной процедурой, поэтому форма для использования его событий не нужна. Но в консольном приложении нет петли сообщений, через которую может быть вызвана эта процедура. Можно сделать эту петлю руками, но это нарушит логику работы программы. Для консольных приложений лучше использовать WinSock API напрямую, без классов VCL. См., например, http://www.delphikingdom.com/asp/viewitem.asp?catalogid=1021

← →
Polevi © (2004-07-03 11:19) [18]

>Можно сделать эту петлю руками, но это нарушит логику работы программы
???

← →
atruhin (2004-07-03 11:31) [19]

А ввобще не мучайся пиши на API один раз разберешся потом иногда даже короче и проще чем с ClientSocket получается. Например посылка комманды клиенту с ожиданием подтверждения:

function TForm1.SendClient(_IP : string; _Msg: string; _WaitOK : boolean): boolean;
const
MAX_PACKET_SIZE = 255;
var
buf : array [0..MAX_PACKET_SIZE] of char;
FSocket:TSocket; // Принимающий серверный сокет
SockAddrIn: TSockAddrIn;
Len : integer;
FDSet:TFDSet;
TV : TTimeVal;
WaitResult: DWORD;
i : Integer;
arg: u_long;
begin
_Msg := _Msg +#13#10;
Result := false;
tV.tv_sec := 1;
tv.tv_usec := 0;
FSocket := socket(PF_INET, SOCK_STREAM, IPPROTO_TCP);
if FSocket = INVALID_SOCKET then exit;
SockAddrIn.sin_family := PF_INET;
SockAddrIn.sin_addr.s_addr := inet_addr(PChar(_IP));
SockAddrIn.sin_port := htons(17001);
if connect(FSocket, @SockAddrIn, SizeOf(SockAddrIn))<>SOCKET_ERROR then begin
FD_Zero(FDSet);
FD_Set(FSocket,FDSet);
// Проверка готовности сокетов
if Select(0,nil,@FDSet,nil,@tv) > 0 then
if FD_IsSet(FSocket,FDSet) then begin
Len := Send(FSocket,_Msg[1],length(_Msg),0);
if Len = length(_Msg) then begin
if _WaitOK then begin
for i := 1 to 10 do begin
arg := 0;
if IOCtlSocket(FSocket, FIONRead, arg) <> 0 then break;
if arg > 0 then Result := true;
sleep(200);
end;
end else result := true;
end;
end;
end;
shutdown(FSocket,2);
closesocket(FSocket);
if not Result then ShowMessage("Ошибка передачи комманды на IP - "+_IP);
end;

← →
Digitman © (2004-07-03 12:04) [20]

> Григорьев Антон © (03.07.04 07:37) [17]

> Можно сделать эту петлю руками, но это нарушит логику работы
> программы

ну ерунду ведь городишь

> Для консольных приложений лучше использовать WinSock API
> напрямую, без классов VCL

где ты увидел четкие аргументированные критерии того, что "лучше", а что "хуже" в конс.приложении ?

← →
Григорьев Антон © (2004-07-03 12:39) [21]

> Digitman © (03.07.04 12:04) [20]
>
> > Григорьев Антон © (03.07.04 07:37) [17]
>
>
>
> > Можно сделать эту петлю руками, но это нарушит логику
> работы
> > программы
>
>
> ну ерунду ведь городишь

Что конкретно ты называешь ерундой? Какой из этих пунктов:

1. Петлю сообщений можно сделать в консольном приложении самостоятельно, с помощью GetMessage и DispatchMessage.

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

> где ты увидел четкие аргументированные критерии того, что
> "лучше", а что "хуже" в конс.приложении ?

То же самое: асинхронные сокеты, ктороые реализует TClientSocket, рассчитаны на событийно-ориентрованную структуру программы, а для консольной с её последовательным исполнением естественнее синхронные сокеты (хотя и асинхронные при желании тоже можно задействовать).

← →
Digitman © (2004-07-03 12:59) [22]

> Григорьев Антон © (03.07.04 12:39) [21]

ничто не препятствует организовать в конс.приложении асинхронную событийно-ориентированную логику .. и никакого нонсенса или криминала в такой логике не будет

в самом простом случае, когда одновременно требуется и синхронный консольный ввод/вывод и асинхронная событийно-ориентированная логика - это создать доп.трэд, в котором и окна будут, и петля будет, и все что душе угодно понаворотить там можно... осн.трэд же при этом преспокойно занимается конс.вводом/выводом с пом. традиционных синхронных ReadLn/WriteLn ... так что одно другому никак не мешает и не противоречит .. и никаких "нарушений"

> Digitman © (03.07.04 12:59) [22]

Ничего не препятсвует - согласен. Но это когда с нуля программа пишется. А когда есть уже наполовину написанная, где всё делается последовательно, и вдруг в неё надо встроить бесконечный (почти) цикл обработки, переделка программы может оказаться не очень приятным делом. Именно это я и имел ввиду с самого начала.

И, ИМХО, в консольных приложениях гораздо удобнее использовать асинхронные сокеты через WSAEventSelect, а не через WSAAsyncSelect - не нужны ни окна, ни петли сообщений, только простейшая дополнительная нить. Но VCL такие сокеты не поддерживает.

> Григорьев Антон © (03.07.04 13:26) [23]

> ИМХО, в консольных приложениях гораздо удобнее использовать
> асинхронные сокеты через WSAEventSelect, а не через WSAAsyncSelect
> - не нужны ни окна, ни петли сообщений, только простейшая
> дополнительная нить. Но VCL такие сокеты не поддерживает.

не спорю
но здесь несколько иной случай - предположим, автор захотел использовать к консоли готовый класс TClientSocket, и при этом его посетила блажь использовать объект оного класса именно в режиме ctNonBlocking ... никаких препятствий к этому в принципе нет, как понимаешь ... но без доп.трэда в этом случае никак не обойтись, если нужна одновременная реакция консоли на польз. ввод/вывод .. ну а раз доп.трэд начинает фигурировать да еще и окна в нем создаются как факт, то реализовать там петлю - проще простого ..

шаблон :

type TMyThread = class(TThread) private FAddress: string; FPort: Integer; FClientSocket: TClientSocket; protected procedure DoConnect(Sender: TObject; Socket: TCustomWinSocket); virtual; procedure DoDisconnect(Sender: TObject; Socket: TCustomWinSocket); virtual; procedure DoError(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer); virtual; procedure DoRead(Sender: TObject; Socket: TCustomWinSocket); virtual; procedure DoWrite(Sender: TObject; Socket: TCustomWinSocket); virtual; public constructor Create(Address: String; Port: Integer); destructor Destroy; override; end; constructor TMyThread.Create(Address: String; Port: Integer); begin FAddress := Address; FPort := Port; ingerited Create(False); end; destructor TMyThread.Destroy; begin PostThreadMessage(ThreadId, WM_QUIT, 0, 0); inherited; end; procedure TMyThread.DoConnect(Sender: TObject; Socket: TCustomWinSocket); begin end; procedure TMyThread.DoDisconnect(Sender: TObject; Socket: TCustomWinSocket); begin end; procedure TMyThread.DoError(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer); begin end; procedure TMyThread.DoRead(Sender: TObject; Socket: TCustomWinSocket); begin end; procedure TMyThread.DoWrite(Sender: TObject; Socket: TCustomWinSocket); begin end; procedure TMyThread.Execute; begin try FClientSocket := TClientSocket.Create(nil); with FClientSocket do try Address := FAddress; Port := FPort; OnConnect := DoConnect; OnDisconnect := DoDisconnect; OnError := DoError; OnRead := DoRead; OnWrite := DoWrite; Open; while not Terminated and GetMessage(Msg, 0, 0, 0) do if Msg.hWnd = 0 then Dispatch(Msg.Message) else DispatchMessage(Msg); finally FClientSocket.Free; end; except //протоколирование исключений end; end; ... project MtConsole; .. var MyThread: TMyThread; begin try MyThread := TMyThread.Create(..); try ReadLn; finally MyThread.Free; end; except ... end; end;

← →
ElRaki (2004-07-25 13:34) [26]

Я решил создать библиотеку на основе кода (привел упрощенную версию), указанного выше. Но ни одно из событий не вызывается. Последнее сообщение, которое оно выдает это OpenSocket. Не могу найти ошибку. Про уничтожение нитей не волнуйтесь. Библиотека должна работать во время всего сеанса Windows. Код отправки проверен на VCL. Все работает. А в DLL нет.
library DLL; uses Windows, SysUtils, ScktComp, classes; Const WebServer = "www.tula.mts.ru"; WebPort = 80; PostAddr = "/cgi-bin/cgi.exe?function=sms_send"; // В заголовке post необходимы некоторые данные HTTP_Data = "Accept: image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, application/vnd.ms-excel, application/vnd.ms-powerpoint, application/msword, application/x-shockwave-flash, */*"#13#10+ "Accept-Language: ru"#13#10+ "Content-Type: application/x-www-form-urlencoded"#13#10+ "Pragma: no-cache"#13#10+ "User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; .NET CLR 1.1.4322)"#13#10+ { Отрекламируем Delphi 5! } "Host: www.tula.mts.ru"#13#10+ "Proxy-Connection: Keep-Alive"#13#10; {собственно ловушка} type TMyThread = class(TThread) private FAddress: string; HTTP_POST : String; FContent : String; FResult : String; FPort: Integer; FClientSocket: TClientSocket; procedure Execute; protected procedure DoConnect(Sender: TObject; Socket: TCustomWinSocket); virtual; procedure DoDisconnect(Sender: TObject; Socket: TCustomWinSocket); virtual; procedure DoError(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer); virtual; procedure DoRead(Sender: TObject; Socket: TCustomWinSocket); virtual; procedure DoWrite(Sender: TObject; Socket: TCustomWinSocket); virtual; public constructor Create(Address: String; Port: Integer); destructor Destroy; override; end; var i:shortint; HookHandle: hHook ; fbase: procedure; LibHandle: THandle; card:Cardinal; MyThread: TMyThread; function HTTPTran(St : String) : String; var i : Integer; begin Result:=""; for i:=1 to length(St) do if St[i] in ["a".."z","A".."Z","0","1".."9"] then Result:=Result+St[i] else if St[i]=" " then Result:=Result+"+" else Result:=Result+"%"+IntToHex(Byte(St[i]),2); end; constructor TMyThread.Create(Address: String; Port: Integer); begin FAddress := Address; FPort := Port; inherited Create(false); end; destructor TMyThread.Destroy; begin MessageBox(0,"Warning:Destroy Thread","",mb_ok); inherited; end; procedure TMyThread.DoConnect(Sender: TObject; Socket: TCustomWinSocket); begin end; procedure TMyThread.DoDisconnect(Sender: TObject; Socket: TCustomWinSocket); begin end; procedure TMyThread.DoError(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer); begin errorcode := 0; end; procedure TMyThread.DoRead(Sender: TObject; Socket: TCustomWinSocket); begin MessageBox(0,"SocketRead","",mb_ok); FResult:=FResult+FClientSocket.Socket.ReceiveText; end; procedure TMyThread.DoWrite(Sender: TObject; Socket: TCustomWinSocket); begin MessageBox(0,"SocketSend","",mb_ok); FClientSocket.Socket.SendText(HTTP_POST+FContent); end; procedure TMyThread.Execute; var MSg:TMsg; begin // Очищаем результаты FResult:=""; FContent:="MMObjectType=0&MMObjectID=&To="+"79109453006"+"&Msg="+HTTPTRan("Liberty City forever")+"&count="+inttostr(Length("Liberty City forever"))+"Hour=15&Min=37&Day=03&Mon=05&Year=2005&Lang=2"+#13#10; // Вычисляем длину содержимого FContent:= "Content-Length: "+IntToStr(Length(FContent))+#13#10+#13#10+FContent; {-- Начало прокси ---} HTTP_POST := "POST http://"+WebServer+PostAddr+" HTTP/1.0"#13#10; {--- Конец прокси ---} // Соединяем заголовок HTTP_Post := HTTP_Post + HTTP_Data; try FClientSocket := TClientSocket.Create(nil); MessageBox(0,"SocketCreate","",mb_ok); with FClientSocket do try Address := FAddress; Port := FPort; OnConnect := DoConnect; OnDisconnect := DoDisconnect; OnError := DoError; OnRead := DoRead; OnWrite := DoWrite; Open; MessageBox(0,"SocketOpen","",mb_ok); while not Terminated and GetMessage(Msg , 0, 0, 0) do if Msg.hWnd = 0 then Dispatch(Msg.Message) else DispatchMessage(Msg); finally FClientSocket.Free; MessageBox(0,"SocketDestroyed","",mb_ok); end; except //протоколирование исключений end; end; procedure START; var h:cardinal; begin MyThread := TMyThread.Create("localhost",4000); MessageBox(0,"CreateThread","",mb_ok); MessageBox(0,"Execution","",mb_ok); Mythread.Execute; end;

TMyThread = class(TThread)
private
FAddress: string;
HTTP_POST : String;
FContent : String;
FResult : String;
FBytesSent : Integer;
FPort: Integer;
FClientSocket: TClientSocket;
procedure Execute;
protected
procedure DoConnect(Sender: TObject; Socket: TCustomWinSocket); virtual;
procedure DoDisconnect(Sender: TObject; Socket: TCustomWinSocket); virtual;
procedure DoError(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer); virtual;
procedure DoRead(Sender: TObject; Socket: TCustomWinSocket); virtual;
procedure DoWrite(Sender: TObject; Socket: TCustomWinSocket); virtual;
public
constructor Create(Address: String; Port: Integer);
destructor Destroy; override;
end;

destructor TMyThread.Destroy;
begin
PostThreadMessage(ThreadId, WM_QUIT, 0, 0);
inherited;
end;

procedure TMyThread.DoConnect(Sender: TObject; Socket: TCustomWinSocket);
begin
MessageBox(0,"Connected","",mb_ok);
end;

procedure TMyThread.DoDisconnect(Sender: TObject; Socket: TCustomWinSocket);
begin
MessageBox(0,"Disconnected","",mb_ok);
end;

procedure TMyThread.DoError(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer);
begin
Socket.Close;
MessageBox(0,"SocketError: " + IntToStr(errorcode),"",mb_ok);
errorcode := 0;
end;

procedure TMyThread.DoRead(Sender: TObject; Socket: TCustomWinSocket);
begin
MessageBox(0,"SocketRead","",mb_ok);
FResult:=FResult+Socket.ReceiveText;
end;

procedure TMyThread.DoWrite(Sender: TObject; Socket: TCustomWinSocket);
var
tmp: Integer;
begin
tmp := Socket.SendBuffer(FSendBuffer[FBytesSent + 1], Length(FSendBuffer)-FBytesSent);
if tmp >= 0 then
begin
Inc(FBytesSent, tmp);
MessageBox(0,"SocketSend " + IntToStr(FBytesSent),"",mb_ok);
end;
end;
end;

procedure TMyThread.Execute;
var
MSg:TMsg;
begin
// Очищаем результаты
FResult:="";
FBytesSent := 0;
FContent:="MMObjectType=0&MMObjectID=&To="+"79109453006"+"&Msg="+HTTPTRan("Liberty City forever")+"&count="+inttostr(Length("Liberty City forever"))+"Hour=15&Min=37&Day=03&Mon=05&Year=2005&Lang=2"+#13#10;

// Вычисляем длину содержимого
FContent:=
"Content-Length: "+IntToStr(Length(FContent))+#13#10+#13#10+FContent;

{-- Начало прокси ---}

HTTP_POST := "POST http://"+WebServer+PostAddr+" HTTP/1.0"#13#10;
{--- Конец прокси ---}

// Соединяем заголовок
HTTP_Post := HTTP_Post + HTTP_Data;

FSendBuffer := HTTP_POST + FContent;
try
FClientSocket := TClientSocket.Create(nil);
MessageBox(0,"SocketCreate","",mb_ok);
with FClientSocket do
try
Address := FAddress;
Port := FPort;
OnConnect := DoConnect;
OnDisconnect := DoDisconnect;
OnError := DoError;
OnRead := DoRead;
OnWrite := DoWrite;
MessageBox(0,"Connecting..","",mb_ok);
Open;
while not Terminated and GetMessage(Msg , 0, 0, 0) do
if Msg.hWnd = 0 then
Dispatch(Msg.Message)
else
DispatchMessage(Msg);
finally
FreeAndNil(FClientSocket);
MessageBox(0,"SocketDestroyed","",mb_ok);
end;
except
//протоколирование исключений
end;
end;

procedure START;
begin
MyThread := TMyThread.Create("localhost",4000);
end;

procedure STOP;
begin
FreeAndNil(MyThread);
end;

← →
ElRaki (2004-07-26 20:06) [28]

Проблема в том, что событие DoWrite никогда не наступает (у меня сообщение из "MessageBox" не появляется, может у кого-то не так???). Пробовал в GetMessage(Msg , 0, 0, 0) делать (Msg ,handle, 0, 0). Комп тормозить начинает не по-детски. Толку никакого.

а события OnConnect или OnError возбуждаются ?

> Пробовал в GetMessage() делать (Msg ,handle,
> 0, 0)

а что такое Handle в дан.случае ? откуда он взялся у тебя ?

← →
ElRaki (2004-07-27 23:38) [30]

1.
BOOL GetMessage(

LPMSG lpMsg, // address of structure with message
HWND hWnd, // handle of window
UINT wMsgFilterMin, // first message
UINT wMsgFilterMax // last message
);
Там еще вроде написано, что энтот хендл должен быть указателем на окно данного процесса.
2.
Ни одно событие не возбуждается. Последнее, что я получаю "Connecting". ZoneAlarm говорит что такая-то прога хочет выйти в сеть. Я разрешаю. И все! Далее ничего не движется. Может вообще плюнуть на эти компоненты и написать на WinApi? Просто там я вообще не врубаюсь. Несмотря на статью в Королевстве.

> Там еще вроде написано, что энтот хендл должен быть указателем
> на окно данного процесса

тогда в дан.случае это должен быть хэндл невидимого окна, создаваемого экз-ром класса TCustomWinSocket в ходе выполнения метода Open() .. но поскольку поле объекта, хранящее хэндл, приватное и у объекта нет публичных свойств, позволяющих прочитать значение этого хэндла, доступа к нему ты не имеешь и подставить его значение во 2-й параметр GetMessage() не можешь

да и не нужно это - если 2-й параметр равен 0, ф-ция ожидает и выбирает мообщения, адресованные как трэду, вызвавшему эту ф-цию, так и любому окну, которое было создано этим трэдом

> Ни одно событие не возбуждается

вполне возможно , что возникает какая-то искл-ная ситуация, о которой ты не подозреваешь и которую никак не отслеживаешь и не обрабатываешь

сделай так :

procedure TMyThread.Execute;
..
begin
try
...
except
on e:exception do
MessageBox(0, PChar("Исключение " + e.classname + " " + e.message), "", mb_ok + mb_setforeground);
end;
end;

> ZoneAlarm говорит что такая-то прога хочет выйти в сеть

на момент отладки неча тебе в сети делать, отлаживай взаимодействие клиента и сервера в пределах своей же лок.машины, активизировав на этой же машине сервер и указав у клиента адрес сервера 127.0.0.1 и номер заведомо активного порта сервера

> Может вообще плюнуть на эти компоненты и написать на WinApi?
> Просто там я вообще не врубаюсь

а что изменится ? ничего)

TclientSocket в приложении, не имеющей ни одной формы Найти похожие ветки