indy Problem

[thetrue]

moin, ich habe das problem, das es keine verbindung bestehen bleibt ...

hier main code :

Delphi-Quellcode:

unit sinsupport.server;
interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IniFiles, ExtCtrls, Menus, Buttons, StdCtrls, IdBaseComponent,
  IdComponent, IdTCPServer;

type
  Tmain = class(TForm)
    menu: TMainMenu;
    menu_connect: TMenuItem;
    userinfo: TMenuItem;
    cmd: TMenuItem;
    cmd_end: TMenuItem;
    cmd_info: TMenuItem;
    cmd_warning: TMenuItem;
    about: TMenuItem;
    server: TIdTCPServer;
    timer: TTimer;
    procedure menu_connectClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormDestroy(Sender: TObject);
    procedure aboutClick(Sender: TObject);
    procedure cmd_endClick(Sender: TObject);
    procedure cmd_infoClick(Sender: TObject);
    procedure cmd_warningClick(Sender: TObject);
    procedure serverConnect(AThread: TIdPeerThread);
    procedure serverDisconnect(AThread: TIdPeerThread);
    procedure timerTimer(Sender: TObject);
  private
  public
    Clients: array [0..255] of TIdPeerThread;
    Cwin: array [0..255] of Integer;
    procedure msgsend(msg: String; tid: Integer);
end;


var
  main: Tmain;
  ini: TIniFile;
  tmpthread: TIdPeerThread;
implementation

uses sinsupport.server.child, sinnsupport.about;

{$R *.dfm}


{///////////////////////::::::C O N N E C T::::::////////////////////////}
procedure Tmain.menu_connectClick(Sender: TObject);
begin
    {connection to the server}
    if server.Active then
      begin
        server.Active := False;
        main.menu_connect.Caption := 'Connect';
      end
    else
      begin
        server.Active := true;
        main.menu_connect.Caption := 'Diconnect';
      end;
end;
{//////////////////////:::::F O R M C R E A T E:::::::::::://///////////////////}
procedure Tmain.FormCreate(Sender: TObject);
begin
  ini:=TIniFile.Create(ExtractFilePath(ParamStr(0))+'conf.ini');
  main.Color := TColor(RGB(ini.ReadInteger('Main-Window', 'background-color-r', 200),ini.ReadInteger('Main-Window', 'background-color-g', 200),ini.ReadInteger('Main-Window', 'background-color-b', 200)));
end;
{/////////////////::F O R M C L O S E::::::::::////////////////////////////////}
procedure Tmain.FormClose(Sender: TObject; var Action: TCloseAction);
var
  i:Integer;
begin
i:=main.MDIChildCount;
while i>0 do
  begin
    i := i-1;
    main.MDIChildren[i].Close;
    Application.ProcessMessages;
  end;
if main.MDIChildCount = 0 then
  begin
    Action := caFree;
  end
else
  Action := caNone;
end;
{/////////////////////:::: D E S T R O Y::://////////////////////////}
procedure Tmain.FormDestroy(Sender: TObject);
begin
 ini.Free;
end;
{////////////////////// ::: A B O U T ::: ///////////////////////////}
procedure Tmain.aboutClick(Sender: TObject);
begin
  aboutdlg.Show;
end;
procedure Tmain.cmd_endClick(Sender: TObject);
begin
  if main.MDIChildCount > 0 then
    Tserv(main.MDIChildren[0]).msg.Text := '/*/end'
  else
    ShowMessage('No channel connected!');
end;

procedure Tmain.cmd_infoClick(Sender: TObject);
begin
  if main.MDIChildCount > 0 then
    Tserv(main.MDIChildren[0]).msg.Text := '/*/info '+InputBox('Info Text :: SinSupport', 'Please enter the info message', 'Info')
  else
    ShowMessage('No channel connected!');
end;
procedure Tmain.cmd_warningClick(Sender: TObject);
begin
  if main.MDIChildCount > 0 then
    Tserv(main.MDIChildren[0]).msg.Text := '/*/warning '+InputBox('Warning Text :: SinSupport', 'Please enter the warning message', 'Warning')
  else
    ShowMessage('No channel connected!');
end;
{///////////////////////////:::::::: O N   C O N N E C T::::::///////////////////////}
procedure Tmain.serverConnect(AThread: TIdPeerThread);
begin
  tmpthread := Athread;
  timer.Enabled := true;
end;
{///////////////////////////:::::::: O N   D I C O N N E C T::::::///////////////////////}
procedure Tmain.serverDisconnect(AThread: TIdPeerThread);
var
  i: Integer;
begin
for i:=0 to 255 do
  begin
    if Clients[i] = AThread then
      begin
        main.MDIChildren[Cwin[i]].Free;
        exit;
      end;
  end;
end;
{///////////////////::::::::: T I M E R  for onconnect ::::///////////////////}
procedure Tmain.timerTimer(Sender: TObject);
var
  i: integer;
begin
timer.Enabled := false;
for i:=0 to 255 do
  begin
    if Clients[i] = nil then
      begin
        Clients[i] := tmpthread;
        Tserv.Create(self);
        MDIChildren[Cwin[i]];
        serv.mkid(Cwin[i]);
        exit;
      end;
  end;
end;
{///////////////////////////// :::::::::::S E N D  M E S S A G E:::::::::///////////////}
procedure Tmain.msgsend(msg: String; tid: Integer);
begin
  Clients[tid].Connection.Write(msg);
end;
end.

und :

Delphi-Quellcode:

unit sinsupport.server.child;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, IniFiles;

type
  Tserv = class(TForm)
    txt: TRichEdit;
    send: TButton;
    msg: TMemo;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure msgKeyPress(Sender: TObject; var Key: Char);
    procedure sendClick(Sender: TObject);
  private
    { Private declarations }
      fid: Integer;
  public
    { Public declarations }
    procedure mkid(id: Integer);
  end;

var
  serv: Tserv;
  ini: TIniFile;
  winId: Integer;
implementation

uses sinsupport.server;

{$R *.dfm}

procedure Tserv.FormClose(Sender: TObject; var Action: TCloseAction);
var
  btn:LongInt;
begin
  btn := MessageDlg('Close '+self.Caption+'?',mtConfirmation, mbYesNoCancel, 0);
  if btn = 6 then
  begin
    Action := caFree;
  end
  else if btn = 7 then
    begin
    Action := caNone;
    end;
end;

procedure Tserv.FormCreate(Sender: TObject);
var
  font: TFont;
begin
  ini:=TIniFile.Create(ExtractFilePath(ParamStr(0))+'conf.ini');
  font := TFont.Create;
  font.Color :=TColor(RGB(ini.ReadInteger('Server-Window', 'font-color-r', 0),ini.ReadInteger('Server-Window', 'font-color-g', 0),ini.ReadInteger('Server-Window', 'font-color-b', 0)));
  font.Size := ini.ReadInteger('Server-Window', 'font-size', 8);
  font.Name := ini.ReadString('Server-Window', 'font', 'Veranda');
  if ini.ReadString('Server-Window', 'font-bold', 'yes') = 'yes' then
    font.Style := font.Style + [fsBold]
  else
    font.Style := font.Style - [fsBold];
  if ini.ReadString('Server-Window', 'font-italic', 'yes') = 'no' then
    font.Style := font.Style - [fsItalic]
  else
    font.Style := font.Style + [fsItalic];
  fid := main.MDIChildCount;
  self.Color := TColor(RGB(ini.ReadInteger('Server-Window', 'background-color-r', 200),ini.ReadInteger('Main-Window', 'background-color-g', 200),ini.ReadInteger('Main-Window', 'background-color-b', 200)));
  self.txt.Color := TColor(RGB(ini.ReadInteger('Server-Window', 'textbg-color-r', 255),ini.ReadInteger('Server-Window', 'textbg-color-g', 255),ini.ReadInteger('Server-Window', 'textbg-color-b', 255)));
  self.msg.Color := TColor(RGB(ini.ReadInteger('Server-Window', 'textbg-color-r', 255),ini.ReadInteger('Server-Window', 'textbg-color-g', 255),ini.ReadInteger('Server-Window', 'textbg-color-b', 255)));
  self.msg.Font := font;
  self.txt.Font := font;
  main.msgsend('/*/info Verbunden...', winId);
end;

procedure Tserv.msgKeyPress(Sender: TObject; var Key: Char);
begin
  if Key = #13 then
    self.sendClick(msg);
end;

procedure Tserv.sendClick(Sender: TObject);
begin
  main.msgsend(self.msg.Text, winId);
end;
procedure Tserv.mkid(id: Integer);
begin
  winId := id;
end;
end.

hoffe ihr findet den Fehler :)
die Verbindung wird einfach getrennt ... Child::OnCrete ist net mal schnell genug um die Nachricht zu senden

[SirThornberry]

Da du bereits einen Thread zu dem Thema erstellst hast mach ich hier mal zu.

Vorgängerthread: http://www.delphipraxis.net/internal...=554986#554986

*** LOCKED ****