Arne Fl. Jensen wrote:
> And both fail, with the same error in clientConnect and
> clientDisConnect, and postmessage.
>
> In your examples, there is no postMessage or postthreadMessage.
> Are there any examples of this, in a formless app.?
Now there is one:
{code}
program Project1;
{ This demo shows how to register and use custom messages posted to }
{ the ICSv7 hidden window. }
{$APPTYPE CONSOLE}
{$DEFINE NOFORMS} // Do not include unit Forms.pas
uses
Windows, Messages, SysUtils, Classes,
OverbyteIcsWndControl,
OverbyteIcsHttpSrv;
type
TMyHttpServer = class(THttpServer)
private
FMsg_WM_MYMESSAGE: UINT;
FOnMyMessage: TNotifyEvent;
protected
procedure AllocateMsgHandlers; override;
procedure FreeMsgHandlers; override;
function MsgHandlersCount: Integer; override;
procedure WndProc(var MsgRec: TMessage); override;
public
constructor Create(AOwner: TComponent); override;
procedure PostMyMessage;
property OnMyMessage: TNotifyEvent read FOnMyMessage write FOnMyMessage;
end;
TApp = class
private
FMyHttpServer : TMyHttpServer;
procedure MyHttpServerMyMessage(Sender: TObject);
public
procedure Run;
end;
constructor TMyHttpServer.Create(AOwner: TComponent);
begin
inherited;
{ Make sure the internal window is created early otherwise our }
{ overridden message registration methods were called too late. }
AllocateHWnd;
end;
function TMyHttpServer.MsgHandlersCount : Integer;
begin
Result := 1 + inherited MsgHandlersCount;
end;
procedure TMyHttpServer.AllocateMsgHandlers;
begin
inherited AllocateMsgHandlers;
FMsg_WM_MYMESSAGE := FWndHandler.AllocateMsgHandler(Self);
end;
procedure TMyHttpServer.FreeMsgHandlers;
begin
if Assigned(FWndHandler) then
FWndHandler.UnregisterMessage(FMsg_WM_MYMESSAGE);
inherited FreeMsgHandlers;
end;
{ Message handler }
procedure TMyHttpServer.WndProc(var MsgRec: TMessage);
begin
with MsgRec do
begin
if Msg = FMsg_WM_MYMESSAGE then
begin
try
if Assigned(FOnMyMessage) then
FOnMyMessage(Self);
except
on E: Exception do
HandleBackGroundException(E);
end;
end
else
inherited WndProc(MsgRec);
end;
end;
procedure TMyHttpServer.PostMyMessage;
begin
PostMessage(Handle, FMsg_WM_MYMESSAGE, 0, 0);
end;
{ TApp }
procedure TApp.MyHttpServerMyMessage(Sender: TObject);
begin
WriteLn('My message received');
{ In current ICSv7 call method PostQuitMessage to break the message loop }
FMyHttpServer.PostQuitMessage;
{ In older versions you have to post message WM_QUIT yourself }
//PostMessage(FMyHttpServer.Handle, WM_QUIT, 0, 0);
end;
procedure TApp.Run;
begin
FMyHttpServer := TMyHttpServer.Create(nil);
try
FMyHttpServer.OnMyMessage := MyHttpServerMyMessage;
FMyHttpServer.PostMyMessage;
{ Start the built-in message pump }
FMyHttpServer.MessageLoop;
finally
FMyHttpServer.Free;
end;
end;
var
App: TApp;
begin
try
App := TApp.Create;
try
App.Run;
finally
App.Free;
end;
WriteLn('Press Enter to exit');
ReadLn;
except
on E: Exception do
begin
WriteLn(E.ClassName + ' ' + E.Message);
WriteLn('Press Enter to exit');
ReadLn;
end;
end;
end.
{code}
--
Arno Garrels
--
To unsubscribe or change your settings for TWSocket mailing list
please goto http://lists.elists.org/cgi-bin/mailman/listinfo/twsocket
Visit our website at http://www.overbyte.be
