mmriff.pas

一套及时通讯的原码

     Result := RIFFERR_NOERROR;
     
     dwInfoSize := lpck^.cksize - sizeof(FOURCC); { take out 'INFO' }

     if dwInfoSize > 0 then
     begin
        lpInfo^.cksize := dwInfoSize;
        lpInfo^.lpChunk := GlobalAllocPtr(GHND,dwInfoSize);
        if (lpInfo^.lpChunk <> NIL) then
        begin
           if mmioRead(hmmio, PChar(lpInfo^.lpChunk), dwInfoSize) <> dwInfoSize then
              Result := RIFFERR_FILEERROR
           else
              Result := RiffParseINFO(lpInfo);
        end
        else Result := RIFFERR_NOMEM;
     end;
end;

{**************************************************************************}
function RiffWriteINFO(hmmio: THMMIO; lpInfo: PInfoChunk): integer;
Var
   ck: TMMCKINFO;
   ckInfo: TMMCKINFO;
   pi: PInfoData;
   lpstr: PChar;
   fList: Boolean;

begin
     fList := False;
     Result := RIFFERR_BADPARAM;

     if (hmmio = 0) OR (lpInfo = Nil) then exit;

     Result := RIFFERR_FILEERROR;

     ckINFO.ckid   := mmioFOURCC('L', 'I', 'S', 'T');
     ckINFO.cksize := 0;  { mmio fill it in later }
     ckINFO.fccType:= mmioFOURCC('I', 'N', 'F', 'O');

     pI := lpInfo^.pHead;

     while (pI <> Nil) do
     begin
	  if (pI^.lpText <> Nil) then
             { Modified text }
	     lpstr := pi^.lpText
          else if (pi^.dwINFOOffset <> 0) then
	     { default text }
	     lpstr := (lpInfo^.lpChunk+pI^.dwINFOOffset)
          else
	     { no text }
	     lpstr := Nil;

          if (lpstr <> Nil) and (lpstr^ <> #0) then
          begin
	     if (Not fList) then
             begin
	        { only create if needed... }
	        if mmioCreateChunk(hmmio, @ckINFO, MMIO_CREATELIST) <> 0 then
                   exit;

		fList := True;
             end;

	     ck.ckid := mmioStringToFOURCC(aINFO[pI^.index].pFOURCC,0);
	     ck.cksize := StrLen(lpstr)+1;
	     ck.fccType := 0;
	     if mmioCreateChunk(hmmio, @ck, 0) <> 0 then
		exit;

	     if mmioWrite(hmmio, lpstr, ck.cksize) <> Longint(ck.cksize) then
		exit;

             if mmioAscend(hmmio, @ck, 0) <> 0 then
		exit;
          end;
	  pi := pi^.pnext;
     end;

     if fList then
     begin
	  if mmioAscend(hmmio, @ckINFO, 0) <> 0 then
	     exit;
     end;

     Result := RIFFERR_NOERROR;
end;

{**************************************************************************}
function RiffCopyINFO(Var lpInfoDst: PInfoChunk; lpInfoSrc: PInfoChunk): integer;
Var
   pISrc,pIDst: PInfoData;
   lpStr,pBuf: PChar;

begin
     Result := RIFFERR_BADPARAM;

     if (lpInfoSrc = Nil) or (lpInfoDst = Nil) then exit;

     pISrc := lpInfoSrc^.pHead;

     while (pISrc <> Nil) do
     begin              
	  if (pISrc^.lpText <> Nil) then
             { Modified text }
	     lpStr := piSrc^.lpText
          else if (pISrc^.wFlags <> CHUNK_MODIFIED) and (pISrc^.dwINFOOffset <> 0) then
	     { default text }
	     lpStr := (lpInfoSrc^.lpChunk+pISrc^.dwINFOOffset)
          else
	     { no text }
	     lpStr := nil;

          if (lpStr <> Nil) and (lpStr^ <> #0) then
          begin
             { the new text MUST allocated with GlobalAlloc }
             pBuf := GlobalAllocPtr(GHND,StrLen(lpStr)+1);
             piDst := RiffFindPIINFO(lpInfoDst, mmioStringToFOURCC(aINFO[pISrc^.index].pFOURCC,0));
	     RiffModifyINFO(lpInfoDst, piDst, CHUNK_MODIFIED, 0, StrCopy(pBuf,lpStr));
         end;
	 piSrc := piSrc^.pNext;
     end;

     Result := RIFFERR_NOERROR;
end;

{**************************************************************************}
procedure RiffInsertINFO(lpInfo: PInfoChunk; pInfo: PInfoData);
Var
   pi: PInfoData;

begin
     if (lpInfo = NIL) then exit;

     if (lpInfo^.pHead = NIL) then
     begin
          lpInfo^.pHead := pInfo;
	  exit;
     end;

     pi := lpInfo^.pHead;
     while (pi^.pnext <> NIL) do pi := pi^.pnext;

     { insert at end }
     pI^.pnext := pInfo;
end;

{**************************************************************************}
function RiffCreateINFO(wFlags, id: Word; dwInfoOffset: Longint; lpText: PChar): PInfoData;
Var
   pi: PInfoData;

begin
     pI := GlobalAllocPtr(GHND,sizeof(TInfoData));
     if (pI <> Nil) then
     begin
          pI^.index := id;
          pI^.wFlags := wFlags;
          pI^.dwINFOOffset := dwInfoOffset;
          pI^.lpText := lpText;
          Result := pi;
     end
     else Result := Nil;
end;

{**************************************************************************}
function RiffFindPIINFO(lpInfo: PInfoChunk; fcc: FOURCC): PInfoData;
Var
   pi: PInfoData;

begin
     pi := lpInfo^.pHead;
     while (pI <> Nil) do
     begin
	  if mmioStringToFOURCC(aINFO[pI^.index].pFOURCC,0) = fcc then
          begin
	       Result := pi;
               exit;
          end;
          pi := pi^.pnext;
     end;
     Result := Nil;
end;

{**************************************************************************}
procedure RiffModifyINFO(lpInfo: PInfoChunk;
                         pi: PInfoData;
                         wFlags: Word; dw: Longint; lpText: PChar);
begin
     if (pI = Nil) then exit;

     if (wFlags and CHUNK_MODIFIED = 0) and
        (wFlags and CHUNK_REVERT = 0) then pi^.dwINFOOffset := dw;

     if (pi^.lpText <> Nil) then
     begin
     	  if (lpText <> Nil) then
	  begin
	       if StrComp(lpText,pi^.lpText) = 0 then
               begin
	           { they are the same, don't bother changing... }
	           GlobalFreePtr(lpText);
               end
	       else
	       begin
		   GlobalFreePtr(pi^.lpText);
                   if (lpText^ <> #0) then
                   begin
                      { new text... }
                      pi^.lpText := lpText;
                      pi^.wFlags := wFlags;
                   end
                   else
                   begin
                      { new is blank, do nothing... }
                      GlobalFreePtr(lpText);
                      pi^.lpText := nil;
                      pi^.wFlags := CHUNK_REVERT;
                   end;
               end;
          end
	  else if (wFlags AND CHUNK_REVERT <> 0) then
	  begin
	       GlobalFreePtr(pi^.lpText);
	       pi^.lpText := Nil;
               pi^.wFlags := wFlags;
          end;
     end
     else if (lpText <> Nil) then
     begin
	  { if no read data, don't bother to check.... }
	  if (lpInfo^.lpChunk = Nil) or (pi^.dwINFOOffset = 0) then
	  begin
               if (lpText^ <> #0) then
               begin
                  { new text... }
                  pi^.lpText := lpText;
                  pi^.wFlags := wFlags;
               end
               else
               begin
                  { new is blank, do nothing... }
                  GlobalFreePtr(lpText);
               end;
          end
	  else if StrComp(lpText, PChar(lpInfo^.lpChunk+pI^.dwINFOOffset)) <> 0 then
	  begin
             if (lpText^ <> #0) then
             begin
                { new text... }
             	pi^.lpText := lpText;
                pi^.wFlags := wFlags;
             end
             else
             begin
                { new is blank }
                if PChar(lpInfo^.lpChunk+pI^.dwINFOOffset)^ <> #0 then
                begin
                   { original was not blank }
                   pi^.lpText := lpText;
                   pi^.wFlags := wFlags;
                end
                else
                begin
                   { do nothing }
                   GlobalFreePtr(lpText);
                end;
             end;
          end
	  else
          begin
	     { the same, don't bother... }
	     GlobalFreePtr(lpText);
          end;
     end;
end;

{**************************************************************************}
function RiffFindaINFO(fcc: FOURCC): integer;
Var
   id: Word;

begin
     id := 0;
     while aINFO[id].pFOURCC <> nil do
     begin
	  if mmioStringToFOURCC(aINFO[id].pFOURCC, 0) = fcc then
          begin
               Result := id;
               exit;
          end;
          inc(id);
     end;
     Result := -1;
end;

{**************************************************************************}
function RiffParseINFO(lpInfo: PInfoChunk): integer;
Var
   pBuf: PChar;
   dwCurInfoOffset: Longint;
   pi: PInfoData;
   lpck: PChunk;

begin
     pBuf := lpInfo^.lpChunk;
     dwCurInfoOffset := 0;
     while dwCurInfoOffset < lpInfo^.cksize do
     begin
	  lpck := PChunk(PChar(pBuf+dwCurInfoOffset));
          { dwCurInfoOffset is offset of data }
	  inc(dwCurInfoOffset, sizeof(TChunk)-1);
	  pi := RiffFindPIINFO(lpInfo, lpck^.fcc);
	  if (pi <> Nil) then
          begin
	       { modify entry to show text (data) from file... }
	       RiffModifyINFO(lpInfo, pi, 0, dwCurInfoOffset, NIL);
          end;
          { skip past data }
	  inc(dwCurInfoOffset, lpck^.cksize+(lpck^.cksize AND 1));
     end;
     Result := RIFFERR_NOERROR;
end;

{**************************************************************************}
function RiffFreeINFO(Var lpInfo: PInfoChunk): integer;
Var
    pi, pit:  PInfoData;

begin
     Result := RIFFERR_BADPARAM;

     if (lpInfo = Nil) then exit;

     if (lpInfo^.lpChunk <> Nil) then
     	GlobalFreePtr(lpInfo^.lpChunk);

     pi := lpInfo^.pHead;

     while (pi <> Nil) do
     begin
	  pit := pi;
	  pi := pi^.pnext;
          if (pit^.lpText <> nil) then GlobalFreePtr(pit^.lpText);
	  GlobalFreePtr(pit);
     end;

     GlobalFreePtr(lpInfo);
     lpInfo := NIL;

     Result := RIFFERR_NOERROR;
end;

{**************************************************************************}
function RiffInitDISP(Var lpDisp: PDispList): integer;
begin
    lpDisp := GlobalAllocPtr(GHND,sizeof(TDispList));
    if (lpDisp <> Nil) then
        Result := RIFFERR_NOERROR
    else
        Result := RIFFERR_NOMEM;
end;

{**************************************************************************}
function RiffCopyDISP(lpDispDst, lpDispSrc: PDISPList): integer;