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: LongInt;
  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, bytesPerSingleCh, sampRate,
  84       sampBits) <> 44 then
  85       raise EWriteError.Create('\83w\83b\83_\82ð\8f\91\82«\8d\9e\82ß\82Ü\82¹\82ñ');
  86     if wavDataWrite(fpIn, fpOut, posOfData, sizeOfData, bytesPerSingleCh) = -1
  87     then
  88       raise EWriteError.Create('\83G\83\89\81[\94\90¶');
  89   except
  90     on EFOpenError do
  91       Writeln(inFile, '\82ð\83I\81[\83v\83\93\82Å\82«\82Ü\82¹\82ñ');
  92     on EFOpenError do
  93       fpIn.Free;
  94     else
  95
  96     begin
  97       fpIn.Free;
  98       fpOut.Free;
  99     end;
 100     result := -1;
 101   end;
 102   result := 0;
 103 end;
 104
 105 var
 106   sampRate: LongWord;
 107   sampBits: Byte;
 108   posOfData, sizeOfData: LongInt;
 109
 110 begin
 111   try
 112     { TODO -oUser -cConsole \83\81\83C\83\93 : \82±\82±\82É\83R\81[\83h\82ð\8bL\8fq\82µ\82Ä\82\82¾\82³\82¢ }
 113     wavHdrRead(PChar(ParamStr(1)), sampRate, sampBits, posOfData, sizeOfData);
 114     wavWrite(PChar(ParamStr(1)), PChar(ParamStr(2)), sampRate, sampBits,
 115       posOfData, sizeOfData);
 116     Writeln('\8a®\97¹');
 117   except
 118     on E: Exception do
 119       Writeln(E.ClassName, ': ', E.Message);
 120   end;
 121
 122 end.