Examples Delphi

We have to live with these things: I'm talking about firewalls.
Deployment of client/server- and multitier systems can be very annoying in company networks, where you don't have control over the firewalls. Lets say you have a DCOM application using two ports 135 and 1234. The server part is to be placed behind a firewall. You order these ports to be opened, install your application and it won't work. Of course, there could be many reasons why it doesn't, but in your lab there was no problem. Is the ports you ordered really open?
This little simple tester could help you. Execute it on the server machine, and use telnet to connect to it from a client machine. If you wan't to change the port on the server, you can do it from the client side. The server echoes back each line you type, except lines beginning with a "P". In that case the server expects a new port number to follow.
In our example, port 135 is already assigned to a RPC-server, (every Windows machine are), and will cause an exception in the server, if set. If this happens the server will "eat" the exception and default back to port 23, where it can be reached again.
If you try: telnet localhost 135 in a command window, you will see an empty window. Thats because something is answering. You can use this technique to determine if a firewall port is open, if you know for certain that there should be a server answering to telnet on that port.
Lets try using the tester for port 1234. First place the tester on the server machine, set the port to 1234 and press activate. Walk over to a client machine and type: telnet 1234. If the port you ordered is open, you should get a resultat like below, and you have to think about other reasons to why your app isn't working.

Download the project:

Here's the code:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, IdBaseComponent, IdComponent, IdTelnetServer, IdTCPServer, Menus,
ExtCtrls, StdCtrls, Spin, AppDlg;
type
TForm1 = class(TForm)
Button1: TButton;
Label1: TLabel;
SpinEdit1: TSpinEdit;
Timer1: TTimer;
MainMenu1: TMainMenu;
Help1: TMenuItem;
Instructions1: TMenuItem;
AboutTelnetserver1: TMenuItem;
AppDlg1: TAppDlg;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure Instructions1Click(Sender: TObject);
procedure AboutTelnetserver1Click(Sender: TObject);
private
Telnet: TIdTelnetServer;
Cmd: string;
procedure CreateServer(Port: integer);
procedure NewPort;
procedure IdTelnetServer1Execute(AThread: TIdPeerThread);
procedure IdTelnetServer1Exception(AThread: TIdPeerThread;
AException: Exception);
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses IdTCPConnection, Unit2;
{$R *.dfm}
procedure TForm1.IdTelnetServer1Execute(AThread: TIdPeerThread);
var
Port: integer;
begin
try
Timer1.Enabled:= false;
with AThread.Connection do
begin
Cmd:= Trim(ReadLn());
if Cmd <> '' then
if Cmd[1] = 'P' then
begin
try
Port:= StrToInt(Trim(Copy(Cmd, 2, 100)));
WriteLn('Changing to port ' + IntToStr(Port));
WriteLn('Goodbye!');
Disconnect;
except
WriteLn('Port not changed');
Cmd:= '';
end;
end
else
if UpperCase(Cmd) = 'EXIT' then
begin
WriteLn('Goodbye!');
Disconnect;
end
else
WriteLn('echo ' + Cmd);
end;
finally
Timer1.Enabled:= true;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
try
if Button1.Caption = 'Activate' then
begin
CreateServer(SpinEdit1.Value);
Button1.Caption:= 'Deactivate';
Caption:= 'Telnet server, port ' + IntToStr(Telnet.DefaultPort);
SpinEdit1.Enabled:= false;
end
else
begin
Telnet.Free;
Button1.Caption:= 'Activate';
SpinEdit1.Enabled:= true;
end
except
Cmd:= 'P23';
NewPort;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
CreateServer(23);
end;
procedure TForm1.NewPort;
begin
try
if Cmd <> '' then
if Cmd[1] = 'P' then
begin
Telnet.Free;
Sleep(100);
CreateServer(StrToInt(Trim(Copy(Cmd, 2, 100))));
Caption:= 'Telnet server, port ' + IntToStr(Telnet.DefaultPort);
SpinEdit1.Value:= Telnet.DefaultPort;
Cmd:= '';
end;
except
Cmd:= 'P23';
NewPort;
end;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
NewPort;
end;
procedure TForm1.CreateServer(Port: integer);
begin
Telnet:= TIdTelnetServer.Create(nil);
Telnet.DefaultPort:= Port;
Telnet.LoginMessage:= 'Connected to Telnet server, port ' +
IntToStr(Telnet.DefaultPort) + #13#10 + 'Type: P to ' +
'change listening port' + #13#10 + 'EXIT to terminate';
Telnet.OnExecute:= IdTelnetServer1Execute;
Telnet.OnException:= IdTelnetServer1Exception;
Telnet.Active:= true;
end;
procedure TForm1.Instructions1Click(Sender: TObject);
begin
Form2.Show;
end;
procedure TForm1.AboutTelnetserver1Click(Sender: TObject);
begin
AppDlg1.Execute;
end;
procedure TForm1.IdTelnetServer1Exception(AThread: TIdPeerThread;
AException: Exception);
begin
MessageDlg(AException.Message, mtError, [mbOK], 0);
end;
end.
And the Unit1.dfm file:
object Form1: TForm1
Left = 339
Top = 309
Width = 269
Height = 121
BorderIcons = [biSystemMenu]
Caption = 'Telnet server, port 23'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
Menu = MainMenu1
OldCreateOrder = False
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object Label1: TLabel
Left = 24
Top = 8
Width = 28
Height = 13
Caption = 'Port:'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
end
object Button1: TButton
Left = 96
Top = 21
Width = 75
Height = 25
Caption = 'Activate'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
TabOrder = 0
OnClick = Button1Click
end
object SpinEdit1: TSpinEdit
Left = 24
Top = 24
Width = 65
Height = 22
MaxValue = 0
MinValue = 0
TabOrder = 1
Value = 23
end
object Timer1: TTimer
OnTimer = Timer1Timer
Left = 224
Top = 24
end
object MainMenu1: TMainMenu
Left = 184
Top = 16
object Help1: TMenuItem
Caption = 'Help'
object Instructions1: TMenuItem
Caption = 'Instructions'
OnClick = Instructions1Click
end
object AboutTelnetserver1: TMenuItem
Caption = 'About Telnet server'
OnClick = AboutTelnetserver1Click
end
end
end
object AppDlg1: TAppDlg
Left = 120
Top = 8
end
end