Program MusicGrab;
{$G+,D+}
{$M 65520, 0, 0}
Uses DOS, CRT;
{C:\D_TEMPOS\GELDVIRS\MUSIS\BEER.COM}
const
  flag : Word = $A000;
  cntnota : Word = 0;
var
  PathPrg : String;
  OldInt08h : Pointer;
  OldInt1Ch : Pointer;
  Mdata : array[0..64501] of Byte;
  Mdw   : array[0..64501 div 2] of Word absolute Mdata;
  i : Word;
Procedure SetInt08hHandler; Assembler;
asm
 push   es

 mov    ax, 3508h
 int    21h

 mov    word ptr OldInt08h, bx
 mov    word ptr OldInt08h+2, es

 mov    word ptr @OI08h, bx
 mov    word ptr @OI08h+2, es

 pop    es

 mov    ax, 2508h

 push   ds

 mov    dx, seg @int08h
 mov    ds, dx
 mov    dx, offset @int08h
 int    21h

 pop    ds

 ret

@int08h:
 pushf
 push   ds
 push   es
 push   ax
 push   bx
 push   cx
 push   dx

 mov    ax, Seg cntnota
 mov    es, ax
 mov    ax, 0B800h
 mov    ds, ax

 xor    bx, bx

 in     al, 42h
 call   @conview

 in     al, 42h
 call   @conview
 inc    bx
 inc    bx

 in     al, 61h
 call   @conview
 inc    bx
 inc    bx

 in     al, 61h
 and    al, 3
 cmp    byte ptr cs:@sndon, al
 je     @checkfrq
 mov    byte ptr cs:@sndon, al
 test   al, al
 jnz    @checkfrq
 xor    ax, ax
 mov    word ptr cs:@prevnota, ax
 jmp    @setdata

@checkfrq:
 in     al, 42h
 shl    al, 8
 in     al, 42h
 cmp    word ptr cs:@prevnota, ax
 je    @nxt

@setdata:
 push   bx

 inc    word ptr es:cntnota
 mov    word ptr cs:@prevnota, ax
 mov    bx, word ptr cs:@moffs
 mov    word ptr es:Mdata[bx], ax
 inc    bx
 inc    bx
 mov    ax, word ptr cs:@ling
 mov    word ptr es:Mdata[bx], ax
 inc    bx
 inc    bx

 mov    word ptr cs:@moffs, bx
 mov    word ptr cs:@ling, 0

 pop    bx
@nxt:
 inc    word ptr cs:@ling
 mov    al, byte ptr es:cntnota+1
 call   @conview
 mov    al, byte ptr es:cntnota
 call   @conview

 pop    dx
 pop    cx
 pop    bx
 pop    ax
 pop    es
 pop    ds
 popf
       db 02Eh, 0EAh {cs:jmp 00000000}
@OI08h :
 dd     0

@prevnota:
 dw       0
@ling:
 dw       0
@moffs:
 dw       0
@sndon:
 db       0
 nop
{ iret}
@conview:
       xor    ah, ah
       shl    ax, 4
       shr    al, 4
       cmp    al, 10
       sbb    al, 69h
       das
       xchg   al, ah
       cmp    al, 10
       sbb    al, 69h
       das

       mov    [bx], al
       inc    bx
       inc    bx
       mov    [bx], ah
       inc    bx
       inc    bx
       ret
end;
Procedure Snd; Assembler;
asm
 push   es

 mov    ax, 351Ch
 int    21h

 mov    word ptr OldInt1Ch, bx
 mov    word ptr OldInt1Ch+2, es

 mov    word ptr @OI1Ch, bx
 mov    word ptr @OI1Ch+2, es

 pop    es

 mov    ax, 251Ch

 push   ds

 mov    dx, seg @int1Ch
 mov    ds, dx
 mov    dx, offset @int1Ch
 int    21h

 pop    ds

 ret

@int1Ch:
 pushf
 push   ds
 push   es
 push   ax
 push   bx
 push   cx
 push   dx

 mov    bx, word ptr cs:@pos
 mov    ax, word ptr Mdata[bx]
 inc    bx
 inc    bx
 dec    word ptr Mdata[bx]
 jnz    @nxt

@nxt:
 pop    dx
 pop    cx
 pop    bx
 pop    ax
 pop    es
 pop    ds
 popf
       db 02Eh, 0EAh {cs:jmp 00000000}
@OI1Ch :
 dd     0
@pos:
 dw  0
 nop
@pl_snd:
	in	al, 61h         {подать ток на динамик - бит 3}
	test	al, 3
	jnz	@makesound
	or	al, 3
	out	61h, al
	mov	al, 0B6h
	out	43h, al
@makesound:                     {делитель частоты}
	mov	al, bl
	out	42h, al
	mov	al, bh
	out	42h, al
@exitsound:
        ret
@nosound1:
	in	al, 61h
	and	al, 0FCh
	out	61h, al
	ret
end;
{
	ret
@getsound:
{        in      al, 43h
        and     al, 11001111b
        out     43h, al}

{	in	ax, 42h
	mov	bx, ax}
{	in	al, 42h
	mov	bl, al
	in	al, 42h
	mov	bh, al}
Procedure RestoreInt08h; Assembler;
asm
  push  ds
  lds   dx, OldInt08h
  mov   ax, 2508h
  int   21h
  pop   ds
end;
Procedure RestoreInt1Ch; Assembler;
asm
  push  ds
  lds   dx, OldInt1Ch
  mov   ax, 251Ch
  int   21h
  pop   ds
end;
Function XchgW(w : Word) : Word; Assembler;
asm
  mov   ax, word ptr w
  xchg  ah, al
end;
begin
  asm
    mov ax, 3
    int 10h
  end;
  PathPrg := ParamStr(1);
  SetInt08hHandler;
  if ParamCount<>0 then
    Exec(PathPrg, ' ') else WriteLn('Введите параметр - имя исполняемого файла!');
  RestoreInt08h;
  for i := 0 to cntnota do Mdw[2*i] := XchgW(Mdw[2*i]);
  for i := 0 to cntnota do
   WriteLn('Частота: ', Mdw[2*i], ' Длительность: ', Mdw[2*i+1]);
  WriteLn('Количество нот: ', cntnota);
  Snd;
  ReadKey;
  RestoreInt1Ch;
  NoSound;
  ReadKey;
end.

Назад