mmriff.pas

一套及时通讯的原码

Label
   riff_DI_Error;
var
   pdSrc,pdDst: PDisp;
   lpData: PChar;
   dwSize: Longint;

begin
   Result := RIFFERR_BADPARAM;

   if (lpDispDst = nil) or (lpDispSrc = nil) then exit;

   Result := RIFFERR_ERROR;

   pdDst := nil;

   { first remove all old 'DISP' chunks }
   if RiffFreeDISP(lpDispDst,False) <> 0 then
      goto riff_DI_Error;

   Result := RIFFERR_NOMEM;

   pdSrc := lpDispSrc^.pHead;
   while pdSrc <> nil do
   begin
      if (pdSrc^.cfid <> 0) then
      begin
         if (pdSrc^.lpChunk <> nil) or (pdSrc^.lpData <> nil) then
         begin
            if (pdSrc^.lpData <> nil) then
                { modified Data }
                lpData := pdSrc^.lpData
            else if (pdSrc^.wFlags <> CHUNK_MODIFIED) then
                { original file Data }
                lpData := pdSrc^.lpChunk
            else
                lpData := nil;

            if (lpData <> nil) and (lpData^ <> #0) then
            begin
               pdDst := RiffCreateDISP(0, pdSrc^.cfid, nil, nil);
               if (pdDst = nil) then
                   goto riff_DI_Error;

               dwSize := GlobalMemSize(lpData);
               pdDst^.lpData := GlobalAllocPtr(GHND,dwSize);
               if (pdDst^.lpData = nil) then
                  goto riff_DI_Error;

               GlobalMoveMem(lpData^,pdDst^.lpData^,dwSize);
               RiffInsertDISP(lpDispDst, pdDst);
            end;
         end;
      end;
      pdSrc := pdSrc^.pNext;
   end;

   Result := RIFFERR_NOERROR;
   exit;

riff_DI_Error:

   if (pdDst <> nil) then
   begin
      if (pdDst^.lpData <> nil) then GlobalFreePtr(pdDst^.lpData);
      GlobalFreePtr(pdDst);
   end;
end;

{**************************************************************************}
function RiffReadDISP(hmmio: THMMIO; lpck: PMMCKINFO; Var lpDisp: PDispList): integer;
Label
   riff_DI_Error;
Var
   pd: PDisp;
   dwDispSize: Longint;

begin
     Result := RIFFERR_BADPARAM;

     if (lpDisp = nil) then exit;

     Result := RIFFERR_NOMEM;

     { create empty 'DISP' }
     pd := RiffCreateDISP(0, 0, nil, nil);
     if (pd = nil) then
        goto riff_DI_Error;

     dwDispSize := lpck^.cksize - sizeof(pd^.cfid);{ take out id of Data }

     if (dwDispSize > 0) then
     begin
        pd^.lpChunk := GlobalAllocPtr(GHND,dwDispSize);
        if (pd^.lpChunk = nil) then
           goto riff_DI_Error;

        Result := RIFFERR_FILEERROR;

        if mmioRead(hmmio, PChar(@pd^.cfid), sizeof(pd^.cfid)) <> sizeof(pd^.cfid) then
           goto riff_DI_Error;

        if mmioRead(hmmio, pd^.lpChunk, dwDispSize) <> dwDispSize then
           goto riff_DI_Error;

        RiffInsertDISP(lpDisp, pd);
        Result := RIFFERR_NOERROR;
        exit;
     end;

     Result := RIFFERR_NOERROR;

riff_DI_Error:

     if (pd <> nil) then
     begin
        if (pd^.lpChunk <> nil) then GlobalFreePtr(pd^.lpChunk);
        GlobalFreePtr(pd);
     end;
end;

{**************************************************************************}
function RiffWriteDISP(hmmio: THMMIO; lpDisp: PDispList): integer;
Var
   ckDISP: TMMCKINFO;
   pData : PChar;
   pd    : PDisp;
   dwSize: Longint;

begin
     Result := RIFFERR_BADPARAM;

     if (hmmio = 0) or (lpDisp = nil) then exit;

     Result := RIFFERR_FILEERROR;

     pd := lpDisp^.pHead;

     while (pd <> nil) do
     with pd^ do
     begin
	if ((cfid = CF_DIB) or (cfid = CF_TEXT)) then
        begin
           if (lpChunk <> nil) or (lpData <> nil) then
           begin
              if (lpData <> nil) then
                  { modified Data }
                  pData := lpData
              else if (wFlags <> CHUNK_MODIFIED) then
                  { original file Data }
                  pData := lpChunk
              else
                  pData := nil;

              if (pData <> nil) and (pData^ <> #0) then
              begin
                 ckDISP.ckid   := mmioFOURCC('D', 'I', 'S', 'P');
                 ckDISP.cksize := 0;  { mmio fill it in later }

	         { create new 'DISP' chunk }
	         if mmioCreateChunk(hmmio, @ckDISP, 0) <> 0 then
                    exit;

                 dwSize := sizeOf(cfid);
                 if mmioWrite(hmmio, @cfid, dwSize) <> dwSize then
                    exit;

                 case cfid of
                   CF_TEXT: dwSize := StrLen(pData)+1;
                   CF_DIB : dwSize := DIB_SIZE(PDIB(pData));
                 end;

                 if mmioWrite(hmmio, pData, dwSize) <> dwSize then
                    exit;

                 if mmioAscend(hmmio, @ckDISP, 0) <> 0 then
		    exit;
              end;
           end;
        end;
        pd := pd^.pNext;
     end;
     Result := RIFFERR_NOERROR;
end;

{**************************************************************************}
function RiffCreateDISP(wFlags: Word; id: Longint; lpChunk, lpData: PChar): PDisp;
Var
   pd: PDisp;

begin
     pd := GlobalAllocPtr(GHND,sizeof(TDisp));
     if (pd <> Nil) then
     begin
          pd^.cfid := id;
          pd^.wFlags := wFlags;
          pd^.lpChunk := lpChunk;
          pd^.lpData := lpData;
          Result := pd;
     end
     else Result := nil;
end;

{**************************************************************************}
procedure RiffInsertDISP(lpDisp: PDispList; pd: PDisp);
Var
   pdi: PDisp;

begin
     if (lpDisp = nil) then exit;

     if (lpDisp^.pHead = nil) then
     begin
          lpDisp^.pHead := pd;
	  exit;
     end;

     pdi := lpDisp^.pHead;
     while (pdi^.pNext <> NIL) do pdi := pdi^.pNext;

     { insert at end }
     pdi^.pNext := pd;
end;

{**************************************************************************}
procedure RiffModifyDISP(lpDisp: PDispList; pd: PDisp;
                         wFlags: Word; lpData: PChar);
var
   Size: Longint;

begin
     if (pd = Nil) then exit;

     if (pd^.lpData <> Nil) then
     begin
     	  if (lpData <> Nil) then
	  begin
               Size := GlobalMemSize(lpData);
               if (Size = GlobalMemSize(pd^.lpData)) and
                   (GlobalCmpMem(lpData^,pd^.lpData^,Size) = True) then
               begin
	           { they are the same, don't bother changing... }
	           GlobalFreePtr(lpData);
               end
	       else
	       begin
		   GlobalFreePtr(pd^.lpData);
                   if (lpData^ <> #0) then
                   begin
                      { new data... }
                      pd^.lpData := lpData;
                      pd^.wFlags := wFlags;
                   end
                   else
                   begin
                      { new is blank, do nothing... }
                      GlobalFreePtr(lpData);
                      pd^.lpData := nil;
                      pd^.wFlags := CHUNK_REVERT;
                   end;
               end;
          end
	  else
          begin
	       GlobalFreePtr(pd^.lpData);
	       pd^.lpData := Nil;
               pd^.wFlags := CHUNK_REVERT;
        end;
     end
     else if (lpData <> Nil) then
     begin
	  { if no read data, don't bother to check.... }
	  if (pd^.lpChunk = Nil) then
	  begin
               if (lpData^ <> #0) then
               begin
                  { new text... }
                  pd^.lpData := lpData;
                  pd^.wFlags := wFlags;
               end
               else
               begin
                  { new is blank, do nothing... }
                  GlobalFreePtr(lpData);
               end;
          end
	  else
          begin
             Size := GlobalMemSize(lpData);
             if IsBadReadPtr(pd^.lpChunk,Size) or
                (GlobalCmpMem(lpData^, pd^.lpChunk^, Size) = False) then
	     begin
                if (lpData^ <> #0) then
                begin
                   { new data... }
                   pd^.lpData := lpData;
                   pd^.wFlags := wFlags;
                end
                else
                begin
                   { new is blank }
                   if pd^.lpChunk^ <> #0 then
                   begin
                      { original was not blank }
                      pd^.lpData := lpData;
                      pd^.wFlags := wFlags;
                   end
                   else
                   begin
                      { do nothing }
                      GlobalFreePtr(lpData);
                   end;
                end;
             end
	     else
             begin
	          { the same, don't bother... }
	          GlobalFreePtr(lpData);
             end;
          end;
     end
     else pd^.wFlags := wFlags;
end;

{**************************************************************************}
function RiffFreeDISP(Var lpDisp: PDispList; FreeList: Boolean): integer;
Var
   p,pd:  PDisp;

begin
   Result := RIFFERR_BADPARAM;

   if (lpDisp = nil) then exit;

   pd := lpDisp^.pHead;
   while (pd <> nil) do
   begin
      p := pd;
      pd := pd^.pNext;
      if (p^.lpChunk <> nil) then
      begin
         GlobalFreePtr(p^.lpChunk);
         p^.lpChunk := nil;
      end;
      if (p^.lpData <> nil) then
      begin
         GlobalFreePtr(p^.lpData);
         p^.lpData := nil;
      end;
      GlobalFreePtr(p);
   end;
   lpDisp^.pHead := nil;

   if FreeList then
   begin
      GlobalFreePtr(lpDisp);
      lpDisp := nil;
   end;

   Result := RIFFERR_NOERROR;
end;

end.