⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 idcoderbinhex4.pas

📁 photo.163.com 相册下载器 多线程下载
💻 PAS
📖 第 1 页 / 共 2 页
字号:
  //$90 is the marker, encoding is made for 3->255 characters
  // 00 11 22 33 44 55 66 77   -> 00 11 22 33 44 55 66 77
  // 11 22 22 22 22 22 22 33   -> 11 22 90 06 33
  // 11 22 90 33 44            -> 11 22 90 00 33 44
  LN := 0;
  while LN < Length(LOut) do begin
    if LOut[LN] = $90 then begin
      if LOut[LN+1] = 0 then begin
        //The 90 is followed by an 00, so it is just a 90.  Remove the 00.
        for LM := LN+1 to Length(LOut)- 2 do begin
          LOut[LM] := LOut[LM+1];
        end;
        SetLength(LOut, Length(LOut)-1);
        Inc(LN);  //Move past the $90
      end else begin
        LRepetition := LOut[LN+1];
        if LRepetition = 1 then begin
          //Not allowed: 22 90 01 -> 22
          //Throw an exception or deal with it?  Deal with it.
          for LM := LN to Length(LOut)- 3 do begin
            LOut[LM] := LOut[LM+2];
          end;
          SetLength(LOut, Length(LOut)-2);
        end else if LRepetition = 2 then begin
          //Not allowed: 22 90 02 -> 22 22
          //Throw an exception or deal with it?  Deal with it.
          LOut[LN] := LOut[LN-1];
          for LM := LN + 1 to Length(LOut)- 2 do begin
            LOut[LM] := LOut[LM+1];
          end;
          SetLength(LOut, Length(LOut)-1);
          Inc(LN);
        end else if LRepetition = 3 then begin
          //22 90 03 -> 22 22 22
          LOut[LN] := LOut[LN-1];
          LOut[LN+1] := LOut[LN-1];
          Inc(LN, 2);
        end else begin
          //Repetition is 4 to 255: expand the sequence.
          //22 90 04 -> 22 22 22 22
          SetLength(LOut, Length(Lout) + LRepetition - 3);
          //Move up the bytes AFTER our 22 90 04...
          for LM := Length(LOut)-1 downto LN+2 do begin
            LOut[LM] := LOut[LM-(LRepetition-3)];
          end;
          //Now that we have the space, expand our 22 90 04
          for LM := LN to LN+LRepetition-2 do begin
            LOut[LM] := LOut[LN-1];
          end;
          Inc(LN, LRepetition - 1);
        end;
      end;
    end else begin
      Inc(LN);
    end;
  end;
  //We are not finished yet.  Strip off the header, by calculating the offset
  //of the start of the attachment and it's length.
  LN := 1 + LOut[0];        //Length byte + length of filename
  Inc(LN, 1 + 4 + 4 + 2);   //Version, type, creator, flags
  LForkLength := (((((LOut[LN]*256)+LOut[LN+1])*256)+LOut[LN+2])*256)+LOut[LN+3];
  Inc(LN, 4);               //Go past the data fork length
  if LForkLength = 0 then begin
    //No data fork present, save the resource fork instead...
    LForkLength := (((((LOut[LN]*256)+LOut[LN+1])*256)+LOut[LN+2])*256)+LOut[LN+3];
  end;
  Inc(LN, 4);               //Go past the resource fork length
  Inc(LN, 2);               //CRC

  //At this point, LOut[LN] points to the actual data (the data fork, if there
  //is one, or else the resource fork if there is no data fork).
  for LM := 0 to LForkLength-1 do begin
    LOut[LM] := LOut[LM+LN];
  end;
  SetLength(LOut, LForkLength);
  FStream.Write(LOut);
end;

{ TIdEncoderBinHex4 }

procedure TIdEncoderBinHex4.InitComponent;
begin
  inherited;
  FCodingTable := GBinHex4CodeTable;
  FFillChar := '=';   {Do not Localize}
end;

function TIdEncoderBinHex4.GetCRC(ABlock: TIdBytes): word;
var
  LCRC: word;
  LN: integer;
begin
  LCRC := 0;
  for LN := 0 to Length(ABlock) do begin
    AddByteCRC(LCRC, ABlock[LN]);
  end;
  Result := LCRC;
end;

procedure TIdEncoderBinHex4.AddByteCRC(var ACRC: word; AByte: Byte);
  //BinHex 4.0 uses a 16-bit CRC with an 0x1021 seed.
var
  LWillShiftedOutBitBeA1: boolean;
  LN: integer;
begin
  for LN := 1 to 8 do begin
    LWillShiftedOutBitBeA1 := (ACRC and $8000) <> 0;
    //Shift the CRC left, and add the next bit from our byte...
    ACRC := (ACRC shl 1) or (AByte shr 7);
    if LWillShiftedOutBitBeA1 then begin
      ACRC := ACRC xor $1021;
    end;
    AByte := (AByte shl 1) and $FF;
  end;
end;

procedure TIdEncoderBinHex4.EncodeFile(AFileName: string; ASrcStream: TIdStreamRandomAccess; ADestStream: TIdStream);
var
  LN: integer;
  LM: integer;
  LOffset: integer;
  LBlocks: integer;
  LOut: TIdBytes;
  LSSize, LTemp: Int64;
  LFile: TIdBytes;
  LFileName: string;
  LCRC: word;
  LOutgoing: TIdBytes;
  LRemainder: integer;
begin
  //Read in the attachment first...
  LSSize := ASrcStream.Size;
  SetLength(LFile, LSSize);
  ASrcStream.ReadBytes(LFile, LSSize);
  //BinHex4.0 allows filenames to be only 255 bytes long (because the length
  //is stored in a byte), so truncate the filename to 255 bytes...
  if Length(AFileName) > 255 then begin
    LFileName := Copy(AFileName, 1, 255);
  end else begin
    LFileName := AFileName;
  end;
  //Construct the header...
  SetLength(LOut, 1+Length(LFileName)+1+4+4+2+4+4);
  LOut[0] := Length(LFileName);               //Length of filename is 1st byte
  for LN := 1 to Length(LFileName) do begin
    LOut[LN] := Byte(LFileName[LN]);
  end;
  LOffset := Length(LFileName)+1;             //Points to byte after filename
  LOut[LOffset] := 0;                         //Version
  for LN := 1 to 8 do begin
    LOut[LOffset+LN] := 32;                   //Use spaces for Type & Creator
  end;
  LOut[LOffset+9] := 0;                       //Flags
  LOut[LOffset+10] := 0;                      //Flags
  LTemp := LSSize;
  LOut[LOffset+14] := LTemp mod 256;          //Length of data fork
  LTemp := LTemp div 256;
  LOut[LOffset+13] := LTemp mod 256;          //Length of data fork
  LTemp := LTemp div 256;
  LOut[LOffset+12] := LTemp mod 256;          //Length of data fork
  LTemp := LTemp div 256;
  LOut[LOffset+11] := LTemp;                  //Length of data fork
  LOut[LOffset+15] := 0;                      //Length of resource fork
  LOut[LOffset+16] := 0;                      //Length of resource fork
  LOut[LOffset+17] := 0;                      //Length of resource fork
  LOut[LOffset+18] := 0;                      //Length of resource fork
  //Next comes the CRC for the header...
  LCRC := GetCRC(LOut);
  SetLength(LOut, Length(LOut)+2);
  LOut[LOffset+20] := LCRC mod 256;           //CRC of data fork
  LCRC := LCRC div 256;
  LOut[LOffset+19] := LCRC;                   //CRC of data fork
  //Next comes the data fork (we will not be using the resource fork)...
  SetLength(LOut, Length(LOut) + LSSize + 2); //2 for the CRC
  LOffset := LOffset + 21;  //LOut[LOffset] now points to where the attachment goes
  //Copy in the attachment...
  LN := 0;
  while LN < LSSize do begin
    LOut[LN+LOffset] := LFile[LN];
    LN := LN+1;
  end;
  LCRC := GetCRC(LFile);
  SetLength(LFile, 0);
  LOffset := LOffset + LSSize;
  LOut[LOffset+1] := LCRC mod 256;            //CRC of data fork
  LCRC := LCRC div 256;
  LOut[LOffset] := LCRC;                      //CRC of data fork
  //To prepare for the 3to4 encoder, make sure our block is a multiple of 3...
  LOffset := Length(LOut) mod 3;
  if LOffset > 0 then begin
    SetLength(LOut, Length(LOut)+3-LOffset);
  end;
  //We now need to 3to4 encode LOut...
  LOutgoing := EncodeIdBytes(LOut);
  SetLength(LOut, 0);  //Free memory
  //Need to add a colon at the start & end of the block...
  LSSize := Length(LOutgoing);
  SetLength(LOutgoing, Length(LOutgoing)+2);
  LN := LSSize;
  while LN >= 0 do begin
    LOutGoing[LN] := LOutgoing[LN-1];
    LN := LN-1;
  end;
  LOutgoing[0] := 58;                    //58 = :
  LOutgoing[Length(LOutgoing)-1] := 58;  //58 = :
  //Expand any 90 to 90 00
  LN := 0;
  while LN < Length(LOutgoing) do begin
    if LOutgoing[LN] = $90 then begin
      SetLength(LOutgoing, Length(LOutgoing)+1);
      LM := Length(LOutgoing)-1;
      while LM > LN + 1 do begin
       LOutgoing[LM] := LOutgoing[LM-1];
        Dec(LM);
      end;
      LOutgoing[LN+1] := 0;
    end;
    Inc(LN);
  end;

  ADestStream.Write(GBinHex4IdentificationString + EOL);
  //Put back in our CRLFs.  A max of 64 chars are allowed per line.
  LBlocks := Length(LOutgoing); //The number of complete 64-char blocks
  LBlocks := LBlocks div 64; //The number of complete 64-char blocks
  SetLength(LOut, 64+2);
  for LN := 0 to LBlocks-1 do begin
    LOffset := LN*64;
    for LM := 0 to 63 do begin
      LOut[LM] := LOutgoing[LM+LOffset];
    end;
    LOut[64] := 13;
    LOut[65] := 10;
    ADestStream.Write(LOut, 64+2);
  end;
  LRemainder := Length(LOutgoing) mod 64;
  if LRemainder > 0 then begin
    SetLength(LOut, LRemainder+2);
    LOffset := LBlocks*64;
    for LM := 0 to LRemainder-1 do begin
      LOut[LM] := LOutgoing[LM+LOffset];
    end;
    LOut[LRemainder] := 13;
    LOut[LRemainder+1] := 10;
    ADestStream.Write(LOut, LRemainder+2);
  end;
end;

initialization
  TIdDecoder4to3.ConstructDecodeTable(GBinHex4CodeTable, GBinHex4DecodeTable);
end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -