l.pas

DOS下直接对声卡IO口操作录放音的方法和实例

program spk_w2v_16a;
  uses dos;
  TYPE
    BUFFTYPE= ARRAY [0..64] OF BYTE;
    bufsp =  array[0..8000] of ^bufftype;

  VAR
    newerr         : byte;
    savesi         : word;
    l1,l2          : longint;
    p1             : bufsp;
    f1,f2          : file;
    kkk,kk5,sbk    : word;           { 打印口 地址}
    zdnc           : word;           { 最大内存}
    xzwz           : word;
    fyks,fycd      : word;
    wjqs           : longint;
    w1,w2,w3,w4,a2 : word;
    b1,b2,b3,b4,k1 : byte;
    s              : string;
    k              : array [0..15] of word;
    buff           : array [0..6000] of byte;

    const
    lcd            : longint=5616;
    fcd            : longint=3856;

FUNCTION KEYPRESSED:BOOLEAN;assembler;
    asm
         mov ah,1;
         int $16;
         mov al,true;
         jnz @1;
         mov al,false;
      @1:;
    end;
{------------------------------------------------------------------}
PROCEDURE NOKEY;assembler;
    ASM
      @2: mov   ah,1;
          int   $16;
          jz    @1;
          mov   ah,0;
          int   $16;
          jmp   @2;
      @1: ;
    end;
{------------------------------------------------------------------}
 procedure fy;assembler;
    asm

       push es
       mov cx,fycd
       mov bx,fyks

       mov dx,kkk
       add dx,3
       mov al,$80
       out dx,al
       sub dx,3
       mov al,2
       out dx,al
       inc dx
       mov al,0
       out dx,al
       inc dx
       inc dx
       mov al,0
       out dx,al
       mov al,0
       dec dx
       dec dx
       out dx,al
       nop
       nop

    @3:
       push bx
       shl bx,1
       shl bx,1
       les di, dword ptr p1[bx]
       mov dx,kkk
       add dx,5
       push cx
       mov cx,64
       xor bh,bh
       cli
    @1:
       in al,dx
       test al,$20
       jz @1
       push  dx
       mov dx,sbk
     @1234:
       in al,dx
       test al,$80
       jnz @1234
       mov al,$20
       out dx,al
     @1235:
       in al,dx
       test al,$80
       jnz @1235
       sub  dx,2
       in   al,dx
       mov  ah,al
       pop dx
       mov dx,kkk
       out dx,al
       add dx,5
    @2:
       in al,dx
       test al,$20
       jz @2
       push  dx
       mov dx,sbk
     @2234:
       in al,dx
       test al,$80
       jnz @2234
       mov al,$20
       out dx,al
     @2235:
       in al,dx
       test al,$80
       jnz @2235
       sub  dx,2
       in   al,dx
       shr  al,1
       shr  al,1
       shr  al,1
       shr  al,1
       and  al,$0f
       and  ah,$f0
       or   al,ah
       stosb
       pop dx
       mov dx,kkk
       out dx,al
       add dx,5

       loop @1
       sti
       pop  cx
       pop  bx

       inc  bx
       mov  ah,1
       int  $16
       jnz @4
       loop @3
    @4:
       mov fyks,bx
       mov fycd,cx
       pop es
    end;

  var ka1:shortint;canspk:byte;

procedure test_sbk;
    var w1:word;ap:byte;
    begin
      sbk:=k[k[15]]+$21c;
      inc(k[15]);
      port[sbk-6]:=1;
      for w1:=0 to 65535 do;
      for w1:=0 to 65535 do;
      port[sbk-6]:=0;
      w1:=0;
      while (w1<100) and (port[sbk-2]<>$aa) do inc(w1);
      if w1>99 then begin
        if k[15]>6 then begin
          writeln(': No SoundBlaster find!'#7);
          halt(1);end else test_sbk;
      end else begin
        ap:=$ff;
        while ap>$80 do ap:=port[sbk];
        port[sbk]:=$d1;
      end;
    end;


  BEGIN
    kkk:=memw[$40:0];
    for k[15]:=0 to 14 do begin  k[k[15]]:=(k[15]*$10);end;
    k[15]:=0;
    test_sbk;

    writeln('Copyright WuSHuGeng, 173# PingYang Road.TaiYuan, BP:0351-126-1103575');
    if (paramcount>=1) then begin
      s:=paramstr(1);  b4:=pos('.',s);
      if b4=0 then s:=s+'.exe' else
        s:=copy(s,1,b4)+'exe';
      assign(f1,s); assign(f2,paramstr(0)); end
      else begin writeln('No filename for record !'#7);
      halt(1); end;

    {$I-}
    reset(f2,1);
    if ioresult<>0 then halt(1);

    rewrite(f1,1);
    if ioresult<>0 then begin writeln('recording FILE Can''t open!');halt(1);end;
    {$I+}

    zdnc:=0; w1:=word(longint(heapend) div 65536)-4;
    while (zdnc<8000) and (word(longint(heapptr) div 65536)<w1) do begin
      new(p1[zdnc]);
      inc(zdnc);
    end;
    {$I-}
    seek(f2,lcd);
    blockread(f2,buff[0],fcd,w1);
    if (ioresult<>0) or (w1<>fcd) then begin writeln('SOUNDEXE.EXE was bad!');halt(1);end;
    {$I+}
    blockwrite(f1,buff[0],fcd);
    close(f2);

    write('Press any Key BEGIN Record into ',s,' ...'#13);
    while not keypressed do;
    for b4:=1 to 255 do;
    nokey;
    writeln('Recording ',s,', Press any Key EXIT ...');

     fyks:=0; fycd:=zdnc; fy;

     for  w1:=0 to fyks-1 do begin
      blockwrite(f1,p1[w1]^[0],64);
      if ioresult<>0 then begin writeln('FILE write error!');halt(1);end;
     end;
     close(f1);
  end.