HanDs
管理员

[Delphi文章] FastRLE 压缩算法 



TSFastRLE = class(TObject)
  private
    t, s: Pointer;
    function PackSeg(Source, Target: Pointer; SourceSize: Word): Word;
    function UnPackSeg(Source, Target: Pointer; SourceSize: Word): Word;
  protected
  public
    Constructor Create;
    Destructor Destroy; override;
    function Pack(Source, Target: Pointer; SourceSize: LongInt): LongInt; { Return TargetSize }
    function UnPack(Source, Target: Pointer; SourceSize: LongInt): LongInt; {Return TargetSize }
    function PackString(Source: String): String;
    function UnPackString(Source: String): String;
    function PackFile(SourceFileName, TargetFileName: String): Boolean; { Return FALSE if IOError }
    function UnPackFile(SourceFileName, TargetFileName: String): Boolean; { Return FALSE if IOError }
  end;


{ TRLE }

Type
  LongType = record
    case Word of
      0: (Ptr: Pointer);
      1: (Long: LongInt);
      2: (Lo: Word;
 Hi: Word);
  end;

constructor TSFastRLE.Create;
begin
  inherited;
  GetMem(s, $FFFF);
  GetMem(t, $FFFF);
end;

destructor TSFastRLE.Destroy;
begin
  FreeMem(t);
  FreeMem(s);
  inherited;
end;

function TSFastRLE.PackSeg(Source, Target: Pointer; SourceSize: Word): Word;
begin
  asm
        push    esi
        push    edi
        push    eax
        push    ebx
        push    ecx
        push    edx

cld
        xor     ecx, ecx
mov cx, SourceSize
mov edi, Target

mov esi, Source
add esi, ecx
dec esi
lodsb
inc eax
mov [esi], al

mov ebx, edi
        add     ebx, ecx
inc ebx
mov esi, Source
        add     ecx, esi
add edi, 2
@CyclePack:
cmp ecx, esi
je @Konec
lodsw
stosb
dec esi
cmp al, ah
jne @CyclePack
cmp ax, [esi+1]
jne @CyclePack
cmp al, [esi+3]
jne @CyclePack
sub ebx, 2
        push    edi
        sub     edi, Target
mov [ebx], di
        pop     edi
mov edx, esi
add esi, 3
@Nimnul:
inc esi
cmp al, [esi]
je @Nimnul
mov eax, esi
sub eax, edx
or ah, ah
jz @M256
mov byte ptr [edi], 0
inc edi
stosw
jmp     @CyclePack
@M256:
stosb
jmp     @CyclePack
@Konec:
        push    ebx
        mov     ebx, Target
        mov     eax, edi
        sub     eax, ebx
mov [ebx], ax
        pop     ebx
inc ecx
cmp ebx, ecx
je @Lock1
mov esi, ebx
        sub     ebx, Target
        sub     ecx, Source
sub ecx, ebx
rep movsb
@Lock1:
        sub     edi, Target
mov Result, di

        pop     edx
        pop     ecx
        pop     ebx
        pop     eax
        pop     edi
        pop     esi
  end;
end;

function TSFastRLE.UnPackSeg(Source, Target: Pointer; SourceSize: Word): Word;
begin
  asm
        push    esi
        push    edi
        push    eax
        push    ebx
        push    ecx
        push    edx
cld
mov esi, Source
mov edi, Target
        mov     ebx, esi
        xor     edx, edx
        mov     dx, SourceSize
add ebx, edx
mov dx, word ptr [esi]
        add     edx, esi
add esi, 2
@UnPackCycle:
cmp edx, ebx
je @Konec2
sub ebx, 2
        xor     ecx, ecx
mov cx, word ptr [ebx]
        add     ecx, Source
sub ecx, esi
dec ecx
rep movsb
lodsb
mov cl, byte ptr [esi]
inc esi
or cl, cl
jnz @Low1
        xor     ecx, ecx
mov cx, word ptr [esi]
add esi, 2
@Low1:
inc ecx
rep stosb
jmp     @UnPackCycle
@Konec2:
mov ecx, edx
sub ecx, esi
rep movsb
        sub     edi, Target
        mov     Result, di

        pop     edx
        pop     ecx
        pop     ebx
        pop     eax
        pop     edi
        pop     esi
  end;
end;

function TSFastRLE.Pack(Source, Target: Pointer; SourceSize: Integer): LongInt;
var
  w, tmp: Word;
  Sourc, Targ: LongType;
begin
{  // Move
  Move(Source^, Target^, SourceSize);
  Result:= SourceSize;
  Exit;{}

  // RLE Compress
  Sourc.Ptr := Source;
  Targ.Ptr := Target;
  Result := 0;
  while SourceSize <> 0 do
  begin
    if SourceSize > $FFFA then tmp := $FFFA
    else tmp := SourceSize;
    dec(SourceSize, tmp);
    move(Sourc.Ptr^, s^, tmp);
    w := PackSeg(s, t, tmp);
    inc(Sourc.Long, tmp);
    Move(w, Targ.Ptr^, 2);
    inc(Targ.Long, 2);
    Move(t^, Targ.Ptr^, w);
    inc(Targ.Long, w);
    Result := Result + w + 2;
  end;
end;

function TSFastRLE.PackFile(SourceFileName, TargetFileName: String): Boolean;
var
  Source, Target: Pointer;
  SourceFile, TargetFile: File;
  RequiredMaxSize, TargetFSize, FSize: LongInt;
begin
  AssignFile(SourceFile, SourceFileName);
  Reset(SourceFile, 1);
  FSize := FileSize(SourceFile);

  RequiredMaxSize := FSize + (FSize div $FFFF + 1) * 2;
  GetMem(Source, RequiredMaxSize);
  GetMem(Target, RequiredMaxSize);

  BlockRead(SourceFile, Source^, FSize);
  CloseFile(SourceFile);

  TargetFSize := Pack(Source, Target, FSize);

  AssignFile(TargetFile, TargetFileName);
  Rewrite(TargetFile, 1);
  { Also, you may put header }
  BlockWrite(TargetFile, FSize, SizeOf(FSize)); { Original file size (Only from 3.0) }
  BlockWrite(TargetFile, Target^, TargetFSize);
  CloseFile(TargetFile);

  FreeMem(Target, RequiredMaxSize);
  FreeMem(Source, RequiredMaxSize);

  Result := IOResult = 0;
end;

function TSFastRLE.PackString(Source: String): String;
var
  PC, PC2: PChar;
  SS, TS: Integer;
begin
  SS := Length(Source);
  GetMem(PC, SS);
  GetMem(PC2, SS + 8); // If line can't be packed its size can be longer
  Move(Source[1], PC^, SS);
  TS := Pack(PC, PC2, SS);
  SetLength(Result, TS + 4);
  Move(SS, Result[1], 4);
  Move(PC2^, Result[5], TS);
  FreeMem(PC2);
  FreeMem(PC);
end;

function TSFastRLE.UnPack(Source, Target: Pointer;
  SourceSize: Integer): LongInt;
var
  Increment, i: LongInt;
  tmp: Word;
  Swap: LongType;
begin
{  // Move
  Move(Source^, Target^, SourceSize);
  Result:= SourceSize;
  Exit;{}

  // RLE Decompress
  Increment := 0;
  Result := 0;
  while SourceSize <> 0 do
  begin
    Swap.Ptr := Source;
    inc(Swap.Long, Increment);
    Move(Swap.Ptr^, tmp, 2);
    inc(Swap.Long, 2);
    dec(SourceSize, tmp + 2);
    i := UnPackSeg(Swap.Ptr, t, tmp);
    Swap.Ptr := Target;
    inc(Swap.Long, Result);
    inc(Result, i);
    Move(t^, Swap.Ptr^, i);
    inc(Increment, tmp + 2);
  end;
end;

function TSFastRLE.UnPackFile(SourceFileName, TargetFileName: String): Boolean;
var
  Source, Target: Pointer;
  SourceFile, TargetFile: File;
  OriginalFileSize, FSize: LongInt;
begin
  AssignFile(SourceFile, SourceFileName);
  Reset(SourceFile, 1);
  FSize := FileSize(SourceFile) - SizeOf(OriginalFileSize);

  { Read header ? }
  BlockRead(SourceFile, OriginalFileSize, SizeOf(OriginalFileSize));

  GetMem(Source, FSize);
  GetMem(Target, OriginalFileSize);

  BlockRead(SourceFile, Source^, FSize);
  CloseFile(SourceFile);

  UnPack(Source, Target, FSize);

  AssignFile(TargetFile, TargetFileName);
  Rewrite(TargetFile, 1);
  BlockWrite(TargetFile, Target^, OriginalFileSize);
  CloseFile(TargetFile);

  FreeMem(Target, OriginalFileSize);
  FreeMem(Source, FSize);

  Result := IOResult = 0;
end;

function TSFastRLE.UnPackString(Source: String): String;
var
  PC, PC2: PChar;
  SS, TS: Integer;
begin
  SS := Length(Source) - 4;
  GetMem(PC, SS);
  Move(Source[1], TS, 4);
  GetMem(PC2, TS);
  Move(Source[5], PC^, SS);
  TS := UnPack(PC, PC2, SS);
  SetLength(Result, TS);
  Move(PC2^, Result[1], TS);
  FreeMem(PC2);
  FreeMem(PC);
end; 


学习中请遵守法律法规,本网站内容均来自于互联网,本网站不负担法律责任
FastRLE 压缩算法
#1楼
发帖时间:2016-7-9   |   查看数:0   |   回复数:0
游客组
快速回复