?? tncnx.pas
字號:
else
Result := wsInvalidState;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TTnCnx.SocketSessionConnected(Sender: TObject; Error : word);
begin
if Assigned(FOnSessionConnected) then
FOnSessionConnected(Self, Error);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TTnCnx.SocketSessionClosed(Sender: TObject; Error : word);
begin
if Socket.State <> wsClosed then
Socket.Close;
if Assigned(FOnSessionClosed) then
FOnSessionClosed(Self, Error);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TTnCnx.SocketDataAvailable(Sender: TObject; Error : word);
var
Len, I : Integer;
Buffer : array [1..2048] of char;
Socket : TWSocket;
begin
Socket := Sender as TWSocket;
Len := Socket.Receive(@Buffer[1], High(Buffer));
if Len = 0 then begin
{ Remote has closed }
Display(#13 + #10 + '**** Remote has closed ****' + #13 + #10);
end
else if Len < 0 then begin
{ An error has occured }
if Socket.LastError <> WSAEWOULDBLOCK then
Display(#13 + #10 + '**** ERROR: ' + IntToStr(Socket.LastError) +
' ****' + #13 + #10);
end
else begin
for I := 1 to Len do
ReceiveChar(Buffer[I]);
FlushBuffer;
end;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TTnCnx.Send(Data : Pointer; Len : Integer) : integer;
begin
if Assigned(Socket) then
Result := Socket.Send(Data, Len)
else
Result := -1;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TTnCnx.SendStr(Data : String) : integer;
begin
Result := Send(@Data[1], Length(Data));
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TTnCnx.Answer(chAns : Char; chOption : Char);
var
Buf : String[3];
begin
{ DebugString('Answer ' + IntToHex(ord(chAns), 2) + ' ' + IntToHex(ord(ChOption), 2) + #13 + #10); }
Buf := TNCH_IAC + chAns + chOption;
Socket.Send(@Buf[1], Length(Buf));
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TTnCnx.WillOption(chOption : Char);
begin
Answer(TNCH_WILL, chOption);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TTnCnx.WontOption(chOption : Char);
begin
Answer(TNCH_WONT, chOption);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TTnCnx.DontOption(chOption : Char);
begin
Answer(TNCH_DONT, chOption);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TTnCnx.DoOption(chOption : Char);
begin
Answer(TNCH_DO, chOption);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TTnCnx.NegociateSubOption(strSubOption : String);
var
Buf : String;
begin
{ DebugString('SubNegociation ' +
IntToHex(ord(strSubOption[1]), 2) + ' ' +
IntToHex(ord(strSubOption[2]), 2) + #13 + #10); }
case strSubOption[1] of
TN_TERMTYPE:
begin
if strSubOption[2] = TN_TTYPE_SEND then begin
{ DebugString('Send TermType' + #13 + #10); }
if Assigned(FOnTermType) then
FOnTermType(Self);
Buf := TNCH_IAC + TNCH_SB + TN_TERMTYPE + TN_TTYPE_IS + FTermType + TNCH_IAC + TNCH_SE;
Socket.Send(@Buf[1], Length(Buf));
end;
end;
else
{ DebugString('Unknown suboption' + #13 + #10); }
end;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TTnCnx.NegociateOption(chAction : Char; chOption : Char);
var
Buf : String;
begin
{ DebugString('Negociation ' + IntToHex(ord(chAction), 2) + ' ' +
IntToHex(ord(ChOption), 2) + #13 + #10); }
case chOption of
TN_TRANSMIT_BINARY:
begin
if chAction = TNCH_WILL then begin
Answer(TNCH_DO, chOption);
RemoteBinMode := TRUE;
LocalBinMode := TRUE;
end
else if chAction = TNCH_WONT then begin
if RemoteBinMode then begin
RemoteBinMode := FALSE;
LocalBinMode := FALSE;
end;
end;
end;
TN_ECHO:
begin
if chAction = TNCH_WILL then begin
Answer(TNCH_DO, chOption);
FLocalEcho := FALSE;
end
else if chAction = TNCH_WONT then begin
FLocalEcho := TRUE;
end;
if Assigned(FOnLocalEcho) then
FOnLocalEcho(self);
end;
TN_SUPPRESS_GA:
begin
if chAction = TNCH_WILL then begin
Answer(TNCH_DO, chOption);
spga := TRUE;
end;
end;
TN_TERMTYPE:
begin
if chAction = TNCH_DO then begin
Answer(TNCH_WILL, chOption);
FTType := TRUE;
end;
end;
TN_SEND_LOC:
begin
if chAction = TNCH_DO then begin
Answer(TNCH_WILL, chOption);
if Assigned(FOnSendLoc) then
FOnSendLoc(Self);
Buf := TNCH_IAC + TNCH_SB + TN_SEND_LOC + FLocation + TNCH_IAC + TNCH_SE;
Socket.Send(@Buf[1], Length(Buf));
end;
end;
TN_EOR:
begin
if chAction = TNCH_DO then begin
Answer(TNCH_WILL, chOption);
FTType := TRUE;
end;
end;
else
{ Answer(TNCH_WONT, chOption); }
{ Jan Tomasek <xtomasej@feld.cvut.cz> }
if chAction = TNCH_WILL then
Answer(TNCH_DONT, chOption)
else
Answer(TNCH_WONT, chOption);
end;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TTnCnx.FlushBuffer;
var
Buffer : PChar;
Count : Integer;
begin
try
if FBufferCnt > 0 then begin
if Assigned(FOnDataAvailable) then begin
{ We need to make a copy for the data because we can reenter }
{ during the event processing }
Count := FBufferCnt; { How much we received }
try
GetMem(Buffer, Count + 1); { Alloc memory for the copy }
except
Buffer := nil;
end;
if Buffer <> nil then begin
try
Move(FBuffer, Buffer^, Count); { Actual copy }
Buffer[Count] := #0; { Add a nul byte }
FBufferCnt := 0; { Reset receivecounter }
FOnDataAvailable(Self, Buffer, Count); { Call event handler }
finally
FreeMem(Buffer, Count + 1); { Release the buffer }
end;
end;
end
else begin
FBufferCnt := 0
end;
end;
except
raise;
end;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TTnCnx.AddChar(Ch : Char);
begin
FBuffer[FBufferCnt] := Ch;
Inc(FBufferCnt);
if FBufferCnt >= SizeOf(FBuffer) then
FlushBuffer;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TTnCnx.ReceiveChar(Ch : Char);
const
bIAC : Boolean = FALSE;
chVerb : Char = #0;
strSubOption : String = '';
bSubNegoc : Boolean = FALSE;
begin
if chVerb <> #0 then begin
NegociateOption(chVerb, Ch);
chVerb := #0;
strSubOption := '';
Exit;
end;
if bSubNegoc then begin
if Ch = TNCH_SE then begin
bSubNegoc := FALSE;
NegociateSubOption(strSubOption);
strSubOption := '';
end
else
strSubOption := strSubOption + Ch;
Exit;
end;
if bIAC then begin
case Ch of
TNCH_IAC: begin
AddChar(Ch);
bIAC := FALSE;
end;
TNCH_DO, TNCH_WILL, TNCH_DONT, TNCH_WONT:
begin
bIAC := FALSE;
chVerb := Ch;
end;
TNCH_EOR:
begin
DebugString('TNCH_EOR' + #13 + #10);
bIAC := FALSE;
if Assigned(FOnEOR) then
FOnEOR(Self);
end;
TNCH_SB:
begin
{ DebugString('Subnegociation' + #13 + #10); }
bSubNegoc := TRUE;
bIAC := FALSE;
end;
else
DebugString('Unknown ' + IntToHex(ord(Ch), 2) + ' ''' + Ch + '''' + #13 + #10);
bIAC := FALSE;
end;
Exit;
end;
case Ch of
TNCH_EL:
begin
DebugString('TNCH_EL' + #13 + #10);
AddChar(Ch);
end;
TNCH_EC:
begin
DebugString('TNCH_EC' + #13 + #10);
AddChar(Ch);
end;
TNCH_AYT:
begin
DebugString('TNCH_AYT' + #13 + #10);
AddChar(Ch);
end;
TNCH_IP:
begin
DebugString('TNCH_IP' + #13 + #10);
AddChar(Ch);
end;
TNCH_AO:
begin
DebugString('TNCH_AO' + #13 + #10);
AddChar(Ch);
end;
TNCH_IAC:
begin
bIAC := TRUE
end;
else
AddChar(Ch);
end;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
end.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -