idcommandhandlers.pas

网络控件适用于Delphi6

  ABase: TIdComponent;
  AReplyClass: TIdReplyClass;
  AReplyTexts: TIdReplies;
  AExceptionReply: TIdReply = nil;
  ACommandHandlerClass: TIdCommandHandlerClass = nil
  );
begin
  if ACommandHandlerClass = nil then begin
    inherited Create(ABase, TIdCommandHandler);
  end else begin
    inherited Create(ABase, ACommandHandlerClass);
  end;
  FBase := ABase;
  FExceptionReply := AExceptionReply;
  FReplyClass := AReplyClass;
  FReplyTexts := AReplyTexts;
end;

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

function TIdCommandHandlers.HandleCommand(
  AContext: TIdContext;
  var VCommand: string
  ): Boolean;
var
  i, j: Integer;
begin
  j := Count - 1;
  Result := False;
  DoBeforeCommandHandler(AContext, VCommand); try
    i := 0;
    while i <= j do begin
      if Items[i].Enabled then begin
        Result := Items[i].Check(VCommand, AContext);
        if Result then begin
          Break;
        end;
      end;
      Inc(i);
    end;
  finally DoAfterCommandHandler(AContext); end;
end;

procedure TIdCommandHandlers.DoAfterCommandHandler(AContext: TIdContext);
begin
  if Assigned(OnAfterCommandHandler) then begin
    OnAfterCommandHandler(Self, AContext);
  end;
end;

procedure TIdCommandHandlers.DoBeforeCommandHandler(AContext: TIdContext;
  var VLine: string);
begin
  if Assigned(OnBeforeCommandHandler) then begin
    OnBeforeCommandHandler(Self, VLine, AContext);
  end;
end;

procedure TIdCommandHandlers.DoOnCommandHandlersException(ACommand: String;
  AContext: TIdContext);
begin
  if Assigned(FOnCommandHandlersException) then begin
    OnCommandHandlersException(ACommand, AContext);
  end;
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 }

procedure TIdCommandHandler.DoCommand(
  AData: string;
  AContext: TIdContext;
  AUnparsedParams: string
  );
var
  LCommand: TIdCommand;
begin
  LCommand := TIdCommand.Create(Self);
  with LCommand do try
    FRawLine := AData;
    FContext := AContext;
    FUnparsedParams := AUnparsedParams;
    Params.Clear;

    if ParseParams then begin
      if Self.FParamDelimiter = #32 then begin
        SplitColumnsNoTrim(AUnparsedParams, Params, #32);
      end else begin
        SplitColumns(AUnparsedParams, Params, Self.FParamDelimiter);
      end;
    end;

    PerformReply := True;
    Reply.Assign(Self.NormalReply);
    // UpdateText here in case user wants to add to it. SendReply also gets it in case
    // a different reply is sent (ie exception, etc), or the user changes the code in the event
    Reply.UpdateText;
    //
    Response.Assign(Self.Response);

    try
      DoCommand;
    except
      on E: Exception do begin
        if PerformReply then begin
          // Try from command handler first
          if ExceptionReply.Code = '' then begin
            Reply.Assign(Self.ExceptionReply);
          end;
          // If still no go, from server
          // Can be nil though. Typically only servers pass it in
          if (ExceptionReply.Code = '') and (TIdCommandHandlers(Collection).FExceptionReply <> nil)
           then begin
            ExceptionReply.Assign(TIdCommandHandlers(Collection).FExceptionReply);
          end;
          if ExceptionReply.Code <> '' then begin
            Reply.Text.Add(E.Message);
            SendReply;
          end else begin
            raise;
          end;
        end else begin
          raise;
        end;
      end else begin
        raise;
      end;
    end;

    if PerformReply then begin
      SendReply;
    end;

    if Response.Count > 0 then begin
      with AContext.Connection do begin
        IOHandler.WriteBufferOpen; try
          WriteRFCStrings(Response);
        finally IOHandler.WriteBufferClose; end;
      end;
    end;
  finally
    try
      if Disconnect then begin
        AContext.Connection.Disconnect;
      end;
    finally Free; end;
  end;
end;

function TIdCommandHandler.Check(AData: string; AContext: TIdContext): 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 := TextIsSame(AData, Command); // Command by itself

  if not Result then begin
    // Dont strip any part of the params out.. - just remove the command purely on length and
    // no delim
    Result := TextIsSame(Copy(AData, 1, Length(Command)), Command);
    //use +2 because we want to skip the deliniator between the command and the parameters
    LUnparsedParams := Copy(AData, Length(Command) + 2, MaxInt);
  end;

  if Result then begin
    DoCommand(AData, AContext, LUnparsedParams);
  end;
end;

constructor TIdCommandHandler.Create(
  ACollection: TCollection
  );
begin
  inherited Create(ACollection);

  FReplyClass := TIdCommandHandlers(ACollection).ReplyClass;
  if FReplyClass = nil then begin
    FReplyClass := TIdReplyRFC;
  end;

  FCmdDelimiter := #32;
  FEnabled := IdEnabledDefault;
  FName := ClassName + IntToStr(ID);
  FParamDelimiter := #32;
  FParseParams := IdParseParamsDefault;
  FResponse := TIdStringList.Create;
  FDescription := TIdStringList.Create;

  FNormalReply := FReplyClass.Create(nil, TIdCommandHandlers(ACollection).ReplyTexts);
  if FNormalReply is TIdReplyRFC then begin
    FNormalReply.Code := '200'; {do not localize}
  end;
  FHelpVisible := IdHelpVisibleDef;
  // Dont initialize, pulls from CmdTCPServer for defaults
  FExceptionReply := FReplyClass.Create(nil, TIdCommandHandlers(ACollection).ReplyTexts);
end;

destructor TIdCommandHandler.Destroy;
begin
  FreeAndNil(FResponse);
  FreeAndNil(FNormalReply);
  FreeAndNil(FDescription);
  FreeAndNil(FExceptionReply);
  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 := TextIsSame(ACommand, FName);
end;

procedure TIdCommandHandler.SetExceptionReply(AValue: TIdReply);
begin
  FExceptionReply.Assign(AValue);
end;

procedure TIdCommandHandler.SetNormalReply(AValue: TIdReply);
begin
  FNormalReply.Assign(AValue);
end;

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

procedure TIdCommandHandler.SetDescription(AValue: TIdStrings);
begin
  FDescription.Assign(AValue);
end;

{ TIdCommand }

constructor TIdCommand.Create(AOwner: TIdCommandHandler);
begin
  inherited Create;
  FParams := TIdStringList.Create;
  FReply := AOwner.FReplyClass.Create(nil, TIdCommandHandlers(AOwner.Collection).ReplyTexts);
  FResponse := TIdStringList.Create;
  FCommandHandler := AOwner;
  FDisconnect := AOwner.Disconnect;
end;

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

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

procedure TIdCommand.SendReply;
begin
  PerformReply := False;
  Reply.UpdateText;
  Context.Connection.IOHandler.Write(Reply.FormattedReply);
end;

procedure TIdCommand.SetReply(AValue: TIdReply);
begin
  FReply.Assign(AValue);
end;

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

end.