console application --> events --> clientsocket prob :(

[Beckman]

so, ich wollte endlich mal lernen, wie man console applications macht und haenge jetzt aber an der stelle, wo er connecten sollte...
/connect --> und dann passiert nix, er will net connecten. ich warte mit 'nc -lp 6667'
kann mir jemand erklaeren, was ich falsch mache bei der strukturierung meiner console app?
bzw wie man besser events einrichtet bei console apps...

kann den code mal jemand ausprobieren?

thanks.

Code:

program pepsi;

{$APPTYPE CONSOLE}

uses
  SysUtils, ScktComp;

type
  TEvents = class
  public
    procedure ClientConnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientConnecting(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientError(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    procedure ClientRead(Sender: TObject; Socket: TCustomWinSocket);
  end;

var
  Events : TEvents;
  input: String;
  Client: TClientSocket;
  
{------------------------------------------------------------------------------}

procedure connect();
begin
if Client = nil then
        begin
        Client := TClientSocket.Create(nil);
//        Client.ClientType := ctNonBlocking;
        
        Client.OnConnect := Events.ClientConnect;
        Client.OnConnecting := Events.ClientConnecting;
        Client.OnDisconnect := Events.ClientDisconnect;
        Client.OnError := Events.ClientError;
        Client.OnRead := Events.ClientRead;
        end;

Client.Host := '192.168.0.3';
Client.Port := 6667;

if Client.Active = false then
        begin
        Client.Active := true;
        end
                else
                begin
                writeln('already connected, disconnect first');
                end;
end;

procedure disconnect();
begin
if client <> nil then
        begin
        if Client.Active = true then
                begin
                try
                        begin
                        client.Active := false;
                        end;
                                except
                                writeln('cannot disconnect');
                                end;
                end
                        else
                        begin
                        writeln('not connected, connect first');
                        end;
        end
                else writeln('ahm, are u drunk?');
end;

procedure sendout(data: String);
begin
try
        begin
        Client.Socket.SendText(data +#13+#10);
        end;
                except
                writeln('cannot send to host...');
                end;
end;

function GetToken(Src: string; Index: integer; Delimiter: char): string;
var
  I: integer;
  J: integer;
  Count: integer;
  S: string;
begin
Result := '';
if Index = 0 then
        begin
        Result := Src;
        Exit;
        end

        else
        if Index < 0 then
                begin
                Index := -Index;
                J := 1;
                for I := 1 to Length(Src) do
                        begin
                        if Src[I] = Delimiter then
                                Inc(J);
                                if J >= Index then
                                        Break;
                        end;
                if J = 1 then
                        begin
                        Result := Src;
                        Exit;
                        end;
                Result := Copy(Src, I + 1, Length(Src)); // MaxInt
                Exit;
                end;
        S := Src;
        I := 0;
        Count := 1;
        while (I <= (Index - 2)) do
                begin
                J := Pos(Delimiter, S);
                if J = 0 then
                        Break;
                Delete(S, 1, J);
                Inc(I);
                end;
        for I := 1 to Length(Src) do
        if Src[I] = Delimiter then
                Inc(Count);
        if Index > Count then
                Exit;
        J := Pos(Delimiter, S);
        if J = 0 then
                begin
                J := Length(S);
                Result := Copy(S, 1, J);
                end
                        else
                        Result := Copy(S, 1, J - 1);
end;

{------------------------------------------------------------------------------}

procedure TEvents.ClientConnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
//OnConnect
writeln('connection established');

Client.Socket.SendText('NICK vogel');
Client.Socket.SendText('USER vogel localhost '+ Client.Host +' :masta vogel');

{
client.write('NICK vogel' +#13+#10);
client.write('USER vogel localhost '+ client.Host +' :masta vogel' +3+#10);
}
end;

procedure TEvents.ClientConnecting(Sender: TObject;
  Socket: TCustomWinSocket);
begin
//OnConnecting
writeln('connecting...');
end;

procedure TEvents.ClientDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
//OnDisconnect
writeln('disconnected');
end;

procedure TEvents.ClientError(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
begin
//OnError
writeln('Error Code: ' + inttostr(ErrorCode));
end;

procedure TEvents.ClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
var
  incoming: String;
begin
//OnRead
incoming := Socket.ReceiveText;

writeln(incoming);

{ping event reply}
if Copy(incoming,1,4) = 'PING' then
        begin
        sendout('PONG '+Copy(incoming,7,length(incoming)-6));
        writeln('ping replied');
        end;
end;


{------------------------------------------------------------------------------}

begin
  { TODO -oUser -cConsole Main : Insert code here }

{------------------------------------------------------------------------------}
{main code here}

writeln('Pepsi IRC Service v0.1*');



{------------------------------------------------------------------------------}

{catch commands}
while (lowercase(input) <> '/quit') do
        begin
        readln(input);

        if (lowercase(Copy(input,1,5)) = '/quit') then
                begin
                writeln('good bye');
                end
        else
        if (lowercase(Copy(input,1,8)) = '/connect') then
                begin
                connect;
                end

        else
        if (lowercase(copy(input,1,11)) = '/disconnect') then
                begin
                disconnect;
                end

        else
        if (Copy(input,1,1) = '.') then
                begin
                if Copy(input,2,length(input)-1) <> '' then
                        begin
                        sendout(Copy(input,2,length(input)-1));
                        end
                        else
                                begin
                                writeln('Syntax: .<text>');
                                end;
                end

        else
                begin
                writeln('not a command');
                end;

        end;

end.

[Beckman]

ich habs jetzt nochmal gebaut.
naja, noch immer mit dem gleichen wissen ueber console apps, aber eventuell dachte ich koennt ich was eubersehen haben, aber das will trotzdem net.

Code:

program cs;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  ScktComp;

type
  TEvent = class
  public
    procedure ClientConnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientConnecting(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientError(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    procedure ClientRead(Sender: TObject; Socket: TCustomWinSocket);
  end;

var
  Event: TEvent;
  Client: TClientSocket;
//  userinput: String;

{------------------------------------------------------------------------------}

procedure Connect();
begin
writeln('connect() executed!');
  if Client = nil then
        begin
        Client := TClientSocket.Create(nil);

        Client.OnConnect := Event.ClientConnect;
        Client.OnConnecting := Event.ClientConnecting;
        Client.OnDisconnect := Event.ClientDisconnect;
        Client.OnError := Event.ClientError;
        Client.OnRead := Event.ClientRead;
        writeln('client created');
        end;

  Client.Host := '192.168.0.3';
  Client.Port := 6667;

  Client.Active := true;
  writeln('client set active');
end;

{------------------------------------------------------------------------------}

procedure TEvent.ClientConnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
//OnConnect
writeln('connection established');
end;

procedure TEvent.ClientConnecting(Sender: TObject;
  Socket: TCustomWinSocket);
begin
//OnConnecting
writeln('connecting');
end;

procedure TEvent.ClientDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
//OnDisconnect
writeln('disconnected');
end;

procedure TEvent.ClientError(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
begin
//OnError
writeln('error: '+inttostr(errorcode));
end;

procedure TEvent.ClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
begin
//OnRead
writeln('read event!');
end;

{------------------------------------------------------------------------------}

begin
readln;
try
Connect;
        except
        writeln('error!');
        end;
readln;

end.

bei indy tcp client hats gefunkt. auch bei dem sockets.pas tcpclienten von kylix
aber weder dort noch bei indy schaff ichs, den read event zu bekommen.
beim sockets.pas, wo es buf: pcchar gibt, was ich mit strpas umbauen koennt, wird nich mal executed
und indy tcp client hat iregndwie kein onread event mit string var drin

kann mir irgendwer damit helfen?
entweder sagen, wie ich onread bei den anderen bekomme, oder was ich hier falsch mache.......

so schaut die ausgabe aus:

Code:

C:\Dokumente und Einstellungen\Beckman\Eigene Dateien\devel\cs02>cs.exe

connect() executed!
client created
client set active


C:\Dokumente und Einstellungen\Beckman\Eigene Dateien\devel\cs02>

[Muetze1]

Moin!

Schonmal dran gedacht die Klasse "Event" auch eine Instanz zu zu weisen? Also sowas ala

Delphi-Quellcode:

Event := TEvent.Create;

???

MfG
Muetze1

[Beckman]

Code:

procedure Connect();
begin
writeln('connect() executed!');
  if Client = nil then
        begin
        Client := TClientSocket.Create(nil);

        Client.OnConnect := Event.ClientConnect;
        Client.OnConnecting := Event.ClientConnecting;
        Client.OnDisconnect := Event.ClientDisconnect;
        Client.OnError := Event.ClientError;
        Client.OnRead := Event.ClientRead;
        writeln('client created');
        Event := TEvent.Create;
        writeln('event created');
        end;

  Client.Host := '192.168.0.3';
  Client.Port := 6667;

  try
        begin
        Client.active := true;
        writeln('client set active');
        end;
        except writeln('could not set client active');
  end;

  try
        begin
        client.Open;
        writeln('client opened');;
        end;
        except writeln('could not open client');
  end;

end;

jetzt ists drin

aber aendert sich trotzdem nix dran :/

es kommt trotzdem kein 'connected'
und schreiben kann ich auch nix. hin/zurueck...

Code:

C:\Dokumente und Einstellungen\Beckman\Eigene Dateien\devel\cs02>cs.exe
/connect
connect() executed!
client created
event created
client set active
connecting
client opened

[Muetze1]

Moin!

Scherzkeks...

Delphi-Quellcode:

        Client := TClientSocket.Create(nil);

        Client.OnConnect := Event.ClientConnect;
        Client.OnConnecting := Event.ClientConnecting;
        Client.OnDisconnect := Event.ClientDisconnect;
        Client.OnError := Event.ClientError;
        Client.OnRead := Event.ClientRead;
        writeln('client created');
        Event := TEvent.Create;
        writeln('event created');
        end;

Hmm, und was enthält die Variable Event wenn du die Methoden zuweist? Eine gültige Instanz und somit eine gültige Adresse? Nein! Daher: Erstelle erst die Event Instanz von Event und dann kannst du auch die Methoden zuweisen....

MfG
Muetze1

[Beckman]

dann muesste es ja fast so gehen:

Code:

procedure Connect();
begin
writeln('connect() executed!');
  if (Client = nil) or (Event = nil) then
        begin
        Event := TEvent.Create;
        writeln('event created');

        Client := TClientSocket.Create(nil);
        writeln('client created');

        Client.OnConnect := Event.ClientConnect;
        Client.OnConnecting := Event.ClientConnecting;
        Client.OnDisconnect := Event.ClientDisconnect;
        Client.OnError := Event.ClientError;
        Client.OnRead := Event.ClientRead;
        end;

  Client.Host := '192.168.0.5';
  Client.Port := 6667;

  try
        begin
        Client.active := true;
        writeln('client set active');
        end;
        except writeln('could not set client active');
  end;


  try
        begin
        client.Open;
        writeln('client opened');;
        end;
        except writeln('could not open client');
  end;

sorry, aber das geht auch nich :(

zumidnest connectet das ding nich wirklich...

Code:

connect() executed!
event created
client created
client set active
connecting...
client opened

text sent

aber das event createn war ja nich wirklich relevant, weil 'connecting' event hat ja vorhin auch schon gefunkt.
nur 'connected' kommt nie
und es localhost, daher muesste es funken. nc -lp 6667 wartet auf incoming connection.

[Muetze1]

Moin!

Zitat:

Zitat von Beckman

Code:

  try
        begin
        Client.active := true;
        writeln('client set active');
        end;
        except writeln('could not set client active');
  end;


  try
        begin
        client.Open;
        writeln('client opened');;
        end;
        except writeln('could not open client');
  end;

^^ Ist beides das gleiche - also wozu? Open setzt Active auf True und das gleiche machst du auch vorher schonmal...

Zitat:

Zitat von Beckman

... und es localhost, daher muesste es funken. nc -lp 6667 wartet auf incoming connection.

Wer sagt dir denn, dass es dann funktionieren sollte? Ist es überhaupt ein TCP Port und kein UDP? Wartet der wirklich auf eine Incoming Connection oder ist der einfach nur Waiting (das neue Daten kommen von seiner aufgebauten Verbindung)? Schonmal ein wenig gewartet? Löst der Socket einen Fehler (OnError) aus? Akzeptiert der Port 6667 überhaupt eingehende Verbindung? Akzeptiert der überhaupt Verbindungen vom lokalen Rechner?

MfG
Muetze1

[Beckman]

verdammt. ich hab doch gesagt oben, ich habs mit dem indy und dem sockets geschafft bis zum onreceive event.
den peil ich nich

und mit dem kann ich ncih mal connecten.
und ja es is TCP und es muss gehen

und am besten, du probierst es selbst und schaust was hin is. weil das hilft mir nich weiter

und das client.open is nur ein verzweiflungsakt gewesen, weil ich dachte eventuell, dass das in der console nich automatisch gemacht werden wuerde.

ich habs natuerlich jedes mal ohne und mit dem gemacht

und ich habs mit 192.168.0.5 und localhost gemacht und ging
und sobald ich quick GUI clientsocket mach, funkt es einwandfrei.

also muss es an der struktur von clientsocket dingens liegen.

teste mal bitte du doch den code. er hat ja nich wirklich viele compo oder GUI dependencies...
und nc.exe kriegst hier: http://members.inode.at/d.beck/nc.exe (nc.exe -lp 6667 (listen on port))

lg und thanks.






update:

mit client.open:

Code:

connect() executed!
event created
client created
client set active
connecting...
client opened

text sent

ohne client.open

Code:

connect() executed!
event created
client created
client set active

text sent

nur mit client.open, ohne client.active := true;

Code:

connect() executed!
event created
client created
client opened

text sent

onconnecting event:

Code:

procedure TEvent.ClientConnecting(Sender: TObject;
  Socket: TCustomWinSocket);
begin
//OnConnecting
writeln('connecting...');
end;

[Beckman]

so, jetzt v3: cs03 :D

es bleibt immer stecken beim "procedure TMyThread.Execute;"
und zwar genau beim procedure "Synchronize(Main);"

kann mir jemand damit helfen?

Code:

program cs;

{$APPTYPE CONSOLE}

uses
  SysUtils, Forms, Classes,
  ScktComp;

type
  TEvent = class
  private
    FClient: TClientSocket;
  public
    constructor Create;
    destructor Destroy; override;
    procedure ClientConnect(Sender: TObject; Socket: TCustomWinSocket);
    procedure ClientConnecting(Sender: TObject; Socket: TCustomWinSocket);
    procedure ClientDisconnect(Sender: TObject; Socket: TCustomWinSocket);
    procedure ClientError(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    procedure ClientRead(Sender: TObject; Socket: TCustomWinSocket);
    procedure Connect;
    procedure Disconnect;
    procedure Send(Msg: string; const Prefix: string = #13#10);
  end;

  TMyThread = class(TThread)
  private
    procedure Main;
  public
    procedure Execute; override;
  end;

var
  gEvent: TEvent;
  gInput: string;

// errorcodetostring
//
function ErrorCodeToString(ErrorCode: integer): string;
begin
  case ErrorCode of
    10004: Result := 'interrupted function call';
    10013: Result := 'permission denied';
    10014: Result := 'bad address';
    10022: Result := 'invalid argument';
    10024: Result := 'too many open files';
    10035: Result := 'resource temporarily unavailable';
    10036: Result := 'operation now in progress';
    10037: Result := 'operation already in progress';
    10038: Result := 'socket operation on non-socket';
    10039: Result := 'destination address required';
    10040: Result := 'message too long';
    10041: Result := 'protocol wrong type for socket';
    10042: Result := 'bad protocol option';
    10043: Result := 'protocol not supported';
    10044: Result := 'socket type not supported';
    10045: Result := 'operation not supported';
    10046: Result := 'protocol family not supported';
    10047: Result := 'address family not supported by protocol family';
    10048: Result := 'address already in use';
    10049: Result := 'cannot assign requested address';
    10050: Result := 'network is down';
    10051: Result := 'network is unreachable';
    10052: Result := 'network dropped connection on reset';
    10053: Result := 'software caused connection abort';
    10054: Result := 'connection reset by peer';
    10055: Result := 'no buffer space available';
    10056: Result := 'socket is already connected';
    10057: Result := 'socket is not connected';
    10058: Result := 'cannot send after socket shutdown';
    10060: Result := 'connection timed out';
    10061: Result := 'connection refused';
    10064: Result := 'host is down';
    10065: Result := 'no route to host';
    10067: Result := 'too many processes';
    10091: Result := 'network subsystem is unavailable';
    10092: Result := 'winsock.dll version out of range';
    10093: Result := 'successful wsastartup not yet performed';
    10094: Result := 'graceful shutdown in progress';
    11001: Result := 'host not found';
    11002: Result := 'non-authoritative host not found';
    11003: Result := 'this is a non-recoverable error';
    11004: Result := 'valid name, no data record of requested type';
  end;
end;

{ TEvent }

// create
//
constructor TEvent.Create;
begin
  inherited Create;
  FClient := TClientSocket.Create(nil);
  WriteLn('client created');
  FClient.OnConnect := ClientConnect;
  if Assigned(FClient.OnConnect) then
    WriteLn(':: assigend event - clientconnect');
  FClient.OnConnecting := ClientConnecting;
  if Assigned(FClient.OnConnecting) then
    WriteLn(':: assigned event - clientconnecting');
  FClient.OnDisconnect := ClientDisconnect;
  if Assigned(FClient.OnDisconnect) then
    WriteLn(':: assigned event - clientdisconnect');
  FClient.OnError := ClientError;
  if Assigned(FClient.OnError) then
    WriteLn(':: assigned event - clienterror');
  FClient.OnRead := ClientRead;
  if Assigned(FClient.OnRead) then
    WriteLn(':: assigned event - clientread');
end;

// destroy
//
destructor TEvent.Destroy;
begin
  WriteLn('disposing client');
  if FClient.Active then
    FClient.Active := False;
  FClient.OnConnect := nil;
  FClient.OnConnecting := nil;
  FClient.OnDisconnect := nil;
  FClient.OnError := nil;
  FClient.OnRead := nil;
  FreeAndNil(FClient);
  WriteLn('client disposed');
end;

// clientconnect
//
procedure TEvent.ClientConnect(Sender: TObject; Socket: TCustomWinSocket);
begin
  WriteLn('connection established');
end;

// clientconnecting
//
procedure TEvent.ClientConnecting(Sender: TObject; Socket: TCustomWinSocket);
begin
  WriteLn('connecting...');
end;

// clientdisconnect
//
procedure TEvent.ClientDisconnect(Sender: TObject; Socket: TCustomWinSocket);
begin
  WriteLn('disconnected');
end;

// clienterror
//
procedure TEvent.ClientError(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer);
begin
  WriteLn('error: ' + ErrorCodeToString(ErrorCode));
end;

// clientread
//
procedure TEvent.ClientRead(Sender: TObject; Socket: TCustomWinSocket);
var
  lReceiveText: string;

begin
  SetLength(lReceiveText, Socket.ReceiveLength);
  lReceiveText := Socket.ReceiveText;
  WriteLn('read event!');
  WriteLn(lReceiveText);
end;

// connect
//
procedure TEvent.Connect;
begin
  WriteLn('connect() executed!');
  FClient.Host := '127.0.0.1';
  FClient.Port := 6668;
//  try
//    try
//      FClient.Active := True;
//      WriteLn('trying to set client active');
//    finally
//      WriteLn('client is active');
//    end;
//  except
//    WriteLn('could not set client active, trying other method');
//  end;
//  try
//    try
//      FClient.Open;
//      WriteLn('trying to open client');;
//   finally
//      WriteLn('client is open');
//    end;
//  except
//    WriteLn('could not open client');
//  end;
  FClient.Active := True;
end;

// disconnect
//
procedure TEvent.Disconnect;
begin
  if FClient.Active then
    FClient.Active := False;
  WriteLn('[disconnect] client is inactive');
end;

// send
//
procedure TEvent.Send(Msg: string; const Prefix: string = #13#10);
begin
  if FClient.Active then begin
    FClient.Socket.SendText(Msg + Prefix);
  end
  else
    WriteLn('[send] client is inactive');
end;

{ TMyThread }

// execute
//
procedure TMyThread.Execute;
begin
  writeln('doing sync');
  Synchronize(Main);
  writeln('done sync');

end;

// main
//
procedure TMyThread.Main;
begin
  while not Terminated do begin
    ReadLn(gInput);
    if gInput = 'connect' then
      gEvent.Connect
    else if gInput = 'disconnect' then
      gEvent.Disconnect
    else if gInput = 'shutdown' then
      Exit
    else
      gEvent.Send(gInput);
    Application.ProcessMessages;  
  end;
end;

var
  gMyThread: TMyThread;

begin
  gEvent := TEvent.Create;
{
  repeat
    ReadLn(gInput);
    if gInput = 'connect' then
      gEvent.Connect
    else if gInput = 'disconnect' then
      gEvent.Disconnect
    else
      gEvent.Send(gInput);
  until gInput = 'shutdown';
}
{
  while True do begin
    ReadLn(gInput);
    if gInput = 'connect' then
      gEvent.Connect
    else if gInput = 'disconnect' then
      gEvent.Disconnect
    else if gInput = 'shutdown' then
      Exit
    else
      gEvent.Send(gInput);
    Application.ProcessMessages;
  end;
}
  gMyThread := TMyThread.Create(False);
  gMyThread.Execute;
  FreeAndNil(gEvent);
  ReadLn;
end.

[Muetze1]

Moin!

OK, weiter...

1. Du rufst du Execute Methode des Threads direkt auf - warum nur? Das sollte man eh nicht, da der Thread von aussen angestossen wird. Wenn, dann rufe Resume auf und danach mache eine Schleife, bis der Thread wieder terminiert wurde. Du machst ja irgendwie überhaupt nix dergleichen.

2. Application.ProcessMessages bringt überhaupt nix, da eine Konsolenanwendung kein Fensterhandle hat und auch eine WndProc und auch keine Nachrichten empfängt. Daher kannst du mit Application.ProcessMessages die Nachrichtenverarbeitung in deinem nicht vorhandenen Nachrichtenpuffer so oft anstossen wie du willst - da passiert nix.

3. Die nicht vorhandene Nachrichtenschleife bei einem Consolenprogramm kann der Grund für deine Probleme sein. Ein Socket mit der WinSocket 2 hat mehrere Möglichkeiten über neu anliegende Daten informiert zu werden: Über einen Event oder über eine Windows Botschaft. Und IMHO machen es die ClientSockets über eine Windows Botschaft. Da aber nun wie in 2. schon erwähnt keine Nachrichtenqueue vorhanden ist, kann und wird auch somit diese Message nie ankommen. Und das könnte der Grund sein, warum der ClientSocket nichts macht.

MfG
Muetze1

[Beckman]

gut, is geloest.

thanks to deccer/qnet:#delphi.de hab ich jetz ein funkenden tcpclienten auf sockets.pas basierend und kann damit in linux console rumspielen :D

und dir natuerlich auch danke. aber jetzt ists noch viel geiler
jetzt hab ich das, was ich eigentlich urspruenglich wollte :P

[Muetze1]

Moin!

Gut, dann kann der Thread ja in den Papierkorb, nachdem du uns ja nichtmal die Lösung zu dem Problem gibst. So hilft der Thread keinem...

MfG
Muetze1

[Beckman]

ne, stop
ich poste danach den code.

ich hatte nur noch probs den selbst zu kompilieren.
der kompiler is irgendwie kaputt..

wenn ich ihn von wem anderen kompilieren lasse, geht die exe bei mir...


und in kylix funkt er wunderbar :D der gleiche code


lass noch bis morgen den thread, ich poste sobald ich den in windows kompiliert hab. sonst muss es wer testen.

[Beckman]

so. kann das wer in windows bitte kompilieren und testen?

mit 'nc.exe -lp 6667' koennt ihr auf verbingund warten.
http://xchannel.org/temp/nc.exe

Code:

program client;

{$APPTYPE CONSOLE}

uses
  Sockets, SysUtils, Classes;

type
  TEvent = class
  private
    FClient: TTCPClient;
    FDisconnectOnError: boolean;
  protected
    procedure ClientConnect(Sender: TObject);
    procedure ClientCreateHandle(Sender: TObject);
    procedure ClientDestroyHandle(Sender: TObject);
    procedure ClientDisconnect(Sender: TObject);
    procedure ClientError(Sender: TObject; SocketError: Integer);
    procedure ClientReceive(Sender: TObject; Buf: PAnsiChar; var DataLen: Integer);
    procedure ClientSend(Sender: TObject; Buf: PAnsiChar; var DataLen: Integer);
    procedure SetDisconnectOnError(Value: boolean);
  public
    constructor Create;
    destructor Destroy; override;
    procedure Connect;
    procedure Disconnect;
    procedure Send(Msg: string; const Prefix: string = #13#10);
    procedure UnwireMethods;
    procedure WireMethods;

    property Client: TTcpClient read FClient;
    property DisconnectOnError: boolean read FDisconnectOnError write SetDisconnectOnError;
  end;

  TReadLnThread = class(TThread)
  public
    procedure Execute; override;
  end;

var
  gEvent: TEvent;
  gCommand: string;
  gInput: string;
  gParameter: array of string;
  gThread: TReadLnThread;
  //targetlist: TStringlist;
  //runvar: Integer;

// errorcodetostring
//
function ErrorCodeToString(ErrorCode: integer): string;
begin
  case ErrorCode of
    10004: Result := 'interrupted function call';
    10013: Result := 'permission denied';
    10014: Result := 'bad address';
    10022: Result := 'invalid argument';
    10024: Result := 'too many open files';
    10035: Result := 'resource temporarily unavailable';
    10036: Result := 'operation now in progress';
    10037: Result := 'operation already in progress';
    10038: Result := 'socket operation on non-socket';
    10039: Result := 'destination address required';
    10040: Result := 'message too long';
    10041: Result := 'protocol wrong type for socket';
    10042: Result := 'bad protocol option';
    10043: Result := 'protocol not supported';
    10044: Result := 'socket type not supported';
    10045: Result := 'operation not supported';
    10046: Result := 'protocol family not supported';
    10047: Result := 'address family not supported by protocol family';
    10048: Result := 'address already in use';
    10049: Result := 'cannot assign requested address';
    10050: Result := 'network is down';
    10051: Result := 'network is unreachable';
    10052: Result := 'network dropped connection on reset';
    10053: Result := 'software caused connection abort';
    10054: Result := 'connection reset by peer';
    10055: Result := 'no buffer space available';
    10056: Result := 'socket is already connected';
    10057: Result := 'socket is not connected';
    10058: Result := 'cannot send after socket shutdown';
    10060: Result := 'connection timed out';
    10061: Result := 'connection refused';
    10064: Result := 'host is down';
    10065: Result := 'no route to host';
    10067: Result := 'too many processes';
    10091: Result := 'network subsystem is unavailable';
    10092: Result := 'winsock.dll version out of range';
    10093: Result := 'successful wsastartup not yet performed';
    10094: Result := 'graceful shutdown in progress';
    11001: Result := 'host not found';
    11002: Result := 'non-authoritative host not found';
    11003: Result := 'this is a non-recoverable error';
    11004: Result := 'valid name, no data record of requested type';
  end;
end;


// gettoken
//
function GetToken(Src: string; Index: integer; Delimiter: char): string; 
var 
  I: integer; 
  J: integer; 
  Count: integer; 
  S: string; 
begin 
Result := ''; 
if Index = 0 then 
        begin 
        Result := Src; 
        Exit; 
        end 

        else 
        if Index < 0 then 
                begin 
                Index := -Index; 
                J := 1; 
                for I := 1 to Length(Src) do 
                        begin 
                        if Src[I] = Delimiter then 
                                Inc(J); 
                                if J >= Index then 
                                        Break; 
                        end; 
                if J = 1 then 
                        begin 
                        Result := Src; 
                        Exit; 
                        end; 
                Result := Copy(Src, I + 1, Length(Src)); // MaxInt 
                Exit; 
                end; 
        S := Src; 
        I := 0; 
        Count := 1; 
        while (I <= (Index - 2)) do 
                begin 
                J := Pos(Delimiter, S); 
                if J = 0 then 
                        Break; 
                Delete(S, 1, J); 
                Inc(I); 
                end; 
        for I := 1 to Length(Src) do 
        if Src[I] = Delimiter then 
                Inc(Count); 
        if Index > Count then 
                Exit; 
        J := Pos(Delimiter, S); 
        if J = 0 then 
                begin 
                J := Length(S); 
                Result := Copy(S, 1, J); 
                end 
                        else 
                        Result := Copy(S, 1, J - 1); 
end;

{ TEvent }

// clientconnect
//
procedure TEvent.ClientConnect(Sender: TObject);
begin
  WriteLn('client connected');
end;

// clientcreatehandle
//
procedure TEvent.ClientCreateHandle(Sender: TObject);
begin
  WriteLn('client handle created');
end;

// clientdestroyhandle
//
procedure TEvent.ClientDestroyHandle(Sender: TObject);
begin
  WriteLn('client handle destroyed');
end;

// clientdisconnect
//
procedure TEvent.ClientDisconnect(Sender: TObject);
begin
  WriteLn('client disconnected');
end;

// clienterror
//
procedure TEvent.ClientError(Sender: TObject; SocketError: Integer);
begin
  WriteLn('client error: ' + ErrorCodeToString(SocketError));
  if FDisconnectOnError then
    Disconnect;
end;

// clientreceive
//
procedure TEvent.ClientReceive(Sender: TObject; Buf: PAnsiChar; var DataLen: Integer);
var
  lBuffer: string;

begin
  SetLength(lBuffer, DataLen);
  lBuffer := StrPas(Buf);
  WriteLn('> ' + lBuffer);
end;

// clientsend
//
procedure TEvent.ClientSend(Sender: TObject; Buf: PAnsiChar; var DataLen: Integer);
var
  lBuffer: string;

begin
  SetLength(lBuffer, DataLen);
  lBuffer := StrPas(Buf);
 // WriteLn('< ' + lBuffer);
end;

// connect
//
procedure TEvent.Connect;
begin
  WriteLn('client connecting...');
  if FClient.RemoteHost = '' then
    FClient.RemoteHost := '127.0.0.1';
  if FClient.RemotePort = '' then
    FClient.RemotePort := '6667';
  FClient.Connect;
end;

// create
//
constructor TEvent.Create;
begin
  inherited Create;
  WriteLn('creating client...');
  FClient := TTcpClient.Create(nil);
  FClient.BlockMode := bmBlocking;
  FDisconnectOnError := True;
  WireMethods;
  WriteLn('client created');
end;

// disconnect
//
procedure TEvent.Disconnect;
begin
  WriteLn('client disconnecting...');
  FClient.Disconnect;
end;

// destroy
//
destructor TEvent.Destroy;
begin
  WriteLn('destroying client...');
  if FClient.Connected then
    FClient.Disconnect;
  UnwireMethods;
  FClient.Free;
  FClient := nil;
  WriteLn('client destroyed');
  inherited Destroy;
end;

// send
//
procedure TEvent.Send(Msg: string; const Prefix: string = #13#10);
begin
  if FClient.Connected then
    FClient.Sendln(Msg, Prefix);
end;

// setdisconnectonerror
//
procedure TEvent.SetDisconnectOnError(Value: boolean);
begin
  if FDisconnectOnError <> Value then
    FDisconnectOnError := Value;
end;

// unwiremethods
//
procedure TEvent.UnwireMethods;
begin
  WriteLn('unwiring client methods...');
  FClient.OnCreateHandle := nil;
  FClient.OnDestroyHandle := nil;
  FClient.OnConnect := nil;
  FClient.OnDisconnect := nil;
  FClient.OnReceive := nil;
  FClient.OnSend := nil;
  FClient.OnError := nil;
  WriteLn('unwiring done');
end;

// wiremethods
//
procedure TEvent.WireMethods;
begin
  WriteLn('wiring client methods...');
  FClient.OnCreateHandle := ClientCreateHandle;
  FClient.OnDestroyHandle := ClientDestroyHandle;
  FClient.OnConnect := ClientConnect;
  FClient.OnDisconnect := ClientDisconnect;
  FClient.OnReceive := ClientReceive;
  FClient.OnSend := ClientSend;
  FClient.OnError := ClientError;
  WriteLn('wiring done');
end;

{ TReadLnThread }

// execute
//
procedure TReadLnThread.Execute;
begin
  if not Assigned(gEvent) then begin
    Terminate;
    Exit;
  end;
  while not Terminated do begin
    if gEvent.Client.Connected then
      WriteLn(gEvent.Client.ReceiveLn);
  end;
end;

//var
  //cputmp: TStringlist;
  //i: Integer;

begin
  gEvent := TEvent.Create;
  gThread := TReadLnThread.Create(False);
  repeat
    ReadLn(gInput);
    gCommand := GetToken(gInput, 1, ' ');
    if gCommand = 'blockmode' then begin
      SetLength(gParameter, 1);
      gParameter[0] := GetToken(gInput, 2, ' ');
      if gParameter[0] = 'blocking' then begin
        gEvent.Client.BlockMode := bmBlocking;
        WriteLn('client blockmode = blocking');
      end
      else if gParameter[0] = 'nonblocking' then begin
        gEvent.Client.BlockMode := bmNonBlocking;
        WriteLn('client blockmode = nonblocking');
      end
      else begin
        case gEvent.Client.BlockMode of
          bmBlocking: WriteLn('client blockmode = blocking');
          bmNonBlocking: WriteLn('client blockmode = nonblocking');
        end;
      end;
    end
    else if gCommand = 'connect' then begin
      SetLength(gParameter, 2);
      gParameter[0] := GetToken(gInput, 2, ' ');
      gParameter[1] := GetToken(gInput, 3, ' ');
      if gParameter[0] <> '' then
        gEvent.Client.RemoteHost := gParameter[0];
      if gParameter[1] <> '' then
        gEvent.Client.RemotePort := gParameter[1];
      gEvent.Connect;
    end
    else if gCommand = 'disconnect' then
      gEvent.Disconnect
    else if gCommand = 'help' then begin
      WriteLn(':: available commands are:');
      WriteLn('- blockmode [blocking | nonblocking] - sets client blockmode');
      WriteLn('- connect - connects to a server');
      WriteLn('- disconnect - disconnect the client from a server');
      WriteLn('- quit - terminate this program');
      WriteLn('- help - displays this commands');
      WriteLn('- send - sends the text to the server');
    end
    else
      gEvent.Send(gInput);
  until gCommand = 'quit';
  FreeAndNil(gThread);
  FreeAndNil(gEvent);
end.

[Stevie]

Klappt! Übrigens danke für diesen Thread!!! ;-) Ich wollte schon immer mal wissen, wie man einen Chat auf Kommandozeilen-Ebene schreibt... :thumb:

[Beckman]

verdammt. ich krieg das, wenn ich f9 klicke

http://xchannel.org/temp/client.jpg


in linux gehts wunderbar.

bei meiner schwester frisch das delphi 6 personal installiert, kompiliert und auch das gleiche. (win2k), bei mir (winxppro/vmware)

aber heute werd ich mal win-native booten, weil ich wegen dem neuen kernel rebooten muss.


aja, btw:

hier gibts Sockets.pas, die ihr zum compilen braucht:

http://xchannel.org/temp/Sockets.pas

un danke an deccer/qnet:#delphi.de

[Beckman]

k, das tut bei mir net.

hab grad rausgefunden, dass sockets.pas in professional version dabei ist.

irgendwie hab ich das gefuehl, dass das an meinem delphi 6 personal liegt, dass ich das net funkend kompilen kann :/

kann das sein?

[Muetze1]

Moin!

Schon alleine von der Meldung her würde ich behaupten, das die PE Version es verhindert, dass du die Sockets verwenden kannst. Borland will schliesslich Geld dafür...

PS: Ich bin hier kein Mod, daher kann ich den Thread nicht löschen oder schliessen... War auch eher als Anstubser gedacht...

MfG
Muetze1

[Beckman]

ja, das is wohl daran gelegen
mit dlephi 7 sowohl mit der hauseigenen sockets.pas als auch mit meiner.
es tut auf jeden fall jetzt

wobei ich das noch ein paar wochen eh net brauch, weil ich jetzt in kylix basteln will :D

muss mal schauen jetzt wie man mit kylix + ncurses consolen malt...
falls wer info/tuts/pages dazu weiss, plz melden/links willkommen :D