Einzelnen Beitrag anzeigen

Benutzerbild von Captnemo
Captnemo

Registriert seit: 27. Jan 2003
Ort: Bodenwerder
1.126 Beiträge
 
Delphi XE4 Architect
 
#6

AW: ICS TWSocket Eingehende Verbindung

  Alt 16. Jun 2014, 16:46
ich habe es mal geändert in
mysocket:=(sender as TWSocket).Accept; und dann klappt es (frag mich aber, wie die das dann mit dem Beispielcode im Wiki geschafft haben).

Leider komme ich aber immer noch nicht zu dem gewünschten Ergebnis.

Ich habe auf der Form 2 TWSocket's. Einer wird mit Listen als Server gestartet, und über den anderen kann man auf einen Port eine Nachricht schicken lassen. Entweder an sich selbst oder halt an eine zweite Instanz (dann natürlich mit einsprechenden Ports).

Ziel dieses Projekt's ist es für mich erst einmal, mir zu verdeutlichen, wie das mit ICS funktioniert. (Also kein Kundenprojekt).

Hier mal mein Übungsprojekt:
Delphi-Quellcode:
unit clt_main;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, JvExControls, JvComCtrls,
  Vcl.ExtCtrls, OverbyteIcsLogger,
  OverbyteIcsWndControl, OverbyteIcsWSocket, JvExStdCtrls, JvEdit,
  JvValidateEdit, Vcl.ComCtrls, winsock;

type
  Tfrm_main = class(TForm)
    lbl1: TLabel;
    edt_ip1: TJvIPAddress;
    edt_text: TEdit;
    btn_send: TButton;
    lbl2: TLabel;
    ipserver: TWSocket;
    icslgr1: TIcsLogger;
    mmo_nachrichten: TMemo;
    edt_port: TJvValidateEdit;
    btn_start: TButton;
    stat1: TStatusBar;
    ipclient: TWSocket;
    edt_sendport: TJvValidateEdit;
    lbl3: TLabel;
    lbl4: TLabel;
    lbl5: TLabel;
    procedure FormShow(Sender: TObject);
    procedure btn_sendClick(Sender: TObject);
    procedure btn_startClick(Sender: TObject);
    procedure ipserverChangeState(Sender: TObject; OldState,
      NewState: TSocketState);
    procedure ipserverDataAvailable(Sender: TObject; ErrCode: Word);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ipserverSessionAvailable(Sender: TObject; ErrCode: Word);
    procedure ipclientSessionConnected(Sender: TObject; ErrCode: Word);
    procedure ipserverSessionClosed(Sender: TObject; ErrCode: Word);
    procedure ipclientSessionClosed(Sender: TObject; ErrCode: Word);
    procedure ipserverSessionConnected(Sender: TObject; ErrCode: Word);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    ServerSocket: TWSocket;
    SendStringBuffer: TStringList;
    function GetTWSocketState(Socket: TWSocket): string;
    { Public-Deklarationen }
  end;

var
  frm_main: Tfrm_main;

implementation

{$R *.dfm}

function Tfrm_main.GetTWSocketState(Socket: TWSocket): string;
begin
  Result:='';
  case Socket.state of
    wsInvalidState: Result:='wsInvalidState';
    wsOpened: Result:='wsOpened';
    wsBound: Result:='wsBound';
    wsConnecting: Result:='wsConnecting';
    wsSocksConnected: Result:='wsSocksConnected';
    wsConnected: Result:='wsConnected';
    wsAccepting: Result:='wsAccepting';
    wsListening: Result:='wsListening';
    wsClosed: Result:='wsClosed';
  end;
end;

procedure Tfrm_main.btn_sendClick(Sender: TObject);
begin
  SendStringBuffer.Add(edt_text.Text);
  edt_text.Text:='';
  edt_text.SetFocus;
  try
    ipclient.Addr:=edt_ip1.Text;
    ipclient.Port:=edt_sendport.Text;
    ipclient.Proto:='tcp';
    ipclient.Connect;
  except
    on E: Exception do
    begin
      mmo_nachrichten.Lines.Insert(0, 'Error: '+E.Message);
    end;
  end;
end;

procedure Tfrm_main.btn_startClick(Sender: TObject);
begin
  if btn_start.Caption='Startthen
  begin
    btn_start.Caption:='Stop';
    ipserver.Addr:='0.0.0.0';
    ipserver.Port:=edt_port.Text;
    ipserver.Proto:='tcp';
    ipserver.Listen;
  end else begin
    btn_start.Caption:='Start';
    ipserver.Shutdown(0);
  end;
end;

procedure Tfrm_main.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  ipserver.Abort;
end;

procedure Tfrm_main.FormCreate(Sender: TObject);
begin
  SendStringBuffer:=TStringList.Create;
end;

procedure Tfrm_main.FormDestroy(Sender: TObject);
begin
  SendStringBuffer.Free;
end;

procedure Tfrm_main.FormShow(Sender: TObject);
begin
  mmo_nachrichten.Lines.Clear;
  edt_text.Text:='';
  edt_port.Value:=17001;
  edt_sendport.Value:=17001;
end;

procedure Tfrm_main.ipclientSessionClosed(Sender: TObject; ErrCode: Word);
begin
  mmo_nachrichten.Lines.Insert(0, 'Client Session Closed: '+IntToStr(ErrCode));
end;

procedure Tfrm_main.ipclientSessionConnected(Sender: TObject; ErrCode: Word);
begin
  mmo_nachrichten.Lines.Insert(0, 'Client Session Connected');
  while SendStringBuffer.Count>0 do
  begin
      ipclient.SendStr(SendStringBuffer[0]+#13#10);
      mmo_nachrichten.Lines.Insert(0, 'Gesendet: '+SendStringBuffer[0]);
      SendStringBuffer.Delete(0);
  end;
  ipclient.Close;
end;

procedure Tfrm_main.ipserverChangeState(Sender: TObject; OldState,
  NewState: TSocketState);
begin
  case newstate of
    wsInvalidState: mmo_nachrichten.Lines.Insert(0, 'ServerState: Invalid State');
    wsOpened: mmo_nachrichten.Lines.Insert(0, 'ServerState: Öffnet');
    wsBound: mmo_nachrichten.Lines.Insert(0, 'ServerState: Gebunden');
    wsConnecting: mmo_nachrichten.Lines.Insert(0, 'ServerState: Verbinden');
    wsSocksConnected: mmo_nachrichten.Lines.Insert(0, 'ServerState: Socks verbunden');
    wsConnected: mmo_nachrichten.Lines.Insert(0, 'ServerState: Verbunden');
    wsAccepting: mmo_nachrichten.Lines.Insert(0, 'ServerState: Akzeptiert');
    wsListening: mmo_nachrichten.Lines.Insert(0, 'ServerState: Wartet...');
    wsClosed: mmo_nachrichten.Lines.Insert(0, 'ServerState: Geschlossen');
  end;
end;

procedure Tfrm_main.ipserverDataAvailable(Sender: TObject; ErrCode: Word);
var
  s: string;
begin
  mmo_nachrichten.Lines.Insert(0, 'Server: DataAvailable');
  if ErrCode<>0 then Exit;
  s:=ipserver.ReceiveStr;
  mmo_nachrichten.Lines.Insert(0, 'Empfangen: '+s);
end;

procedure Tfrm_main.ipserverSessionAvailable(Sender: TObject; ErrCode: Word);
var
  mysocket: TSocket;
begin
  if ErrCode <> 0 then exit;
  mysocket:=ipserver.Accept;
  ServerSocket:=TWSocket.Create(nil);
  ServerSocket.Dup(mysocket);
  mmo_nachrichten.Lines.Insert(0, 'Server Session Available: '+ServerSocket.PeerPort);
end;

procedure Tfrm_main.ipserverSessionClosed(Sender: TObject; ErrCode: Word);
begin
  mmo_nachrichten.Lines.Insert(0, 'Server Session Closed: '+IntToStr(ErrCode));
end;

procedure Tfrm_main.ipserverSessionConnected(Sender: TObject; ErrCode: Word);
begin
  mmo_nachrichten.Lines.Insert(0, 'Server Session Connected');
end;

end.
Mein Problem ist jetzt, dass er wohl connected und auch sendet, aber das OnDataAvailable von der Server-Komponente wird nie ausgelöst.

Hier mal das Ergebnis im Memo, was ich beim Senden eines Textes erhalte:

Code:
Client Session Closed: 0
Gesendet: TestTestTest
Client Session Connected
Server Session Available: 49946
ServerState: Wartet...
ServerState: Gebunden
Achso: Und ipserver.LineEnd=#13#10 und ipserver.LineMode=True ist gesetzt.
Dieter
9 von 10 Stimmen in meinem Kopf sagen ich bin nicht verrückt. Die 10. summt dazu die Melodie von Supermario Bros.
MfG Captnemo

Geändert von Captnemo (16. Jun 2014 um 16:49 Uhr)
  Mit Zitat antworten Zitat