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