idtcpserver.pas

Indy控件的使用源代码

  LThread: TIdPeerThread;
begin
  try
    if Assigned(Server) then begin  // This is temporary code just to test one exception
      while True do begin
        LThread := nil;
        LPeer := TIdTCPServerConnection.Create(Server);
        LIOHandler := Server.IOHandler.Accept(Binding.Handle, SELF);
        if LIOHandler = nil then begin
          FreeAndNil(LPeer);
          Stop;
          Exit;
        end
        else begin
          LThread := TIdPeerThread(Server.ThreadMgr.GetThread);
          LThread.FConnection := LPeer;
          LThread.FConnection.IOHandler := LIOHandler;
          LThread.FConnection.FFreeIOHandlerOnDisconnect := true;
        end;

        // LastRcvTimeStamp := Now;  // Added for session timeout support
        // ProcessingTimeout := False;
        if (Server.MaxConnections > 0) and // Check MaxConnections
          NOT TIdThreadSafeList(Server.Threads).IsCountLessThan(Server.MaxConnections)
        then begin
          //Do not UpdateText here - in thread. Is done in constructor
          LPeer.WriteRFCReply(Server.MaxConnectionReply);
          LPeer.Disconnect;
          Server.ThreadMgr.ReleaseThread(LThread); // Give the thread back to the thread-manager
        end else begin
          Server.Threads.Add(LThread); //APR
          // Start Peer Thread
          LThread.Start;
          Break;
        end;
      end;
    end;
  except
    on E: Exception do begin
      if Assigned(LThread) then begin
        FreeAndNil(LThread);
      end;
      if Assigned(LPeer) then begin
        if not Assigned(LPeer.IOHandler) then begin
          FreeAndNil(LIOHandler);
        end;
        FreeAndNil(LPeer);
      end;
      Server.DoListenException(Self, E);
    end;
  end;
End;

{ TIdTCPServerConnection }

constructor TIdTCPServerConnection.Create(AServer: TIdTCPServer);
begin
  inherited Create(nil);
  FServer := AServer;
end;

{ TIdPeerThread }

procedure TIdPeerThread.BeforeRun;
begin
  try
    if Assigned(Connection.IOHandler) then begin
      Connection.IOHandler.AfterAccept;
    end
    else begin
      raise EIdTCPServerError.Create('');
    end;
  except
    Terminate; //APR: was FreeOn Terminate := True; ?! It is ThreadMgr work
    raise;
  end;
  if Assigned(Connection.Server.Intercept) then begin
    Connection.Intercept := Connection.Server.Intercept.Accept(Connection);
  end;
  Connection.Server.DoConnect(Self);

  // Stop this thread if we were disconnected
  if not Connection.Connected then begin
    Stop;
  end;
end;

procedure TIdPeerThread.AfterRun;
begin
  with Connection.Server do begin
    DoDisconnect(Self);
    if Assigned(Connection.Server.Intercept) then begin
      Connection.Intercept.free;
      Connection.Intercept:=nil;
    end;
  end;
end;

procedure TIdPeerThread.Cleanup;
begin
  inherited Cleanup;
  if Assigned(FConnection) then begin
    if Assigned(FConnection.Server) then begin
      { Remove is not neede if we are going to use only ActiveThreads;  Threads.Remove(Self);}
      with Connection.Server do begin
        if Assigned(Threads) then begin
          Threads.Remove(SELF);
        end;
        //from AfterRun
        if Assigned(ThreadMgr) then begin
          ThreadMgr.ReleaseThread(Self);
        end;
      end;//with
    end;//if
    FreeAndNil(FConnection);
  end;
  // Other things are done in AfterExecute&destructor
End;//TIdPeerThread.Cleanup

procedure TIdPeerThread.Run;
begin
  try
    try
      if not Connection.Server.DoExecute(Self) then begin
        raise EIdNoExecuteSpecified.Create(RSNoExecuteSpecified);
      end;
    except
      // We handle these seperate as after these we expect .Connected to be false
      // and caught below. Other exceptions are caught by the outer except.
       on E: EIdSocketError do begin
        Connection.Server.DoException(Self, E);
        case E.LastError of
          Id_WSAECONNABORTED // WSAECONNABORTED - Other side disconnected
           , Id_WSAECONNRESET:
            Connection.Disconnect;
        end;
      end;
      on E: EIdClosedSocket do begin
        // No need to disconnect - this error means we are already disconnected or never connected 
        Connection.Server.DoException(Self, E);
      end;
      on E: EIdConnClosedGracefully do begin
        // No need to Disconnect, .Connected will detect a graceful close
        Connection.Server.DoException(Self, E);
      end;
    end;
    // If connection lost, stop thread
    if not Connection.Connected then begin
      Stop;
    end;
  // Master catch. Catch errors not known about above, or errors in Stop, etc.
  // Must be a master catch to prevent thread from doing nothing.
  except
    on E: Exception do begin
      Connection.Server.DoException(Self, E);
      raise;
    end;
  end;
end;

{ TIdCommandHandlers }

function TIdCommandHandlers.Add: TIdCommandHandler;
begin
  Result := TIdCommandHandler(inherited Add);
end;

constructor TIdCommandHandlers.Create(AServer: TIdTCPServer);
begin
  inherited Create(AServer, TIdCommandHandler);
  FServer := AServer;
end;

function TIdCommandHandlers.GetItem(AIndex: Integer): TIdCommandHandler;
begin
  Result := TIdCommandHandler(inherited Items[AIndex]);
end;

function TIdCommandHandlers.GetOwnedBy: TPersistent;
begin
  Result := GetOwner;
end;

procedure TIdCommandHandlers.SetItem(AIndex: Integer; const AValue: TIdCommandHandler);
begin
  inherited SetItem(AIndex, AValue);
end;

{ TIdCommandHandler }

function TIdCommandHandler.Check(const AData: string; AThread: TIdPeerThread): boolean;
// AData is not preparsed and is completely left up to the command handler. This will allow for
// future expansion such as wild cards etc, and allow the logic to properly remain in each of the
// command handler implementations. In the future there may be a base type and multiple descendants
var
  LUnparsedParams: string;
begin
  LUnparsedParams := '';
  Result := AnsiSameText(AData, Command); // Command by itself
  if not Result then begin
    if CmdDelimiter <> #0 then begin
      Result := AnsiSameText(Copy(AData, 1, Length(Command) + 1), Command + CmdDelimiter);
      LUnparsedParams := Copy(AData, Length(Command) + 2, MaxInt);
    end else begin
      // Dont strip any part of the params out.. - just remove the command purely on length and
      // no delim
      Result := AnsiSameText(Copy(AData, 1, Length(Command)), Command);
      LUnparsedParams := Copy(AData, Length(Command) + 1, MaxInt);
    end;
  end;
  if Result then begin
    with TIdCommand.Create do try
      FRawLine := AData;
      FCommandHandler := Self;
      FThread := AThread;
      FUnparsedParams := LUnparsedParams;
      Params.Clear;
      if ParseParams then begin
        if Self.FParamDelimiter = #32 then begin
          SplitColumnsNoTrim(LUnparsedParams,Params,#32);
        end else begin
          SplitColumns(LUnparsedParams,Params,Self.FParamDelimiter);
        end;
      end;
      PerformReply := True;
      Reply.Assign(Self.ReplyNormal);
      while True do begin
        try
          DoCommand;
        except
          on E: Exception do begin
            if PerformReply then begin
              if Self.ReplyExceptionCode > 0 then begin
                Reply.SetReply(ReplyExceptionCode, E.Message);
                SendReply;
              end else if AThread.Connection.Server.ReplyExceptionCode > 0 then begin
                Reply.SetReply(AThread.Connection.Server.ReplyExceptionCode, E.Message);
                SendReply;
              end else begin
                raise;
              end;
              Break;
            end else begin
              raise;
            end;
          end;
        end;
        if PerformReply then begin
          SendReply;
        end;
        if Response.Count > 0 then begin
          AThread.Connection.WriteRFCStrings(Response);
        end else if CommandHandler.Response.Count > 0 then begin
          AThread.Connection.WriteRFCStrings(CommandHandler.Response);
        end;
        Break;
      end;
    finally
      try
        if Disconnect then begin
          AThread.Connection.Disconnect;
        end;
      finally
        FREE;
      end;
    end;//tryf
  end;
end;

constructor TIdCommandHandler.Create(ACollection: TCollection);
begin
  inherited Create(ACollection);
  FCmdDelimiter := ' ';
  FEnabled := IdEnabledDefault;
  FName := ClassName + IntToStr(ID);
  FParamDelimiter := #32;
  FParseParams := IdParseParamsDefault;
  FReplyNormal := TIdRFCReply.Create(nil);
  FResponse := TStringList.Create;
end;

destructor TIdCommandHandler.Destroy;
begin
  FreeAndNil(FResponse);
  FreeAndNil(FReplyNormal);
  inherited Destroy;
end;

function TIdCommandHandler.GetDisplayName: string;
begin
  if Command = '' then begin
    Result := Name;
  end else begin
    Result := Command;
  end;
end;


function TIdCommandHandler.GetNamePath: string;
begin
  if Collection <> nil then begin
    // OwnedBy is used because D4/D5 dont expose Owner on TOwnedCollection but D6 does
    Result := TIdCommandHandlers(Collection).OwnedBy.GetNamePath + '.' + Name;
  end else begin
    Result := inherited GetNamePath;
  end;
end;

function TIdCommandHandler.NameIs(ACommand: string): Boolean;
begin
  Result := AnsiSameText(ACommand, FName);
end;

procedure TIdCommandHandler.SetDisplayName(const AValue: string);
begin
  FName := AValue;
  inherited SetDisplayName(AValue);
end;

procedure TIdCommandHandler.SetResponse(AValue: TStrings);
begin
  FResponse.Assign(AValue);
end;

{ TIdCommand }

constructor TIdCommand.Create;
begin
  inherited Create;
  FParams := TStringList.Create;
  FReply := TIdRFCReply.Create(nil);
  FResponse := TStringList.Create;
end;

destructor TIdCommand.Destroy;
begin
  FreeAndNil(FReply);
  FreeAndNil(FResponse);
  FreeAndNil(FParams);
  inherited Destroy;
end;

procedure TIdCommand.DoCommand;
begin
  if Assigned(CommandHandler.OnCommand) then begin
    CommandHandler.OnCommand(Self);
  end;
end;

procedure TIdCommand.SendReply;
begin
  PerformReply := False;
  TIdCommandHandlers(CommandHandler.Collection).Server.ReplyTexts.UpdateText(Reply);
  Thread.Connection.WriteRFCReply(Reply);
end;

procedure TIdCommand.SetResponse(AValue: TStrings);
begin
  FResponse.Assign(AValue);
end;

end.