idiohandler.pas

网络控件适用于Delphi6

begin
  for i := GIOHandlerClassList.Count - 1 downto 0 do begin
    if TIdIOHandlerClass(GIOHandlerClassList.Items[i]).InheritsFrom(ABaseType) then begin
      Result := TIdIOHandlerClass(GIOHandlerClassList.Items[i]).Create;
      Exit;
    end;
  end;
  raise EIdException.Create(Format(RSIOHandlerTypeNotInstalled, [ABaseType.ClassName]));
end;

function TIdIOHandler.GetDestination: string;
begin
  Result := FDestination;
end;

procedure TIdIOHandler.SetDestination(const AValue: string);
begin
  FDestination := AValue;
end;

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

procedure TIdIOHandler.WriteBufferOpen(AThreshhold: Integer);
begin
  FWriteBuffer := TIdBuffer.Create;
  FWriteBufferThreshhold := AThreshhold;
end;

procedure TIdIOHandler.WriteBufferClose;
begin
  try
    WriteBufferFlush;
  finally FreeAndNil(FWriteBuffer); end;
end;

procedure TIdIOHandler.WriteBufferFlush(AByteCount: Integer);
var
  LBytes: TIdBytes;
begin
  if FWriteBuffer.Size > 0 then begin
    FWriteBuffer.ExtractToBytes(LBytes, AByteCount);
    WriteDirect(LBytes);
  end;
end;

procedure TIdIOHandler.WriteBufferClear;
begin
  FWriteBuffer.Clear;
end;

procedure TIdIOHandler.WriteBufferCancel;
begin
  WriteBufferClear;
  WriteBufferClose;
end;

procedure TIdIOHandler.Write(const AOut: string);
begin
  if AOut <> '' then begin
    Write(ToBytes(AOut));
  end;
end;

procedure TIdIOHandler.Write(AValue: Char);
begin
  Write(ToBytes(AValue));
end;

procedure TIdIOHandler.Write(AValue: Cardinal; AConvert: boolean);
begin
  if AConvert then begin
    AValue := GStack.HostToNetwork(AValue);
  end;
  Write(ToBytes(AValue));
end;

procedure TIdIOHandler.Write(AValue: Integer; AConvert: Boolean = True);
begin
  if AConvert then begin
    AValue := Integer(GStack.HostToNetwork(LongWord(AValue)));
  end;
  Write(ToBytes(AValue));
end;

procedure TIdIOHandler.Write(AValue: Int64; AConvert: Boolean = True);
begin
  if AConvert then begin
    AValue := Integer(GStack.HostToNetwork(LongWord(AValue)));
  end;
  Write(ToBytes(AValue));
end;

procedure TIdIOHandler.Write(AValue: TIdStrings; AWriteLinesCount: Boolean = False);
var
  i: Integer;
begin
  WriteBufferOpen; try
    if AWriteLinesCount then begin
      Write(AValue.Count);
    end;
    for i := 0 to AValue.Count - 1 do begin
      WriteLn(AValue.Strings[i]);
    end;
  // Kudzu: I had an except here and a close, but really even if error we should
  // write out whatever we have. Very doubtful any errors will occur in above
  // code anyways unless given bad input, which incurs bigger problems anyways.
  finally WriteBufferClose; end;
end;

procedure TIdIOHandler.Write(AValue: SmallInt; AConvert: boolean = true);
begin
  if AConvert then begin
    AValue := SmallInt(GStack.HostToNetwork(Word(AValue)));
  end;
  Write(ToBytes(AValue));
end;

function TIdIOHandler.ReadString(ABytes: Integer): string;
var
  LBytes: TIdBytes;
begin
  if ABytes > 0 then begin
    ReadBytes(LBytes, ABytes, False);
    Result := BytesToString(LBytes);
  end else begin
    Result := ''
  end;
end;

procedure TIdIOHandler.ReadStrings(ADest: TIdStrings; AReadLinesCount: Integer = -1);
var
  i: Integer;
begin
  if AReadLinesCount <= 0 then begin
    AReadLinesCount := ReadInteger;
  end;
  for i := 0 to AReadLinesCount - 1 do begin
    ADest.Add(ReadLn);
  end;
end;

function TIdIOHandler.ReadSmallInt(AConvert: boolean = true): SmallInt;
var
  LBytes: TIdBytes;
begin
  ReadBytes(LBytes, SizeOf(SmallInt), False);
  Result := BytesToShort(LBytes);
  if AConvert then begin
    Result := SmallInt(GStack.NetworkToHost(Word(Result)));
  end;
end;

function TIdIOHandler.ReadChar: Char;
var
  LBytes: TIdBytes;
begin
//  Result := ReadString(1)[1];
  ReadBytes(LBytes, 1, False);
  Result := Char(LBytes[0]);
end;

function TIdIOHandler.ReadInteger(AConvert: boolean): Integer;
var
  LBytes: TIdBytes;
begin
  ReadBytes(LBytes, SizeOf(Integer), False);
  Result := BytesToInteger(LBytes);
  if AConvert then begin
    Result := Integer(GStack.NetworkToHost(LongWord(Result)));
  end;
end;

function TIdIOHandler.ReadInt64(AConvert: boolean): Int64;
var
  LBytes: TIdBytes;
begin
  ReadBytes(LBytes, SizeOf(Int64), False);
  Result := BytesToInt64(LBytes);
  if AConvert then begin
    Result := Integer(GStack.NetworkToHost(LongWord(Result)));
  end;
end;

function TIdIOHandler.ReadCardinal(
  AConvert: boolean)
  : Cardinal;
var
  LBytes: TIdBytes;
begin
  ReadBytes(LBytes, SizeOf(LBytes), False);
  Result := BytesToCardinal(LBytes);
  if AConvert then begin
    Result := GStack.NetworkToHost(Result);
  end;
end;

function TIdIOHandler.ReadLn
  : string;
begin
  Result := ReadLn(LF);
end;

function TIdIOHandler.ReadLn(
  ATerminator: string;
  ATimeout: Integer = IdTimeoutDefault;
  AMaxLineLength: Integer = -1)
  : string;
var
  LInputBufferSize: Integer;
  LSize: Integer;
  LTermPos: Integer;
  LReadLnStartTime: Cardinal;
begin
  if AMaxLineLength = -1 then begin
    AMaxLineLength := MaxLineLength;
  end;
  // User may pass '' if they need to pass arguments beyond the first.
  if ATerminator = '' then begin
    ATerminator := LF;
  end;
  FReadLnSplit := False;
  FReadLnTimedOut := False;
  LTermPos := -1;
  LSize := 0;
  LReadLnStartTime := Ticks;
  repeat
    LInputBufferSize := FInputBuffer.Size;
    if LInputBufferSize > 0 then begin
      LTermPos := FInputBuffer.IndexOf(ATerminator, LSize);
      //CC: LInputBufferSize - 1 does not seem to work for me...
      //LSize := LInputBufferSize - 1;
      LSize := LInputBufferSize;
    end;
    if (LTermPos > AMaxLineLength) and (AMaxLineLength <> 0) then begin
      EIdReadLnMaxLineLengthExceeded.IfTrue(MaxLineAction = maException, RSReadLnMaxLineLengthExceeded);
      FReadLnSplit := True;
      Result := FInputBuffer.Extract(AMaxLineLength);
      Exit;
    // ReadFromSource blocks - do not call unless we need to
    end else if LTermPos = -1 then begin
      if (LSize > AMaxLineLength) and (AMaxLineLength <> 0) then begin
        EIdReadLnMaxLineLengthExceeded.IfTrue(MaxLineAction = maException, RSReadLnMaxLineLengthExceeded);
        FReadLnSplit := True;
        Result := FInputBuffer.Extract(AMaxLineLength);
        Exit;
      end;
      // ReadLn needs to call this as data may exist in the buffer, but no EOL yet disconnected
      CheckForDisconnect(True, True);
      // Can only return -1 if timeout
      FReadLnTimedOut := ReadFromSource(True, ATimeout, ATimeout = IdTimeoutDefault) = -1;
      if not FReadLnTimedOut and (ATimeout >= 0) then begin
        if GetTickDiff(LReadLnStartTime, Ticks) >= Cardinal(ATimeout) then begin
          FReadLnTimedOut := True;
        end;
      end;
      if ReadLnTimedout then begin
        Result := '';
        Exit;
      end;
    end;
  until LTermPos > -1;
  // Extract actual data
  Result := FInputBuffer.Extract(LTermPos + Length(ATerminator));
  if (ATerminator = LF) and (LTermPos > 0) then begin
    if Result[LTermPos] = CR then begin
      Dec(LTermPos);
    end;
  end;
  SetLength(Result, LTermPos);
end;

function TIdIOHandler.ReadLnSplit(
  var AWasSplit: Boolean;
  ATerminator: string = LF;
  ATimeout: Integer = IdTimeoutDefault;
  AMaxLineLength: Integer = -1)
  : string;
var
  LModeWasException: Boolean;
begin
  LModeWasException := False;
  if MaxLineAction = maException then begin
    MaxLineAction := maSplit;
    LModeWasException := True;
  end;
  Result := ReadLn(ATerminator, ATimeout, AMaxLineLength);
  AWasSplit := FReadLnSplit;
  if LModeWasException = True then begin
    MaxLineAction := maException;
  end;
end;

function TIdIOHandler.ReadLnWait(AFailCount: Integer = MaxInt): string;
var
  LAttempts: Integer;
begin
  Result := '';
  LAttempts := 0;
  while (Length(Result) = 0) and (LAttempts < AFailCount) do begin
    Inc(LAttempts);
    Result := Trim(ReadLn);
  end;
end;

procedure TIdIOHandler.Write(AStream: TIdStreamVCL; ASize: Integer = 0;
 AWriteByteCount: Boolean = FALSE);
var
  LBuffer: TIdBytes;
  LBufSize: Integer;
begin
  if ASize < 0 then begin //"-1" All form current position
    LBufSize := AStream.VCLStream.Position;
    ASize := AStream.VCLStream.Size;
    AStream.VCLStream.Position := LBufSize;
    ASize := ASize - LBufSize;
  end
  else if ASize = 0 then begin //"0" ALL
    ASize := AStream.VCLStream.Size;
    AStream.VCLStream.Position := 0;
  end;
  //else ">0" ACount bytes
  if AWriteByteCount then begin
  	Write(ASize);
  end;

  BeginWork(wmWrite, ASize); try
    while ASize > 0 do begin
      SetLength(LBuffer, FSendBufferSize); //BGO: bad for speed
      LBufSize := Min(ASize, FSendBufferSize);
      // Do not use ReadBuffer. Some source streams are real time and will not
      // return as much data as we request. Kind of like recv()
      // NOTE: We use .Size - size must be supported even if real time
      LBufSize := AStream.ReadBytes(LBuffer, LBufSize, 0, False);
      if LBufSize = 0 then begin
        raise EIdNoDataToRead.Create(RSIdNoDataToRead);
      end;
      SetLength(LBuffer, LBufSize);
      Write(LBuffer);
      Dec(ASize, LBufSize);
    end;
  finally
    EndWork(wmWrite);
    LBuffer := nil;
  end;
end;

procedure TIdIOHandler.ReadBytes(
  var VBuffer: TIdBytes;
  AByteCount: Integer;
  AAppend: Boolean = True);
begin
  if AByteCount > 0 then begin
    // Read from stack until we have enough data
    while FInputBuffer.Size < AByteCount do begin
      ReadFromSource(False);
      CheckForDisconnect(True, True);
    end;
    FInputBuffer.ExtractToBytes(VBuffer, AByteCount, AAppend);
  end else if AByteCount = -1 then begin
    ReadFromSource(False, ReadTimeout, False);
    CheckForDisconnect(True, True);
    FInputBuffer.ExtractToBytes(VBuffer, -1, AAppend);
  end;
end;

procedure TIdIOHandler.WriteLn(const AOut: string);
begin
  // Do as one write so it only makes one call to network
  Write(AOut + EOL);
end;

function TIdIOHandler.Readable(AMSec: Integer): Boolean;
begin
  // In case descendant does not override this or other methods but implements the higher level
  // methods
  Result := False;
end;

procedure TIdIOHandler.SetHost(const AValue: string);
begin
  FHost := AValue;
end;

procedure TIdIOHandler.SetPort(AValue: Integer);
begin
  FPort := AValue;
end;

function TIdIOHandler.Connected: Boolean;
begin
  CheckForDisconnect(False);
  Result :=
   (
     (
       // Set when closed properly. Reflects actual socket state.
       (ClosedGracefully = False)
       // Created on Open. Prior to Open ClosedGracefully is still false.
       and (FInputBuffer <> nil)
     )
     // Buffer must be empty. Even if closed, we are "connected" if we still have
     // data
     or (InputBufferIsEmpty = False)
   )
   and Opened;
end;

procedure TIdIOHandler.ReadStream(AStream: TIdStreamVCL; AByteCount: Integer;
  AReadUntilDisconnect: Boolean);
var