//******************************************************************************
// decThumbsDB library
// (c) 2007 Dec AnisimovDec(at)mail(dot)ru
// version 1.05
//******************************************************************************

unit decThumbsDB;

{

  Win Version         | Thumbs.db version
  ---------------------------------------
  Win95               | none
  Win95OSR2           | none
  Win98               | none
  Win98SE             | none
  WinME               | no info
  WinNT31             | no info
  WinNT35             | no info
  WinNT351            | no info
  WinNT4              | no info
  Win2000 SP0 - SP3   | $00080004 (?)
  Win2000 SP4         | $00080004
  WinXP MCE           | $00080001 - ehthumbs.db
  WinXP               | $00100005 (?)
  WinXP SP1           | $00100006
  WinXP SP2           | $00100007
  Win2003             | no info
  WinXP64             | no info
  Win2003R2           | no info
  WinVista            | thumbcache_*.db - not supported yet
  WinServer2008       | no info

}

interface

{$DEFINE USEVCL}
{$DEFINE USEJPEG}
{$DEFINE USEIJL}

{$IFNDEF USEVCL}
{$UNDEF USEJPEG}
{$DEFINE GMN}
{$ENDIF}

{$IFDEF VER130}
{$DEFINE GMN}
{$ENDIF}

{$IFDEF VER120}
{$DEFINE GMN}
{$ENDIF}

uses Windows, ActiveX
  {$IFDEF USEVCL}, Classes, Graphics {$IFDEF USEJPEG}, Jpeg {$ENDIF}{$ENDIF};

type
  TdecTDB_FindData = record
    FFileName: array[0..MAX_PATH - 1] of WideChar;
    FCreationTime: TFileTime;
    FLastAccessTime: TFileTime;
    FLastWriteTime: TFileTime;
    FID: DWORD;
    FSourceLastWriteTime: TFileTime;
  end;

  TdecTDB_SearchRec = record
    FStorage: IStorage;
    FCatalog: IStream;
    FVersion: DWORD;
    FCount: Integer;
    FWidth: DWORD;
    FHeight: DWORD;
    FFindData: TdecTDB_FindData;
  end;
  PdecTDB_SearchRec = ^TdecTDB_SearchRec;

function decTDB_FindFirst(const AFileName: WideString; out ASearchRec: TdecTDB_SearchRec): Integer;
function decTDB_FindNext(var ASearchRec: TdecTDB_SearchRec): Integer;
procedure decTDB_FindClose(var ASearchRec: TdecTDB_SearchRec);
function decTDB_ExtractThumbnail(AStorage: IStorage; AID, AVersion: DWORD): {$IFDEF USEVCL} TGraphic {$ELSE} HBITMAP {$ENDIF}; overload;
function decTDB_ExtractThumbnail(const ASearchRec: TdecTDB_SearchRec): {$IFDEF USEVCL} TGraphic {$ELSE} HBITMAP {$ENDIF}; overload;
{$IFDEF USEVCL}
function decTDB_ExtractStream(AStorage: IStorage; AID, AVersion: DWORD): TStream; overload;
function decTDB_ExtractStream(const ASearchRec: TdecTDB_SearchRec): TStream; overload;
{$ENDIF}

{$IFDEF USEIJL}
function decTDB_IJLLoadJpeg(ABuffer: Pointer; const ASize: Int64): HBITMAP;
procedure decTDB_IJLUnload;
{$ENDIF}

implementation

{$IFDEF USEVCL}
uses SysUtils;
{$ELSE}

{$IFDEF USEIJL}
function ExtractFilePath(const AFileName: string): string;
var i: integer;
begin
  for i := Length(AFileName) downto 1 do
    if AFileName[i] = '\' then
      begin
        Result := Copy(AFileName, 1, i);
        exit;
      end;
  Result := '';
end;
{$ENDIF}

function IntToStr(AValue: Integer): string;
begin
  Result := '';
  repeat
    Result := Char(Ord('0') + AValue mod 10) + Result;
    AValue := AValue div 10;
  until AValue = 0;
end;
{$ENDIF}

{$IFDEF GMN}
{$IFDEF USEIJL}
function GetModuleName(AModule: HMODULE): string;
var ModName: array[0..MAX_PATH] of Char;
begin
  SetString(Result, ModName, GetModuleFileName(AModule, ModName, SizeOf(ModName)));
end;
{$ENDIF}
{$ENDIF}

type
  TOleStream = class {$IFDEF USEVCL}(TStream){$ENDIF}
  public
    constructor Create(const Stream: IStream);
    function Read(var Buffer; Count: Longint): Longint; {$IFDEF USEVCL} override; {$ENDIF}
    function Write(const Buffer; Count: Longint): Longint; {$IFDEF USEVCL} override; {$ENDIF}
    function Seek(Offset: Longint; Origin: Word): Longint; {$IFDEF USEVCL} override; {$ENDIF}
  private
    FStream: IStream;
  {$IFNDEF USEVCL}
  public
    procedure ReadBuffer(var Buffer; Count: Longint);
    procedure WriteBuffer(const Buffer; Count: Longint);
  private
    function GetPosition: Int64;
    procedure SetPosition(const Pos: Int64);
    function GetSize: Int64;
  public
    property Position: Int64 read GetPosition write SetPosition;
    property Size: Int64 read GetSize;
  {$ENDIF}
  end;

procedure RaiseException(ACode: Cardinal = 0);
begin
  Windows.RaiseException(ACode, 0, 0, nil);
end;

procedure OleCheck(Result: HResult);
begin
  if not Succeeded(Result) then RaiseException(Result);
end;

constructor TOleStream.Create(const Stream: IStream);
begin
  inherited Create;
  FStream := Stream;
end;

function TOleStream.Read(var Buffer; Count: Longint): Longint;
begin
  OleCheck(FStream.Read(@Buffer, Count, @Result));
end;

function TOleStream.Write(const Buffer; Count: Longint): Longint;
begin
  OleCheck(FStream.Write(@Buffer, Count, @Result));
end;

function TOleStream.Seek(Offset: Longint; Origin: Word): Longint;
var
  Pos: Largeint;
begin
  OleCheck(FStream.Seek(Offset, Origin, Pos));
  Result := Longint(Pos);
end;

{$IFNDEF USEVCL}
procedure TOleStream.ReadBuffer(var Buffer; Count: Longint);
begin
  if (Count <> 0) and (Read(Buffer, Count) <> Count) then
    RaiseException;
end;

procedure TOleStream.WriteBuffer(const Buffer; Count: Longint);
begin
  if (Count <> 0) and (Write(Buffer, Count) <> Count) then
    RaiseException;
end;

function TOleStream.GetPosition: Int64;
begin
  Result := Seek(0, STREAM_SEEK_CUR);
end;

procedure TOleStream.SetPosition(const Pos: Int64);
begin
  Seek(Pos, STREAM_SEEK_SET);
end;

function TOleStream.GetSize: Int64;
var
  Pos: Int64;
begin
  Pos := Seek(0, STREAM_SEEK_CUR);
  Result := Seek(0, STREAM_SEEK_END);
  Seek(Pos, STREAM_SEEK_SET);
end;
{$ENDIF}

function decTDB_ExtractProperties(ACatalog: IStream; var AVersion, ACount, AWidth, AHeight: DWORD): Integer;
var S: TOleStream;
begin
  S := TOleStream.Create(ACatalog);
  try
    Result := 0;
    S.ReadBuffer(AVersion, SizeOf(AVersion));
    AVersion := (AVersion shl 16) and $FFFF0000 or (AVersion shr 16);
    S.ReadBuffer(ACount, SizeOf(ACount));
    if AVersion <= $00080001 then
      begin
        AWidth := 124;
        AHeight := AWidth
      end
    else
      if AVersion < $00100000 then
        begin
          AWidth := 120;
          AHeight := AWidth
        end
      else
        begin
          S.ReadBuffer(AWidth, SizeOf(AWidth));
          S.ReadBuffer(AHeight, SizeOf(AHeight));
        end;
    Result := 1;
  finally
    S.Free;
  end;
end;

function decTDB_FindFirst(const AFileName: WideString; out ASearchRec: TdecTDB_SearchRec): Integer;
begin
  with ASearchRec do begin
    Result := 1;
    FStorage := nil;
    FCatalog := nil;
    if Failed(StgOpenStorage(PWideChar(AFileName), nil,
      STGM_DIRECT or STGM_READ or STGM_SHARE_DENY_WRITE, nil, 0, FStorage)) then exit;
    if Failed(ASearchRec.FStorage.OpenStream('Catalog', nil,
      STGM_DIRECT or STGM_READ or STGM_SHARE_EXCLUSIVE, 0, FCatalog)) then
         FStorage := nil
    else
      try
        if decTDB_ExtractProperties(FCatalog, FVersion, DWORD(FCount), FWidth, FHeight) = 0 then
          RaiseException;
        Result := decTDB_FindNext(ASearchRec);
        if Result <> 0 then
          RaiseException;
      except
        decTDB_FindClose(ASearchRec);
        Result := 1;
      end;
  end;
end;

function Min(A, B: Integer): Integer;
begin
  if A < B then Result := A
           else Result := B;
end;

function decTDB_ID2String(AID, AVersion: DWORD): WideString;
var T: string;
    i: integer;
begin
  T := IntToStr(AID);
  Result := '';
  if AVersion <= $80001 then
    Result := '0';
  for i := Length(T) downto 1 do
    Result := Result + T[i];
end;

function decTDB_FindNext(var ASearchRec: TdecTDB_SearchRec): Integer;
var S: TOleStream;
    Size: integer;
    Skip: Word;
    FileName: WideString;
    C: WideChar;
    F: IStream;
    Times: TStatStg;
begin
  Result := 1;
  if ASearchRec.FCount = 0 then exit;
  try
    S := TOleStream.Create(ASearchRec.FCatalog);
    with ASearchRec do try
      Dec(FCount);
      ZeroMemory(@FFindData, SizeOf(FFindData));
      S.ReadBuffer(Size, SizeOf(Size));
      S.ReadBuffer(FFindData.FID, SizeOf(FFindData.FID));
      S.ReadBuffer(FFindData.FSourceLastWriteTime, SizeOf(FFindData.FSourceLastWriteTime));
      FileName := '';
      repeat
        S.ReadBuffer(C, SizeOf(C));
        if C <> #0 then FileName := FileName + C;
      until C = #0;
      CopyMemory(@FFinddata.FFileName, PWideChar(FileName), Min(Length(FFinddata.FFileName), Length(FileName)) * SizeOf(C));
      if Succeeded(ASearchRec.FStorage.OpenStream(PWideChar(decTDB_ID2String(FFindData.FID, FVersion)),
        nil, STGM_DIRECT or STGM_READ or STGM_SHARE_EXCLUSIVE, 0, F)) then
        try
          if Succeeded(F.Stat(Times, STATFLAG_NONAME)) then
            begin
              FFindData.FCreationTime := Times.ctime;
              FFindData.FLastAccessTime := Times.atime;
              FFindData.FLastWriteTime := Times.mtime;
            end;
        finally
          F := nil;
        end;
      S.ReadBuffer(Skip, SizeOf(Skip));
      Result := 0;
    finally
      S.Free;
    end;
  except
    Result := 1;
  end;
end;

procedure decTDB_FindClose(var ASearchRec: TdecTDB_SearchRec);
begin
  ASearchRec.FCatalog := nil;
  ASearchRec.FStorage := nil;
end;

type
  TdecTDB_WinXpMCERec = packed record
    Size: integer;
    Unknown1: integer;
    Unknown2: integer;
    Width: integer;
    Height: integer;
    Total: integer;
  end;

function decTDB_ExtractWinXpMCEThumbnail(AStream: IStream): HBITMAP;
var S: TOleStream;
    R: TdecTDB_WinXpMCERec;
    BytesPerPixel, y, BytesToSkip: integer;
    BitmapInfo: TBitmapInfo;
    DC: HDC;
    Data: Pointer;
    BytesPerRow: Integer;
begin
  Result := 0;
  S := TOleStream.Create(AStream);
  try
    S.ReadBuffer(R.Size, SizeOf(R.Size));
    if R.Size < SizeOf(R) then exit;
    S.ReadBuffer(R.Unknown1, SizeOf(R) - SizeOf(R.Size));
    S.Position := S.Position + R.Size - SizeOf(R);
    BytesPerPixel := R.Total div (R.Width * R.Height);
    if (BytesPerPixel <> 3) and (BytesPerPixel <> 4) then exit;
    BytesToSkip := (R.Total - R.Width * R.Height * BytesPerPixel) div R.Height;
    ZeroMemory(@BitmapInfo, SizeOf(BitmapInfo));
    with BitmapInfo.bmiHeader do begin
      biSize := sizeof(TBitmapInfoHeader);
      biHeight := R.Height;
      biWidth := R.Width;
      biPlanes := 1;
      if BytesPerPixel = 3 then
        biBitCount := 24
      else
        begin
          biBitCount := 32;
          biHeight := -R.Height;
        end;
      biCompression := BI_RGB;
    end;
    DC := CreateCompatibleDC(0);
    try
      Result := CreateDIBSection(DC, BitmapInfo, DIB_RGB_COLORS, Data, 0, 0);
      if Result = 0 then exit;
      BytesPerRow := (((BitmapInfo.bmiHeader.biBitCount * BitmapInfo.bmiHeader.biWidth) + 31) and not 31) div 8;
      try
        for y := 0 to R.Height - 1 do
          begin
            S.ReadBuffer(Data^, R.Width * BytesPerPixel);
            Inc(Integer(Data), BytesPerRow);
            S.Position := S.Position + BytesToSkip;
          end;
      except
      end;
    finally
      DeleteDC(DC);
    end;
  finally
    S.Free;
  end;
end;

function decTDB_ExtractWinXpThumbnail(AStream: IStream): {$IFDEF USEVCL} TGraphic {$ELSE} HBITMAP {$ENDIF};
var S: TOleStream;
    {$IFNDEF USEJPEG}
    Size: Int64;
    MS: Pointer;
    {$ENDIF}
begin
  S := TOleStream.Create(AStream);
  try
    S.Position := 12;
    {$IFDEF USEJPEG}
    Result := TJPEGImage.Create;
    try
      Result.LoadFromStream(S);
    except
      Result.Free;
      Result := nil;
    end;
    {$ELSE}
    Result := {$IFDEF USEVCL} nil {$ELSE} 0 {$ENDIF};
    Size := S.Size - S.Position;
    if Size = 0 then exit;
    GetMem(MS, Size);
    try
      S.ReadBuffer(MS^, Size);
      {$IFDEF USEVCL}
      {$IFDEF USEIJL}
      Result := TBitmap.Create;
      try
        TBitmap(Result).Handle := decTDB_IJLLoadJpeg(MS, Size);
      except
        Result.Free;
        Result := nil;
      end;
      {$ENDIF}
      {$ELSE}
      {$IFDEF USEIJL}
      Result := decTDB_IJLLoadJpeg(MS, Size);
      {$ENDIF}
      {$ENDIF}
    finally
      FreeMem(MS);
    end;
    {$ENDIF}
  finally
    S.Free
  end;
end;

{$IFDEF USEIJL}
function decTDB_ExtractWinMeThumbnail(AStream: IStream): HBITMAP;
var S: TOleStream;
    Size: Int64;
    MS, PS: Pointer;
const
  Ins1: array[0..68] of byte = (
	$FF, $DB, $00, $43, $00, $08, $06, $06, $07, $06, $05, $08, $07, $07, $07, $09,
	$09, $08, $0A, $0C, $14, $0D, $0C, $0B, $0B, $0C, $19, $12, $13, $0F, $14, $1D,
	$1A, $1F, $1E, $1D, $1A, $1C, $1C, $20, $24, $2E, $27, $20, $22, $2C, $23, $1C,
	$1C, $28, $37, $29, $2C, $30, $31, $34, $34, $34, $1F, $27, $39, $3D, $38, $32,
	$3C, $2E, $33, $34, $32);
  Ins2: packed array[0..431] of byte = (
	$FF, $C4, $00, $1F, $00, $00, $01, $05, $01, $01, $01, $01, $01, $01, $00, $00,
	$00, $00, $00, $00, $00, $00, $01, $02, $03, $04, $05, $06, $07, $08, $09, $0A,
	$0B, $FF, $C4, $00, $B5, $10, $00, $02, $01, $03, $03, $02, $04, $03, $05, $05,
	$04, $04, $00, $00, $01, $7D, $01, $02, $03, $00, $04, $11, $05, $12, $21, $31,
	$41, $06, $13, $51, $61, $07, $22, $71, $14, $32, $81, $91, $A1, $08, $23, $42,
	$B1, $C1, $15, $52, $D1, $F0, $24, $33, $62, $72, $82, $09, $0A, $16, $17, $18,
	$19, $1A, $25, $26, $27, $28, $29, $2A, $34, $35, $36, $37, $38, $39, $3A, $43,
	$44, $45, $46, $47, $48, $49, $4A, $53, $54, $55, $56, $57, $58, $59, $5A, $63,
	$64, $65, $66, $67, $68, $69, $6A, $73, $74, $75, $76, $77, $78, $79, $7A, $83, 
	$84, $85, $86, $87, $88, $89, $8A, $92, $93, $94, $95, $96, $97, $98, $99, $9A,
	$A2, $A3, $A4, $A5, $A6, $A7, $A8, $A9, $AA, $B2, $B3, $B4, $B5, $B6, $B7, $B8, 
	$B9, $BA, $C2, $C3, $C4, $C5, $C6, $C7, $C8, $C9, $CA, $D2, $D3, $D4, $D5, $D6,
	$D7, $D8, $D9, $DA, $E1, $E2, $E3, $E4, $E5, $E6, $E7, $E8, $E9, $EA, $F1, $F2,
	$F3, $F4, $F5, $F6, $F7, $F8, $F9, $FA, $FF, $C4, $00, $1F, $01, $00, $03, $01,
	$01, $01, $01, $01, $01, $01, $01, $01, $00, $00, $00, $00, $00, $00, $01, $02,
	$03, $04, $05, $06, $07, $08, $09, $0A, $0B, $FF, $C4, $00, $B5, $11, $00, $02, 
	$01, $02, $04, $04, $03, $04, $07, $05, $04, $04, $00, $01, $02, $77, $00, $01,
	$02, $03, $11, $04, $05, $21, $31, $06, $12, $41, $51, $07, $61, $71, $13, $22, 
	$32, $81, $08, $14, $42, $91, $A1, $B1, $C1, $09, $23, $33, $52, $F0, $15, $62,
	$72, $D1, $0A, $16, $24, $34, $E1, $25, $F1, $17, $18, $19, $1A, $26, $27, $28,
	$29, $2A, $35, $36, $37, $38, $39, $3A, $43, $44, $45, $46, $47, $48, $49, $4A,
	$53, $54, $55, $56, $57, $58, $59, $5A, $63, $64, $65, $66, $67, $68, $69, $6A, 
	$73, $74, $75, $76, $77, $78, $79, $7A, $82, $83, $84, $85, $86, $87, $88, $89,
	$8A, $92, $93, $94, $95, $96, $97, $98, $99, $9A, $A2, $A3, $A4, $A5, $A6, $A7,
	$A8, $A9, $AA, $B2, $B3, $B4, $B5, $B6, $B7, $B8, $B9, $BA, $C2, $C3, $C4, $C5,
	$C6, $C7, $C8, $C9, $CA, $D2, $D3, $D4, $D5, $D6, $D7, $D8, $D9, $DA, $E2, $E3,
	$E4, $E5, $E6, $E7, $E8, $E9, $EA, $F2, $F3, $F4, $F5, $F6, $F7, $F8, $F9, $FA);
begin
  S := TOleStream.Create(AStream);
  try
    S.Position := 28;
    Size := S.Size - S.Position + SizeOf(Ins1) + SizeOf(Ins2);
    GetMem(MS, Size);
    try
      PS := MS;
      S.ReadBuffer(PS^, 2);
      Inc(Integer(PS), 2);
      CopyMemory(PS, @Ins1, SizeOf(Ins1));
      Inc(Integer(PS), SizeOf(Ins1));
      S.ReadBuffer(PS^, 22);
      Inc(Integer(PS), 22);
      CopyMemory(PS, @Ins2, SizeOf(Ins2));
      Inc(Integer(PS), SizeOf(Ins2));
      S.ReadBuffer(PS^, S.Size - S.Position);
      Result := decTDB_IJLLoadJpeg(MS, Size);
    finally
      FreeMem(MS);
    end;
  finally
    S.Free
  end;
end;
{$ENDIF}

function decTDB_ExtractThumbnail(AStorage: IStorage; AID, AVersion: DWORD): {$IFDEF USEVCL} TGraphic {$ELSE} HBITMAP {$ENDIF};
var Stream: IStream;
    ID: WideString;
begin
  try
    ID := decTDB_ID2String(AID, AVersion);
    Result := {$IFDEF USEVCL} nil {$ELSE} 0 {$ENDIF};
    if Failed(AStorage.OpenStream(PWideChar(ID), nil,
      STGM_DIRECT or STGM_READ or STGM_SHARE_EXCLUSIVE, 0, Stream)) then exit;
    try
      if AVersion <= $80001 then
        begin
          {$IFDEF USEVCL}
          Result := TBitmap.Create;
          TBitmap(Result).AutoAlpha := true;
          TBitmap(Result).Handle := decTDB_ExtractWinXpMCEThumbnail(Stream)
          {$ELSE}
          Result := decTDB_ExtractWinXpMCEThumbnail(Stream)
          {$ENDIF}
        end
      else
        if AVersion >= $100007 then
          Result := decTDB_ExtractWinXpThumbnail(Stream)
        {$IFDEF USEIJL}
        else
          begin
          {$IFDEF USEVCL}
          Result := TBitmap.Create;
          TBitmap(Result).Handle := decTDB_ExtractWinMeThumbnail(Stream)
          {$ELSE}
          Result := decTDB_ExtractWinMeThumbnail(Stream)
          {$ENDIF}
          end;
        {$ENDIF}
    finally
      Stream := nil;
    end;
  except
    Result := {$IFDEF USEVCL} nil {$ELSE} 0 {$ENDIF};
  end;
end;

function decTDB_ExtractThumbnail(const ASearchRec: TdecTDB_SearchRec): {$IFDEF USEVCL} TGraphic {$ELSE} HBITMAP {$ENDIF};
begin
  with ASearchRec do
    Result := decTDB_ExtractThumbnail(FStorage, FFindData.FID, FVersion);
end;

{$IFDEF USEVCL}
function decTDB_ExtractStream(AStorage: IStorage; AID, AVersion: DWORD): TStream;
var Stream: IStream;
    ID: WideString;
    S: TOleStream;
    G: TGraphic;
begin
  Result := nil;
  try
    if AVersion >= $100007 then
      begin
        ID := decTDB_ID2String(AID, AVersion);
        if Failed(AStorage.OpenStream(PWideChar(ID), nil,
          STGM_DIRECT or STGM_READ or STGM_SHARE_EXCLUSIVE, 0, Stream)) then exit;
        S := TOleStream.Create(Stream);
        try
          if S.Size < 13 then exit;
          S.Position := 12;
          Result := TMemoryStream.Create;
          try
            Result.CopyFrom(S, S.Size - S.Position);
            Result.Position := 0;
          except
            Result.Free;
            Result := nil;
          end;
        finally
          S.Free;
        end;
      end
    else
      begin
        G := decTDB_ExtractThumbnail(AStorage, AID, AVersion);
        if G <> nil then
          try
            Result := TMemoryStream.Create;
            try
              G.SaveToStream(Result);
              Result.Position := 0;
            except
              Result.Free;
              Result := nil;
            end;
          finally
            G.Free;
          end;
      end;
  except
    Result := nil;
  end;
end;

function decTDB_ExtractStream(const ASearchRec: TdecTDB_SearchRec): TStream;
begin
  with ASearchRec do
    Result := decTDB_ExtractStream(FStorage, FFindData.FID, FVersion);
end;
{$ENDIF}

{$IFDEF USEIJL}
{$Z+,A+}
type
  TIJL_COLOR = (IJL_PAD1, IJL_RGB, IJL_BGR, IJL_YCBCR, IJL_G, IJL_RGBA_FPX, IJL_YCBCRA_FPX);
  TIJL_JPGSUBSAMPLING = (IJL_PAD2, IJL_411, IJL_422, IJL_4114, IJL_4224);
  TIJL_DIBSUBSAMPLING = TIJL_JPGSUBSAMPLING;

  TJPEG_CORE_PROPERTIES = record
    UseJPEGPROPERTIES : DWORD;
    DIBBytes          : PByte;
    DIBWidth          : DWORD;
    DIBHeight         : Integer;
    DIBPadBytes       : DWORD;
    DIBChannels       : DWORD;
    DIBColor          : TIJL_COLOR;
    DIBSubsampling    : TIJL_DIBSUBSAMPLING;
    JPGFile           : PChar;
    JPGBytes          : PByte;
    JPGSizeBytes      : DWORD;
    JPGWidth          : DWORD;
    JPGHeight         : DWORD;
    JPGChannels       : DWORD;
    JPGColor          : TIJL_COLOR;
    JPGSubsampling    : TIJL_JPGSUBSAMPLING;
    JPGThumbWidth     : DWORD;
    JPGThumbHeight    : DWORD;
    cconversion_reqd  : DWORD;
    upsampling_reqd   : DWORD;
    jquality          : DWORD;
    Pad               : DWORD;
    jprops            : packed array[0..19983] of byte ; //TJPEG_PROPERTIES;
  end;
  PJPEG_CORE_PROPERTIES = ^TJPEG_CORE_PROPERTIES;

  TIJLIOType = (
    IJL_JFILE_READPARAMS,
    IJL_JBUFF_READPARAMS,
    IJL_JFILE_READWHOLEIMAGE,
    IJL_JBUFF_READWHOLEIMAGE,
    IJL_JFILE_READHEADER,
    IJL_JBUFF_READHEADER);

var
  IJLLoadError: boolean;
  IJLHandle: THandle;
  IJLInit: function(jcprops: PJPEG_CORE_PROPERTIES): Integer; stdcall;
  IJLFree: function(jcprops: PJPEG_CORE_PROPERTIES): Integer; stdcall;
  IJLRead: function(jcprops: PJPEG_CORE_PROPERTIES; IoType: TIJLIOTYPE): Integer; stdcall;

const
  IJLDLL = 'ijl15.dll';

function IsIJLLoaded: boolean;
var OldErrorMode: Integer;
begin
  Result := not IJLLoadError;
  if not Result then exit;
  if IJLHandle <> 0 then
    begin
      Result := true;
      exit;
    end;
  OldErrorMode := SetErrorMode(SEM_NOOPENFILEERRORBOX or SEM_FAILCRITICALERRORS);
  IJLHandle := LoadLibrary(PChar(ExtractFilePath(GetModuleName(HInstance)) + IJLDLL));
  if IJLHandle = 0 then
    IJLHandle := LoadLibrary(IJLDLL);
  SetErrorMode(OldErrorMode);
  IJLLoadError := IJLHandle = 0;
  if not IJLLoadError then
    begin
      @IJLInit := GetProcAddress(IJLHandle, 'ijlInit');
      @IJLFree := GetProcAddress(IJLHandle, 'ijlFree');
      @IJLRead := GetProcAddress(IJLHandle, 'ijlRead');
      if not Assigned(IJLInit) or not Assigned(IJLFree) or not Assigned(IJLRead) then
        begin
          FreeLibrary(IJLHandle);
          IJLHandle := 0;
          IJLLoadError := true;
          Result := false
        end
      else
        Result := true;
    end
  else
    Result := false;
end;

function decTDB_IJLLoadJpeg(ABuffer: Pointer; const ASize: Int64): HBITMAP;
var jcprops: TJPEG_CORE_PROPERTIES;
    BitmapInfo: TBitmapInfo;
    DC: HDC;
    Data: Pointer;
begin
  Result := 0;
  if not IsIJLLoaded then exit;
  if IJLInit(@jcprops) < 0 then exit;
  try
    jcprops.JPGFile := nil;
    jcprops.JPGBytes := ABuffer;
    jcprops.JPGSizeBytes := ASize;
    if ijlRead(@jcprops, IJL_JBUFF_READPARAMS) < 0 then
      RaiseException;
    ZeroMemory(@BitmapInfo, SizeOf(BitmapInfo));
    with BitmapInfo.bmiHeader do begin
      biSize := sizeof(TBitmapInfoHeader);
      biWidth := jcprops.JPGWidth;
      biHeight := -jcprops.JPGHeight;
      biPlanes := 1;
      if jcprops.JPGChannels = 4 then
        begin
          biBitCount := 32;
          biHeight := -biHeight;
        end
      else
        biBitCount := 24;
      biCompression := BI_RGB;
    end;
    DC := CreateCompatibleDC(0);
    if DC = 0 then exit;
    try
      Result := CreateDIBSection(DC, BitmapInfo, DIB_RGB_COLORS, Data, 0, 0);
      if Result = 0 then exit;
      try
        jcprops.DIBWidth := jcprops.JPGWidth;
        jcprops.DIBHeight := jcprops.JPGHeight;
        jcprops.DIBChannels := jcprops.JPGChannels;
        if jcprops.JPGChannels = 4 then jcprops.DIBColor := IJL_RGBA_FPX
                                   else jcprops.DIBColor := IJL_BGR;
        jcprops.DIBPadBytes := ((jcprops.JPGWidth * jcprops.JPGChannels + 3) div 4) * 4 - jcprops.JPGWidth * jcprops.JPGChannels;
        jcprops.DIBBytes := Data;
        case jcprops.JPGChannels of
          3: jcprops.JPGColor := IJL_YCBCR;
          4: jcprops.JPGColor := IJL_RGBA_FPX;
          1: jcprops.JPGColor := IJL_G;
          else
             jcprops.JPGColor := TIJL_COLOR(255);
        end;
        if ijlRead(@jcprops, IJL_JBUFF_READWHOLEIMAGE) < 0 then
          RaiseException;
        except
          DeleteObject(Result);
          Result := 0;
        end;
    finally
      DeleteDC(DC);
    end;
  finally
    ijlFree(@jcprops);
  end;
end;

procedure decTDB_IJLUnload;
begin
  if IJLHandle <> 0 then
    FreeLibrary(IJLHandle);
  IJLHandle := 0;
end;

initialization
  IJLLoadError := false;
  IJLHandle    := 0;

finalization
  decTDB_IJLUnload;
{$ENDIF}

end.
