f.pas

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

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

  VAR
    savesi         : word;
    l1,l2          : longint;
    p1             : bufsp;
    f1             : 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;
    k              : array [0..15] of word;


 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 si, 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
       seges lodsb
       mov   ah,al
       push  dx
       mov dx,sbk
     @1234:
       in al,dx
       test al,$80
       jnz @1234
       mov al,$10
       out dx,al
     @1235:
       in al,dx
       test al,$80
       jnz @1235
       mov al,ah
       and al,$f0
       out dx,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,$10
       out dx,al
     @2235:
       in al,dx
       test al,$80
       jnz @2235
       mov al,ah
       shl al,1
       shl al,1
       shl al,1
       shl al,1
       and al,$f0
       out dx,al
       pop dx
       mov dx,kkk
       out dx,al
       add dx,5
       loop @1
       sti
       pop  cx
       pop  bx

       inc  bx
       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
          halt(4);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;

    assign(f1,paramstr(0));wjqs:=3496;

    {$I-}
    reset(f1,1);
    if ioresult<>0 then halt(1);
    l1:=filesize(f1);
    {$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;

    w1:=(l1-wjqs) div 64;
    if w1<zdnc then zdnc:=w1+1;
    {每块 64 zdnc=准备分配块数}

    {$I-}
    seek(f1,wjqs);
    if ioresult<>0 then halt(2);
    {$I+}

    while not eof(f1) do begin
     fyks:=0; w1:=0;
     while w1< zdnc-1 do begin
      blockread(f1,p1[w1]^[0],64,w2);
      if ioresult<>0 then halt(3);
      if w2<>64 then zdnc:=w1-1;
      inc(w1);
     end;
       fycd:=zdnc; fy; fyks:=0;
     end;
     close(f1);
  end.