ezzlib.pas

很管用的GIS控件

begin
  source := s1p;
  dest := s2p;
  for j := 0 to pred(len) do begin
    if (source^ <> dest^) then begin
      zmemcmp := 2 * Ord(source^ > dest^) - 1;
      exit;
    end;
    Inc(source);
    Inc(dest);
  end;
  zmemcmp := 0;
end;

procedure zmemzero(destp: pBytef; len: uInt);
begin
  FillChar(destp^, len, 0);
end;

procedure zcfree(opaque: voidpf; ptr: voidpf);
begin
  FreeMem(ptr);
end;

function zcalloc(opaque: voidpf; items: uInt; size: uInt): voidpf;
var
  p: voidpf;
  memsize: uLong;
begin
  try                                { Modified on 8/13/00 by DOM to return  }
    memsize := uLong(items) * size;  { a nil pointer rather than raise a     }
    GetMem(p, memsize);              { memory error exception (which could   }
    zcalloc := p;                    { cause problems such as skipping       }
  except                             { memory deallocation code)             }
    zcalloc := NIL;
  end;
end;

{-----------------------------------------------------------------------------}
{-----------------------------------------------------------------------------}
{-----------------------------------------------------------------------------}

{ zlib.h -- interface of the 'zlib' general purpose compression library
  Copyright (C) 1995-1998 Jean-loup Gailly and Mark Adler

  zlib.pas -- pascal translation
  Copyright (C) 1998 by Jacques Nomssi Nzali
}

function zError(err: int): string;
begin
  zError := z_errmsg[Z_NEED_DICT - err];
end;

function zlibVersion: string;
begin
  zlibVersion := ZLIB_VERSION;
end;

function ZALLOC(var strm: z_stream; items: uInt; size: uInt): voidpf;
begin
  ZALLOC := strm.zalloc(strm.opaque, items, size);
end;

procedure ZFREE(var strm: z_stream; ptr: voidpf);
begin
  strm.zfree(strm.opaque, ptr);
end;

procedure TRY_FREE(var strm: z_stream; ptr: voidpf);
begin
  strm.zfree(strm.opaque, ptr);
end;

{-----------------------------------------------------------------------------}
{-----------------------------------------------------------------------------}
{-----------------------------------------------------------------------------}

{ types and macros common to blocks and codes
  Copyright (C) 1995-1998 Mark Adler

  infutil.pas -- pascal translation
  Copyright (C) 1998 by Jacques Nomssi Nzali
}

function inflate_flush(var s: inflate_blocks_state;
  var z: z_stream; r: int): int;
var
  n: uInt;
  p: pBytef;
  q: pBytef;
begin
  p := z.next_out;
  q := s.read;
  if ptr2int(q) <= ptr2int(s.write) then
    n := uInt(ptr2int(s.write) - ptr2int(q))
  else
    n := uInt(ptr2int(s.zend) - ptr2int(q));
  if (n > z.avail_out) then
    n := z.avail_out;
  if (n <> 0) and (r = Z_BUF_ERROR) then
    r := Z_OK;
  Dec(z.avail_out, n);
  Inc(z.total_out, n);
  if Assigned(s.checkfn) then begin
    s.check := s.checkfn(s.check, q, n);
    z.adler := s.check;
  end;
  zmemcpy(p, q, n);
  Inc(p, n);
  Inc(q, n);
  if (q = s.zend) then begin
    q := s.window;
    if (s.write = s.zend) then s.write := s.window;
    n := uInt(ptr2int(s.write) - ptr2int(q));
    if (n > z.avail_out) then n := z.avail_out;
    if (n <> 0) and (r = Z_BUF_ERROR) then r := Z_OK;
    Dec(z.avail_out, n);
    Inc(z.total_out, n);
    if Assigned(s.checkfn) then begin
      s.check := s.checkfn(s.check, q, n);
      z.adler := s.check;
    end;
    zmemcpy(p, q, n);
    Inc(p, n);
    Inc(q, n);
  end;
  z.next_out := p;
  s.read := q;
  inflate_flush := r;
end;

const
  inflate_mask: array[0..17 - 1] of uInt = (
    $0000,
    $0001, $0003, $0007, $000F, $001F, $003F, $007F, $00FF,
    $01FF, $03FF, $07FF, $0FFF, $1FFF, $3FFF, $7FFF, $FFFF);

{-----------------------------------------------------------------------------}
{-----------------------------------------------------------------------------}
{-----------------------------------------------------------------------------}

{ inffast.h and
  inffast.c -- process literals and length/distance pairs fast
  Copyright (C) 1995-1998 Mark Adler

  inffast.pas -- pascal translation
  Copyright (C) 1998 by Jacques Nomssi Nzali
}

function inflate_fast(bl: uInt;
  bd: uInt; tl: pInflate_huft; td: pInflate_huft;
  var s: inflate_blocks_state; var z: z_stream): int;
var
  t: pInflate_huft;
  e: uInt;
  b: uLong;
  k: uInt;
  p: pBytef;
  n: uInt;
  q: pBytef;
  m: uInt;
  ml: uInt;
  md: uInt;
  c: uInt;
  d: uInt;
  r: pBytef;
begin
  p := z.next_in;
  n := z.avail_in;
  b := s.bitb;
  k := s.bitk;
  q := s.write;
  if ptr2int(q) < ptr2int(s.read) then
    m := uInt(ptr2int(s.read) - ptr2int(q) - 1)
  else
    m := uInt(ptr2int(s.zend) - ptr2int(q));
  ml := inflate_mask[bl];
  md := inflate_mask[bd];
  repeat
    while (k < 20) do begin
      Dec(n);
      b := b or (uLong(p^) shl k);
      Inc(p);
      Inc(k, 8);
    end;
    t := @(huft_ptr(tl)^[uInt(b) and ml]);
    e := t^.exop;
    if (e = 0) then begin
      b := b shr t^.bits;
      Dec(k, t^.bits);
      q^ := Byte(t^.base);
      Inc(q);
      Dec(m);
      continue;
    end;
    repeat
      b := b shr t^.bits;
      Dec(k, t^.bits);
      if (e and 16 <> 0) then begin
        e := e and 15;
        c := t^.base + (uInt(b) and inflate_mask[e]);
        b := b shr e;
        Dec(k, e);
        while (k < 15) do begin
          Dec(n);
          b := b or (uLong(p^) shl k);
          Inc(p);
          Inc(k, 8);
        end;
        t := @huft_ptr(td)^[uInt(b) and md];
        e := t^.exop;
        repeat
          b := b shr t^.bits;
          Dec(k, t^.bits);
          if (e and 16 <> 0) then begin
            e := e and 15;
            while (k < e) do begin
              Dec(n);
              b := b or (uLong(p^) shl k);
              Inc(p);
              Inc(k, 8);
            end;
            d := t^.base + (uInt(b) and inflate_mask[e]);
            b := b shr e;
            Dec(k, e);
            Dec(m, c);
            if (uInt(ptr2int(q) - ptr2int(s.window)) >= d) then begin
              r := q;
              Dec(r, d);
              q^ := r^; Inc(q); Inc(r); Dec(c);
              q^ := r^; Inc(q); Inc(r); Dec(c);
            end
            else begin
              e := d - uInt(ptr2int(q) - ptr2int(s.window));
              r := s.zend;
              Dec(r, e);
              if (c > e) then begin
                Dec(c, e);
                repeat
                  q^ := r^;
                  Inc(q);
                  Inc(r);
                  Dec(e);
                until (e = 0);
                r := s.window;
              end;
            end;
            repeat
              q^ := r^;
              Inc(q);
              Inc(r);
              Dec(c);
            until (c = 0);
            break;
          end
          else if (e and 64 = 0) then begin
            Inc(t, t^.base + (uInt(b) and inflate_mask[e]));
            e := t^.exop;
          end
          else begin
            z.msg := 'invalid distance code';
            c := z.avail_in - n;
            if (k shr 3) < c then
              c := k shr 3;
            Inc(n, c);
            Dec(p, c);
            Dec(k, c shl 3);
            s.bitb := b;
            s.bitk := k;
            z.avail_in := n;
            Inc(z.total_in, ptr2int(p) - ptr2int(z.next_in));
            z.next_in := p;
            s.write := q;
            inflate_fast := Z_DATA_ERROR;
            exit;
          end;
        until FALSE;
        break;
      end;
      if (e and 64 = 0) then begin
        Inc(t, t^.base + (uInt(b) and inflate_mask[e]));
        e := t^.exop;
        if (e = 0) then begin
          b := b shr t^.bits;
          Dec(k, t^.bits);
          q^ := Byte(t^.base);
          Inc(q);
          Dec(m);
          break;
        end;
      end
      else if (e and 32 <> 0) then begin
        c := z.avail_in - n;
        if (k shr 3) < c then
          c := k shr 3;
        Inc(n, c);
        Dec(p, c);
        Dec(k, c shl 3);
        s.bitb := b;
        s.bitk := k;
        z.avail_in := n;
        Inc(z.total_in, ptr2int(p) - ptr2int(z.next_in));
        z.next_in := p;
        s.write := q;
        inflate_fast := Z_STREAM_END;
        exit;
      end
      else begin
        z.msg := 'invalid literal/length code';
        c := z.avail_in - n;
        if (k shr 3) < c then
          c := k shr 3;
        Inc(n, c);
        Dec(p, c);
        Dec(k, c shl 3);
        s.bitb := b;
        s.bitk := k;
        z.avail_in := n;
        Inc(z.total_in, ptr2int(p) - ptr2int(z.next_in));
        z.next_in := p;
        s.write := q;
        inflate_fast := Z_DATA_ERROR;
        exit;
      end;
    until FALSE;
  until (m < 258) or (n < 10);
  c := z.avail_in - n;
  if (k shr 3) < c then c := k shr 3;
  Inc(n, c);
  Dec(p, c);
  Dec(k, c shl 3);
  s.bitb := b;
  s.bitk := k;
  z.avail_in := n;
  Inc(z.total_in, ptr2int(p) - ptr2int(z.next_in));
  z.next_in := p;
  s.write := q;
  inflate_fast := Z_OK;
end;

{-----------------------------------------------------------------------------}
{-----------------------------------------------------------------------------}
{-----------------------------------------------------------------------------}

{ infcodes.c -- process literals and length/distance pairs
  Copyright (C) 1995-1998 Mark Adler

  infcodes.pas -- pascal translation
  Copyright (C) 1998 by Jacques Nomssi Nzali
}

function inflate_codes_new(bl: uInt;
  bd: uInt; tl: pInflate_huft; td: pInflate_huft;
  var z: z_stream): pInflate_codes_state;
var
  c: pInflate_codes_state;
begin
  c := pInflate_codes_state(ZALLOC(z, 1, sizeof(inflate_codes_state)));
  if (c <> Z_NULL) then begin
    c^.mode := START;
    c^.lbits := Byte(bl);
    c^.dbits := Byte(bd);
    c^.ltree := tl;
    c^.dtree := td;
  end;
  inflate_codes_new := c;
end;

function inflate_codes(var s: inflate_blocks_state;
  var z: z_stream; r: int): int;
var
  j: uInt;
  t: pInflate_huft;
  e: uInt;
  b: uLong;
  k: uInt;
  p: pBytef;
  n: uInt;
  q: pBytef;
  m: uInt;
  f: pBytef;
  c: pInflate_codes_state;
begin
  c := s.sub.decode.codes;
  p := z.next_in;
  n := z.avail_in;
  b := s.bitb;
  k := s.bitk;
  q := s.write;
  if ptr2int(q) < ptr2int(s.read) then
    m := uInt(ptr2int(s.read) - ptr2int(q) - 1)
  else
    m := uInt(ptr2int(s.zend) - ptr2int(q));
  while True do
    case (c^.mode) of
      START: