📄 idcoderbinhex4.pas
字号:
//$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 + -