clencoder.pas

Clever_Internet_Suite_6.2的代码 Clever_Internet_Suite_6.2的代码 Clever_Internet_Suite_6.2的代码

    while(FSuppressCrlf or(i <= GetCorrectCharsPerLine() - 6)) do
    begin
      if (ASource.Read(Symbol, 1) = 1) then
      begin
        Code := Ord(Symbol);
        case Code of
        32..60,62..126:
          ADestination.Write(Symbol, 1);
        61:
          begin
            ADestination.Write(Pointer(Format('=%2.2X', [Code]))^, 3);
            i := i + 2;
          end;
        13:
          begin
            if (ASource.Read(Symbol, 1) = 1) then
            begin
              if (Symbol = LF) then
              begin
                Symbol1 := CR;
                ADestination.Write(Symbol1, 1);
                Symbol1 := LF;
                ADestination.Write(Symbol1, 1);
                SoftBreak := False;
                Break;
              end else
              begin
                ADestination.Write(Pointer(Format('=%2.2X', [Code]))^, 3);
                i := i + 2;
                ASource.Seek(-1, soFromCurrent);
              end;
            end;
          end;
        else
          begin
            ADestination.Write(Pointer(Format('=%2.2X', [Code]))^, 3);
            i := i + 2;
          end;
        end;
        FFirstPass := False;
      end else
      begin
        SoftBreak := False;
        Result := False;
        break;
      end;
      Inc(i);
    end;
    if SoftBreak and not FStringProcessed then
    begin
      Symbol := '=';
      ADestination.Write(Symbol, 1);
      Symbol1 := CR;
      ADestination.Write(Symbol1, 1);
      Symbol1 := LF;
      ADestination.Write(Symbol1, 1);
    end;
  until not Result;
end;

function TclEncoder.DecodeQP(ASource, ADestination: TStream): Boolean;
var
  Symbol: Char;
  Buffer: string;
  Eof: Boolean;
  i: Integer;
  HexNumber: Integer;
  CRLFSkipped: Integer;
  CodePresent: Boolean;
begin
  HexNumber := 0;
  CRLFSkipped := 0;
  CodePresent := False;
  ADestination.Size := 0;
  ADestination.Position := 0;
  repeat
    Buffer := ReadOneLine(ASource, Eof, CRLFSkipped);
    Result := not Eof;
    if FDelimPresent then
    begin
      Dec(CRLFSkipped);
    end;
    FDelimPresent := False;

    for i := 0 to CRLFSkipped - 1 do
    begin
      ADestination.Write(#13#10, 2);
    end;
    CRLFSkipped := 0;

    for i := 1 to Length(Buffer) do
    begin
      if (FDelimPresent) then
      begin
        case Buffer[i] of
        'A'..'F':
          begin
            HexNumber := HexNumber + (Ord(Buffer[i]) - 55);
          end;
        'a'..'f':
          begin
            HexNumber := HexNumber + (Ord(Buffer[i]) - 87);
          end;
        '0'..'9':
          begin
            HexNumber := HexNumber + (Ord(Buffer[i]) - 48);
          end;
        else
          begin
            CodePresent := False;
            FDelimPresent := False;
            HexNumber := 0;
            Symbol := '=';
            ADestination.Write(Symbol, 1);
            ADestination.Write(Buffer[i], 1);
          end;
        end;
        if not CodePresent then
        begin
          HexNumber := HexNumber*16;
          CodePresent := True;
          continue;
        end else
        begin
          Symbol := Chr(HexNumber);
          ADestination.Write(Symbol, 1);
          CodePresent := False;
          FDelimPresent := False;
          HexNumber := 0;
        end;
      end else
      begin
        if Buffer[i] = '=' then
        begin
          FDelimPresent := True;
        end else
        begin
          ADestination.Write(Buffer[i], 1);
        end;
      end;
    end;
  until Eof;
end;

function TclEncoder.EncodeUUE(ASource, ADestination: TStream): Boolean;

  procedure ConvertToUUE(ASymbolsArray: PChar; ACount, ALineLength: Integer);
  var
    SymbCount, Symb,
    i: Integer;
  begin
    SymbCount := 0;
    for i := 0 to ACount - 1 do
    begin
      Inc(SymbCount);
      if (SymbCount > ALineLength) then
      begin
        if (SymbCount <= (ALineLength + 2)) then Continue;
        SymbCount := 1;
      end;
      Symb := Integer(ASymbolsArray[i]);
      if Symb = 0 then
        ASymbolsArray[i] := '`'
      else
        ASymbolsArray[i] := Chr((Symb and 63) + Ord(' '));
    end;
  end;

var
  Buffer: PChar;
  OutBuffer: PChar;
  LineLength, Length, OutLineLength, OutLen,
  i, k,
  Completed,
  Index, OutIndex: Integer;
begin
  Result := False;
  if FSuppressCrlf then
  begin
    Length:= ASource.Size;
  end else
  begin
    Length:= Trunc(GetCorrectCharsPerLine() * 3/4);
  end;
  Completed := ASource.Size;
  if (Completed = 0) then Exit;
  GetMem(Buffer, Completed);
  OutLen := ((Completed div Length) + 1) * (GetCorrectCharsPerLine() + 5);
  OutLen := (OutLen + ($2000 - 1)) and not ($2000 - 1);
  GetMem(OutBuffer, OutLen);
  try
    ASource.Read(Buffer^, Completed);
    Index := 0;
    OutIndex := 0;
    LineLength := 0;
    OutLineLength := 0;
    for i := 0 to (Completed div Length) do
    begin
      LineLength := Completed - Index;
      if (LineLength > Length) then LineLength := Length;
      OutBuffer[OutIndex] := Char(LineLength);
      Inc(OutIndex);
      for k := 0 to (LineLength div 3) - 1 do
      begin
        OutBuffer[OutIndex] := Char(Word(Buffer[Index]) shr 2);
        OutBuffer[OutIndex + 1] := Char(((Word(Buffer[Index]) shl 4) and 48) or ((Word(Buffer[Index + 1]) shr 4) and 15));
        OutBuffer[OutIndex + 2] := Char(((Word(Buffer[Index + 1]) shl 2) and 60) or ((Word(Buffer[Index + 2]) shr 6) and 3));
        OutBuffer[OutIndex + 3] := Char(Word(Buffer[Index + 2]) and 63);
        Inc(Index, 3);
        Inc(OutIndex, 4);
      end;
      if ((LineLength mod 3) > 0) then
      begin
        OutBuffer[OutIndex] := Char(Word(Buffer[Index]) shr 2);
        if ((LineLength mod 3) = 2) then
        begin
          OutBuffer[OutIndex + 1] := Char(((Word(Buffer[Index]) shl 4) and 48) or ((Word(Buffer[Index + 1]) shr 4) and 15));
          OutBuffer[OutIndex + 2] := Char(((Word(Buffer[Index + 1]) shl 2) and 60));
        end else
        begin
          OutBuffer[OutIndex + 1] := Char(((Word(Buffer[Index]) shl 4) and 48));
          OutBuffer[OutIndex + 2] := #0;
        end;
        Inc(Index, LineLength mod 3);
        Inc(OutIndex, LineLength mod 3 + 1);
      end;
      if (OutLineLength = 0) then OutLineLength := OutIndex;
      if (not FSuppressCrlf) and (LineLength >= Length) then
      begin
        OutBuffer[OutIndex] := CR;
        OutBuffer[OutIndex + 1] := LF;
        Inc(OutIndex, 2);
      end;
    end;
    ConvertToUUE(OutBuffer, OutIndex, OutLineLength);
    if not FSuppressCrlf then
    begin
      if (LineLength < Length) then
      begin
        OutBuffer[OutIndex] := CR;
        OutBuffer[OutIndex + 1] := LF;
        Inc(OutIndex, 2);
      end;
      OutBuffer[OutIndex] := '`';
      Inc(OutIndex, 1);
      OutBuffer[OutIndex] := CR;
      OutBuffer[OutIndex + 1] := LF;
      Inc(OutIndex, 2);
    end;
    ADestination.Write(OutBuffer^, OutIndex);
  finally
    FreeMem(OutBuffer);
    FreeMem(Buffer);
  end;
end;

function TclEncoder.DecodeUUE(ASource, ADestination: TStream): Boolean;
var
  Buffer,
  DestBuffer: PChar;
  curStrLength, Completed,
  i, Index, OutIndex, LineStartIndex,
  StrLength: Integer;
  SckipToLineEnd, HeaderSkipped, CRLFSkipped: Boolean;
  TmpStr: string;
begin
  Result := False;
  Completed := ASource.Size;
  if (Completed = 0) then Exit;
  GetMem(Buffer, Completed);
  GetMem(DestBuffer, Completed);
  try
    ASource.Read(Buffer^, Completed);
    StrLength := 0;
    OutIndex := 0;
    curStrLength := 0;
    LineStartIndex := 0;
    CRLFSkipped := True;
    HeaderSkipped := False;
    SckipToLineEnd := False;
    for Index := 0 to Completed - 1 do
    begin
      if ((Buffer[Index] in [CR, LF]) or (Index = (Completed - 1))) then
      begin
        if (Index = (Completed - 1)) and (not SckipToLineEnd) and not (Buffer[Index] in [CR, LF]) then
        begin
          DestBuffer[OutIndex] := Char((Integer(Buffer[Index]) - $20) and 63);
        end;
        SckipToLineEnd := False;
        OutIndex := LineStartIndex;
        for i := 0 to (StrLength div 4) - 1 do
        begin
          DestBuffer[OutIndex] := Chr((Word(DestBuffer[LineStartIndex]) shl 2) or (Word(DestBuffer[LineStartIndex + 1]) shr 4));
          DestBuffer[OutIndex + 1] := Chr((Word(DestBuffer[LineStartIndex + 1]) shl 4) or (Word(DestBuffer[LineStartIndex + 2]) shr 2));
          DestBuffer[OutIndex + 2] := Chr((Word(DestBuffer[LineStartIndex + 2]) shl 6) or (Word(DestBuffer[LineStartIndex + 3])));
          Inc(OutIndex, 3);
          Inc(LineStartIndex, 4);
        end;
        if ((StrLength mod 4) > 0) then
        begin
          DestBuffer[OutIndex] := Chr((Word(DestBuffer[LineStartIndex]) shl 2) or (Word(DestBuffer[LineStartIndex + 1]) shr 4));
          DestBuffer[OutIndex + 1] := Chr((Word(DestBuffer[LineStartIndex + 1]) shl 4) or (Word(DestBuffer[LineStartIndex + 2]) shr 2));
          Inc(OutIndex, StrLength mod 4);
        end;
        curStrLength := 0;
        StrLength := 0;
        CRLFSkipped := True;
        LineStartIndex := OutIndex;
      end else
      begin
        if SckipToLineEnd then
        begin
          DestBuffer[OutIndex] := #0;
          Inc(OutIndex);
          Continue;
        end;
        if CRLFSkipped then
        begin
          curStrLength := 0;
          if not HeaderSkipped then
          begin
            HeaderSkipped := True;
            TmpStr := 'begin';
            if CompareMem(PChar(Buffer + Index), PChar(TmpStr), 5) then
            begin
              SckipToLineEnd := True;
              Continue;
            end;
          end;
          StrLength := (((Integer(Buffer[Index]) - $20) and 63)*4) div 3;
          CRLFSkipped := False;
          if StrLength = 0 then
            Break
          else
            Continue;
        end;
        DestBuffer[OutIndex] := Char((Integer(Buffer[Index]) - $20) and 63);
        Inc(OutIndex);
        Inc(curStrLength);
        if (curStrLength > StrLength) then
        begin
          SckipToLineEnd := True;
        end;
      end;
    end;
    ADestination.Write(DestBuffer^, OutIndex);
  finally
    FreeMem(DestBuffer);
    FreeMem(Buffer);
  end;
end;

procedure TclEncoder.DoProgress(ABytesProceed, ATotalBytes: Integer);
begin
  if Assigned(FOnProgress) then
  begin
    FOnProgress(Self, ABytesProceed, ATotalBytes);
  end;
end;

function TclEncoder.ReadOneLine(AStream: TStream; var Eof: Boolean;
  var crlfSkipped: Integer): string;
var
  Symbol: Char;
  PrevSymbol: Char;
  Completed: Integer;
  StrLength: Integer;
  RollBackCnt: Integer;
begin
  Result := '';
  Eof := False;
  crlfSkipped := 0;
  StrLength := 0;
  PrevSymbol := #0;
  RollBackCnt := 0;
  while (True) do
  begin
    Completed := AStream.Read(Symbol, 1);
    if (Completed = 0) then
    begin
      Eof := True;
      RollBackCnt := StrLength;
      Break;
    end;
    if (Symbol in [CR, LF]) then
    begin
      if (StrLength <> 0) then
      begin
        RollBackCnt := StrLength + 1;
        Break;
      end;
      if not ((PrevSymbol = CR) and (Symbol = LF)) then
      begin
        Inc(crlfSkipped);
      end;
    end else
    begin
      Inc(StrLength);
    end;
    PrevSymbol := Symbol;
  end;
  if (StrLength <> 0) then
  begin
    SetLength(Result, StrLength);
    AStream.Seek(-RollBackCnt, soFromCurrent);
    AStream.Read(Pointer(Result)^, StrLength);
  end;
end;

function TclEncoder.GetCorrectCharsPerLine: Integer;
begin
  Result := CharsPerLine;
  if (Result < 1) then
  begin
    Result := DefaultCharsPerLine;
  end;
  
  case FMethod of
  cmUUEncode:
    begin
      if (CharsPerLine < 3) then
      begin
        Result := 3;
      end else
      if (CharsPerLine > MaxUUECharsPerLine) then
      begin
        Result := MaxUUECharsPerLine;
      end;
    end;
  cmMIMEQuotedPrintable:
    begin
      if (CharsPerLine < 4) then
      begin
        Result := 4;
      end else
      if (CharsPerLine > MaxQPCharsPerLine) then
      begin
        Result := MaxQPCharsPerLine;
      end;
    end;
  cmMIMEBase64:
    begin
      if(MinBASE64CharsPerLine <= CharsPerLine) then
      begin
        Result := Round(CharsPerLine/4 + 0.25) * 4;
      end else
      begin
        Result := MinBASE64CharsPerLine;
      end;
    end;
  end;
end;

procedure TclEncoder.DecodeFromString(const ASource: string; ADestination: TStream; AMethod: TclEncodeMethod);
var
  SourceStream: TStream;
begin
  SourceStream := TMemoryStream.Create();
  try
    SourceStream.WriteBuffer(PChar(ASource)^, Length(ASource));
    SourceStream.Position := 0;
    DecodeStream(SourceStream, ADestination, AMethod);
  finally
    SourceStream.Free();
  end;
end;

procedure TclEncoder.EncodeToString(ASource: TStream; var ADestination: string; AMethod: TclEncodeMethod);
var
  DestinationStream: TStream;
begin
  DestinationStream := TMemoryStream.Create();
  try
    FStringProcessed := True;
    EncodeStream(ASource, DestinationStream, AMethod);
    SetLength(ADestination, DestinationStream.Size);
    DestinationStream.Position := 0;
    DestinationStream.ReadBuffer(PChar(ADestination)^, DestinationStream.Size);
  finally
    DestinationStream.Free();
    FStringProcessed := False;
  end;
end;

end.