paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-18 14:49:11 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ adds LocalEcho property to TLTelnetClient

Browse Source 
* fixes telnet example to do proper error reporting and lineendings

git-svn-id: trunk@5267 -
This commit is contained in:
Almindor 2006-11-06 21:41:22 +00:00
parent b07cd83892
commit 2599c81018
2 changed files with 22 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
fcl/lnet/examples/ltelnet/ltclient.pp
View File

@ -30,6 +30,7 @@ type
constructor TLTelnetTest.Create; constructor TLTelnetTest.Create;
begin begin
FCon:=TLTelnetClient.Create(nil); FCon:=TLTelnetClient.Create(nil);
FCon.OnError:=@OnError;
end; end;
destructor TLTelnetTest.Destroy; destructor TLTelnetTest.Destroy;
@ -46,9 +47,8 @@ end;
procedure TLTelnetTest.Run; procedure TLTelnetTest.Run;
var var
s: string; s, SendStr: string;
c: Char; c: Char;
l: Longint; // length of line currently written
AD: string; AD: string;
PORT: Word; PORT: Word;
begin begin
@ -63,8 +63,9 @@ begin
Writeln('Usage: ', ExtractFileName(ParamStr(0)), ' IP PORT'); Writeln('Usage: ', ExtractFileName(ParamStr(0)), ' IP PORT');
Exit; Exit;
end; end;
FQuit:=False; FQuit:=False;
l:=0;
if FCon.Connect(AD, PORT) then begin if FCon.Connect(AD, PORT) then begin
Writeln('Connecting... press any key to cancel'); Writeln('Connecting... press any key to cancel');
repeat repeat
@ -73,27 +74,28 @@ begin
if KeyPressed then if KeyPressed then
Halt; Halt;
until FCon.Connected; // wait until timeout or we actualy connected until FCon.Connected; // wait until timeout or we actualy connected
SendStr:='';
while not FQuit do begin // if we connected, do main loop while not FQuit do begin // if we connected, do main loop
if KeyPressed then begin if KeyPressed then begin
c:=ReadKey; c:=ReadKey;
case c of case c of
#27: FQuit:=True; #27: FQuit:=True;
#8: if l > 0 then #8: if Length(SendStr) > 0 then begin
begin GotoXY(WhereX-1, WhereY);
GotoXY(WhereX-1, WhereY); Write(' ');
Write(' '); GotoXY(WhereX-1, WhereY);
Dec(l); SetLength(SendStr, Length(SendStr) - 1);
FCon.SendMessage(c); end;
end; else if c = #13 then begin
else begin Writeln;
Inc(l); FCon.SendMessage(SendStr + #13#10);
if c = #13 then begin SendStr:='';
Writeln; end else begin
l:=0; SendStr:=SendStr + c;
Write(c);
end; end;
FCon.SendMessage(c);
end;
end; end;
end; end;
if FCon.GetMessage(s) > 0 then if FCon.GetMessage(s) > 0 then

4
fcl/lnet/ltelnet.pp
View File

@ -124,6 +124,7 @@ type
TLTelnetClient = class(TLTelnet, ILClient) TLTelnetClient = class(TLTelnet, ILClient)
protected protected
FLocalEcho: Boolean;
procedure OnEr(const msg: string; aSocket: TLSocket); procedure OnEr(const msg: string; aSocket: TLSocket);
procedure OnDs(aSocket: TLSocket); procedure OnDs(aSocket: TLSocket);
procedure OnRe(aSocket: TLSocket); procedure OnRe(aSocket: TLSocket);
@ -139,6 +140,7 @@ type
function SendMessage(const msg: string; aSocket: TLSocket = nil): Integer; override; function SendMessage(const msg: string; aSocket: TLSocket = nil): Integer; override;
procedure SendCommand(const aCommand: Char; const How: TLHowEnum); procedure SendCommand(const aCommand: Char; const How: TLHowEnum);
procedure CallAction; override; procedure CallAction; override;
property LocalEcho: Boolean read FLocalEcho write FLocalEcho;
end; end;
implementation implementation
@ -424,7 +426,7 @@ begin
SetLength(Tmp, aSize); SetLength(Tmp, aSize);
Move(aData, PChar(Tmp)^, aSize); Move(aData, PChar(Tmp)^, aSize);
DoubleIAC(Tmp); DoubleIAC(Tmp);
if (not OptionIsSet(TS_ECHO)) and (not OptionIsSet(TS_HYI)) then if LocalEcho and (not OptionIsSet(TS_ECHO)) and (not OptionIsSet(TS_HYI)) then
FOutput.Write(PChar(Tmp)^, Length(Tmp)); FOutput.Write(PChar(Tmp)^, Length(Tmp));
Result:=FConnection.SendMessage(Tmp); Result:=FConnection.SendMessage(Tmp);
end; end;