//Written by Alexander Alexandrow aka BYTEMAN
//mailto: sash-a@nm.ru



unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    ProgressBar1: TProgressBar;
    OpenDialog1: TOpenDialog;
    Edit1: TEdit;
    CheckBox1: TCheckBox;
    Button2: TButton;
    TrackBar1: TTrackBar;
    StatusBar1: TStatusBar;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label6: TLabel;
    XPManifest1: TXPManifest;
    Label5: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
    procedure Prepare;


  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  stream,inputstream:TFileStream;
  checksum,datalength:longint;
  load:ansistring;
  i:longint;
  n:byte;
  t1,t2:char;
  name1:ansistring;
const
  chunk1=#$52#$49#$46#$46#$0#$0#$0#$0'WAVEfmt '#$10#$0#$0#$0#$1#$0#$1#$0+
  #$22#$56#$0#$0#$22#$56#$0#$0#$1#$0#$8#$0#$64#$61#$74#$61#$0#$0#$0#$0;
  bit1=#$11#$5f#$bf#$d8#$f2#$d5#$5a#$2a#$1b#$11#$5f#$bf#$d8#$f2#$d5#$5a#$2a#$1b;
  bit0=#$63#$b8#$d3#$e4#$ea#$ef#$ec#$ef#$d8#$6c#$2a#$19#$0f#$0f#$10#$11#$26;
  pilot=#$a8#$a8#$a8#$a8#$a8#$a8#$a8#$a8#$a8#$a8#$a8#$a8#$a8#$a8#$a8#$a8+
  #$a8#$a8#$a8#$a8#$a8#$a8#$a8#$a8#$a8#$a8#$a8#$a8#$a8#$a8#$a8#$a8+
  #$a8#$a8#$a8#$a8#$a8#$a8#$a8#$a8#$a8#$a8#$a8#$a8#$a8#$a8#$a8#$a8+
  #$a8#$a8#$a8#$a8#$a8#$a8#$a8#$a8#$a8#$a8#$a8#$a8#$a8#$a8#$a8#$a8+
  #$a8#$9c#$51#$25#$1b#$12#$10#$0f#$0d#$0d#$0d#$0d#$0f#$0f#$0f#$0f+
  #$0f#$0f#$0f#$0f#$0f#$10#$10#$10#$10#$10#$10#$10#$12#$12#$12#$12+
  #$12#$12#$12#$12#$12#$13#$13#$13#$13#$13#$13#$13#$13#$13#$15#$15+
  #$15#$15#$15#$15#$15#$15#$16#$16#$16#$16#$16#$16#$16#$16#$18#$18+
  #$18#$18#$18#$18#$18#$18#$19#$19#$19#$19#$19#$19#$19#$19#$1b#$1b+
  #$1b#$1b#$1b#$1b#$1b#$1b#$1b#$1c#$1c#$1c#$1c#$1c#$1c#$1c#$1c#$1e+
  #$1e#$1e#$1e#$1e#$1e#$1e#$1e#$1e#$1f#$1f#$1f#$1f#$1f#$1f#$1f#$1f+
  #$1f#$21#$21#$21#$21#$21#$21#$21#$21#$21#$22#$22#$22#$22#$22#$22+
  #$22#$22#$22#$24#$24#$24#$24#$24#$24#$24#$24#$24#$25#$25#$25#$25+
  #$25#$25#$25#$25#$27#$27#$27#$27#$27#$27#$27#$27#$27#$28#$28#$28+
  #$28#$28#$28#$28#$28#$28#$28#$2a#$2a#$2a#$2a#$2a#$2a#$2a#$2b#$49+
  #$a2#$b9#$c2#$c5#$c5#$c6#$c6#$c6#$c6#$c6#$c6#$c6#$c6#$c6#$c6#$c6+
  #$c6#$c6#$c6#$c6#$c6#$c6#$c6#$c5#$c5#$c5#$c5#$c5#$c5#$c5#$c5#$c5+
  #$c5#$c5#$c5#$c5#$c5#$c5#$c5#$c5#$c5#$c5#$c5#$c5#$c5#$c5#$c5#$c5+
  #$c5#$c5#$c5#$c5#$c5#$c5#$c5#$c5#$c5#$c5#$c5#$c5#$c5#$c5#$c5#$c5+
  #$c5#$c5#$c5#$c5#$c5#$c5#$c5#$c5#$c5#$c5#$c5#$c5#$c5#$c5#$c5#$c5+
  #$c5#$c3#$c5#$c3#$c5#$c5#$c3#$c3#$c3#$c3#$c3#$c3#$c3#$c3#$c3#$c3+
  #$c3#$c3#$c3#$c3#$c3#$c3#$c3#$c3#$c3#$c3#$c3#$c3#$c3#$c3#$c3#$c3+
  #$c3#$c3#$c3#$c3#$c3#$c3#$c3#$c3#$c3#$c3#$c3#$c3#$c3#$c3#$c3#$c3+
  #$c3#$c3#$c3#$c3#$c3#$c3#$c3#$c3#$c3#$c3#$c3#$c3#$c3#$c3#$c3#$c3+
  #$c3#$c3#$c3#$c3#$c3#$c3#$c3#$c3#$c3#$c3#$c2#$c2#$c2#$c2#$c2#$c2+
  #$c2#$c2#$c2#$c2#$c2#$c2#$c2#$c2#$c2#$c2#$c2#$c2#$bf#$89#$46#$39+
  #$2d#$2a#$28#$28#$28#$28#$28#$28#$28#$28#$28#$28#$28#$28#$28#$28+
  #$2a#$2a#$2a#$2a#$2a#$2a#$2a#$2a#$2b#$2b#$2b#$2b#$2b#$2b#$2b#$2b+
  #$2b#$2d#$2d#$2d#$2d#$2d#$2d#$2d#$2d#$2d#$2e#$2e#$2e#$2e#$2e#$2e+
  #$2e#$2e#$2e#$2e#$30#$30#$30#$30#$30#$30#$30#$30#$30#$31#$31#$31+
  #$31#$31#$31#$31#$31#$31#$31#$33#$33#$33#$33#$33#$33#$33#$33#$33+
  #$34#$34#$34#$34#$34#$34#$34#$34#$34#$34#$36#$36#$36#$36#$36#$36+
  #$36#$36#$36#$36#$37#$37#$37#$37#$37#$37#$37#$37#$37#$37#$39#$39+
  #$39#$39#$39#$39#$39#$39#$39#$39#$39#$39#$3a#$3a#$3a#$3a#$3a#$3a+
  #$3a#$3a#$3a#$3c#$3c#$3c#$3c#$3c#$3c#$3c#$3c#$3c#$3c#$3d#$3d#$3d+
  #$3d#$3d#$3d#$3d#$3d#$3d#$3d#$3f#$3f#$3f#$3f#$3f#$3f#$3f#$3f#$3f+
  #$3f#$40#$40#$40#$40#$40#$40#$40#$40#$40#$4c#$9c#$ce#$d4#$db#$db+
  #$dd#$dd#$dd#$dd#$dd#$dd#$dd#$dd#$dd#$db#$db#$db#$db#$db#$db#$db+
  #$db#$db#$db#$db#$db#$db#$db#$db#$db#$db#$db#$db#$db#$db#$db#$db+
  #$db#$db#$db#$db#$db#$db#$db#$db#$db#$da#$da#$da#$da#$da#$da#$da+
  #$da#$da#$da#$da#$da#$da#$da#$da#$da#$da#$da#$da#$da#$da#$da#$da+
  #$da#$da#$da#$da#$da#$da#$da#$da#$d8#$d8#$d8#$d8#$d8#$d8#$d8#$d8+
  #$d8#$d8#$d8#$d8#$d8#$d8#$d8#$d8#$d8#$d8#$d8#$d8#$d8#$d8#$d8#$d8+
  #$d8#$d8#$d8#$d8#$d8#$d8#$d8#$d8#$d8#$d8#$d8#$d8#$d8#$d8#$d8#$d7+
  #$d7#$d8#$d7#$d7#$d7#$d8#$d7#$d7#$d7#$d7#$d7#$d7#$d7#$d7#$d7#$d7+
  #$d7#$d7#$d7#$d7#$d7#$d7#$d7#$d7#$d7#$d7#$d7#$d7#$d7#$d7#$d7#$d7+
  #$d5#$d5#$d5#$d5#$d5#$d5#$d5#$d5#$d5#$d5#$d5#$d5#$d5#$d5#$d5#$d5+
  #$d5#$d5#$d5#$d5#$d5#$d5#$d5#$d5;

loader=#$a0#$00#$21#$01#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00+
#$ac#$00#$e0#$00#$00#$00#$00#$00#$8c#$00#$e0#$00#$a0#$00#$e0#$00+
#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00+
#$38#$00#$e0#$00#$00#$00#$00#$00#$df#$0b#$72#$ff#$02#$00#$00#$00+
#$44#$00#$80#$00#$02#$00#$c6#$15#$00#$02#$c0#$15#$0c#$01#$04#$00+
#$c0#$15#$ff#$ff#$01#$7e#$c0#$15#$ba#$00#$00#$88#$f7#$8b#$5e#$00+
#$0c#$03#$d7#$ad#$58#$00#$ff#$00#$03#$02#$c1#$15#$01#$01#$02#$01+
#$c1#$15#$f5#$00#$00#$89#$00#$00#$fe#$01#$c6#$17#$22#$00#$df#$55+
#$40#$00#$70#$ff#$17#$8d#$00#$00#$c7#$17#$20#$00#$c1#$15#$05#$00+
#$02#$01#$1f#$94#$be#$fd#$df#$8b#$bc#$fd#$fd#$80#$46#$7e#$02#$00+
#$c0#$15#$ec#$00#$04#$00#$40#$10#$04#$00#$02#$00#$df#$8b#$74#$ff+
#$fd#$80#$1f#$94#$76#$ff#$fa#$02#$02#$00#$be#$00#$ff#$ff#$00#$08+
#$09#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00+
#$00#$00#$00#$02#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00+
#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$3f#$54#$41#$50+
#$45#$2d#$55#$2d#$00#$49#$2f#$4f#$20#$65#$72#$72#$6f#$72#$0d#$0a+
#$00#$42#$72#$65#$61#$6b#$2e#$2e#$2e#$0d#$0a#$00#$4c#$6f#$61#$64+
#$69#$6e#$67#$20#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00+
#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00+
#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00+
#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00+
#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00+
#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00+
#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00+
#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00+
#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00+
#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00+
#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00+
#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00+
#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00+
#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00+
#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00#$00;


implementation

{$R *.dfm}

procedure PauseWrite(n:longint);                //Запись паузы
var i:longint;
wr:byte;
begin
  wr:=$7f;
  for i:=1 to n do stream.Write(wr,sizeof(wr));
end;

procedure ByteWrite(n:byte);                    //Запись байта
  var k,l:longint;
begin
  stream.Write(bit0,length(bit0));
  for k:=1 to 8 do begin                        //Побитово раскладываем
    l:=n mod 2;
    n:=n div 2;
    if l = 0 then stream.Write(bit0,length(bit0)) else
      stream.Write(bit1,length(bit1));
      end;
    stream.Write(bit1,length(bit1));
    stream.Write(bit1,length(bit1));
  end;

procedure WordWrite (n:longint);                //Запись слова
  var low,high:byte;
begin
  high:=n div 256;
  low:= n - n * 256;
  ByteWrite(low);
  ByteWrite(high);
end;

procedure DefWaveFormat;                        //Пишем заголовок WAV
var
  length1,length2,samplerate:dword;
begin
  stream.Position:=4;
  length1:=stream.size-8;
  length2:=stream.Size-44;
  stream.Write(length1,sizeof(length1));
  stream.Position:=40;
  stream.Write(length2,sizeof(length2));
  if Form1.Checkbox1.Checked then begin
    samplerate:=round(22050+Form1.TrackBar1.Position*0.2*22050);
    stream.Position:=24;
    stream.Write(samplerate,sizeof(samplerate));
    stream.Position:=28;
    stream.Write(samplerate,sizeof(samplerate));
  end else begin
    samplerate:=22050;
    stream.Position:=24;
    stream.Write(samplerate,sizeof(samplerate));
    stream.Position:=28;
    stream.Write(samplerate,sizeof(samplerate));
  end;
  stream.Free;
  inputstream.Free;
  end;



procedure TForm1.Button1Click(Sender: TObject); //Открываем файл


begin
  ProgressBar1.Position:=0;
  if not opendialog1.Execute then begin
    StatusBar1.SimpleText:='File not found!!!';
    exit;
  end;
   StatusBar1.SimpleText:='Opened '+ExtractFileName(opendialog1.FileName)+' file successfully!';
   Edit1.Text:=ChangeFileExt(ExtractFileName(opendialog1.FileName),'');
   Button2.Enabled:=true;
  end;
procedure TForm1.prepare;                      //Подготавливаем загрузчик...
var
  i:longint;
  n:byte;
  t1,t2:char;
begin
  name1:='';
  Button2.Enabled:=true;


  stream.Write(chunk1,length(chunk1));         //Пишем заголовок WAV-файла

  stream.Write(pilot, length(pilot));          //Пишем заготовку для пилот-тона

  checksum:=0;                                 //Обнеляем КС
  load:=loader;
  Edit1.Text:=ChangeFileExt(ExtractFileName(opendialog1.FileName),'');

  //Colors from HERE:
  //http://kisly-alexey.newmail.ru/UKNC/TAPE/


  //YELLOW color
  inputstream.Position:=32;                    //Записываем адреса в загрузчик
  inputstream.Read(t1,sizeof(t1));
  load[33]:=t1;

  inputstream.Read(t1,sizeof(t1));
  load[34]:=t1;

  inputstream.Read(t1,sizeof(t1));
  load[35]:=t1;

  inputstream.Read(t1,sizeof(t1));
  load[36]:=t1;

  inputstream.Position:=41;
  inputstream.Read(t1,sizeof(t1));
  load[42]:=t1;

  inputstream.Read(t1,sizeof(t1));
  load[43]:=t1;

  inputstream.Position:=320;
  for i:=321 to 512 do begin
  inputstream.read(t1,sizeof(t1));
  load[i]:=t1;

  end;

  //GREEN color
  inputstream.Position:=276;
  for i:=1 to 6 do if edit1.Text[i] <> '' then load[276+i]:=Edit1.Text[i] else break;
  load[283-7+i]:=#13;
  load[284-7+i]:=#10;
  load[285-7+i]:=#0;

  //BLUE color
  for i:=1 to 6 do if Edit1.Text[i] <> #0 then name1:=name1+Edit1.Text[i] else break;
  while length(name1) <> 16 do name1:=name1+#32;
  for i:=1 to 16 do load[194+i]:=name1[i];

  //RED color
  inputstream.Position:=40;
  inputstream.Read(t1,sizeof(t1));
  inputstream.Read(t2,sizeof(t2));
  datalength:=((ord(t1)+ord(t2)*256)-510) div 2;
  load[214]:=chr(datalength div 256);
  load[213]:= chr(datalength - ((datalength div 256) * 256));

end;

procedure TForm1.Button2Click(Sender: TObject); //CONVERT!!!

begin
    stream:=TFileStream.create(ExtractFilePath(opendialog1.FileName)+ExtractFileName(opendialog1.FileName)+
    '.wav',fmCreate);
    inputstream:=TFileStream.Create(opendialog1.filename,fmOpenRead);
    prepare;                                    //Подготовительный этап...
    if Edit1.Text='' then begin
    ShowMessage('You MUST define name!!!');
    exit;
   end;
  for i:=1 to 8000 do stream.Write(bit1,length(bit1));

  for i:=1 to 16 do ByteWrite(0);
  WordWrite(256);
  WordWrite(0);
  for i:=1 to 2000 do stream.Write(bit1,length(bit1));

  for i:=1 to 256 do begin
  ByteWrite(ord(load[i*2-1]));             //Пишем loader...
  ByteWrite(ord(load[i*2]));
  checksum:=checksum+ord(load[i*2-1])+ord(load[i*2])*256;
  checksum:=checksum-checksum div 65536 * 65536 + checksum div 65536;
  end;
  WordWrite(checksum);                     //Пишем КС

  PauseWrite(11000);
  stream.Write(pilot, length(pilot));      //Пишем даные...
  for i:=1 to 8000 do stream.Write(bit1,length(bit1));

  for i:=1 to 16 do ByteWrite(ord(name1[i]));
  WordWrite(datalength);
  WordWrite(512);
  for i:=1 to 2000 do stream.Write(bit1,length(bit1));
  inputstream.Position:=512;
  CheckSum:=0;
  for i:=1 to datalength  do begin
  progressbar1.Position:=i div (datalength div 100);
  inputstream.Read(n,sizeof(n));
  ByteWrite(n);
  checksum:=checksum+ord(n);
  inputstream.Read(n,sizeof(n));
  ByteWrite(n);
  checksum:=checksum+(ord(n)*256);
  checksum:=checksum-checksum div 65536 * 65536 + checksum div 65536;
  end;
  WordWrite(Checksum);

  {for i:=1 to inputstream.Size do begin
    progressbar1.Position:=i div (inputstream.size div 100);
    inputstream.read(n,sizeof(n));
    ByteWrite(n);
    form1.Repaint;
  end;}

  DefWaveFormat;                       //Формируем длину в заголовке WAV-файла
  StatusBar1.SimpleText:=ExtractFileName(opendialog1.FileName)+' successfully '+
    'converted to '+ChangeFileExt(ExtractFileName(opendialog1.FileName),'.wav');
end;                                   //ГОТОВО!!!





procedure TForm1.FormCreate(Sender: TObject);
begin
StatusBar1.SimpleText:='Ready!';
end;

procedure TForm1.CheckBox1Click(Sender: TObject);
begin
  if Checkbox1.Checked then TrackBar1.Enabled:=true else
    TrackBar1.Enabled:=false;
end;



end.