1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219
| procedure DecompressLZW(Buffer: Pointer; Count: PtrInt; out NewBuffer: PByte; // ligne 2091
out NewCount: PtrInt);
type
TLZWString = packed record
Count: integer;
Data: PByte;
end;
PLZWString = ^TLZWString;
const
ClearCode = 256; // clear table, start with 9bit codes
EoiCode = 257; // end of input
var
NewCapacity: PtrInt;
SrcPos: PtrInt;
SrcPosBit: integer;
CurBitLength: integer;
Code: Word;
Table: PLZWString;
TableCapacity: integer;
TableCount: integer;
OldCode: Word;
procedure Error(const Msg: string);
begin
raise Exception.Create(Msg);
end;
function GetNextCode: Word;
var
v: Integer;
begin
Result:=0;
// CurBitLength can be 9 to 12
//writeln('GetNextCode CurBitLength=',CurBitLength,' SrcPos=',SrcPos,' SrcPosBit=',SrcPosBit,' ',hexstr(PByte(Buffer)[SrcPos],2),' ',hexstr(PByte(Buffer)[SrcPos+1],2),' ',hexstr(PByte(Buffer)[SrcPos+2],2));
// read two or three bytes
if CurBitLength+SrcPosBit>16 then begin
// read from three bytes
if SrcPos+3>Count then Error('LZW stream overrun');
v:=PByte(Buffer)[SrcPos];
inc(SrcPos);
v:=(v shl 8)+PByte(Buffer)[SrcPos];
inc(SrcPos);
v:=(v shl 8)+PByte(Buffer)[SrcPos];
v:=v shr (24-CurBitLength-SrcPosBit);
end else begin
// read from two bytes
if SrcPos+2>Count then Error('LZW stream overrun');
v:=PByte(Buffer)[SrcPos];
inc(SrcPos);
v:=(v shl 8)+PByte(Buffer)[SrcPos];
if CurBitLength+SrcPosBit=16 then
inc(SrcPos);
v:=v shr (16-CurBitLength-SrcPosBit);
end;
Result:=v and ((1 shl CurBitLength)-1);
SrcPosBit:=(SrcPosBit+CurBitLength) and 7;
//writeln('GetNextCode END SrcPos=',SrcPos,' SrcPosBit=',SrcPosBit,' Result=',Result,' Result=',hexstr(Result,4));
end;
procedure ClearTable;
var
i: Integer;
begin
for i:=0 to TableCount-1 do
ReAllocMem(Table[i].Data,0);
TableCount:=0;
end;
procedure InitializeTable;
begin
CurBitLength:=9;
ClearTable;
end;
function IsInTable(Code: word): boolean;
begin
Result:=Code<258+TableCount;
end;
procedure WriteStringFromCode(Code: integer; AddFirstChar: boolean = false);
var
s: TLZWString;
b: byte;
begin
//WriteLn('WriteStringFromCode Code=',Code,' AddFirstChar=',AddFirstChar,' x=',(NewCount div 4) mod IFD.ImageWidth,' y=',(NewCount div 4) div IFD.ImageWidth,' PixelByte=',NewCount mod 4);
if Code<256 then begin
// write byte
b:=Code;
s.Data:=@b;
s.Count:=1;
end else if Code>=258 then begin
// write string
if Code-258>=TableCount then
Error('LZW code out of bounds');
s:=Table[Code-258];
end else
Error('LZW code out of bounds');
if NewCount+s.Count+1>NewCapacity then begin
NewCapacity:=NewCapacity*2+8;
ReAllocMem(NewBuffer,NewCapacity);
end;
System.Move(s.Data^,NewBuffer[NewCount],s.Count);
//for i:=0 to s.Count-1 do write(HexStr(NewBuffer[NewCount+i],2)); // debug
inc(NewCount,s.Count);
if AddFirstChar then begin
NewBuffer[NewCount]:=s.Data^;
//write(HexStr(NewBuffer[NewCount],2)); // debug
inc(NewCount);
end;
//writeln(',WriteStringFromCode'); // debug
end;
procedure AddStringToTable(Code, AddFirstCharFromCode: integer);
// add string from code plus first character of string from code as new string
var
b1, b2: byte;
s1, s2: TLZWString;
p: PByte;
begin
//WriteLn('AddStringToTable Code=',Code,' FCFCode=',AddFirstCharFromCode,' TableCount=',TableCount,' TableCapacity=',TableCapacity);
if TableCount=4096-259 then
Error('LZW too many codes');
// grow table
if TableCount>=TableCapacity then begin
TableCapacity:=TableCapacity*2+128;
ReAllocMem(Table,TableCapacity*SizeOf(TLZWString));
end;
// find string 1
if Code<256 then begin
// string is byte
b1:=Code;
s1.Data:=@b1;
s1.Count:=1;
end else if Code>=258 then begin
// normal string
if Code-258>=TableCount then
Error('LZW code out of bounds');
s1:=Table[Code-258];
end else
Error('LZW code out of bounds');
// find string 2
if AddFirstCharFromCode<256 then begin
// string is byte
b2:=AddFirstCharFromCode;
s2.Data:=@b2;
s2.Count:=1;
end else begin
// normal string
if AddFirstCharFromCode-258>=TableCount then
Error('LZW code out of bounds');
s2:=Table[AddFirstCharFromCode-258];
end;
// set new table entry
Table[TableCount].Count:=s1.Count+1;
p:=nil;
GetMem(p,s1.Count+1);
Table[TableCount].Data:=p;
System.Move(s1.Data^,p^,s1.Count);
// add first character from string 2
p[s1.Count]:=s2.Data^;
// increase TableCount
inc(TableCount);
case TableCount+259 of
512,1024,2048: inc(CurBitLength);
end;
end;
begin
NewBuffer:=nil;
NewCount:=0;
if Count=0 then exit;
//WriteLn('DecompressLZW START Count=',Count);
//for SrcPos:=0 to 19 do
// write(HexStr(PByte(Buffer)[SrcPos],2));
//writeln();
NewCapacity:=Count*2;
ReAllocMem(NewBuffer,NewCapacity);
SrcPos:=0;
SrcPosBit:=0;
CurBitLength:=9;
Table:=nil;
TableCount:=0;
TableCapacity:=0;
try
repeat
Code:=GetNextCode;
//WriteLn('DecompressLZW Code=',Code);
if Code=EoiCode then break;
if Code=ClearCode then begin
InitializeTable;
Code:=GetNextCode;
//WriteLn('DecompressLZW after clear Code=',Code);
if Code=EoiCode then break;
if Code=ClearCode then
Error('LZW code out of bounds');
WriteStringFromCode(Code);
OldCode:=Code;
end else begin
if Code<TableCount+258 then begin
WriteStringFromCode(Code);
AddStringToTable(OldCode,Code);
OldCode:=Code;
end else if Code=TableCount+258 then begin
WriteStringFromCode(OldCode,true);
AddStringToTable(OldCode,OldCode);
OldCode:=Code;
end else
Error('LZW code out of bounds');
end;
until false;
finally
ClearTable;
ReAllocMem(Table,0);
end;
ReAllocMem(NewBuffer,NewCount);
end; |
Partager