idtunnelslave.pas

indy的原文件哈!大家可以下来参考和学习之用.也可以用以作组件.开发其他的应用程序.

    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.