home *** CD-ROM | disk | FTP | other *** search
/ Personal Computer World 1995 May / pcw-0595.bin / demos / databeck / wsounds / setup.dir / wswsrc.exe / RIFFCOMM.PAS < prev    next >
Pascal/Delphi Source File  |  1992-11-09  |  4KB  |  167 lines
  1. {
  2.           RIFFComm.TPU
  3.  
  4.           Reads and saves comments as a chunk in
  5.           an existing RIFF file
  6.  
  7.           Thorsten Petrowski 1992
  8.  
  9.           for NobleSoft
  10.  
  11.           (c) Copyright 1992 
  12.  
  13.  
  14.                                                                         }
  15. UNIT RIFFComm;
  16.  
  17. INTERFACE
  18.  
  19. uses WinCrt,Strings, WinTypes, WinProcs, WObjects, WinDOS, Win31, ShellAPI,
  20.   MMSystem,BWCC,dataobj, WaveUtil;
  21.  
  22.  
  23. CONST
  24.    MMWriteOK       = 0;
  25.    MMWriteCancel   = 1;
  26.    MMWriteSecure   = 2;
  27.    MMReadOK        = 0;
  28.    MMReadCancel    = 1;
  29.    MMReadNoSuccess = 2;
  30.  
  31. PROCEDURE GetRIFFCommentICMT (Var Data : WaveDataType; VAR MMessage : INTEGER );
  32. PROCEDURE GetRIFFCommentINAM (Var Data : WaveDataType; VAR Message : INTEGER );
  33. PROCEDURE PutRIFFComment (Data: WaveDataType; VAR MMessage : Integer);
  34.  
  35. IMPLEMENTATION
  36.  
  37. CONST
  38.   SOWChunk = 'ICMT';
  39.  
  40. PROCEDURE GetRIFFCommentINAM (Var Data : WaveDataType; VAR Message : INTEGER );
  41. Var InFile : THMMIO;
  42.     Parent : TMMCKINFO;
  43.     Infos  : TMMIOInfo;
  44.     Result : Integer;
  45.     FileP : Array[0..300] of char;
  46. Begin
  47. {FileP[0] := Data.DiskDrive;
  48. FileP[1] := #0;
  49. StrCat  (FileP,':');
  50. StrCat  (FileP,Data.PathName);
  51. StrCat  (FileP,Data.FileName);
  52. WriteLn('FileP:',FileP);
  53. InFile := mmioOpen (FileP,NIL,MMIO_READ);
  54. IF InFile <> 0 then
  55.  Begin
  56.   Parent.ckID := mmioStringToFourCC ('INFO',0);
  57.   Parent.fccType := mmioStringToFourCC ('INAM',0);
  58.   Result := mmioDescend (InFile,@Parent,NIL,MMIO_FINDList);
  59.   if result = 0 then
  60.    Begin
  61.     Message := MMReadOK;
  62.     mmioRead (InFile,@Data.FileComment,64);
  63.    End
  64.   ELSE BEGIN
  65.      Message := MMReadNoSuccess;
  66.      END;
  67. End
  68. ELSE BEGIN
  69.    Message := MMReadCancel;
  70.    END;
  71. mmioClose (InFile,0);}
  72. message := MMREADNOSUCCESS;
  73. End;
  74.  
  75. PROCEDURE GetRIFFCommentICMT (Var Data : WaveDataType; VAR MMessage : INTEGER );
  76. Var InFile : THMMIO;
  77.     Parent : TMMCKINFO;
  78.     Infos  : TMMIOInfo;
  79.     Result : Integer;
  80.     FileP : Array[0..140] of char;
  81. Begin
  82. FileP[0] := Data.DiskDrive;
  83. FileP[1] := #0;
  84. StrCat  (FileP,':');
  85. StrCat  (FileP,Data.PathName);
  86. StrCat  (FileP,Data.FileName);
  87. InFile := mmioOpen (FileP,NIL,MMIO_READ);
  88. IF InFile <> 0 then
  89.  Begin
  90.   FillChar(Parent,SizeOf(Parent),0);
  91.   Parent.fccType := mmioStringToFourCC (SOWChunk,0);
  92.   Result := mmioDescend (InFile,@Parent,NIL,MMIO_FINDLIST);
  93.   if result = 0 then
  94.    Begin
  95.     MMessage := MMReadOK;
  96.     mmioRead (InFile,@Data.FileComment,64);
  97.    End
  98.   ELSE BEGIN
  99.      MMessage := MMReadNoSuccess;
  100.      END;
  101. End
  102. ELSE BEGIN
  103.    MMessage := MMReadCancel;
  104.    END;
  105. mmioClose (InFile,0);
  106. End;
  107.  
  108. PROCEDURE PutRIFFComment (Data: WaveDataType; VAR MMessage : Integer);
  109. Var InFile : THMMIO;
  110.     Parent : TMMCKINFO;
  111.     Infos  : TMMIOInfo;
  112.     Result : Integer;
  113.     F      : File;
  114.     FileP : Array[0..140] of char;
  115.     FPath :Array[0..140] of char;
  116. Begin
  117. MMessage := MMReadCancel+5;
  118. FileP[0] := Data.DiskDrive;
  119. FileP[1] := #0;
  120. StrCat  (FileP,':');
  121. StrCat  (FileP,Data.PathName);
  122. StrCopy (FPath, FileP);
  123. StrCat  (FileP,Data.FileName);
  124.  
  125. Assign(F, FileP);
  126.  
  127. InFile := mmioOpen (FileP,NIL,MMIO_READWRITE);
  128. IF InFile <> 0 then
  129.  Begin
  130.   Parent.fccType := mmioStringToFourCC (SOWChunk,0);
  131.   Result := mmioDescend (InFile,@Parent,NIL,MMIO_FINDLIST);
  132.   if (result <> 0) then
  133.    Begin 
  134.     mmioSeek (InFile,LongInt(0),SEEK_END);
  135.     Parent.fccType := mmioStringToFourCC (SOWChunk,0);
  136.     Parent.ckSize  := 64;
  137.     mmioCreateChunk (InFile,@parent,MMIO_CREATELIST);
  138.     mmioWrite (InFile,Data.FileComment,64);
  139.     MMessage := MMWriteOK;
  140.    End
  141.   Else
  142.    Begin
  143.     MMessage := MMWriteOK;
  144.     mmioWrite (InFile,Data.FileComment,64);
  145.   End;
  146. End
  147. ELSE BEGIN
  148.    MMessage := MMWriteCancel;
  149.    END;
  150. mmioClose (InFile,0);
  151. IF MMessage = MMWriteOK THEN BEGIN
  152.    {$I-}
  153.    Reset(F);
  154.    SetFTime(F,Data.CreationDate);
  155.    Close(F);
  156.    {$I+}
  157.    IF IOResult = 0 THEN BEGIN
  158.       END
  159.    ELSE BEGIN
  160.       MMessage := MMWriteCancel;
  161.       END;
  162.    END;
  163. End;
  164.  
  165. Begin;
  166. End.
  167.