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

[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