wav_proj.dpr

   1 program wav_proj;
   2
   3 {$APPTYPE CONSOLE}
   4 {$R *.res}
   5
   6 uses
   7   System.SysUtils,
   8   System.Classes,
   9   wav in 'wav.pas',
  10   WriteHeader in 'WriteHeader.pas';
  11
  12 function effect8BitWav(fpIn, fpOut: TFileStream; sizeOfData: LongInt): integer;
  13 var
  14   i, j: integer;
  15   s: Single;
  16   c: array [0 .. 1] of Byte;
  17   mix: Byte;
  18 begin
  19   result := 0;
  20   i := 0;
  21   s := sizeOfData / SizeOf(@c);
  22   while i < s do
  23   begin
  24     try
  25       fpIn.ReadBuffer(c, SizeOf(@c));
  26       j := (c[0] + c[1]) div 2;
  27       mix := j;
  28       fpOut.WriteBuffer(mix, SizeOf(@mix));
  29     except
  30       result := -1;
  31       break;
  32     end;
  33     inc(i);
  34   end;
  35 end;
  36
  37 function effect16BitWav(fpIn, fpOut: TFileStream; sizeOfData: LongInt): integer;
  38 var
  39   i, j: integer;
  40   s: Single;
  41   c: array [0 .. 1] of ShortInt;
  42   mix: ShortInt;
  43 begin
  44   result := 0;
  45   i := 0;
  46   s := sizeOfData / SizeOf(@c);
  47   while i < s do
  48   begin
  49     try
  50       fpIn.ReadBuffer(c, SizeOf(@c));
  51       j := (c[0] + c[1]) div 2;
  52       mix := j;
  53       fpOut.WriteBuffer(mix, SizeOf(@mix));
  54     except
  55       result := -1;
  56       break;
  57     end;
  58     inc(i);
  59   end;
  60 end;
  61
  62 function wavDataWrite(fpIn, fpOut: TFileStream; posOfData, sizeOfData: LongInt;
  63   bytesPerSingleCh: SmallInt): integer;
  64 begin
  65   fpIn.Position := posOfData;
  66   fpOut.Position := posOfData;
  67   if bytesPerSingleCh = 1 then
  68     result := effect8BitWav(fpIn, fpOut, sizeOfData)
  69   else
  70     result := effect16BitWav(fpIn, fpOut, sizeOfData);
  71 end;
  72
  73 function wavWrite(inFile, outFile: PChar; sampRate: LongWord; sampBits: Byte;
  74   posOfData, sizeOfData: LongInt): integer;
  75 var
  76   bytesPerSingleCh: Word;
  77   fpIn, fpOut: TFileStream;
  78 begin
  79   try
  80     fpIn := TFileStream.Create(inFile, fmOpenRead);
  81     fpOut := TFileStream.Create(outFile, fmCreate);
  82     bytesPerSingleCh := sampBits div 8;
  83     if waveHeaderWrite(fpOut, sizeOfData div 2, WAV_MONAURAL, sampRate, sampBits) <> 44 then
  84       raise EWriteError.Create('\83w\83b\83_\82ð\8f\91\82«\8d\9e\82ß\82Ü\82¹\82ñ');
  85     if wavDataWrite(fpIn, fpOut, posOfData, sizeOfData, bytesPerSingleCh) = -1
  86     then
  87       raise EWriteError.Create('\83G\83\89\81[\94\90¶');
  88   except
  89     on EFOpenError do
  90       Writeln(inFile, '\82ð\83I\81[\83v\83\93\82Å\82«\82Ü\82¹\82ñ');
  91     on EFOpenError do
  92       fpIn.Free;
  93     else
  94
  95     begin
  96       fpIn.Free;
  97       fpOut.Free;
  98     end;
  99     result := -1;
 100   end;
 101   result := 0;
 102 end;
 103
 104 var
 105   sampRate: LongWord;
 106   sampBits: Byte;
 107   posOfData, sizeOfData: LongInt;
 108
 109 begin
 110   try
 111     { TODO -oUser -cConsole \83\81\83C\83\93 : \82±\82±\82É\83R\81[\83h\82ð\8bL\8fq\82µ\82Ä\82\82¾\82³\82¢ }
 112     wavHdrRead(PChar(ParamStr(1)), sampRate, sampBits, posOfData, sizeOfData);
 113     wavWrite(PChar(ParamStr(1)), PChar(ParamStr(2)), sampRate, sampBits,
 114       posOfData, sizeOfData);
 115     Writeln('\8a®\97¹');
 116   except
 117     on E: Exception do
 118       Writeln(E.ClassName, ': ', E.Message);
 119   end;
 120
 121 end.