home *** CD-ROM | disk | FTP | other *** search
/ Personal Computer World 1995 May / pcw-0595.bin / demos / databeck / wsounds / setup.dir / wswsrc.exe / WAVEUTIL.PAS < prev    next >
Pascal/Delphi Source File  |  1992-11-02  |  4KB  |  168 lines
  1. Unit WaveUtil;
  2.  
  3. Interface
  4.  
  5. Uses WinCrt, WinDos, WObjects, Strings;
  6.  
  7. TYPE
  8.    FourCC     = Array[0..3] OF CHAR;
  9.    ChunkSize  = Array[0..3] OF Byte;
  10.  
  11.    CK = RECORD
  12.       ckId   : FourCC;
  13.       ckSize : ChunkSize;
  14.       END;
  15.  
  16. FUNCTION  WAVCalcSize(MSize : ChunkSize): LongInt;
  17. FUNCTION  WAVCheckType(VAR F : TDosStream) : BOOLEAN;
  18. FUNCTION  WAVNextChunk(VAR F : TDosStream; VAR Name : FourCC) : BOOLEAN;
  19. FUNCTION  WAVskip2fmtChunk(VAR F : TDosStream; VAR Name : FourCC) : BOOLEAN;
  20. FUNCTION  WAVOpenFile(VAR F : TDosStream; Name : PChar) : BOOLEAN;
  21. FUNCTION  WAVGetInfo(VAR F : TDosStream; VAR SRate : WORD; VAR NChan : Byte) : BOOLEAN;
  22. PROCEDURE WAVCloseFile(VAR F : TDosStream);
  23. PROCEDURE WAVReadPrint(VAR F:TDosStream);
  24. FUNCTION  WAVExists(Name : PChar) : BOOLEAN;
  25.  
  26. IMPLEMENTATION
  27. VAR
  28.    F : TDosStream;
  29.  
  30. FUNCTION WAVExists(Name : PChar) : BOOLEAN;
  31. VAR
  32.    F : TDosStream;
  33. BEGIN
  34. (*
  35. {$I-}
  36.    F.Init(Name, stOpenRead);
  37. {$I+}
  38. *)
  39.    F.Init(Name, stOpenRead);
  40.    IF F.Status = stOk THEN BEGIN
  41.       WAVExists := TRUE;
  42.       F.Done;
  43.       END
  44.    ELSE WAVExists := FALSE;
  45.    F.Done;
  46.    END;
  47.  
  48. FUNCTION WAVCalcSize(MSize : ChunkSize): LongInt;
  49. {
  50.  * INPUT    : 32-bit number as 4-byte array
  51.  * OUTPUT   : True 32-bit value as LongInt
  52.  * PURPOSE  : Converts the 32-bit value for WAV file
  53.  *            to  a true 32-bit LongInt value
  54. }
  55. VAR
  56.    Power : REAL;
  57.    Dummy : LongInt;
  58.    Count : BYTE;
  59.  
  60.   BEGIN
  61.    Dummy := 0;
  62.    FOR Count := 0 TO 3 DO BEGIN
  63.     Power := Exp(Count * Ln(256));
  64.     Dummy := Dummy + (Trunc(Power)*MSize[Count]);
  65.     END;
  66.    WAVCalcSize := Dummy;
  67.    END;
  68.  
  69. FUNCTION WAVCheckType(VAR F : TDosStream) : BOOLEAN;
  70. VAR
  71.    Check : FourCC;
  72.    CurPos : LongInt;
  73. BEGIN
  74.    F.Read(Check,SizeOf(Check));
  75.    IF StrLComp(Check,'RIFF',4) = 0 THEN BEGIN
  76.       CurPos := F.GetPos;
  77.       F.Seek(CurPos+4);
  78.       F.Read(Check, SizeOf(Check));
  79.       IF StrLComp(Check,'WAVE',4) = 0 THEN WAVCheckType := TRUE
  80.                                      ELSE WAVCheckType := FALSE;
  81.       END
  82.    ELSE WAVCheckType := FALSE;
  83.    END;
  84.  
  85. FUNCTION WAVNextChunk(VAR F : TDosStream; VAR Name : FourCC) : BOOLEAN;
  86. VAR
  87.   CSize  : ChunkSize;
  88. BEGIN
  89.    F.Read(Name, SizeOf(Name));
  90.    IF (F.Status <> stOK) THEN BEGIN
  91.       WAVNextChunk := False;
  92.       Exit;
  93.       END;
  94.    IF ((StrLComp(Name,'RIFF',4) <> 0) AND
  95.        (StrLComp(Name,'fmt ',4) <> 0) AND
  96.        (StrLComp(Name,'data',4) <> 0))THEN BEGIN
  97.       F.Read(CSize, SizeOf(CSize));
  98.       F.Seek(F.GetPos+WAVCalcSize(CSize));
  99.       IF (WavNextChunk(F, Name) = FALSE) THEN WAVNextChunk := False;
  100.       END
  101.    ELSE WAVNextChunk := TRUE;
  102.    END;
  103.  
  104. FUNCTION WAVskip2fmtChunk(VAR F : TDosStream; VAR Name : FourCC) : BOOLEAN;
  105. VAR
  106.   CSize  : ChunkSize;
  107. BEGIN
  108.    F.Read(Name, SizeOf(Name));
  109.    IF (F.Status <> stOK) THEN BEGIN
  110.       WAVSkip2fmtChunk := False;
  111.       Exit;
  112.       END;
  113.    IF ((StrLComp(Name,'fmt ',4) <> 0))THEN BEGIN
  114.       F.Read(CSize, SizeOf(CSize));
  115.       F.Seek(F.GetPos+WAVCalcSize(CSize));
  116.       IF (WavSkip2fmtChunk(F, Name) = FALSE) THEN WAVSkip2fmtChunk := False;
  117.       END
  118.    ELSE WAVSkip2fmtChunk := TRUE;
  119.    END;
  120.  
  121. FUNCTION WAVOpenFile(VAR F : TDosStream; Name : PChar) : BOOLEAN;
  122. BEGIN
  123.   IF WAVExists(Name) THEN BEGIN
  124.      F.Init(Name,stOpenRead);
  125.      if F.Status = stOk THEN BEGIN
  126.         IF WAVCheckType(F) = TRUE THEN WAVOpenFile := TRUE
  127.                                   ELSE WAVOpenFile := FALSE
  128.         END
  129.      END
  130.   ELSE WavOpenFile := False;
  131.   END;
  132.  
  133. FUNCTION WAVGetInfo(VAR F : TDosStream; VAR SRate : WORD; VAR NChan : Byte) : BOOLEAN;
  134. VAR
  135.   SampPS : ChunkSize;
  136.   Chann  : WORD;
  137. BEGIN
  138.    F.Seek(F.GetPos + 6);
  139.    F.Read(Chann, SizeOf(Chann));
  140.    F.Read(SampPS, SizeOf(SampPS));
  141.    IF (F.Status <> stOk) THEN BEGIN
  142.       NChan := 0;
  143.       SRate := 0;
  144.       WavGetInfo := False;
  145.       END
  146.    ELSE BEGIN
  147.       NChan := Chann;
  148.       SRate := WORD(WAVCalcSize(SampPS));
  149.       WavGetInfo := True;
  150.       END;
  151.    END;
  152.  
  153. PROCEDURE WAVCloseFile(VAR F : TDosStream);
  154. BEGIN
  155.    F.Done;
  156.    END;
  157.  
  158. PROCEDURE WAVReadPrint(VAR F:TDosStream);
  159. VAR
  160.   C : CHar;
  161. BEGIN
  162.   F.Read(C, SizeOf(C));
  163.   Write('-',C);
  164.   END;
  165.    
  166. BEGIN
  167.    END.
  168.