mmriff.pas

一套及时通讯的原码

{========================================================================}
{=                (c) 1995-98 SwiftSoft Ronald Dittrich                 =}
{========================================================================}
{=                          All Rights Reserved                         =}
{========================================================================}
{=  D 01099 Dresden             = Tel.: [phone]                   =}
{=  Loewenstr.7a                = [e-mail]                     =}
{========================================================================}
{=  Actual versions on http://www.swiftsoft.de/mmtools.html             =}
{========================================================================}
{=  This code is for reference purposes only and may not be copied or   =}
{=  distributed in any format electronic or otherwise except one copy   =}
{=  for backup purposes.                                                =}
{=                                                                      =}
{=  No Delphi Component Kit or Component individually or in a collection=}
{=  subclassed or otherwise from the code in this unit, or associated   =}
{=  .pas, .dfm, .dcu, .asm or .obj files may be sold or distributed     =}
{=  without express permission from SwiftSoft.                          =}
{=                                                                      =}
{=  For more licence informations please refer to the associated        =}
{=  HelpFile.                                                           =}
{========================================================================}
{=  $Date: 20.01.1998 - 18:00:00 $                                      =}
{========================================================================}
Unit MMRIFF;

{$I COMPILER.INC}

interface

uses
{$IFDEF WIN32}
    Windows,
{$ELSE}
    WinTypes,
    WinProcs,
{$ENDIF}
    SysUtils,
    MMSystem,
    MMUtils,
    MMDIB,
    MMAbout;

const
     CHUNK_MODIFIED = 1;    { chunk was modified                      }
     CHUNK_REVERT   = 2;    { command to revert to original text      }

{$IFDEF WIN32}
type
    THMMIO = HMMIO;             { whats that BORLAND !? }
{$ENDIF}

type
    PChunk = ^TChunk;
    TChunk = packed record
       fcc: FOURCC;
       cksize: Longint;
       data: array[0..0] of Byte;
    end;

    PInfoData = ^TInfoData;
    TInfoData = packed record
       index       : Word;      { index into aINFO                        }
       wFlags      : Word;      { flags for chunk                         }
       dwINFOOffset: Longint;   { offset in file to INFO chunk            }
       lpText      : PChar;     { text of modified chunk. None if NULL.   }
       pNext       : PInfoData; { next read sub-chunk                     }
    end;

    PInfoChunk = ^TInfoChunk;
    TInfoChunk = packed record
       lpChunk     : PChar;     { complete chunk in memory (GlobalPtr)    }
       cksize      : Longint;   { size of chunk data                      }
       pHead       : PInfoData; { first sub-chunk data                    }
    end;

    TInfo = packed record
      pFOURCC: PChar;
      pShort : PChar;
      pLong  : PChar;
    end;

    PDisp = ^TDisp;
    TDisp = packed record
       cfid   : Longint;        { Clipboard id of data                    }
       wFlags : Word;           { flags for chunk                         }
       lpChunk: PChar;          { ptr to original file data               }
       lpData : PChar;          { ptr to modified data                    }
       pNext  : PDISP;          { next in list                            }
    end;

    PDispList = ^TDispList;
    TDispList = packed record
       pHead : PDisp;           { first 'DISP' chunk                      }
    end;

const
     aINFO: array[0..23] of TInfo = (

(pFOURCC: 'IARL';
 pShort: 'Archival Location';
 pLong: 'Indicates where the subject of the file is archived.'),
(pFOURCC: 'IART';
 pShort: 'Artist'; 
 pLong: 'Lists the artist of the original subject of the file. For example,'
        +' "Michaelangelo."'),
(pFOURCC: 'ICMS'; 
 pShort: 'Commissioned'; 
 pLong: 'Lists the name of the person or organization that commissioned '
         +'the subject of the file. For example, "Pope Julian II."'),
(pFOURCC: 'ICMT';
 pShort: 'Comments';
 pLong: 'Provides general comments about the file or the subject of the '
        +'file. If the comment is several sentences long, end each sentence '
        +'with a period. Do not include newline characters.'),
(pFOURCC: 'ICOP';
 pShort: 'Copyright';
 pLong: 'Records the copyright information for the file. For example, '
       +'"Copyright Encyclopedia International 1991." If there are multiple '
       +'copyrights, separate them by a semicolon followed by a space.'),
(pFOURCC: 'ICRD'; 
 pShort: 'Creation date';
 pLong: 'Specifies the date the subject of the file was created. List dates '
       +'in year-month-day format, padding one-digit months and days with a'
       +' zero on the left. For example, "1553-05-03" for May 3), 1553.'),
(pFOURCC: 'ICRP'; 
 pShort: 'Cropped'; 
 pLong: 'Describes whether an image has been cropped and, if so, how it was '
       +'cropped. For example, "lower right corner."'),
(pFOURCC: 'IDIM';
 pShort: 'Dimensions';
 pLong: 'Specifies the size of the original subject of the file. For example, '
       +'"8.5 in h, 11 in w."'),
(pFOURCC: 'IDPI'; 
 pShort: 'Dots Per Inch';
 pLong: 'Stores dots per inch setting of the digitizer used to produce the '
       +'file, such as "300."'),
(pFOURCC: 'IENG'; 
 pShort: 'Engineer';
 pLong: 'Stores the name of the engineer who worked on the file. If there '
       +'are multiple engineers, separate the names by a semicolon and a '
       +'blank. For example, "Smith, John; Adams, Joe."'),
(pFOURCC: 'IGNR'; 
 pShort: 'Genre'; 
 pLong: 'Describes the original work, such as, "landscape," "portrait," '
       +'"still life," etc.'),
(pFOURCC: 'IKEY'; 
 pShort: 'Keywords';
 pLong: 'Provides a list of keywords that refer to the file or subject of '
       +'the file. Separate multiple keywords with a semicolon and a blank. For example, "Seattle; aerial view; scenery."'),
(pFOURCC: 'ILGT';
 pShort: 'Lightness'; 
 pLong: 'Describes the changes in lightness settings on the digitizer required '
       +'to produce the file. Note that the format of this information depends on hardware used.'),
(pFOURCC: 'IMED'; 
 pShort: 'Medium'; 
 pLong: 'Describes the original subject of the file, such as, "computer image," '
       +'"drawing," "lithograph," and so forth.'),
(pFOURCC: 'INAM'; 
 pShort: 'Name';
 pLong: 'Stores the title of the subject of the file, such as, "Seattle From '
       +'Above."'),
(pFOURCC: 'IPLT'; 
 pShort: 'Palette Setting';
 pLong: 'Specifies the number of colors requested when digitizing an image, '
       +'such as "256."'),
(pFOURCC: 'IPRD';
 pShort: 'Product';
 pLong: 'Specifies the name of the title the file was originally intended '
       +'for, such as "Encyclopedia of Pacific Northwest Geography."'),
(pFOURCC: 'ISBJ'; 
 pShort: 'Subject';
 pLong: 'Describes the contents of the file, such as "Aerial view of Seattle."'),
(pFOURCC: 'ISFT'; 
 pShort: 'Software';
 pLong: 'Identifies the name of the software package used to create the file, '
       +'such as "Microsoft WaveEdit."'),
(pFOURCC: 'ISHP'; 
 pShort: 'Sharpness';
 pLong: 'Identifies the changes in sharpness for the digitizer required to '
       +'produce the file (the format depends on the hardware used).'),
(pFOURCC: 'ISRC'; 
 pShort: 'Source';
 pLong: 'Identifies the name of the person or organization who supplied the '
       +'original subject of the file. For example, "Trey Research."'),
(pFOURCC: 'ISRF';
 pShort: 'Source Form';
 pLong: 'Identifies the original form of the material that was digitized, '
       +'such as "slide," "paper," "map," and so forth. This is not necessarily '
       +'the same as IMED.'),
(pFOURCC: 'ITCH'; 
 pShort: 'Technician'; 
 pLong: 'Identifies the technician who digitized the subject file. For '
       +'example, "Smith, John."'),
(pFOURCC: NIL;
 pShort: NIL;
 pLong: NIL));

{*************************************************************************}
{ error returns from RIFF functions                                       }
{*************************************************************************}
const
     RIFFERR_BASE      = 0;
     RIFFERR_NOERROR   = 0;
     RIFFERR_ERROR     = RIFFERR_BASE+1;
     RIFFERR_BADPARAM  = RIFFERR_BASE+2;
     RIFFERR_FILEERROR = RIFFERR_BASE+3;
     RIFFERR_NOMEM     = RIFFERR_BASE+4;
     RIFFERR_BADFILE   = RIFFERR_BASE+5;

(************************************************************************)
function  mmioFourCC(ch0,ch1,ch2,ch3: Char): FourCC;

function  RiffCopyChunk(hmmioSrc,hmmioDst: THMMIO; lpck: PMMCKINFO): Boolean;
function  RiffCopyList(hmmioSrc,hmmioDst: THMMIO; lpck: PMMCKINFO): Boolean;

(************************************************************************)
function  RiffInitINFO(Var lpInfo: PInfoChunk): integer;
function  RiffCopyInfo(Var lpInfoDst: PInfoChunk; lpInfoSrc: PInfoChunk): integer;
function  RiffFreeINFO(Var lpInfo: PInfoChunk): integer;

function  RiffReadINFO(hmmio: THMMIO; lpck: PMMCKINFO; lpInfo: PInfoChunk): integer;
function  RiffWriteINFO(hmmio: THMMIO; lpInfo: PInfoChunk): integer;

function  RiffCreateINFO(wFlags, id: Word; dwInfoOffset: Longint; lpText: PChar): PInfoData;
procedure RiffInsertINFO(lpInfo: PInfoChunk; pInfo: PInfoData);

function  RiffFindPIINFO(lpInfo: PInfoChunk; fcc: FOURCC): PInfoData;
procedure RiffModifyINFO(lpInfo: PInfoChunk; pi: PInfoData;
                         wFlags: Word; dw: Longint; lpText: PChar);
function  RiffFindaINFO(fcc: FOURCC): integer;
function  RiffParseINFO(lpInfo: PInfoChunk): integer;

(************************************************************************)
function  RiffInitDISP(Var lpDisp: PDispList): integer;
function  RiffCopyDISP(lpDispDst, lpDispSrc: PDISPList): integer;
function  RiffFreeDISP(Var lpDisp: PDispList; FreeList: Boolean): integer;

function  RiffReadDISP(hmmio: THMMIO; lpck: PMMCKINFO; Var lpDisp: PDispList): integer;
function  RiffWriteDISP(hmmio: THMMIO; lpDisp: PDispList): integer;

function  RiffCreateDISP(wFlags: Word; id: Longint; lpChunk, lpData: PChar): PDisp;
procedure RiffInsertDISP(lpDisp: PDispList; pd: PDisp);
procedure RiffModifyDISP(lpDisp: PDispList; pd: PDisp;
                         wFlags: Word; lpData: PChar);

implementation

{**************************************************************************}
function mmioFourCC(ch0,ch1,ch2,ch3: Char): FourCC;
begin
     Result := Longint(ch0) OR
               (Longint(ch1) shl 8) OR
               (Longint(ch2) shl 16) OR
               (Longint(ch3) shl 24);
end;

{**************************************************************************}
function RiffCopyChunk(hmmioSrc, hmmioDst: THMMIO; lpck: PMMCKINFO): Boolean;
Label rscc_Error;
var
   ck: TMMCKINFO;
   pBuf: PChar;

begin
     Result := False;

     pBuf := GlobalAllocPtr(GHND, lpck^.cksize);
     if (pBuf = NIL) then
        goto rscc_Error;

     ck.ckid   := lpck^.ckid;
     ck.cksize := lpck^.cksize;
     if mmioCreateChunk(hmmioDst, @ck, 0) <> 0 then
        goto rscc_Error;

     if mmioRead(hmmioSrc, pBuf, lpck^.cksize) <> Longint(lpck^.cksize) then
        goto rscc_Error;

     if mmioWrite(hmmioDst, pBuf, lpck^.cksize) <> Longint(lpck^.cksize) then
        goto rscc_Error;

     if mmioAscend(hmmioDst, @ck, 0) <> 0 then
        goto rscc_Error;

     Result := True;

rscc_Error:

     if (pBuf <> NIL) then GlobalFreePtr(pBuf);
end;

{**************************************************************************}
function RiffCopyList(hmmioSrc,hmmioDst: THMMIO; lpck: PMMCKINFO): Boolean;
Label
   rscl_Error;
Var
   ck: TMMCKINFO;
   pBuf: PChar;
   dwCopySize: Longint;

begin
     Result := False;

     pBuf := GlobalAllocPtr(GHND,lpck^.cksize);
     if (pBuf = NIL ) then
        goto rscl_Error;

     dwCopySize := lpck^.cksize;

     { mmio leaves us after LIST ID }

     ck.ckid    := lpck^.ckid;
     ck.cksize  := dwCopySize;
     ck.fccType := lpck^.fccType;

     if mmioCreateChunk(hmmioDst, @ck, MMIO_CREATELIST) <> 0 then
	goto rscl_Error;

     { we already wrote 'LIST' ID, so reduce byte count }
     dec(dwCopySize, sizeof(FOURCC));

     if mmioRead(hmmioSrc, pBuf, dwCopySize) <> dwCopySize then
        goto rscl_Error;

     if mmioWrite(hmmioDst, pBuf, dwCopySize) <> dwCopySize then
        goto rscl_Error;

     if mmioAscend(hmmioDst, @ck, 0) <> 0 then
        goto rscl_Error;

     Result := True;

rscl_Error:

    if (pBuf <> NIL) then GlobalFreePtr(pBuf);
End;

{**************************************************************************}
function RiffInitINFO(Var lpInfo: PInfoChunk): integer;
Var
   id: Word;
   pi: PInfoData;

begin
    lpInfo := GlobalAllocPtr(GHND,sizeof(TInfoChunk));
    if (lpInfo <> Nil) then
    begin
         id := 0;
         while (aINFO[id].pFOURCC <> NIL) do
         begin
	      pI := RiffCreateINFO(0, id, 0, NIL);   { create empty INFO }
	      RiffInsertINFO(lpInfo, pI);
              inc(id);
         end;
         Result := RIFFERR_NOERROR;
    end
    else Result := RIFFERR_NOMEM;
end;

{**************************************************************************}
function RiffReadINFO(hmmio: THMMIO; lpck: PMMCKINFO; lpInfo: PInfoChunk): integer;
Var
   dwInfoSize: Longint;

begin