"Mike C" <MikeCooperInWG@ic24.net> wrote in message
news:445c63fa$1@newsgroups.borland.com...
> I am migrating an application from 'Delphi 5' to 'Delphi 2006
> VCL for Win32'. The D5 code uses a TServerSocket, so I
> am having to use a TIdTCPServer in D2006, which might be
> causing a problem.
Any particular reason why you don't continue to use TServerSocket? It is
still available in BDS, although you have to install the dclsocket100
package manually now.
> However, with the line 'ShowWindow()' active, the MainForm
> is initially in the Tray. When telnet is used and the MainForm
> shown again, the listbox has disappeared. Also when the
> apllication shuts down it generates a 'System Error Code 1400 -
> Invalid window handle'.
TIdTCPServer is a multi-threaded component, and your event handler code for
the server is not thread-safe. You need to use the TThread.Synchronize()
method, either directly or via the TIdSync class, in order to access the GUI
safely.
Try this code instead:
unit IndyErrorMain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics,
Controls, Forms, Dialogs, StdCtrls, IdBaseComponent, IdComponent,
IdCustomTCPServer, IdTCPServer, IdContext, Menus, ShellAPI;
type
TfrmIEMain = class(TForm)
IdTCPServer: TIdTCPServer;
lbxLog: TListBox;
puTray: TPopupMenu;
puitRestore: TMenuItem;
btnToTray: TButton;
puTerminate: TMenuItem;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure puTerminateClick(Sender: TObject);
procedure btnToTrayClick(Sender: TObject);
procedure puitRestoreClick(Sender: TObject);
procedure IdTCPServerExecute(AContext: TIdContext);
procedure IdTCPServerDisconnect(AContext: TIdContext);
procedure IdTCPServerConnect(AContext: TIdContext);
protected
procedure CreateWnd; override;
procedure DestroyWnd; override;
procedure WndProc(var Msg : TMessage); override;
private
procedure MakeOrderlyExit;
public
{ Public declarations }
end;
var
frmIEMain: TfrmIEMain;
implementation
uses
IdSync;
{$R *.dfm}
{ TLogSync }
type
TLogSync = class(TIdSync)
protected
FStr: String;
procedure DoSynchronize; override;
public
constructor Create(const AStr: String); reintroduce;
class procedure Add(const AStr: String);
end;
constructor TLogSync.Create(const AStr: String);
begin
inherited Create;
FStr := AStr;
end;
procedure TLogSync.DoSynchronize;
begin
frmIEMain.lbxLog.Items.Add(FStr);
end;
class procedure TLogSync.Add(const AStr: String);
begin
with Create(AStr) do try
Synchronize;
finally
Free;
end;
end;
{ TfrmIEMain }
procedure TfrmIEMain.WndProc(var Msg : TMessage);
var
p : TPoint;
begin
if Msg.Msg = WM_USER+1 then
begin
if Msg.lParam = WM_RBUTTONDOWN then
begin
GetCursorPos(p);
puTray.PopUp(p.x, p.y);
end;
end else
inherited;
end;
procedure TfrmIEMain.btnToTrayClick(Sender: TObject);
begin
Close;
end;
procedure TfrmIEMain.FormClose(Sender: TObject; var Action:
TCloseAction);
begin
if not Application.Terminated then
Action := caHide;
end;
procedure TfrmIEMain.CreateWnd;
var
IconData : TNotifyIconData;
begin
inherited;
if HandleAllocated then
begin
FillChar(@IconData, sizeof(TNotifyIconData), 0);
with IconData do
begin
cbSize := sizeof(IconData);
Wnd := Handle;
uID := 100;
uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP;
uCallbackMessage := WM_USER+1;
hIcon := Application.Icon.Handle;
StrPCopy(szTip, Application.Title);
end;
Shell_NotifyIcon(NIM_ADD, @IconData);
end;
end;
procedure TfrmIEMain.DestroyWnd;
var
IconData : TNotifyIconData;
begin
if HandleAllocated then
begin
FillChar(@IconData, sizeof(TNotifyIconData), 0);
with IconData do
begin
cbSize := sizeof(IconData);
Wnd := Handle;
uID := 100;
end;
Shell_NotifyIcon(NIM_DELETE, @IconData);
end;
inherited;
end;
procedure TfrmIEMain.IdTCPServerConnect(AContext: TIdContext);
begin
TLogSync.Add('Connected');
try
AContext.Connection.IOHandler.WriteLn(Application.Title + '
ready');
except
on E: Exception do
begin
TLogSync.Add('Error: ' + E.Message);
raise;
end;
end;
end;
procedure TfrmIEMain.IdTCPServerDisconnect(AContext: TIdContext);
begin
TLogSync.Add('Disconnected');
end;
procedure TfrmIEMain.IdTCPServerExecute(AContext: TIdContext);
var
s : string;
begin
try
s := AContext.Connection.IOHandler.ReadLn;
TLogSync.Add(s);
except
on E: Exception do
begin
TLogSync.Add('Error: ' + E.Message);
raise;
end;
end;
end;
procedure TfrmIEMain.MakeOrderlyExit;
begin
IdTCPServer.Active := False;
Application.Terminate;
end;
procedure TfrmIEMain.puitRestoreClick(Sender: TObject);
begin
frmIEMain.Show;
end;
procedure TfrmIEMain.puTerminateClick(Sender: TObject);
const
strMsg = 'Do you really want to close down %s ?'#13#13'If you do
then -'#13' PIMS will not be able'#13' to print any more labels
!';
strCaption = 'Exiting %s application';
begin
if Application.MessageBox(PChar(Format(strMsg,
[Application.Title])), PChar(Format(strCaption, [Application.Title])),
MB_YESNO or MB_ICONQUESTION) = IDYES then
MakeOrderlyExit;
end;
end.
Gambit
