unit Unit1; // Rom to Wav Converter

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, Unit2, Spin;

type
  TForm1 = class(TForm)
    Button1: TButton;
    OpenDialog1: TOpenDialog;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    CheckBox1: TCheckBox;
    ProgressBar1: TProgressBar;
    Label5: TLabel;
    Label6: TLabel;
    TrackBar1: TTrackBar;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    SpinEdit1: TSpinEdit;
    Label11: TLabel;
    CheckBox2: TCheckBox;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure TrackBar1Change(Sender: TObject);
    procedure SpinEdit1Change(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
const
WaveHeader:Array[0..47]of Byte=($52,$49,$46,$46,$00,$00,$00,$00, $57,$41,$56,$45,$66,$6D,$74,$20,
                                $10,$00,$00,$00,$01,$00,$01,$00, $22,$56,$00,$00,$22,$56,$00,$00,
                                $01,$00,$08,$00,$64,$61,$74,$61, $00,$00,$00,$00,$7F,$7F,$7F,$7F);
ExtF:Set of char=['0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F','a','b','c','d','e','f'];
Version:String='Ver. 2.1';

var
  Form1: TForm1;
  FileName:String[11];
  Wav:File;
  Wav2:File of Byte;
  WavFileName:String;
  //WaveLevelsH:Array[0..15]of Byte=(205,205,205,205,205,205,205,205,205,205,205,205,205,205,205,205);
  //WaveLevelsL:Array[0..15]of Byte=(050,050,050,050,050,050,050,050,050,050,050,050,050,050,050,050);
  Memory:Array[0..$1FFFF]of Byte;
  BlockFirst,Blocks,BlockEnd,BlockCur:Byte;
  CRSUM,CRName:Byte;
  CurDir,OpenFileName:String;
  FileNamePos:Integer;
  Speed:Byte=6;
  Speed2,Delay:Byte;
  CurLevel:Integer=205;

implementation

{$R *.dfm}

// Процедура записи одного байта в Wave файл
Procedure OutByte(B:Byte);
Var
A,C,D,FC,i:Byte;
OutData:Array[0..31]of byte;
Begin
 Inc(CRSUM,B);
 A:=B;
 D:=A;
 C:=8;
 Repeat
  A:=D;
  if(A and $80)<>0 then FC:=1 else FC:=0;
  A:=(A shl 1)or FC;
  D:=A;
  A:=1;
  A:=A xor D;
  A:=A and 01;
  {if A=1 then BlockWrite(Wav,WaveLevelsH,Speed2)
         else BlockWrite(Wav,WaveLevelsL,Speed2);}
  if A=1 then Begin
              for i:=0 to Speed2-1 do
                  Begin
                  if CurLevel<205 then Inc(CurLevel,310 div(Speed2+(Speed2 and $01)));
                  if CurLevel>205 then CurLevel:=205;
                  OutData[i]:=CurLevel;
                  end;
              BlockWrite(Wav,OutData,Speed2);
              end
         else Begin
              for i:=0 to Speed2-1 do
                  Begin
                  if CurLevel>50 then Dec(CurLevel,310 div(Speed2+(Speed2 and $01)));
                  if CurLevel<50 then CurLevel:=50;
                  OutData[i]:=CurLevel;
                  end;
              BlockWrite(Wav,OutData,Speed2);
              end;
  A:=0;
  A:=A xor D;
  A:=A and 01;
  {if A=1 then BlockWrite(Wav,WaveLevelsH,Speed2)
         else BlockWrite(Wav,WaveLevelsL,Speed2);}
  if A=1 then Begin
              for i:=0 to Speed2-1 do
                  Begin
                  if CurLevel<205 then Inc(CurLevel,310 div(Speed2+(Speed2 and $01)));
                  if CurLevel>205 then CurLevel:=205;
                  OutData[i]:=CurLevel;
                  end;
              BlockWrite(Wav,OutData,Speed2);
              end
         else Begin
              for i:=0 to Speed2-1 do
                  Begin
                  if CurLevel>50 then Dec(CurLevel,310 div(Speed2+(Speed2 and $01)));
                  if CurLevel<50 then  CurLevel:=50;
                  OutData[i]:=CurLevel;
                  end;
              BlockWrite(Wav,OutData,Speed2);
              end;
  Dec(C);
 Until C=0;
 //Компенсация задержки на загрузку очередного байта из памяти
 {if A=1 then BlockWrite(Wav,WaveLevelsH,1)
        else BlockWrite(Wav,WaveLevelsL,1);}
 For i:=1 to Delay do BlockWrite(Wav,Byte(CurLevel),1);
end;

//Процедура записи полного Wave файла
Procedure OutToWav;
Var
i:Integer;
BlockName:String[25];
WavSize:DWord;
TempL,TempH:Byte;
WordL,WordH:Word;
Begin
AssignFile(Wav,WavFileName);
FileMode:=fmOpenReadWrite;
Rewrite(Wav,1);
BlockWrite(Wav,WaveHeader,48);
//Преамбула
for i:=1 to 25 do OutByte($00);for i:=1 to 25 do OutByte($55);
for i:=1 to 25 do OutByte($00);for i:=1 to 25 do OutByte($55);
for i:=1 to 25 do OutByte($00);for i:=1 to 25 do OutByte($55);
for i:=1 to 25 do OutByte($00);for i:=1 to 25 do OutByte($55);
//Блоки...
for BlockCur:=BlockFirst to BlockEnd-1 do
    Begin
    Form1.ProgressBar1.Position:=Round(100*(BlockCur-BlockFirst)/Blocks);
    Form1.Refresh;
    //Дубль первый
    //Синхронизатор
    for i:=1 to 16 do OutByte($00);for i:=1 to 4 do OutByte($55);
    OutByte($E6);CRSUM:=0;
    //Имя блока
    for i:=1 to 4 do OutByte($00);
    BlockName:='NODISC00000000'+FileName;for i:=1 to 25 do OutByte(Ord(BlockName[i]));
    OutByte($00);OutByte($00);
    OutByte(BlockFirst);OutByte(Blocks);OutByte(BlockEnd-BlockCur);
    CRName:=CRSUM;OutByte(CRName);
    //Синхронизаторы и информационные подблоки 8 шт.
    for i:=1 to 4 do OutByte($00);OutByte($E6);CRSUM:=0;OutByte($80);OutByte(CRName);
    for i:=BlockCur*256+$00 to BlockCur*256+$1F do OutByte(Memory[i]);OutByte(CRSUM);
    for i:=1 to 4 do OutByte($00);OutByte($E6);CRSUM:=0;OutByte($81);OutByte(CRName);
    for i:=BlockCur*256+$20 to BlockCur*256+$3F do OutByte(Memory[i]);OutByte(CRSUM);
    for i:=1 to 4 do OutByte($00);OutByte($E6);CRSUM:=0;OutByte($82);OutByte(CRName);
    for i:=BlockCur*256+$40 to BlockCur*256+$5F do OutByte(Memory[i]);OutByte(CRSUM);
    for i:=1 to 4 do OutByte($00);OutByte($E6);CRSUM:=0;OutByte($83);OutByte(CRName);
    for i:=BlockCur*256+$60 to BlockCur*256+$7F do OutByte(Memory[i]);OutByte(CRSUM);
    for i:=1 to 4 do OutByte($00);OutByte($E6);CRSUM:=0;OutByte($84);OutByte(CRName);
    for i:=BlockCur*256+$80 to BlockCur*256+$9F do OutByte(Memory[i]);OutByte(CRSUM);
    for i:=1 to 4 do OutByte($00);OutByte($E6);CRSUM:=0;OutByte($85);OutByte(CRName);
    for i:=BlockCur*256+$A0 to BlockCur*256+$BF do OutByte(Memory[i]);OutByte(CRSUM);
    for i:=1 to 4 do OutByte($00);OutByte($E6);CRSUM:=0;OutByte($86);OutByte(CRName);
    for i:=BlockCur*256+$C0 to BlockCur*256+$DF do OutByte(Memory[i]);OutByte(CRSUM);
    for i:=1 to 4 do OutByte($00);OutByte($E6);CRSUM:=0;OutByte($87);OutByte(CRName);
    for i:=BlockCur*256+$E0 to BlockCur*256+$FF do OutByte(Memory[i]);OutByte(CRSUM);
    if Form1.CheckBox1.Checked then//Дубль второй
       Begin
       //Синхронизатор
       for i:=1 to 16 do OutByte($00);for i:=1 to 4 do OutByte($55);
       OutByte($E6);CRSUM:=0;
       //Имя блока
       for i:=1 to 4 do OutByte($00);
       BlockName:='NODISC00000000'+FileName;for i:=1 to 25 do OutByte(Ord(BlockName[i]));
       OutByte($00);OutByte($00);
       OutByte(BlockFirst);OutByte(Blocks);OutByte(BlockEnd-BlockCur);
       CRName:=CRSUM;OutByte(CRName);
       //Синхронизаторы и информационные подблоки 8 шт.
       for i:=1 to 4 do OutByte($00);OutByte($E6);CRSUM:=0;OutByte($88);OutByte(CRName);
       for i:=BlockCur*256+$00 to BlockCur*256+$1F do OutByte(Memory[i]);OutByte(CRSUM);
       for i:=1 to 4 do OutByte($00);OutByte($E6);CRSUM:=0;OutByte($89);OutByte(CRName);
       for i:=BlockCur*256+$20 to BlockCur*256+$3F do OutByte(Memory[i]);OutByte(CRSUM);
       for i:=1 to 4 do OutByte($00);OutByte($E6);CRSUM:=0;OutByte($8A);OutByte(CRName);
       for i:=BlockCur*256+$40 to BlockCur*256+$5F do OutByte(Memory[i]);OutByte(CRSUM);
       for i:=1 to 4 do OutByte($00);OutByte($E6);CRSUM:=0;OutByte($8B);OutByte(CRName);
       for i:=BlockCur*256+$60 to BlockCur*256+$7F do OutByte(Memory[i]);OutByte(CRSUM);
       for i:=1 to 4 do OutByte($00);OutByte($E6);CRSUM:=0;OutByte($8C);OutByte(CRName);
       for i:=BlockCur*256+$80 to BlockCur*256+$9F do OutByte(Memory[i]);OutByte(CRSUM);
       for i:=1 to 4 do OutByte($00);OutByte($E6);CRSUM:=0;OutByte($8D);OutByte(CRName);
       for i:=BlockCur*256+$A0 to BlockCur*256+$BF do OutByte(Memory[i]);OutByte(CRSUM);
       for i:=1 to 4 do OutByte($00);OutByte($E6);CRSUM:=0;OutByte($8E);OutByte(CRName);
       for i:=BlockCur*256+$C0 to BlockCur*256+$DF do OutByte(Memory[i]);OutByte(CRSUM);
       for i:=1 to 4 do OutByte($00);OutByte($E6);CRSUM:=0;OutByte($8F);OutByte(CRName);
       for i:=BlockCur*256+$E0 to BlockCur*256+$FF do OutByte(Memory[i]);OutByte(CRSUM);
       end;
    end;
for i:=0 to 1023 do OutByte($00);// продлим файл в конце примерно на 1 сек.
CloseFile(Wav);
//Запись размера файла и данных
AssignFile(Wav2,WavFileName);
Reset(Wav2);
FileMode:=fmOpenReadWrite;
WavSize:=FileSize(Wav2);
seek(Wav2,4);
WordL:=LoWord(WavSize);
WordH:=HiWord(WavSize);
TempL:=Lo(WordL);
TempH:=Hi(WordL);
Write(Wav2,TempL,TempH);
TempL:=Lo(WordH);
TempH:=Hi(WordH);
Write(Wav2,TempL,TempH);
seek(Wav2,24);// Запись Sample Rate
TempL:=Lo(Word(Form1.SpinEdit1.Value));
TempH:=Hi(Word(Form1.SpinEdit1.Value));
Write(Wav2,TempL,TempH);
seek(Wav2,28);// Запись Bytes Per Second
TempL:=Lo(Word(Form1.SpinEdit1.Value));
TempH:=Hi(Word(Form1.SpinEdit1.Value));
Write(Wav2,TempL,TempH);
seek(Wav2,40);
WordL:=LoWord(WavSize-44);
WordH:=HiWord(WavSize-44);
TempL:=Lo(WordL);
TempH:=Hi(WordL);
Write(Wav2,TempL,TempH);
TempL:=Lo(WordH);
TempH:=Hi(WordH);
Write(Wav2,TempL,TempH);
CloseFile(Wav2);
Form1.ProgressBar1.Position:=0;
end;

//Открытие файла и запуск конвертации
procedure TForm1.Button1Click(Sender: TObject);
Var
Rom:File of Byte;
SizeRom,i,StartByte,EndByte:Integer;
Ext:String;
begin
FileNamePos:=0;
if CheckBox2.Checked then Begin // Resample Data
                          Speed2:=Round(Speed*SpinEdit1.Value/22050);
                          Delay:=Round(SpinEdit1.Value/22050+0.1);
                          end
                     else Begin // Resample Header Only
                          Speed2:=Speed;
                          Delay:=1;
                          end;
if OpenDialog1.Execute then
   Begin
   Button1.Enabled:=False;
   CheckBox1.Enabled:=False;
   CheckBox2.Enabled:=False;
   TrackBar1.Enabled:=False;
   SpinEdit1.Enabled:=False;
   Repeat
     OpenFileName:='';
     Repeat
       Inc(FileNamePos);
       if(OpenDialog1.Files.DelimitedText[FileNamePos]<>OpenDialog1.Files.QuoteChar)and
         (OpenDialog1.Files.DelimitedText[FileNamePos]<>OpenDialog1.Files.Delimiter)then
          OpenFileName:=OpenFileName+OpenDialog1.Files.DelimitedText[FileNamePos];
     Until(FileNamePos=Length(OpenDialog1.Files.DelimitedText))or(OpenDialog1.Files.DelimitedText[FileNamePos]=OpenDialog1.Files.Delimiter);
     FillChar(Memory,Sizeof(Memory),0);
     FileName:=ExtractFileName(OpenFileName);
     FileName:=Copy(FileName,1,Length(FileName)-Length(ExtractFileExt(FileName)));
     repeat
       if Length(FileName)<11 then FileName:=FileName+' ';
     until Length(FileName)=11;
     WavFileName:=Copy(OpenFileName,1,Length(OpenFileName)-Length(ExtractFileExt(OpenFileName)))+'.wav';
     if CurDir[Length(CurDir)]<>'\' then WavFileName:=CurDir+'\'+ExtractFileName(WavFileName)
                                    else WavFileName:=CurDir+ExtractFileName(WavFileName);
     AssignFile(Rom,OpenFileName);
     FileMode:=fmOpenRead;
     Reset(Rom);
     SizeRom:=FileSize(Rom);
     Ext:=UpperCase(ExtractFileExt(OpenFileName));
     if(Ext='.R0M')and(SizeRom>$C000)then
        if MessageDlg('The size of a file "'+ExtractFileName(OpenFileName)+'" more than 48 KB, to truncate?',
                                     mtWarning,[mbYes,mbNo],0)=mrYes then SizeRom:=$C000;
     if((Ext='.ROM')or(Ext='.COM'))and(SizeRom>$BF00)then
        if MessageDlg('The size of a file "'+ExtractFileName(OpenFileName)+'" more than 48 KB, to truncate?',
                                     mtWarning,[mbYes,mbNo],0)=mrYes then SizeRom:=$BF00;
     if SizeRom>$FFFF then SizeRom:=$FFFF;
     if SizeRom=0 then Ext:='';
     StartByte:=-1;
     if(Ext='.ROM')or(Ext='.COM')then StartByte:=256; // для *.rom;*.com
     if Ext='.R0M' then StartByte:=0; // для *.r0m
     if(Ext<>'.COM')and(Ext<>'.ROM')and(Ext<>'.R0M')and(Ext<>'')then
        if(Length(Ext)=4)and(Ext[2]='R')and(Ext[3] in ExtF)and(Ext[4] in ExtF)then
          Begin // для *.Rxx
          StartByte:=HexToInt(Copy(Ext,3,2));
          if StartByte<>-1 then StartByte:=StartByte*256;
          end
        else
          Begin // для неизвестных расширений
          Form2.Caption:=ExtractFileName(OpenFileName);
          Form2.ShowModal;
          StartByte:=StartAddress;
          end;
     if StartByte<>-1 then
        Begin
        EndByte:=StartByte;
        for i:=StartByte to SizeRom+StartByte-1 do
            Begin
            Read(Rom,Memory[i]);
            if Memory[i]<>0 then EndByte:=i;
            end;
        if EndByte>$FFFF then EndByte:=$FFFF;
        BlockFirst:=StartByte div 256;
        BlockEnd:=(EndByte div 256)+1;
        Blocks:=BlockEnd-BlockFirst;
        Label1.Caption:='Name: '+FileName;
        Label2.Caption:='First Block: '+IntToHex(BlockFirst,3)+'h';
        Label3.Caption:='End Block: '+IntToHex(BlockEnd,3)+'h';
        Label4.Caption:='Blocks: '+IntToHex(Blocks,3)+'h';
        Refresh;
        end;
     CloseFile(Rom);
     if StartByte<>-1 then OutToWav;
   Until FileNamePos=Length(OpenDialog1.Files.DelimitedText);
   Button1.Enabled:=True;
   CheckBox1.Enabled:=True;
   CheckBox2.Enabled:=not(SpinEdit1.Value=22050);
   TrackBar1.Enabled:=True;
   SpinEdit1.Enabled:=True;
   end;
end;

//Инициализация
procedure TForm1.FormCreate(Sender: TObject);
begin
CurDir:=GetCurrentDir;
OpenDialog1.InitialDir:=CurDir;
Label5.Caption:=Version;
TrackBar1.Position:=14-Speed;
end;

//Изменение скорости
procedure TForm1.TrackBar1Change(Sender: TObject);
begin
Speed:=14-TrackBar1.Position;
end;

//Изменение значения Sample Rate
procedure TForm1.SpinEdit1Change(Sender: TObject);
begin
CheckBox2.Enabled:=not(SpinEdit1.Value=22050);
end;

end.
