Delphi 6 and indy 10.1.5 Indy Components/10.0.52 source
I am posting this on Borland now - not Google... (Ugghhhh - now it'll be on google twice...)
I am trying to create an application that connects(telnet) to
multiple(8 to 20+) unix boxes and executes a list of several commands. (I will simplify the commands to buttons.)
The list of servers is loaded via an INI file. A TListbox and TIdTelnet are placed on a frame and are created dynamically on a TTabSheet(in a TPageControl) base on the number of entries in the INI file.
So far it seems to work for about 3 or less connections. On the fourth and more, I start getting hangs. The application becomes unresponsive. Occasionally it returns - only to become unresponsive again.
I am alittle unsure as to which way to go now.
I suspect my design is at fault, but it could simply be my
implementation. Am I being unrealistic? I am thinking that this
should be accomplishable for the magnitude(20-25) that I am looking at.
I haven't created threads for each dynamic tab - I assume some
threading is done in the component, but not sure exactly how that
playes into it. Do I need to create my own threads for each?
I'll post code so as to skip that request ;-) Thanks in advance for any help. Any streamlining/improvements on the component searching would be nice also. It is 380 lines or so including Francois Piette's demo code for the DataAvailable. I use long lines to(well past 80 sometimes) - sorry.
More info:
I tried changing this connecting to each in a serial manner and the same hang occurs. The fourth connection hangs in the
HandleIncomingData procedure of the IdTelnet component.
I rearranged my servers to ensure it wasn't one specific server giving me issues. I am not expecting any more data, so I can't determine why it is hanging.
More testing indicates actually that 5 connections are good and 7
connections are good, but even numbered connections over 2 are bad (4, 6, or 8). Weird. Still hanging in the HandleIncomingData procedure.
More testing...
unit fOctopus;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Menus, StdCtrls, ComCtrls, ToolWin, IniFiles, Dialogs, ImgList,
IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdTelnet,
fTelnet, ExtCtrls;
//******************************************************************************
type
TSite = record
site : string;
visn : string;
moniker : string;
id : string;
server : string;
port : integer;
FContinue : boolean;
FNext : boolean;
FConnected: boolean;
end;
//******************************************************************************
TfrmOctopus = class(TForm)
MainMenu1: TMainMenu;
statusBar: TStatusBar;
File1: TMenuItem;
Connection1: TMenuItem;
Help1: TMenuItem;
ToolBar1: TToolBar;
tbtnConnect: TToolButton;
tbtnButton1: TToolButton;
tbtnUpCarat: TToolButton;
ToolButton4: TToolButton;
tbtnKIDS: TToolButton;
ToolButton6: TToolButton;
ToolButton7: TToolButton;
imagesEnabled: TImageList;
imagesDisabled: TImageList;
tabPage: TPageControl;
pnlLeft: TPanel;
listboxSites: TListBox;
pnlAccessVerify: TPanel;
lblAccess: TLabel;
lblVerify: TLabel;
editAccess: TEdit;
editVerify: TEdit;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Connect(i, j: integer);
procedure Disconnect(Sender: TObject);
//------------------------------------------------
procedure telnetClientDataAvailable(Sender: TIdTelnet; const Buffer: String);
procedure telnetClientStatus(ASender: TObject; const AStatus: TIdStatus; const AStatusText: String);
procedure tbtnUpCaratClick(Sender: TObject);
procedure tbtnConnectClick(Sender: TObject);
procedure tbtnKIDSClick(Sender: TObject);
procedure listboxSitesDrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
//------------------------------------------------
private
{ Private declarations }
FOctopusINI: TIniFile;
FSites: array of TSite;
FslSitelist: TStringlist;
FCursor: TCursor;
FStageConnect: boolean;
public
{ Public declarations }
procedure ImportINI;
procedure SetSites(i: integer);
procedure UpdateScreen(listboxToSendTo: TListbox);
procedure SendCommand(S: string; telnetToSendTo: TIdTelnet);
procedure KIDS;
end;
//******************************************************************************
var
frmOctopus: TfrmOctopus;
implementation
{$R *.dfm}
//******************************************************************************
procedure TfrmOctopus.ImportINI;
var
iniSectionName: string;
i: integer;
begin
listboxSites.Items.Clear;
FOctopusINI := TIniFile.Create(ExtractFilePath(ParamStr(0)) + 'Octopus.ini');
with FOctopusINI do
begin
FslSitelist := TStringlist.Create;
FslSitelist.Clear;
FOctopusINI.ReadSection('Sites', FslSitelist);
if (FslSitelist.Count > 0) then
begin
SetLength(FSites, FslSitelist.Count);
for i := 0 to (FslSitelist.Count - 1) do
begin
iniSectionName := FOctopusINI.ReadString('Sites', 'site' + IntToStr(Ord(i)), '');
with FSites[i] do
begin
site := FOctopusINI.ReadString(iniSectionName, 'site', '');
visn := FOctopusINI.ReadString(iniSectionName, 'visn', '');
moniker := FOctopusINI.ReadString(iniSectionName, 'moniker', '');
id := FOctopusINI.ReadString(iniSectionName, 'id', '');
server := FOctopusINI.ReadString(iniSectionName, 'server', '');
port := FOctopusINI.ReadInteger(iniSectionName, 'port', 0);
FContinue := TRUE;
FNext := FALSE;
FConnected := FALSE;
end;
listboxSites.Items.Add(FSites[i].site);
end;
end;
end;
end;
//******************************************************************************
procedure TfrmOctopus.SetSites(i: integer);
var
tabClients: TTabSheet;
frameClients: TframeClient;
begin
tabClients := TTabSheet.Create(tabPage);
tabClients.PageControl := tabPage;
tabClients.Caption := FSites[i].moniker;
tabClients.Tag := i;
frameClients := TframeClient.Create(tabClients);
frameClients.Parent := tabClients;
frameClients.Align := alClient;
frameClients.telnetClient.Host := FSites[i].server;
frameClients.telnetClient.OnStatus := telnetClientStatus;
frameClients.telnetClient.OnDataAvailable := telnetClientDataAvailable;
end;
//******************************************************************************
procedure TfrmOctopus.FormCreate(Sender: TObject);
var
i: integer;
begin
ImportINI;
for i := 0 to FslSiteList.Count - 1 do SetSites(i);
end;
//******************************************************************************
procedure TfrmOctopus.SendCommand(S: string; telnetToSendTo: TIdTelnet);
var
i: integer;
begin
for i := 1 to length(S) do telnetToSendTo.SendCh(S[i]);
telnetToSendTo.SendCh(#13);
end;
//******************************************************************************
procedure TfrmOctopus.Connect(i, j: integer);
var
s: string;
l: integer;
begin
(*
for i := 0 to tabPage.PageCount - 1 do
begin
for j := 0 to tabPage.Pages[i].ControlCount - 1 do
*)
if not((tabPage.Pages[i].Controls[j] as TframeClient).telnetClient.Connected) then
begin
(tabPage.Pages[i].Controls[j] as TframeClient).telnetClient.Connect;
l := tabPage.Pages[i].Tag;
tabPage.Pages[i].Tag := (tabPage.Pages[i].Controls[j] as TframeClient).telnetClient.TelnetThread.ThreadID;
s := UPPERCASE(FSites[l].moniker) + 'VISTA';
SendCommand(s, (tabPage.Pages[i].Controls[j] as TframeClient).telnetClient);
end;
(*
end;
*)
end;
//******************************************************************************
procedure TfrmOctopus.Disconnect(Sender: TObject);
var
i, j: integer;
begin
for i := 0 to tabPage.PageCount - 1 do
begin
for j := 0 to tabPage.Pages[i].ControlCount - 1 do
if ((tabPage.Pages[i].Controls[j] as TframeClient).telnetClient.Connected) then
begin
(tabPage.Pages[i].Controls[j] as TframeClient).telnetClient.Disconnect;
end;
end;
end;
//******************************************************************************
procedure TfrmOctopus.FormDestroy(Sender: TObject);
var
i, j: integer;
begin
for i := 0 to tabPage.PageCount - 1 do
begin
for j := 0 to tabPage.Pages[i].ControlCount - 1 do
if not((tabPage.Pages[i].Controls[j] as TframeClient).telnetClient.Connected) then
begin
if ((tabPage.Pages[i].Controls[j] as TframeClient).telnetClient.Connected) then
(tabPage.Pages[i].Controls[j] as TframeClient).telnetClient.Disconnect;
end;
end;
FslSitelist.Free;
FOctopusINI.Free;
end;
//******************************************************************************
procedure TfrmOctopus.UpdateScreen(listboxToSendTo: TListbox);
begin
if (listboxToSendTo.Items.Count > 0) then
listboxToSendTo.TopIndex := listboxToSendTo.Items.Count - 1;
// Application.ProcessMessages;
end;
//******************************************************************************
procedure TfrmOctopus.telnetClientDataAvailable(Sender: TIdTelnet; const Buffer: String);
const
CR = #13;
LF = #10;
var
Start, Stop, iCurrentPID, i, j: Integer;
begin
iCurrentPID := Sender.TelnetThread.ThreadID;
for i := 0 to tabPage.PageCount - 1 do
begin
if tabPage.Pages[i].Tag = iCurrentPID then // Sync tab
begin
for j := 0 to tabPage.Pages[i].ControlCount - 1 do
begin // Find frame (only control, but for later...)
//------------------------------------------------
{This routine comes directly from the ICS TNDEMO code. Thanks to Francois Piette
It updates the memo control when we get data}
if ((tabPage.Pages[i].Controls[j] as TframeClient).listboxClient.Items.Count = 0) then
(tabPage.Pages[i].Controls[j] as TframeClient).listboxClient.Items.Add('');
Start := 1;
Stop := Pos(CR, Buffer);
if Stop = 0 then Stop := Length(Buffer) + 1;
while Start <= Length(Buffer) do
begin
(tabPage.Pages[i].Controls[j] as TframeClient).listboxClient.Items.Strings[(tabPage.Pages[i].Controls[j] as TframeClient).listboxClient.Items.Count - 1] :=
(tabPage.Pages[i].Controls[j] as TframeClient).listboxClient.Items.Strings[(tabPage.Pages[i].Controls[j] as TframeClient).listboxClient.Items.Count - 1] +
Copy(Buffer, Start, Stop - Start);
if Buffer[Stop] = CR then
begin
(tabPage.Pages[i].Controls[j] as TframeClient).listboxClient.Items.Add('');
{$IFNDEF Linux}
SendMessage((tabPage.Pages[i].Controls[j] as TframeClient).listboxClient.Handle, WM_KEYDOWN, VK_UP, 1);
{$ENDIF}
end;
Start := Stop + 1;
if Start > Length(Buffer) then Break;
if Buffer[Start] = LF then Start := Start + 1;
Stop := Start;
while (Buffer[Stop] <> CR) and (Stop <= Length(Buffer)) do Stop := Stop + 1;
end;
//-------------------------------------------------------
if FStageConnect then
begin // Access & Verify codes
if (pos('ACCESS CODE:', Buffer) > 0) and FSites[i].FContinue then
SendCommand(editAccess.Text + #9 + editVerify.Text, (tabPage.Pages[i].Controls[j] as TframeClient).telnetClient);
if pos('Not a valid ACCESS CODE/VERIFY CODE pair.', Buffer) > 0 then
begin // Signed on?
FSites[i].FContinue := FALSE;
listboxSites.Items[listboxSites.Items.IndexOf(FSites[i].site)] := '-' + FSites[i].site;
FSites[i].FConnected := FALSE;
if (i < tabPage.PageCount - 1) then Connect(i + 1, 0); // Connect singly.
if (i = tabPage.PageCount - 1) then Screen.Cursor := FCursor;
FSites[i].FNext := TRUE;
end;
if pos('You last signed on', Buffer) > 0 then
begin // Signed on?
FSites[i].FNext := TRUE;
listboxSites.Items[listboxSites.Items.IndexOf(FSites[i].site)] := '+' + FSites[i].site;
FSites[i].FConnected := TRUE;
if (i < tabPage.PageCount - 1) then Connect(i + 1, 0); // Connect singly.
if (i = tabPage.PageCount - 1) then Screen.Cursor := FCursor;
end;
UpdateScreen((tabPage.Pages[i].Controls[j] as TframeClient).listboxClient);
end;
//-------------------------------------------------------
end;
end;
end;
end;
//******************************************************************************
procedure TfrmOctopus.telnetClientStatus(ASender: TObject; const AStatus: TIdStatus; const AStatusText: String);
begin
// Showmessage(AStatusText);
// Showmessage(ASender.ClassName); //TIdtelnet
// statusBar.Panels[0].Text := statusBar.Panels[0].Text + 'BOI' + '+ ';
// (ASender as TIdTelnet).TelnetThread.ThreadID
{SetStatus Bar}
end;
//******************************************************************************
procedure TfrmOctopus.tbtnUpCaratClick(Sender: TObject);
var
i, j:integer;
begin
for i := 0 to tabPage.PageCount - 1 do
begin
for j := 0 to tabPage.Pages[i].ControlCount - 1 do
SendCommand('^' + #13, (tabPage.Pages[i].Controls[j] as TframeClient).telnetClient);
end;
end;
//******************************************************************************
procedure TfrmOctopus.tbtnConnectClick(Sender: TObject);
begin
FStageConnect := TRUE;
FCursor := Screen.Cursor;
Screen.Cursor := crHourGlass;
Connect(0, 0);
end;
//******************************************************************************
procedure TfrmOctopus.tbtnKIDSClick(Sender: TObject);
begin
FStageConnect := FALSE;
KIDS;
end;
//******************************************************************************
procedure TfrmOctopus.KIDS;
var
s: string;
i, j: integer;
begin
for i := 0 to tabPage.PageCount - 1 do
begin
for j := 0 to tabPage.Pages[i].ControlCount - 1 do
if FSites[i].FConnected then
begin
SendCommand('Programmer Options', (tabPage.Pages[i].Controls[j] as TframeClient).telnetClient);
SendCommand('KIDS', (tabPage.Pages[i].Controls[j] as TframeClient).telnetClient);
SendCommand('Installation', (tabPage.Pages[i].Controls[j] as TframeClient).telnetClient);
end;
end;
end;
//******************************************************************************
procedure TfrmOctopus.listboxSitesDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
begin
try
with (Control as TListBox).Canvas do { draw on control canvas, not on the form }
begin
FillRect(Rect); { clear the rectangle }
if odSelected in State then
Font.Color := clWhite
else
begin
if (pos('+', listboxSites.Items[Index]) > 0) then Font.Color := clGreen
else if (pos('-', listboxSites.Items[Index]) > 0) then Font.Color := clMaroon
else Font.Color := clBlack;
end;
TextOut(Rect.Left + 2, Rect.Top, (Control as TListBox).Items[Index]); { display the text }
end;
except
MessageDlg('Access Violation Error Trap: On Draw.', mtError, [mbOK],0);
Application.Terminate;
end;
end;
//******************************************************************************
end.
