mmwaveio.pas

一套及时通讯的原码

{*************************************************************************}
procedure wioGetFormatName(pwfx: PWaveFormatEx; var FormatName: String);
Var
   i: integer;

begin
     if (pwfx <> Nil) then
     begin
          i := 0;
          while (formats[i].szformat <> '') do
          begin
	       if (formats[i].wFormat = pwfx^.wFormatTag) then
	       begin
	            FormatName := formats[i].szformat;
                    exit;
               end;
               inc(i);
          end;
     end;
     FormatName := 'Unknown';
end;

{*************************************************************************}
procedure wioGetFormat(pwfx: PWaveFormatEx; var Format: String);
const
     gszIntl        = 'Intl';
     gszIntlList    = 'sList';
     gszIntlDecimal = 'sDecimal';
     gchIntlList    : char = ',';
     gchIntlDecimal : char = '.';
var
   aBuf    : array[0..255] of char;
   ach     : array[0..1] of char;
   Channels: array[0..24] of char;
   Bits    : word;

begin
     if (pwfx <> Nil) then
     begin
        ach[0] := gchIntlList;
        ach[1] := #0;

        GetProfileString(gszIntl, gszIntlList, ach, ach, sizeof(ach));
        gchIntlList := ach[0];

        ach[0] := gchIntlDecimal;
        ach[1] := #0;

        GetProfileString(gszIntl, gszIntlDecimal, ach, ach, sizeof(ach));
        gchIntlDecimal := ach[0];

        { compute the bit depth--this _should_ be the same as }
        { wBitsPerSample, but isn't always...                 }

        Bits := (pwfx^.nAvgBytesPerSec * 8 div
                 pwfx^.nSamplesPerSec div pwfx^.nChannels);

        if (pwfx^.nChannels = 1) or (pwfx^.nChannels = 2) then
        begin
           if (pwfx^.nChannels = 1)then
               StrCopy(Channels, 'Mono')
           else
               StrCopy(Channels, 'Stereo');

           StrFmt(aBuf,'%d%s%.03d kHz%s %d Bit%s %s',
                       [pwfx^.nSamplesPerSec div 1000, gchIntlDecimal,
                        pwfx^.nSamplesPerSec mod 1000, gchIntlList,
                        Bits, gchIntlList, Channels]);
        end
        else
        begin
           StrFmt(aBuf,'%d%s%.03d kHz%s %d Bit%s %d Channels',
                  [pwfx^.nSamplesPerSec div 1000, gchIntlDecimal,
                   pwfx^.nSamplesPerSec mod 1000, gchIntlList,
                   Bits, gchIntlList, pwfx^.nChannels]);
        end;
        Format := StrPas(aBuf);
     end
     else Format := 'Unknown';
end;

{**************************************************************************}
function wioIsWaveFile(FilePath: TFileName; dwFlags: DWORD): Boolean;
Var
   aBuf: PChar;
   lpwio: PWAVEIOCB;

begin
     Result := False;
     if FilePath <> '' then
     begin
          aBuf := StrAlloc(Length(FilePath)+1);
          try
             StrPCopy(aBuf, FilePath);
             if wioReadFileInfo(lpwio, aBuf,
                                mmioFOURCC('W', 'A', 'V', 'E'),
                                dwFlags) = 0 then
                Result := True;

          finally
             wioFreeFileInfo(lpwio);
             StrDispose(aBuf);
          end;
     end;
end;

{**************************************************************************}
function wioGetFullPathName(lpFilePath: PChar): Boolean;
begin
   { return a full path for this file }
   Result := mmioOpen(lpFilePath, Nil, MMIO_PARSE) <> 0;
end;

{**************************************************************************}
function wioFileExists(lpFilePath: PChar): Boolean;
begin
     Result := mmioOpen(lpFilePath, Nil, MMIO_EXIST) <> 0;
end;

{**************************************************************************}
function wioFileDelete(lpFilePath: PChar): Boolean;
begin
     Result := mmioOpen(lpFilePath, Nil, MMIO_DELETE) <> 0;
end;

{**************************************************************************}
procedure wioExtractPath(lpFilePath: PChar);
var
  i: Integer;

begin
   i := StrLen(lpFilePath);
   while (i > 0) and not (lpFilePath[i] in ['\', ':']) do
   begin
      lpFilePath[i] := #0;
      dec(i);
   end;
end;

{**************************************************************************}
function wioFileCreateTemp(lpFilePath: PChar): Boolean;
begin
     {$IFDEF WIN32}
     if (lpFilePath = '') or (lpFilePath[0] = #0) then
     begin
        GetTempPath(MAX_PATH-1,lpFilePath);
     end;
     {$ENDIF}

     { make sure we have a full pathname }
     wioGetFullPathName(lpFilePath);
{$IFDEF WIN32}
     { extract the filename }
     wioExtractPath(lpFilePath);
     { create the temp file }
     Result := GetTempFileName(lpFilePath,
                               'w'#0,
                               Random(256)+1,
                               lpFilePath) <> 0;
{$ELSE}
     { get the drive letter }
     StrLCopy(lpFilePath, StrUpper(lpFilePath), 2);
     { create the temp file }
     Result := GetTempFileName(Char(Byte(UpCase(lpFilePath[0]))or TF_FORCEDRIVE),
                               'w'#0, 0, lpFilePath) <> 0;
{$ENDIF}
     { return a full path for this file }
     if Result then
     begin
        wioGetFullPathName(lpFilePath);
        wioFileDelete(lpFilePath);
     end;
end;

{**************************************************************************}
procedure wioFileClose(Var hmmio: THMMIO; Var hMem: THandle);
begin
     if (hMem <> 0) then
     begin
          UnlockResource(hMem);
	  FreeResource(hMem);
          hMem := 0;
     end;

     if (hmmio <> 0) then mmioClose(hmmio, 0);
     hmmio := 0;
end;

(**************************************************************************)
function wioFileOpen(Var hmmio: THMMIO;
                     Var ckRIFF: TMMCKINFO;
                     Var HMem: THandle;
                     lpFilePath: PChar;
                     fccType: FourCC;
                     dwFlags: DWORD): integer;
Label ERROR_OPEN_WAVE;
Var
   HRsrc: THandle;
   mmioInfo: TMMIOINFO;

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

     { first try to open the file, etc.. open the given file for reading }
     { using buffered I/O                                                }

     if (dwFlags AND RIFF_RESOURCE <> 0) then
     begin
	  HRsrc := FindResource(HInstance, lpFilePath, 'WAVE');
          HMem := LoadResource(HInstance, HRsrc);
          if HMem = 0 then
             goto ERROR_OPEN_WAVE;

          FillChar(mmioInfo, sizeOf(TMMIOINFO), 0);
          mmioInfo.pchBuffer := LockResource(HMem);
	  if mmioInfo.pchBuffer = Nil then
             goto ERROR_OPEN_WAVE;

{$IFDEF WIN32}
          mmioInfo.cchBuffer := SizeofResource(HInstance,HRsrc);
{$ELSE}
	  mmioInfo.cchBuffer := GlobalSize(HMem);
{$ENDIF}
	  mmioInfo.fccIOProc := FOURCC_MEM;
	  mmioInfo.adwInfo[0] := 0;

          hmmio := mmioOpen(Nil, @mmioInfo, MMIO_READ OR MMIO_ALLOCBUF);
          if (hmmio = 0) then
             goto ERROR_OPEN_WAVE;
     end
     else if (dwFlags AND RIFF_MEMORY <> 0) then
     begin
          move(lpFilePath^, mmioInfo, sizeOf(TMMIOINFO));
          mmioInfo.fccIOProc := FOURCC_MEM;
          mmioInfo.adwInfo[0] := 0;
          hmmio := mmioOpen(Nil, @mmioInfo, MMIO_READ OR MMIO_ALLOCBUF);
          if (hmmio = 0) then
             goto ERROR_OPEN_WAVE;
     end
     else { Open the given file for reading using buffered I/O. }
     begin
          if (FileGetAttr(StrPas(lpFilePath)) and faReadOnly = 0) then
          begin
             hmmio := mmioOpen(lpFilePath, Nil, MMIO_READWRITE OR MMIO_ALLOCBUF);
             if (hmmio = 0) then
                 hmmio := mmioOpen(lpFilePath, Nil, MMIO_READ OR MMIO_ALLOCBUF);
          end
          else
             hmmio := mmioOpen(lpFilePath, Nil, MMIO_READ OR MMIO_ALLOCBUF);

          if (hmmio = 0) then
              goto ERROR_OPEN_WAVE;
     end;

     if mmioDescend(hmmio, @ckRIFF, Nil, 0) <> 0 then
        goto ERROR_OPEN_WAVE;

     if (ckRIFF.ckid <> FOURCC_RIFF) or (ckRIFF.fccType <> fccType) then
        goto ERROR_OPEN_WAVE;

     Result := WIOERR_NOERROR;
     exit;

ERROR_OPEN_WAVE:

     wioFileClose(hmmio, hMem);
end;

{**************************************************************************}
function wioReadFileInfo(Var lpwio: PWAVEIOCB; lpFilePath: PChar;
                         fccType: FourCC; dwFlags: DWORD): integer;
Label ERROR_READING_WAVE;
Var
   hmmio: THMMIO;
   hMem : THandle;
   wio: TWAVEIOCB;
   ck,ckRIFF: TMMCKINFO;
   dw: Longint;
   TempRes: integer;
   CheckDataSize: Boolean;
   NextOffset: DWORD;
   hasFormat,hasData: Boolean;

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

     { first try to open the file, etc.. open the given file for reading }
     { using buffered I/O                                                }
     if (wioFileOpen(hmmio, ckRIFF, hMem, lpFilePath, fccType, dwFlags) <> 0) OR (hmmio = 0) then
        goto ERROR_READING_WAVE;

     FillChar(wio, sizeof(wio), 0);

     { Save the filename or the memory/resource mmioInfo structure }
     if (dwFlags = RIFF_MEMORY) then
     begin
          wio.lpFilePath := StrAlloc(sizeOf(TMMIOINFO)+1);
          move(lpFilePath^, wio.lpFilePath^, sizeOf(TMMIOINFO));
     end
     else wio.lpFilePath := StrNew(lpFilePath);

    { get the file size }
     wio.dwFileSize := mmioSeek(hmmio, 0, SEEK_END);
     if (wio.dwFileSize = $FFFFFFFF) then
        goto ERROR_READING_WAVE;

     { return to RIFF chunk }
     if mmioSeek(hmmio, ckRIFF.dwDataOffset + sizeOf(FOURCC), SEEK_SET) = -1 then
        goto ERROR_READING_WAVE;

     { quickly check for corrupt RIFF file--don't ascend past end!  }
     if (ckRIFF.dwDataOffset + ckRIFF.cksize > wio.dwFileSize) then
     begin
        ckRIFF.ckSize := wio.dwFileSize-ckRIFF.dwDataOffset;
        {goto ERROR_READING_WAVE;}
     end;

     { we found a WAVE chunk--now go through and get all subchunks that }
     { we know how to deal with...                                      }