📄 idtunnelslave.pas
字号:
// Id := Thread.Handle;
SID := Id;
TimeOfConnection := Now;
DisconnectedOnRequest := False;
if fbSocketize then begin
Port := GStack.WSNToHs(req.Port);
IpAddr := req.IpAddr;
end
else begin
Port := self.DefaultPort;
IpAddr.S_addr := 0;
end;
Header.Port := Port;
Header.IpAddr := IpAddr;
end;
Header.MsgType := tmConnect;
Header.UserId := SID;
SendMsg(Header, RSTunnelConnectMsg);
end;
procedure TIdTunnelSlave.DoDisconnect(Thread: TIdPeerThread);
var
Header: TIdHeader;
begin
try
with TClientData(Thread.Data) do begin
if DisconnectedOnRequest = False then begin
Header.MsgType := tmDisconnect;
Header.UserId := Id;
SendMsg(Header, RSTunnelDisconnectMsg);
end;
end;
SetStatistics(NumberOfClientsType, Integer(soDecrease));
except
;
end;
end;
// Thread to communicate with the user
// reads the requests and transmits them through the tunnel
function TIdTunnelSlave.DoExecute(Thread: TIdPeerThread): boolean;
var
user: TClientData;
s: String;
Header: TIdHeader;
begin
result := true;
if Thread.Connection.IOHandler.Readable(IdTimeoutInfinite) then begin
s := Thread.Connection.CurrentReadBuffer;
try
user := TClientData(Thread.Data);
Header.MsgType := tmData;
Header.UserId := user.Id;
SendMsg(Header, s);
except
Thread.Connection.Disconnect;
raise;
end;
end;
end;
procedure TIdTunnelSlave.SendMsg(var Header: TIdHeader; s: String);
var
tmpString: String;
begin
SendThroughTunnelLock.Enter;
try
try
if not StopTransmiting then begin
if Length(s) > 0 then begin
try
// Custom data transformation before send
tmpString := s;
try
DoTransformSend(Header, tmpString);
except
on E: Exception do begin
raise;
end;
end;
if Header.MsgType = 0 then begin // error ocured in transformation
raise EIdTunnelTransformErrorBeforeSend.Create(RSTunnelTransformErrorBS);
end;
try
Sender.PrepareMsg(Header, PChar(@tmpString[1]), Length(tmpString));
except
raise;
end;
try
SClient.Write(Sender.Msg);
except
StopTransmiting := True;
raise;
end;
except
;
raise;
end;
end
end;
except
SClient.Disconnect;
end;
finally
SendThroughTunnelLock.Leave;
end;
end;
procedure TIdTunnelSlave.DoBeforeTunnelConnect(var Header: TIdHeader; var CustomMsg: String);
begin
if Assigned(fOnBeforeTunnelConnect) then
fOnBeforeTunnelConnect(Header, CustomMsg);
end;
procedure TIdTunnelSlave.DoTransformRead(Receiver: TReceiver);
begin
if Assigned(fOnTransformRead) then
fOnTransformRead(Receiver);
end;
procedure TIdTunnelSlave.DoInterpretMsg(var CustomMsg: String);
begin
if Assigned(fOnInterpretMsg) then
fOnInterpretMsg(CustomMsg);
end;
procedure TIdTunnelSlave.DoTransformSend(var Header: TIdHeader; var CustomMsg: String);
begin
if Assigned(fOnTransformSend) then
fOnTransformSend(Header, CustomMsg);
end;
procedure TIdTunnelSlave.DoTunnelDisconnect(Thread: TSlaveThread);
begin
try
StopTransmiting := True;
if not ManualDisconnected then begin
if Active then begin
Active := False;
end;
end;
except
;
end;
If Assigned(OnTunnelDisconnect) then
OnTunnelDisconnect(Thread);
end;
procedure TIdTunnelSlave.OnTunnelThreadTerminate(Sender:TObject);
begin
// Just set the flag
SlaveThreadTerminated := True;
end;
function TIdTunnelSlave.GetClientThread(UserID: Integer): TIdPeerThread;
var
user: TClientData;
Thread: TIdPeerThread;
i: integer;
begin
// GetClientThreadLock.Enter;
Result := nil;
with ThreadMgr.ActiveThreads.LockList do
try
try
for i := 0 to Count-1 do begin
try
if Assigned(Items[i]) then begin
Thread := TIdPeerThread(Items[i]);
if Assigned(Thread.Data) then begin
user := TClientData(Thread.Data);
if user.Id = UserID then begin
Result := Thread;
break;
end;
end;
end;
except
Result := nil;
end;
end;
except
Result := nil;
end;
finally
ThreadMgr.ActiveThreads.UnlockList;
// GetClientThreadLock.Leave;
end;
end;
procedure TIdTunnelSlave.TerminateTunnelThread;
begin
OnlyOneThread.Enter;
try
if Assigned(SlaveThread) then begin
// if GetCurrentThreadID <> SlaveThread.ThreadID then begin
if not IsCurrentThread(SlaveThread) then begin
SlaveThread.TerminateAndWaitFor;
SlaveThread.Free;
SlaveThread := nil;
end else begin
SlaveThread.FreeOnTerminate := True;
end;
end;
finally
OnlyOneThread.Leave;
end;
{
if Assigned(SlaveThread) then begin
if not IsCurrentThread(SlaveThread) then begin
SlaveThread.TerminateAndWaitFor;
// SlaveThread.Terminate;
SlaveThread.Free;
end else begin
SlaveThread.FreeOnTerminate := True;
end;
end;
}
end;
procedure TIdTunnelSlave.ClientOperation(Operation: Integer; UserId: Integer; s: String);
var
Thread: TIdPeerThread;
user: TClientData;
begin
if not StopTransmiting then begin
Thread := GetClientThread(UserID);
if Assigned(Thread) then begin
try
case Operation of
1:
begin
try
if Thread.Connection.Connected then begin
try
Thread.Connection.Write(s);
except
;
end;
end;
except
try
Thread.Connection.Disconnect;
except
end;
end;
end;
2:
begin
user := TClientData(Thread.Data);
user.DisconnectedOnRequest := True;
Thread.Connection.Disconnect;
end;
end;
except
;
end;
end
else begin
;
end;
end; // if StopTransmiting
end;
procedure TIdTunnelSlave.DisconectAllUsers;
begin
TerminateAllThreads;
end;
//
// END Slave Tunnel classes
///////////////////////////////////////////////////////////////////////////////
constructor TClientData.Create;
begin
inherited Create;
id := GetNextID;
Locker := TCriticalSection.Create;
SelfDisconnected := False;
end;
destructor TClientData.Destroy;
begin
Locker.Free;
inherited Destroy;
end;
constructor TSlaveThread.Create(Slave: TIdTunnelSlave);
begin
SlaveParent := Slave;
// FreeOnTerminate := True;
FreeOnTerminate := False;
FExecuted := False;
FConnection := Slave.SClient;
OnTerminate := Slave.OnTunnelThreadTerminate;
// InitializeCriticalSection(FLock);
FLock := TCriticalSection.Create;
Receiver := TReceiver.Create;
inherited Create(True);
StopMode := smTerminate;
end;
destructor TSlaveThread.Destroy;
begin
// Executed := True;
Connection.Disconnect;
Receiver.Free;
// DeleteCriticalSection(FLock);
FLock.Destroy;
inherited Destroy;
end;
procedure TSlaveThread.SetExecuted(Value: Boolean);
begin
// Lock;
FLock.Enter;
try
FExecuted := Value;
finally
// Unlock;
FLock.Leave;
end;
end;
function TSlaveThread.GetExecuted: Boolean;
begin
// Lock;
FLock.Enter;
try
Result := FExecuted;
finally
// Unlock;
FLock.Leave;
end;
end;
procedure TSlaveThread.Execute;
begin
inherited;
Executed := True;
end;
procedure TSlaveThread.Run;
var
Header: TIdHeader;
s: String;
CustomMsg: String;
begin
try
if Connection.IOHandler.Readable(IdTimeoutInfinite) then begin
// if Connection.Binding.Readable(IdTimeoutDefault) then begin
Receiver.Data := Connection.CurrentReadBuffer;
// increase the packets counter
SlaveParent.SetStatistics(NumberOfPacketsType, 0);
while (Receiver.TypeDetected) and (not Terminated) do begin
if Receiver.NewMessage then begin
if Receiver.CRCFailed then begin
raise EIdTunnelCRCFailed.Create(RSTunnelCRCFailed);
end;
try
// Custom data transformation
SlaveParent.DoTransformRead(Receiver);
except
raise EIdTunnelTransformError.Create(RSTunnelTransformError);
end;
// Action
case Receiver.Header.MsgType of
0: // transformation of data failed, disconnect the tunnel
begin
SlaveParent.ManualDisconnected := False;
raise EIdTunnelMessageTypeRecognitionError.Create(RSTunnelMessageTypeError);
end; // Failure END
1: // Data
begin
try
SetString(s, Receiver.Msg, Receiver.MsgLen);
SlaveParent.ClientOperation(1, Receiver.Header.UserId, s);
except
raise EIdTunnelMessageHandlingFailed.Create(RSTunnelMessageHandlingError);
end;
end; // Data END
2: // Disconnect
begin
try
SlaveParent.ClientOperation(2, Receiver.Header.UserId, ''); {Do not Localize}
except
raise EIdTunnelMessageHandlingFailed.Create(RSTunnelMessageHandlingError);
end;
end;
99: // Session
begin
// Custom data interpretation
CustomMsg := ''; {Do not Localize}
SetString(CustomMsg, Receiver.Msg, Receiver.MsgLen);
try
try
SlaveParent.DoInterpretMsg(CustomMsg);
except
raise EIdTunnelInterpretationOfMessageFailed.Create(RSTunnelMessageInterpretError);
end;
if Length(CustomMsg) > 0 then begin
Header.MsgType := 99;
Header.UserId := 0;
SlaveParent.SendMsg(Header, CustomMsg);
end;
except
SlaveParent.ManualDisconnected := False;
raise EIdTunnelCustomMessageInterpretationFailure.Create(RSTunnelMessageCustomInterpretError);
end;
end;
end; // case
// Shift of data
Receiver.ShiftData;
end
else
break; // break the loop
end; // end while
end; // if readable
except
on E: EIdSocketError do begin
case E.LastError of
10054: Connection.Disconnect;
else
begin
Terminate;
end;
end;
end;
on EIdClosedSocket do ;
else
raise;
end;
if not Connection.Connected then
Terminate;
end;
procedure TSlaveThread.AfterRun;
begin
SlaveParent.DoTunnelDisconnect(self);
end;
procedure TSlaveThread.BeforeRun;
var
Header: TIdHeader;
tmpString: String;
begin
tmpString := ''; {Do not Localize}
try
SlaveParent.DoBeforeTunnelConnect(Header, tmpString);
except
;
end;
if Length(tmpString) > 0 then begin
Header.MsgType := 99;
Header.UserId := 0;
SlaveParent.SendMsg(Header, tmpString);
end;
end;
initialization
GUniqueID := TIdThreadSafeInteger.Create;
finalization
FreeAndNil(GUniqueID);
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -