mmwaveio.pas

一套及时通讯的原码

begin
   Result := WIOERR_FILEERROR;
   lpwio  := nil;

   if wioCreateFileInfo(lpwio, pwfx) = WIOERR_NOERROR then
   begin
      h := FileOpen(StrPas(lpFileName), fmOpenRead or fmShareDenyNone);
      if (h <> $FFFFFFFF) then
      with lpwio^ do
      begin
         dwFlags      := RAW_FILE;
         dwFileSize   := FileSeek(h, 0, 2);
         dwDataBytes  := dwFileSize-DataOffset;

         dwDataOffset := DataOffset;
         dwDataSamples:= wioBytesToSamplesEx(lpwio,dwDataBytes);

         dwFirstSample:= 0;
         dwLastSample := dwDataSamples;
         dwBytesLeft  := 0;
         dwPosition   := 0;

         lpFilePath   := StrNew(lpFileName);

         FileClose(h);
         Result := WIOERR_NOERROR;
      end
      else wioFreeFileInfo(lpwio);
   end;
end;

{**************************************************************************}
function  wioBuildFileInfoFromRAW(Var lpwio: PWaveIOCB; lpFileName: PChar;
                                  DataOffset, BitLength,
                                  Channels, SampleRate: DWORD): integer;
var
   wfx: TWaveFormatEx;
begin
   pcmBuildWaveHeader(@wfx,BitLength,Channels,SampleRate);
   Result := wioBuildFileInfoFromRAWEx(lpwio,lpFileName,DataOffset,@wfx);
end;

{**************************************************************************}
function wioWriteFileInfo(Var lpwio: PWAVEIOCB; lpFilePath: PChar): integer;
Label ERROR_CANNOT_WRITE;
Var
   hmmio: THMMIO;
   ckDATA, ckRIFF: TMMCKINFO;
   dw: Longint;

begin
    { default our error return (assume the worst) }
    Result := WIOERR_FILEERROR;
    hmmio := 0;

    { validate a couple of things }
    if (lpwio = Nil) or (lpFilePath = Nil) then
    begin
       Result := WIOERR_BADPARAM;
       goto ERROR_CANNOT_WRITE;
    end;

    { yes, this is the open... }
    hmmio := mmioOpen(lpFilePath, Nil, MMIO_CREATE or MMIO_READWRITE or MMIO_ALLOCBUF);
    if (hmmio = 0) then
       goto ERROR_CANNOT_WRITE;

    { create the RIFF chunk of form type 'WAVE' }
    ckRIFF.fccType := mmioFOURCC('W', 'A', 'V', 'E');
    ckRIFF.cksize  := 0;
    if mmioCreateChunk(hmmio, @ckRIFF, MMIO_CREATERIFF) <> 0 then
       goto ERROR_CANNOT_WRITE;

    { now create the destination fmt and data chunks _in that order_       }
    { hmmio is now descended into the 'RIFF' chunk--create the format chunk}
    { and write the format header into it                                  }
    dw := wioSizeOfWaveFormat(@lpwio^.wfx);

    ckDATA.ckid := mmioFOURCC('f', 'm', 't', ' ');
    ckDATA.cksize := dw;
    if mmioCreateChunk(hmmio, @ckDATA, 0) <> 0 then
       goto ERROR_CANNOT_WRITE;

    { Write the WAVEFORMAT structure to the 'fmt ' chunk. }
    if mmioWrite(hmmio, @lpwio^.wfx, dw) <> dw then
       goto ERROR_CANNOT_WRITE;

    { Ascend out of the 'fmt ' chunk, back into the 'RIFF' chunk. }
    if mmioAscend(hmmio, @ckDATA, 0) <> 0 then
       goto ERROR_CANNOT_WRITE;

    { create the data chunk AND STAY DESCENDED... for reasons that }
    { will become apparent later..                                 }
    ckDATA.ckid   := mmioFOURCC('d', 'a', 't', 'a');
    ckDATA.cksize := 0;
    ckData.dwFlags:= MMIO_DIRTY;
    if mmioCreateChunk(hmmio, @ckDATA, 0) <> 0 then
       goto ERROR_CANNOT_WRITE;

    { to close the file do:
    mmioAscend(hmmio, @ckData, 0);
    mmioAscend(hmmio, @ckRIFF, 0);
    mmioClose(hmmio, 0); }

    { cool! no problems.. }
    lpwio^.hmmio         := hmmio;
    lpwio^.ckRIFF        := ckRIFF;
    lpwio^.ckDATA        := ckDATA;
    lpwio^.dwDataOffset  := ckDATA.dwDataOffset;
    lpwio^.lpFilePath    := StrNew(lpFilePath);
    lpwio^.dwDataSamples := wioBytesToSamplesEx(lpwio, lpwio^.dwDataBytes);
    lpwio^.dwFirstSample := 0;
    lpwio^.dwLastSample  := lpwio^.dwDataSamples;

    Result := WIOERR_NOERROR;
    exit;

    { return error (after minor cleanup) }
ERROR_CANNOT_WRITE:

    if (hmmio <> 0) then
       mmioClose(hmmio, 0);    { close the new file }

    { delete the half-written file. }
    wioFileDelete(lpFilePath);
end;

{**************************************************************************}
function wioFreeFileInfo(Var lpwio: PWAVEIOCB): integer;
begin
     { validate a couple of things... }
     if (lpwio = Nil) then
     begin
	  Result := WIOERR_BADPARAM;
          exit;
     end;

     { get rid of stuff... }
     if (lpwio^.hmmio <> 0) then
     begin
          if (lpwio^.dwFlags and RAW_FILE <> 0) then
              FileClose(lpwio^.hmmio)
          else
              mmioClose(lpwio^.hmmio, 0);
	  lpwio^.hmmio := 0;
     end;

     if (lpwio^.lpFilePath <> Nil) then
        StrDispose(lpwio^.lpFilePath);

     if (lpwio^.lpInfo <> Nil) then
	RiffFreeINFO(lpwio^.lpInfo);

     if (lpwio^.lpDisp <> Nil) then
	RiffFreeDISP(lpwio^.lpDisp,True);

     GlobalFreeMem(Pointer(lpwio));
     lpwio := Nil;

     Result := WIOERR_NOERROR;
end;

(**************************************************************************
 * This routine will copy from a source wave file to a destination wave
 * file all those useless chunks (well, the ones useless to conversions,
 * etc --> apparently people use them!). The source will be seeked to the
 * begining, but the destination has to be at a current pointer to put the
 * new chunks. This will also seek back to the start of the wave riff
 * header at the end of the routine.
 *
 * Both files must be open !!!
 *
 * Returns 0 if successful, else the error code. If this routine fails, it
 * still attemps to seek back to the start of the wave riff header, though
 * this too could be unsuccessful.
 **************************************************************************)
function wioWaveCopyUselessChunks(lpwioSrc, lpwioDst: PWaveIOCB): integer;
Label COPY_ERROR;
begin
     Result := WIOERR_FILEERROR;
     { First seek to the start of the file, not including the riff header }
     with lpwioSrc^ do
     begin
        if mmioSeek(hmmio, ckRIFF.dwDataOffset + sizeOf(FOURCC), SEEK_SET) = -1 then
           goto COPY_ERROR;

        while mmioDescend(hmmio, @ckDATA, @ckRIFF, 0) = 0 do
        begin
           { quickly check for corrupt RIFF file--don't ascend past end! }
           if (ckData.dwDataOffset + ckDATA.cksize > ckRIFF.dwDataOffset + ckRIFF.cksize) then
              goto COPY_ERROR;

           { copy chunks that are OK to copy }
           if ckDATA.ckid = mmioFOURCC('c', 'u', 'e', ' ') then
              { it doesn't make much sense }
              RiffCopyChunk(hmmio, lpwioDst^.hmmio, @ckDATA)

           else if ckDATA.ckid = mmioFOURCC('p', 'l', 's', 't') then
              { although without the 'cue' chunk, it doesn't make much sense }
              RiffCopyChunk(hmmio, lpwioDst^.hmmio, @ckDATA)

           { don't copy unknown chunks }
           else break;

           { step up to prepare for next chunk.. }
           mmioAscend(hmmio, @ckDATA, 0);
        end;
     end;

     Result := WIOERR_NOERROR;

COPY_ERROR:

     { Seek back to source RIFF header }
     with lpwioSrc^ do
     mmioSeek(hmmio, ckRIFF.dwDataOffset + sizeof(FOURCC), SEEK_SET);
end;

{**************************************************************************}
(* TODO: does not work !? mmioGetInfo returns in cchBuffer bad size !!!???*)
function wioSetIOBufferSize(lpwio: PWaveIOCB; dwSize: integer): integer;
begin
     Result := WIOERR_BADPARAM;

     { validate a couple of things... }
     if (lpwio = Nil) then exit;

     Result := WIOERR_ERROR;

     if (lpwio^.dwFlags and RIFF_MEMORY <> 0) or
        (lpwio^.dwFlags and RIFF_RESOURCE <> 0) or
        (lpwio^.dwFlags and RAW_FILE <> 0) then
        Result := WIOERR_NOERROR
     else if (lpwio^.hmmio <> 0) and (dwSize >= 0) then
        Result := mmioSetBuffer(lpwio^.hmmio, Nil, dwSize, 0);
end;

{**************************************************************************}
function wioWaveOpen(lpwio: PWaveIOCB): integer;
begin
     Result := WIOERR_BADPARAM;

     { validate a couple of things... }
     if (lpwio = Nil) then exit;

     Result := WIOERR_FILEERROR;

     { (re)open the file }
     if (lpwio^.hmmio = 0) then
     with lpwio^ do
     begin
        if (dwFlags and RAW_FILE <> 0) then
            hmmio := FileOpen(StrPas(lpFilePath),fmOpenRead or fmShareDenyNone)
        else wioFileOpen(hmmio, ckRIFF, hMem, lpFilePath,
                         mmioFOURCC('W', 'A', 'V', 'E'),dwFlags);
     end;

     { set start position }
     if (lpwio^.hmmio <> 0) then
        if wioWaveSetPosition(lpwio, lpwio^.dwPosition) = 0 then
           Result := WIOERR_NOERROR;
end;

{**************************************************************************}
function wioWaveClose(lpwio: PWaveIOCB): integer;
Label ERROR_CANNOT_WRITE;
Var
   mmioInfo: TMMIOINFO;

begin
     Result := WIOERR_NOERROR;
     if (lpwio = Nil) or (lpwio^.hmmio = 0) then exit;

     with lpwio^ do
     begin
        Result := WIOERR_FILEERROR;

        if (dwFlags and RAW_FILE = 0) and
           (ckData.dwFlags and MMIO_DIRTY <> 0) then
        begin
           if mmioGetInfo(hmmio, @mmioInfo, 0) <> 0 then
              goto ERROR_CANNOT_WRITE;

           if mmioFlush(hmmio,0) <> 0 then
              goto ERROR_CANNOT_WRITE;    { cannot write file, probably }

           if mmioInfo.dwFlags and MMIO_CREATE = 0 then
           begin
              { rewrite the size of data chunk }
              ckData.cksize := 0;
              ckData.dwFlags:= ckData.dwFlags or MMIO_DIRTY;

              { seek to the end of the chunk first }
              if mmioSeek(hmmio,dwDataOffset+dwDataBytes,SEEK_SET) = -1 then
                 goto ERROR_CANNOT_WRITE;    { cannot seek, probably }

              { force the rif chunk to rewrite }
              ckRiff.cksize := 0;
              ckRiff.dwFlags:= ckRiff.dwFlags or MMIO_DIRTY;
           end;

           { Ascend the output file out of the 'data' chunk - this will }
           { cause the chunk size of the 'data' chunk to be written.    }
           if mmioAscend(hmmio, @ckDATA, 0) <> 0 then
              goto ERROR_CANNOT_WRITE;    { cannot write file, probably }

           { Now create the fact chunk, not required for PCM but nice to have. }
           ckDATA.ckid   := mmioFOURCC('f', 'a', 'c', 't');
           ckDATA.cksize := 0;
           if mmioCreateChunk(hmmio, @ckDATA, 0) <> 0 then
              goto ERROR_CANNOT_WRITE;

           { If it didn't fail, write the fact chunk out }
           if mmioWrite(hmmio, @dwDataSamples, sizeOf(Longint)) <> sizeOf(Longint) then
              goto ERROR_CANNOT_WRITE;

           { Now ascend out of the fact chunk... }
           if mmioAscend(hmmio, @ckDATA, 0) <> 0 then
              goto ERROR_CANNOT_WRITE;

           { now write out possibly editted chunks... }
           if RiffWriteDISP(hmmio, lpDisp) <> 0 then