idtcpconnection.pas

Indy控件的使用源代码

        LSize := AStream.Read(LBuffer.Memory^, LSize);
        if LSize = 0 then begin
          raise EIdNoDataToRead.Create(RSIdNoDataToRead);
        end;
        WriteBuffer(LBuffer.Memory^, LSize);
      end;
    finally FreeAndNil(LBuffer); end;
  finally EndWork(wmWrite); end;
end;

procedure TIdTCPConnection.WriteStrings(AValue: TStrings; const AWriteLinesCount: Boolean = False);
var
  i: Integer;
begin
  if AWriteLinesCount then begin
    WriteInteger(AValue.Count);
  end;
  for i := 0 to AValue.Count - 1 do begin
    WriteLn(AValue.Strings[i]);
  end;
end;

function TIdTCPConnection.SendCmd(const AOut: string; const AResponse: SmallInt): SmallInt;
begin
  if AResponse = -1 then begin
    Result := SendCmd(AOut, []);
  end else begin
    Result := SendCmd(AOut, [AResponse]);
  end;
end;

procedure TIdTCPConnection.DisconnectSocket;
begin
  if IOHandler <> nil then begin
    FClosedGracefully := True;
    // In design time don't use propertyes which point to other compoenents
    if not (csDesigning in ComponentState) then begin
      if Assigned(Intercept) then begin
        Intercept.Disconnect;
      end;
      IOHandler.Close;
    end;
  end;
end;

procedure TIdTCPConnection.OpenWriteBuffer(const AThreshhold: Integer = -1);
begin
  FWriteBuffer := TIdSimpleBuffer.Create;
  FWriteBufferThreshhold := AThreshhold;
end;

procedure TIdTCPConnection.CloseWriteBuffer;
begin
  try
    FlushWriteBuffer;
  finally
    FreeAndNil(FWriteBuffer);
  end;
end;

procedure TIdTCPConnection.FlushWriteBuffer(const AByteCount: Integer = -1);
begin
  if FWriteBuffer.Size > 0 then begin
    if (AByteCount = -1) or (FWriteBuffer.Size < AByteCount) then begin
      WriteBuffer(PChar(FWriteBuffer.Memory)[0], FWriteBuffer.Size, True);
      ClearWriteBuffer;
    end else begin
      WriteBuffer(PChar(FWriteBuffer.Memory)[0], AByteCount, True);
      FWriteBuffer.Remove(AByteCount);
    end;
  end;
end;

procedure TIdTCPConnection.ClearWriteBuffer;
begin
  FWriteBuffer.Clear;
end;

function TIdTCPConnection.InputLn(const AMask: string = ''; AEcho: Boolean = True;
 ATabWidth: Integer = 8; AMaxLineLength: Integer = -1): string;
var
  i: Integer;
  LChar: Char;
  LTmp: string;
Begin
  if AMaxLineLength = -1 then begin
    AMaxLineLength := MaxLineLength;
  end;
  Result := '';
  repeat
    LChar := ReadChar;
    i := Length(Result);
    if i <= AMaxLineLength then begin
      case LChar of
        BACKSPACE:
          begin
            if i > 0 then begin
              SetLength(Result, i - 1);
              if AEcho then begin
                Write(BACKSPACE + ' ' + BACKSPACE);
              end;
            end;
          end;
        TAB:
          begin
            if ATabWidth > 0 then begin
              i := ATabWidth - (i mod ATabWidth);
              LTmp := StringOfChar(' ', i);
              Result := Result + LTmp;
              if AEcho then begin
                Write(LTmp);
              end;
            end else begin
              Result := Result + LChar;
              if AEcho then begin
                Write(LChar);
              end;
            end;
          end;
        LF: ;
        CR: ;
        #27: ; //ESC - currently not supported
      else
        Result := Result + LChar;
        if AEcho then begin
          if Length(AMask) = 0 then begin
            Write(LChar);
          end else begin
            Write(AMask);
          end;
        end;
      end;
    end;
  until LChar = LF;
  // Remove CR trail
  i := Length(Result);
  while (i > 0) and (Result[i] in [CR, LF]) do begin
    Dec(i);
  end;
  SetLength(Result, i);
  if AEcho then begin
    WriteLn;
  end;
end;

function TIdTCPConnection.ReadString(const ABytes: Integer): string;
begin
  SetLength(result, ABytes);
  if ABytes > 0 then begin
    ReadBuffer(result[1], Length(result));
  end;
end;

procedure TIdTCPConnection.ReadStrings(var AValue: TStrings; AReadLinesCount: Integer = -1);
Var
  i: Integer;
begin
  if AReadLinesCount <= 0 then begin
    AReadLinesCount := ReadInteger;
  end;
  for i := 0 to AReadLinesCount - 1 do begin
    AValue.Add(ReadLn);
  end;
end;

procedure TIdTCPConnection.CancelWriteBuffer;
begin
  ClearWriteBuffer;
  CloseWriteBuffer;
end;

function TIdTCPConnection.ReadSmallInt(const AConvert: boolean = true): SmallInt;
begin
  ReadBuffer(Result, SizeOf(Result));
  if AConvert then begin
    Result := SmallInt(GStack.WSNToHs(Word(Result)));
  end;
end;

procedure TIdTCPConnection.WriteSmallInt(AValue: SmallInt; const AConvert: boolean = true);
begin
  if AConvert then begin
    AValue := SmallInt(GStack.WSHToNs(Word(AValue)));
  end;
  WriteBuffer(AValue, SizeOf(AValue));
end;

procedure TIdTCPConnection.CheckForGracefulDisconnect(const ARaiseExceptionIfDisconnected: boolean);
begin
  ReadFromStack(ARaiseExceptionIfDisconnected, 1, False);
end;

{ TIdBuffer }

constructor TIdSimpleBuffer.Create(AOnBytesRemoved: TIdBufferBytesRemoved);
begin
  inherited Create;
  FOnBytesRemoved := AOnBytesRemoved;
end;

function TIdSimpleBuffer.Extract(const AByteCount: Integer): string;
begin
  if AByteCount > Size then begin
    raise EIdNotEnoughDataInBuffer.Create(RSNotEnoughDataInBuffer);
  end;
  SetString(Result, PChar(Memory), AByteCount);
  Remove(AByteCount);
end;

procedure TIdSimpleBuffer.Remove(const AByteCount: integer);
begin
  if AByteCount > Size then begin
    raise EIdNotEnoughDataInBuffer.Create(RSNotEnoughDataInBuffer);
  end;
  if AByteCount = Size then begin
    Clear;
  end else begin
    Move(PChar(Memory)[AByteCount], PChar(Memory)[0], Size - AByteCount);
    SetSize(Size - AByteCount);
  end;
  if Assigned(FOnBytesRemoved) then begin
    FOnBytesRemoved(Self, AByteCount);
  end;
end;

function TIdTCPConnection.WaitFor(const AString: string): string;
//TODO: Add a time out (default to infinite) and event to pass data
//TODO: Add a max size argument as well.
//TODO: Add a case insensitive option
//TODO: Bug - returns too much data. Should only return up to search string adn not including
//      and leave the rest in the buffer.
begin
  Result := '';
  // NOTE: AnsiPos should be used here, but AnsiPos has problems if result has any #0 in it,
  // which is often the case. So currently this function is not MBCS compliant and should
  // not be used in MBCS environments. However this function should only be used on incoming
  // TCP text data as it is 7 bit.
  while Pos(AString, Result) = 0 do begin
    Result := Result + CurrentReadBuffer;
    CheckForDisconnect;
  end;
end;

function TIdTCPConnection.ReadCardinal(const AConvert: boolean): Cardinal;
begin
  ReadBuffer(Result, SizeOf(Result));
  if AConvert then begin
    Result := GStack.WSNToHL(Result);
  end;
end;

procedure TIdTCPConnection.WriteCardinal(AValue: Cardinal; const AConvert: boolean);
begin
  if AConvert then begin
    AValue := GStack.WSHToNl(AValue);
  end;
	WriteBuffer(AValue, SizeOf(AValue));
end;

function TIdTCPConnection.CheckResponse(const AResponse: SmallInt;
 const AAllowedResponses: array of SmallInt): SmallInt;
var
  i: Integer;
  LResponseFound: Boolean;
begin
  if High(AAllowedResponses) > -1 then begin
    LResponseFound := False;
    for i := Low(AAllowedResponses) to High(AAllowedResponses) do begin
      if AResponse = AAllowedResponses[i] then begin
        LResponseFound := True;
        Break;
      end;
    end;
    if not LResponseFound then begin
      RaiseExceptionForLastCmdResult;
    end;
  end;
  Result := AResponse;
end;

procedure TIdTCPConnection.GetInternalResponse;
var
  LLine: string;
  LResponse: TStringList;
  LTerm: string;
begin
  LResponse := TStringList.Create; try
    LLine := ReadLnWait;
    LResponse.Add(LLine);
    if Length(LLine) > 3 then begin
      if LLine[4] = '-' then begin // Multi line response coming
        LTerm := Copy(LLine, 1, 3) + ' ';
        {We keep reading lines until we encounter either a line such as "250" or "250 Read"}
        repeat
          LLine := ReadLnWait;
          LResponse.Add(LLine);
        until (Length(LLine) < 4) or (AnsiSameText(Copy(LLine, 1, 4), LTerm));
      end;
    end;
    FLastCmdResult.ParseResponse(LResponse);
  finally FreeAndNil(LResponse); end;
end;

procedure TIdTCPConnection.WriteRFCReply(AReply: TIdRFCReply);
begin
  if AReply.ReplyExists then begin
    Write(AReply.GenerateReply);
  end;
end;

procedure TIdTCPConnection.WriteRFCStrings(AStrings: TStrings);
var
  i: Integer;
begin
  for i := 0 to AStrings.Count - 1 do begin
    if AStrings[i] = '.' then begin
      WriteLn('..');
    end else begin
      WriteLn(AStrings[i]);
    end;
  end;
  WriteLn('.');
end;

function TIdTCPConnection.GetResponse(const AAllowedResponse: SmallInt): SmallInt;
begin
  Result := GetResponse([AAllowedResponse]);
end;

procedure TIdTCPConnection.Capture(ADest: TStream; const ADelim: string;
  const AIsRFCMessage: Boolean);
var
  LLineCount: Integer;
begin
  PerformCapture(ADest, LLineCount, ADelim, AIsRFCMessage);
end;

procedure TIdTCPConnection.Capture(ADest: TStrings; const ADelim: string;
  const AIsRFCMessage: Boolean);
var
  LLineCount: Integer;
begin
  PerformCapture(ADest, LLineCount, ADelim, AIsRFCMessage);
end;

function TIdTCPConnection.ReadChar: Char;
begin
  ReadBuffer(Result, SizeOf(Result));
end;

procedure TIdTCPConnection.Capture(ADest: TStream; out VLineCount: Integer;
 const ADelim: string; const AIsRFCMessage: Boolean);
begin
  PerformCapture(ADest, VLineCount, ADelim, AIsRFCMessage);
end;

procedure TIdTCPConnection.Capture(ADest: TStrings; out VLineCount: Integer; const ADelim: string;
 const AIsRFCMessage: Boolean);
begin
  PerformCapture(ADest, VLineCount, ADelim, AIsRFCMessage);
end;

procedure TIdTCPConnection.BufferRemoveNotify(ASender: TObject; const ABytes: Integer);
begin
  DoWork(wmRead, ABytes);
end;

{ TIdManagedBuffer }

procedure TIdManagedBuffer.Clear;
Begin
  inherited Clear;
  FReadedSize:= 0;
End;//

constructor TIdManagedBuffer.Create(AOnBytesRemoved: TIdBufferBytesRemoved);
Begin
  inherited;
  FPackReadedSize := IdInBufCacheSizeDefault;
End;//

function TIdManagedBuffer.Extract(const AByteCount: Integer): string;
Begin
  if AByteCount > Size then begin
    raise EIdNotEnoughDataInBuffer.Create(RSNotEnoughDataInBuffer);
  end;
  SetString(Result, PChar(Memory), AByteCount);
  Remove(AByteCount);
End;//TIdManagedBuffer.Extract

function TIdManagedBuffer.Memory: Pointer;
Begin
  Result:=Pointer(Integer(inherited Memory) + FReadedSize);
End;//Memory

procedure TIdManagedBuffer.PackBuffer;
Begin
  if FReadedSize > 0 then begin
    Move(Pointer(Integer(inherited Memory) + FReadedSize)^,inherited Memory^,Size);
    SetSize(Size); //set REAL size to fresh size
    FReadedSize := 0;
  end;
End;//TIdManagedBuffer.PackBuffer

procedure TIdManagedBuffer.Remove(const AByteCount: integer);
Begin
  if AByteCount > Size then begin
    raise EIdNotEnoughDataInBuffer.Create(RSNotEnoughDataInBuffer);
  end else if AByteCount = Size then begin
    Clear;
  end else begin
    FReadedSize := FReadedSize + AByteCount;

    if FReadedSize >= PackReadedSize then begin
      PackBuffer;
    end;
  end;

  if Assigned(FOnBytesRemoved) then begin
    FOnBytesRemoved(Self, AByteCount);
  end;
End;

function TIdManagedBuffer.Seek(Offset: Integer; Origin: Word): Longint;
Begin //note: FPosition is TRUE, FSize is TRUE
  case Origin of
    soFromBeginning:
      begin
        Result:=inherited Seek(Offset + FReadedSize,soFromBeginning) - FReadedSize;
      end;
  else //soFromCurrent,soFromEnd:
    Result:=inherited Seek(Offset,Origin) - FReadedSize;
  end;
End;//TIdManagedBuffer.Seek

procedure TIdManagedBuffer.SetPackReadedSize(const Value: Integer);
Begin
  if Value>0 then begin
    FPackReadedSize := Value;
  end
  else begin
    FPackReadedSize := IdInBufCacheSizeDefault;
  end;
End;//

end.