usbio.pas

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

var
  a: char;
  i,ws: integer;
  fifosize: integer;
  value: byte;
begin
  if not(IsWriteStarted) and not(IsReadStarted) then
  begin
    IsWriteStarted := true;
    IsIsoFlag := MainDlg.writeisocheck.Checked;
    // query fifo size 
    fifosize := USBIOInterface.EndpointFifoSize;
    // prepare buffers for write
    if IsIsoFlag then
    begin
      // iso transfer
      writebuffer:=SafeArrayCreateVector(VT_UI1,0,(strtoint(writebuffersize.text)* fifosize));
      infobuffer:=SafeArrayCreateVector(VT_UI4,0,(strtoint(writebuffersize.text)));
      if MainDlg.WriteStatusCheck.checked then
        // create status array
        StatusArray := SafeArrayCreateVector(VT_UI4,0,(strtoint(writebuffersize.text)));
      // setup info buffer
      for i:=0 to strtoint(writebuffersize.text) do
      begin
        // put an element into the SafeArray
        SafeArrayPutElement(infobuffer,i,fifosize);
      end;
    end
    else
      // bulk or interrupt transfer
      writebuffer:=SafeArrayCreateVector(VT_UI1,0,strtoint(writebuffersize.text));

    // fill the buffer from file or with constant values
    if FromFileCheck.Checked then
    begin
      if not(FileExists(MainDlg.writefile.Text)) then
        FileExists(MainDlg.writefile.Text)
      else
      // read one buffer from file
      begin
        AssignFile(InputFile, MainDlg.writefile.Text);
        Reset(InputFile);
        for i:=0 to (strtoint(writebuffersize.text)) do
        begin
          read(InputFile,a);
          value:=ord(a);
          SafeArrayPutElement(writebuffer,i,value);
        end;
      end;
    end
    else
      // fill buffer with constant values
      for i:=0 to (strtoint(writebuffersize.text)) do
      begin
        value:=strtoint(FilledWith.Text);
        // put an element into the SafeArray
        SafeArrayPutElement(writebuffer,i,value);
      end;
    // setup
    if MainDlg.WriteStatusCheck.checked then
    begin
      ws:=1;
      WriteSt:=true;
    end
    else
    begin
      ws:=0;
      WriteSt:=false;
    end;
    // reset the pipe
    USBIOInterface.ResetPipe(status);
    MainDlg.ShowError(status);
    if status = USBIO_ERR_SUCCESS then
    begin
      USBIOInterface.StartWriting(
        strtoint(writebuffersize.text),
        strtoint(writenumberofbuffers.text),
        strtoint(writeerrorcount.text),
        ws,
        status
        );
      MainDlg.ShowError(status);
      // send the prepared data until an error is returned
      if status = USBIO_ERR_SUCCESS then
        SendBuffer();
    end;
  end;
end; // TMainDlg.StartWriteClick



procedure TMainDlg.StopWriteClick(Sender: TObject);
begin
  StopWriting;
end;


// called when a free buffer is available
procedure TMainDlg.WriteComplete(Sender: TObject; var Obj: OleVariant);
begin
  // send further buffers
  SendBuffer();
end;


// called when a write operation is finished
// and the final status of the write operation is available
procedure TMainDlg.WriteStatus(Sender: TObject; var Obj: OleVariant);
var
  ByteCount,i,st: integer;
begin
  if IsWriteStarted then
  begin
    if IsIsoFlag then
    begin
      USBIOInterface.GetIsoWriteStatus(UserId,StatusArray,ByteCount,status);
      for i:=0 to bytecount do
      begin
        // get an element from the Safearray
        SafeArrayGetElement(StatusArray,i,st);
        MainDlg.ShowError(st);
      end;
    end
    else
      USBIOInterface.GetWriteStatus(UserId,status);
    MainDlg.ShowError(status);
    if status <> USBIO_ERR_SUCCESS then
      StopWriting;
  end;
end; // TMainDlg.WriteStatus

procedure TMainDlg.OpenFileClick(Sender: TObject);
begin
  if MainDlg.OpenDialog1.Execute then
    MainDlg.writefile.Text:=MainDlg.OpenDialog1.FileName;
end;


// *****************************************************
// Feature Page
// *****************************************************

// set feature
procedure TMainDlg.setfeatureClick(Sender: TObject);
begin
  USBIOInterface.SetFeature(
    featurecombo.itemindex,
    strtoint(featurefield.text),
    strtoint(featureindexfield.text),
    status
    );
  ShowError(status);
end;

// clear feature
procedure TMainDlg.clearfeatureClick(Sender: TObject);
begin
  USBIOInterface.ClearFeature(
    featurecombo.itemindex,
    strtoint(featurefield.text),
    strtoint(featureindexfield.text),
    status
    );
  ShowError(status);
end;


// *****************************************************
// Class or Vendor request page
// *****************************************************

procedure TMainDlg.VendorSendButtonClick(Sender: TObject);
var
  buffer: PSAFEARRAY;
  typ,recipient,request,value,index,bufsize,pos,i: integer;
  BufferString: string;
  pb: byte;
begin
  // out request
  if VendorDirectionCombo.ItemIndex = 0 then
  begin
    // set variables
    typ := VendorTypeCombo.ItemIndex +1;
    recipient := VendorRecipientCombo.ItemIndex +1;
    request := strtoint(VendorRequest.Text);
    value := strtoint(VendorValueText.Text);
    index := strtoint(VendorIndexText.Text);
    bufsize := strtoint(VendorBufferSizeText.Text);
    // create SafeArray
    buffer := SafeArrayCreateVector(VT_UI1,0,bufsize);
    // get buffer string
    BufferString := VendorBufferText.Text;
    // fill the SafeArray
    for i:=0 to bufsize-1 do
    begin
      pos:=AnsiPos('$',BufferString);
      if pos = 0 then pb:=0
        else pb:=strtoint(Copy(BufferString,pos,3));
      // put element into SafeArray
      SafeArrayPutElement(Buffer,i,pb);
      Delete(BufferString,1,pos);
    end;
    // out request
    USBIOInterface.ClassOrVendorOutRequest(buffer,0,typ,recipient,0,request,value,index,status);
    ShowError(status);
    // destroy SafeArray
    SafeArrayDestroy(buffer);
  end;
  // in request
  if VendorDirectionCombo.ItemIndex = 1 then
  begin
    // set variables
    typ := VendorTypeCombo.ItemIndex +1;
    recipient := VendorRecipientCombo.ItemIndex +1;
    request := strtoint(VendorRequest.Text);
    value := strtoint(VendorValueText.Text);
    index := strtoint(VendorIndexText.Text);
    bufsize := strtoint(VendorBufferSizeText.Text);
    // create SafeArray
    buffer := SafeArrayCreateVector(VT_UI1,0,bufsize);
    // in request
    USBIOInterface.ClassOrVendorInRequest(buffer,bufsize,0,typ,recipient,0,request,value,index,status);
    ShowError(status);
    // if success
    If Status=0 then
    begin
      BufferString:='';
      // print to output window
      OutPut.OutputMemo.Lines.Append('Vendor in request');
      for i:=0 to bufsize-1 do
      begin
        // get one element from the SafeArray
        SafeArrayGetElement(buffer,i,pb);
        BufferString:=BufferString + inttohex(pb,2) + ' ';
        if (i mod 8) = 7 then
        begin
          OutPut.OutputMemo.Lines.Append(BufferString);
          BufferString:='';
        end;
      end;
      OutPut.OutputMemo.Lines.Append(BufferString);
    end;
    // destroy SafeArray
    SafeArrayDestroy(buffer);
  end;
end;


// *****************************************************
// Other Page
// *****************************************************

// cycle port simulates a device disconnect/connect
procedure TMainDlg.CyclePortClick(Sender: TObject);
begin
  USBIOInterface.CyclePort(status);
  ShowError(status);
end;

// reset device
procedure TMainDlg.ResetDeviceClick(Sender: TObject);
begin
  USBIOInterface.ResetDevice(status);
  ShowError(status);
end;

// get the current USB frame number from host controller
procedure TMainDlg.getframenoClick(Sender: TObject);
var
  FrmNumber : integer;
begin
  USBIOInterface.GetCurrentFrameNumber(FrmNumber,status);
  ShowError(status);
  if status = 0 then frmno.Text:=inttohex(FrmNumber,8);
end;

// get device path, the path can be used to open the native
// interface of the USBIO device driver directly
procedure TMainDlg.GetDevicePathNameClick(Sender: TObject);
begin
  GetDevicePathNameField.Text:=USBIOInterface.DevicePathName;
end;

// get powerstate
procedure TMainDlg.getpowerstateClick(Sender: TObject);
var
  PowerState: integer;
begin
  USBIOInterface.GetDevicePowerState(PowerState, status);
  ShowError(status);
  if status =0  then getpowerstatefield.Text:=inttostr(PowerState);
end;

// set powerstate
procedure TMainDlg.setpowerstateClick(Sender: TObject);
begin
  USBIOInterface.SetDevicePowerState(powerstatecombo.ItemIndex,status);
  ShowError(status);
end;

// get status
procedure TMainDlg.getstatusClick(Sender: TObject);
var
  DeviceStatus: integer;
begin
  USBIOInterface.GetStatus(
    DeviceStatus,
    statuscombo.itemindex,
    strtoint(statusindex.text),
    status
    );
  ShowError(status);
  if status = 0 then statusout.text:=inttostr(DeviceStatus);
end;



// *****************************************************
// Internal helper functions
// *****************************************************

// show an error
procedure TMainDlg.ShowError(Status: integer);
var
  error: string;
begin
  if Status <> USBIO_ERR_SUCCESS then
    // get error text for the code
    error := USBIOInterface.ErrorText(Status);
    MainDlg.ErrorText.Text := error;
end;

// clear error message
procedure TMainDlg.ClearErrorClick(Sender: TObject);
begin
  MainDlg.ErrorText.Text := '';
end;


// init the USBIOCOM object here
procedure InitUSBIOCom;
begin
  // create the USBIOCOM object instance
  USBIOInterface := TUSBIOInterface.Create(MainDlg);
  // set the call-back handlers, they have to be methods of a class
  USBIOInterface.OnReadComplete := MainDlg.ReadComplete;
  USBIOInterface.OnWriteComplete := MainDlg.WriteComplete;
  USBIOInterface.OnWriteStatusAvailable := MainDlg.WriteStatus;
  USBIOInterface.OnPnPAddNotification := MainDlg.PnPAddNotification;
  USBIOInterface.OnPnPRemoveNotification := MainDlg.PnPRemoveNotification;
  try
    USBIOInterface.Connect;
  except
    MessageDlg('USBIOCOM not registered! Use "regsvr32 usbiocom.dll"', mtError, [mbOk], 0);
  end;
end;


// this procedure is called during startup
procedure TMainDlg.FormCreate(Sender: TObject);
begin
  // init COM object
  InitUSBIOCom;
  // init combo boxes
  featurecombo.ItemIndex:=0;
  powerstatecombo.ItemIndex:=0;
  statuscombo.ItemIndex:=0;
  VendorDirectionCombo.ItemIndex:=0;
  VendorRecipientCombo.ItemIndex:=0;
  VendorTypeCombo.ItemIndex:=0;
end;


// this procedure is called during shutdown
procedure TMainDlg.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  // we try to stop read and write operations 
  // these functions will do nothing if no read/write operation is in progress
  StopWriting();
  StopReading();
end;

// timer procedure
procedure TMainDlg.Timer1Timer(Sender: TObject);
begin
  DataRate.Text:=inttostr(TotalData);
  TotalData:=0;
  Timer1.Enabled:=true;
end;

end.