usbio.pas

6个用VB和DELPHI编写的FOR USB驱动程序

// *****************************************************
// Descriptor Page
// *****************************************************

// get string descriptor from device
procedure TMainDlg.GetStringDescClick(Sender: TObject);
type
  PByte = ^byte;
var
  ps: PSAFEARRAY;
  sp: tagSAFEARRAYBOUND;
  pb: PByte;
  p: pointer;
  s: string;
  z,size,index: integer;

begin
  size:=256;
  index:=strtoint(StringIndex.text);
  // create SAFEARRAY
  ps:=SafeArrayCreateVector(VT_UI1,0,256);
  // call USBIO
  USBIOInterface.GetStringDescriptor(ps,size,index,0,status);
  ShowError(status);
  if status = USBIO_ERR_SUCCESS then
  begin
    // format UNICODE string descriptor
    MainDlg.StringDesc.Text:='';
    SafeArrayAccessData(ps,p);
    sp:=ps^.rgsabound[0];
    pb:=p;
    // skip the first two entries: length and type
    inc(pb);
    inc(pb);
    if index = 0 then
    begin
      // this is the language ID
      s := 'LanguageID: ';
      inc(pb);
      if (pb^ < 10 ) then s:= s+'0';
      s := s + inttostr(pb^);
      dec(pb);
      if (pb^ < 10 ) then s:= s+'0';
      s := s + inttostr(pb^);
    end
    else
    begin
      // this is an unicode string
      for z:=1 to (sp.cElements div 2) do
      begin
        s := s + chr(pb^);
        inc(pb);
        inc(pb);
      end;
    end;
    MainDlg.StringDesc.Text := s;
  end;
  SafeArrayUnAccessData(ps);
  // we have to free the buffer
  SafeArrayDestroy(ps);
end; // GetStringDescClick


procedure TMainDlg.GetDescClick(Sender: TObject);
var
  data: PSAFEARRAY;
  by:byte;
  i,s,size : integer;
  OutputString: string;
begin
  // number of bytes to read from the descriptor
  s:=strtoint(descsize.text);
  // create SafeArray
  data:=SafeArrayCreateVector(VT_UI1,0,s);
  // call USBIO
  USBIOInterface.GetDescriptor(data,s,0,strtoint(desctype.text),strtoint(descindex.text),0,status);
  MainDlg.ShowError(status);
  if status = USBIO_ERR_SUCCESS then
  begin
    output.outputmemo.Lines.Append('Descriptor , type '+ (desctype.text) + ', index '+ (descindex.text));
    if s>0 then
    begin
      size:=0;
      for i:=0 to s-1 do
      begin
        // print data in readable form
        SafeArrayGetElement(data,i,by);
        if size> i then
          OutputString := OutputString + inttohex(by,2)+' '
        else
        begin
          size:= size + by;
          if i<>0 then output.outputmemo.Lines.Append(OutputString);
          OutputString := inttohex(by,2)+' ';
        end;
      end;
      output.outputmemo.Lines.Append(OutputString);
    end;
  end;
  // destroy SafeArray
  SafeArrayDestroy(data);
end; // GetDescClick


// get devicedescriptor
procedure TMainDlg.getdevicedescriptorClick(Sender: TObject);
var
  data: PSAFEARRAY;
  by: byte;
  i,s,size: integer;
  OutputString: string;
begin
  // number of bytes to read from the descriptor
  s:=4096;
  // create SafeArray
  data:=SafeArrayCreateVector(VT_UI1,0,4096);
  // call USBIO
  USBIOInterface.GetDeviceDescriptor(data,s,status);
  MainDlg.ShowError(status);
  if status = USBIO_ERR_SUCCESS then
  begin
    output.outputmemo.Lines.Append('');
    output.outputmemo.Lines.Append('Device Descriptor');
    output.outputmemo.Lines.Append('');
    if s>0 then
    begin
      size:=0;
      for i:=0 to s-1 do
      begin
        // print data in readable form
        SafeArrayGetElement(data,i,by);
        if size> i then
          OutputString := OutputString + inttohex(by,2)+' '
        else
        begin
          size:= size + by;
          if i<>0 then output.outputmemo.Lines.Append(OutputString);
          OutputString := inttohex(by,2)+' ';
        end;
      end;
      output.outputmemo.Lines.Append(OutputString);
    end;
  end;
  // destroy SafeArray
  SafeArrayDestroy(data);
end;


// output window control
procedure TMainDlg.showwindowClick(Sender: TObject);
begin
  output.Show;
end;

procedure TMainDlg.hidewindowClick(Sender: TObject);
begin
  output.Hide;
end;

procedure TMainDlg.clearoutputClick(Sender: TObject);
begin
  output.outputmemo.Clear;
end;


// *****************************************************
// Interface Page
// *****************************************************

// Add Interface
procedure TMainDlg.AddInterfaceClick(Sender: TObject);
begin
  USBIOInterface.AddInterface(
    StrToInt(MainDlg.InterfaceIndex.text),
    StrToInt(MainDlg.AlternateSetting.text),
    StrToInt(MainDlg.MaxTransferSize.text),
    status
    );
  ShowError(status);
end;

// delete interfaces
procedure TMainDlg.DeleteInterfaceClick(Sender: TObject);
begin
  USBIOInterface.DeleteInterfaces;
end;

// set configuration
procedure TMainDlg.SetConfClick(Sender: TObject);
begin
  USBIOInterface.SetConfiguration(strtoint(MainDlg.ConfIndex.text),status);
  ShowError(status);
end;

// unconfigure the device
procedure TMainDlg.UnConfigureClick(Sender: TObject);
begin
  USBIOInterface.UnconfigureDevice(Status);
  ShowError(status);
end;

// bind an endpoint
procedure TMainDlg.BindClick(Sender: TObject);
begin
  USBIOInterface.Bind(strtoint(MainDlg.PipeNumber.text),status);
  ShowError(status);
end;

// unbind an endpoint
procedure TMainDlg.UnBindClick(Sender: TObject);
begin
  USBIOInterface.Unbind(status);
  ShowError(status);
end;


// *****************************************************
// Read Page
// *****************************************************

// start reading
procedure TMainDlg.StartReadingClick(Sender: TObject);
begin
  if  not(IsWriteStarted) and not(IsReadStarted) then
  begin
    IsIsoFlag := MainDlg.IsIso.Checked;
    IsReadStarted := true;
    Timer1.Enabled := true;
    if not(IsIsoFlag and ((strtoint(MainDlg.BufferSize.text)*
      strtoint(MainDlg.NoOfBuffer.text))>1024)) then
    begin
      // reset the pipe, work-around for a bug in the UHC driver
      USBIOInterface.ResetPipe(status);
      MainDlg.ShowError(status);
      if (status = USBIO_ERR_SUCCESS) then
      begin
        USBIOInterface.StartReading(
          strtoint(MainDlg.BufferSize.text),
          strtoint(MainDlg.NoOfBuffer.text),
          strtoint(MainDlg.MaxErrorCount.text),
          status
        );
        ShowError(status);
        if IsIsoFlag then
        begin
          // create bufferarray for isochronous read
          readbuffer:=SafeArrayCreateVector(VT_UI1,0,strtoint(BufferSize.text)*USBIOInterface.EndpointFifoSize);
          infobuffer:=SafeArrayCreateVector(VT_UI4,0,strtoint(BufferSize.text));
        end
        else
          // create bufferarray for bulk read
          readbuffer:=SafeArrayCreateVector(VT_UI1,0,strtoint(BufferSize.text));
        if (status = USBIO_ERR_SUCCESS) and (FileOpenFlag = false) and (WriteToFile.Checked) then
        begin
          // open/create file
          AssignFile(OutputFile, MainDlg.FileName.Text);
          Rewrite(OutputFile,1);
          FileOpenFlag := true;
          IsReadStarted := true;
        end;
        StartTime := Time();
        TotalData := 0;
      end;
    end
    else MessageDlg('Frames per buffer * Number of buffers <= 1024"', mtError, [mbOk], 0);
  end;
end;  // StartReadingClick


// stop reading
procedure StopReading;
begin
  if  not(IsWriteStarted) and IsReadStarted then
  begin
    IsReadStarted := false;
    USBIOInterface.StopReading;
    SafeArrayDestroy(readbuffer);
    if IsIsoFlag then SafeArrayDestroy(infobuffer);
    if FileOpenFlag then
    begin
      // close File
      CloseFile(OutputFile);
      FileOpenFlag := false;
    end;
  end;
end; // StopReading


// stop reading
procedure TMainDlg.StopReadClick(Sender: TObject);
begin
  Timer1.Enabled:=false;
  StopReading;
end;


// call-back function: called when a read buffer has been completed
procedure TMainDlg.ReadComplete(Sender: TObject; var Obj: OleVariant);
type
  PByte = ^Byte;
var
  nob: integer;
  datapointer: pointer;
begin
  if IsReadStarted then
  begin
    // read data
    if IsIsoFlag then USBIOInterface.ReadIsoData(readbuffer,nob,infobuffer,status)
    else USBIOInterface.ReadData(readbuffer,nob,status);
    MainDlg.ShowError(status);
    helpstatus:=status;
    if status = USBIO_ERR_SUCCESS then
    begin
      if FileOpenFlag then
      begin
        // write data buffer to file
        SafeArrayAccessData(readbuffer,datapointer);
        Blockwrite(OutputFile,datapointer^,nob);
        SafeArrayUnAccessData(readbuffer);
      end;
      // calculate and display the data rate
      TotalData := TotalData + nob;
    end
    else
      if helpstatus <> USBIO_ERR_POWER_DOWN then StopReading;
        // This special error code is returned if the
        // PC enters the suspend state and a read operation
        // is still in progress. We can ignore this error code.
        // The reading operation is continued after the PC wakes up.
     

      // isochronous transfer errors are ignored here
      // check infobuffer if needed

    // move the progress bar
    if not DisableProgressBar.Checked then
    begin
      if (ProgressBar1.Max<=ProgressBar1.Position) then ProgressBar1.Position:=0;
      ProgressBar1.StepBy(1);
    end;
  end;
end;  // TMainDlg.ReadComplete


procedure TMainDlg.SaveFileClick(Sender: TObject);
begin
  if MainDlg.SaveDialog1.Execute then
    MainDlg.FileName.Text:=MainDlg.SaveDialog1.FileName;
end;


// *****************************************************
// Write Page
// *****************************************************

// stop writing
procedure StopWriting;
begin
  if  IsWriteStarted and not(IsReadStarted) then
  begin
    IsWriteStarted := false;
    USBIOInterface.StopWriting;
    SafeArrayDestroy(writebuffer);
    if IsIsoFlag then SafeArrayDestroy(infobuffer);
    if WriteSt then SafeArrayDestroy(StatusArray);
  end;
end; // StopWriting


// write data to the COM object
procedure SendBuffer();
begin
  if IsWriteStarted then
  begin
    repeat
      if IsIsoFlag then
        // write iso data buffer
        USBIOInterface.WriteIsoData(writebuffer,infobuffer,UserId,status)
      else
        // write bulk data buffer
        USBIOInterface.WriteData(writebuffer,UserId,status);
    until status <> USBIO_ERR_SUCCESS;
    helpstatus:=status;
    If (helpstatus <> USBIO_ERR_NO_BUFFER) and (helpstatus <> USBIO_ERR_SUCCESS) Then
    begin
      MainDlg.ShowError(status);
      StopWriting;
    end;
  end;
end;


// start a write operation
procedure TMainDlg.StartWriteClick(Sender: TObject);