usb.pas

delphi usb源代码,但版本比较旧。需要Dos.pas 和,crt.pas

        begin
          { Redirect IRQD = Register 63h  to ISA-BUS IRQ }
          command:=IntNo+ord(not active)*128; { Set interrupt Number to MSB }
          command2:=1 shl intno;
          if command2>255 then
              begin
                dummy:=port[$4d1] and (not (command2 shr 8));
                port[$4d1]:=port[$4d1] and (not (command2 shr 8));
              end else
              begin
                dummy:=port[$4d0] and (not (command2 shr 8));
                port[$4d0]:=port[$4d0] and (not (command2));
              end;
          dummy:=port[$21];
          if writePCIRegisterByte($63,ISABusNumber,ISAFunctionNumber,command) then
            begin
              dummy:=port[$21];
              { Set Interrupt Sensitive Mode }
                okay:=true;
            end;
          if intno>7 then
             begin
               asm
                 in al,0a1h
                 mov cl,byte ptr intno
                 sub cl,8
                 mov dl,1
                 shl dl,cl
                 not dl
                 and al,dl
                 out 0a1h,al
                 in al,021h
                 mov dl,2
                 not dl
                 and al,dl
                 out 021h,al
               end;
             end else
             begin
               asm
                 in al,021h
                 mov cl,byte ptr intno
                 mov dl,1
                 shl dl,cl
                 not dl
                 and al,dl
                 out 021h,al
               end;
             end;

          end;
   asm
     sti
   end;
   USBSetInterruptNumber:=okay;
  end;

function USBDisable:boolean;
var okay:boolean;
begin
  okay:=false;
  if usbdetected and (USBIOspace<>0) then
    if WritePCIRegisterWord($4,USBBusNumber,USBFunctionNumber,0) then
      begin
        okay:=true;
      end;
  USBDisable:=okay;
end;

procedure usbclearframelist;
var i:word;
begin
      for i:=0 to 1023 do
        FrameListPtr^[i]:= 1; { Set Terminate }
end;

function USBAllocateFrameList(Var FList:FrameList;VAR FLBase:FrameListPointer):boolean;
var okay:boolean;
    i:word;
begin
  if memavail>8192 then
    begin
      getmem(FrameListHandle,8192);
      FrameListBase:=longint(seg(FrameListHandle^)) shl 4+longint(ofs(FrameListHandle^));
      { 4K alignment }
      FrameListBase:=longint(FrameListbase + 4096) and $fffff000;
      FrameListPtr:=getbaseptr(FrameListBase);
      FList:=FrameListPtr;
      FLBase:=FrameListBase;
      USBWriteFrameNumberReg(0);
      for i:=0 to 1023 do
        FrameListPtr^[i]:= 1; { Set Terminate }
      asm
        mov dx,USBIOSpace
        add dx,08h
        db 66h; mov ax, word ptr FrameListBase  { mov eax, ... }
        db 66h; out dx,ax                       { out dx,eax  }
      end;
      USBWriteFrameNumberReg(0);
      okay:=true;
    end;
  USBAllocateFrameList:=okay;
end;

procedure InsertTransferDescriptorInFrameList(Number:word;p:pointer);
begin
  FrameListPtr^[Number]:= getPtrBase(p) and $fffffffc;
end;

function GetLinkPointerFromFrameList(number:word):LinkPointer;
begin
  GetLinkPointerFromFrameList:=FrameListPtr^[Number] and $fffffffc;
end;

procedure InsertQueueDescriptorInFrameList(Number:word;p:pointer);
begin
  FrameListPtr^[Number]:= getPtrBase(p) and $fffffffc +2;
end;



procedure USBCommandRun;
var value:word;
begin
  value:=USBReadCommandReg;
  value:=value or 1;
  USBWriteCommandReg(value);
end;

procedure USBCommandStop;
var value:word;
begin
  value:=USBReadCommandReg;
  value:=value and $fe;
  USBWriteCommandReg(value);
end;


function DetectVirtualRealMode:boolean;assembler;
asm
  smsw ax
  and ax,1
end;

function GetPtrBase(p:pointer):longint;
begin
  GetPtrBase:=longint(seg(p^)) shl 4 + longint(ofs(p^));
end;

function GetBasePtr(b:longint):pointer;
var h1,h2:longint;
begin
  h1:=b shr 4;
  h2:=b and $f;
  GetbasePtr:=Ptr(h1,h2);
end;

function AllocateTransferDescriptor:pointer;
var i,j,k:word;
    p1:^transferdescriptor;
    PA:array[1..1000] of pointer;
begin
  p1:=nil;
  getmem(p1,32);
  if ofs(p1^) and $f<>0 then
     begin
        j:=0;
        repeat
          inc(j);
          freemem(p1,32);p1:=NIL;
          getmem(pa[j],1);
          getmem(p1,32);
        until (j=1000) or (ofs(p1^)=0);
        if j=1000 then
          begin
            writeln('Fatal: Allocating TD memory error...');
            halt(3);
          end;
        for k:=1 to j do Freemem(pa[k],1);
    end;
  if p1<>NIL then
  with p1^ do
        begin
          next:=0;
          ActLen:=0;
          Status:=0;
          Flags:=0;
          token:=0;
          BufferPtr:=0;
         end;
  AllocateTransferDescriptor:=p1;
end;

procedure FreeTransferDescriptor(p:pointer);
var td:^TransferDescriptor;
begin
  freemem(p,32);
end;

function GetLinkPointerFromTransferDescriptor(p:pointer):LinkPointer;
begin
  GetLinkPointerFromTransferDescriptor:=getptrbase(p);
end;

function GetTransferDescriptorFromLinkPointer(l:linkpointer):pointer;
begin
  GetTransferDescriptorFromLinkPointer:=getbaseptr(l and $fffffffc) ;
end;

function GetTransferDescriptorFromFrameList(number:word):pointer;
begin
  GetTransferDescriptorFromFrameList:=getbaseptr(FrameListPtr^[Number] and $fffffffc);
end;

procedure AlterTransferDescriptor(p:pointer;Actln:word;State:word;IOC,IOS,LS:Boolean;C_error:byte;SPD:boolean);
var td:^TransferDescriptor;
begin
  td:=p;
  if td<>nil then with td^ do
    begin
      Actlen:=Actln;
      flags:=ord(IOC)+ord(IOS) shl 1 +ord(ls) shl 2+(c_error and 3) shl 3+ord(spd) shl 5;
      Status:=state;
    end;
end;

function CreateTransferDescriptor(Terminate,Queue,Depth:boolean;Link:linkpointer;
                                  Actln:word;State:word;IOC,IOS,LS:Boolean;C_error:byte;SPD:boolean;
                                  PID,DeviceAddress,EndPt:Byte;DataToggle:boolean;MaxLen:word;
                                  BPtr:BufferPointer):pointer; { Allocates and configures TD - Returns pointer to TD or nil }
var td:^TransferDescriptor;
begin
  td:=AllocateTransferDescriptor;
  if td<>nil then with td^ do
    begin
      next:=link and $fffffff0+ord(Terminate)+ord(Queue) shl 1+ord(Depth) shl 2;
      Actlen:=Actln;
      Status:=state;
      flags:=ord(IOC)+ord(IOS) shl 1 +ord(ls) shl 2+(c_error and 3) shl 3+ord(spd) shl 5;
      token:=pid+longint(DeviceAddress) shl 8+longint(EndPt) shl 15+longint(ord(DataToggle)) shl 19+longint(maxlen) shl 21;
      bufferPtr:=Bptr;

    end;
  CreateTransferDescriptor:=td;
end;

{$IFDEF DEBUG}
procedure USBprintLinkPtr(L:LinkPointer);
var h:longint;
    i:word;
begin
      h:=l and $fffffff0;
      write('LinkPtr:  ');
      if h=0 then write('-EMPTY- [');
      write('- [',hexs(h));
      if l and 4=4 then write('] Vf ') else write('] -- ');
      if l and 2=2 then write(' Q ') else write(' - ');
      if l and 1=1 then write(' T ') else write(' - ');
      writeln;
end;

procedure USBprintFrameList;
var i,j:word;
    l:longint;
begin
  write('FrameList---------------[',hexs(FrameListBase),']---------------------------------------');
  for i:=0 to 1023 do
    begin
      if i mod 6=0 then writeln;
      l:=FrameListPtr^[i];
      write('[',hexs(l),']');
      if l and 2=2 then write('Q') else write('-');
      if l and 1=1 then write('T') else write('-');
      write(' ');
    end;
  writeln;
  writeLn('-------------------------------------------------------------------------');
end;

procedure USBprintTD(P:pointer);
var td:^TransferDescriptor;
    i:word;
    h:longint;
    hp:^byte;
begin
  td:=p;
  with td^ do
    begin
      writeLn('Transfer Descriptor-----[',hexs(GetPtrBase(p)),']---------------------------------------');
      USBprintLinkPtr(next);
      write('Control:  ');
      if flags and 32=32 then write(' SP ') else write(' -- ');
      write('C_ERROR: ',chr(48+ord(flags and 16=16)),chr(48+ord(flags and 8=8)));
      if flags and 4=4 then write(' LS ') else write(' -- ');
      if flags and 2=2 then write(' ISO ') else write(' --- ');
      if flags and 1=1 then write(' ICO ') else write(' --- ');
      write(' Status: ',bins8(status));
      writeln(' Len: ',Actlen);
      write('Token:    MaxLen: ',Token shr 21 and $7ff);
      write('  Toggle: ',(Token shr 19) and 1);
      WRite('  EndPt:',hexs8((Token shr 15) and $f));
      WRite('  DevAddr:',hexs8((Token shr 8) and $7f));
      WRite('  PID:',hexs8((Token) and $ff));
      writeln;
      write('BufferPtr:',hexs(bufferptr));
      if bufferptr<>0 then
        begin
          write(' - ');
          hp:=getBasePtr(bufferptr);
          for i:=1 to 8 do
            begin
              write(hexs8(hp^),' ');
              inc(hp);
            end;
        end;
      writeln;


      writeLn('-------------------------------------------------------------------------');
    end;
  end;



{$ENDIF}


var oldmasterintmask:byte;
    oldslaveintmask:byte;
    old_port4d0:byte;
    old_port4d1:byte;
    old_pirqd:byte;

procedure USBDone;
begin
       port[$4d0]:=old_port4d0;
       port[$4d1]:=old_port4d1;
       WritePCIRegisterByte($63,ISABusNumber,ISAFunctionNumber,old_pirqd);
    asm
      mov al,oldslaveintmask
      out 0a1h,al
      mov al,oldmasterintmask
      out 021h,al
    end;
end;

begin
  USBdetected:=false;
  if detectPCIbios then
    begin
       USBdetected:=USBdetect(USBDeviceId,USBVendorId,USBBusNumber,USBFunctionNumber,USBdescription);
       ISAdetected:=ISAdetect(ISADeviceId,ISAVendorId,ISABusNumber,ISAFunctionNumber,ISAdescription);
       old_port4d0:=port[$4d0];
       old_port4d1:=port[$4d1];
       readPCIRegisterByte($63,ISABusNumber,ISAFunctionNumber,old_pirqd);
       asm
        in al,0a1h
        mov oldslaveIntMask,al
        in al,021h
        mov oldmasterIntMask,al
       end;
    end;
end.