⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 umain.pas

📁 用DELPHI编写的与C8051F32X进行USB通讯程序
💻 PAS
字号:
unit UMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    ComboBox1: TComboBox;
    btnUpdateList: TButton;
    btnTx: TButton;
    btnRx: TButton;
    edtFileTx: TEdit;
    edtFileRx: TEdit;
    btnFileTx: TButton;
    btnFileRx: TButton;
    btnExit: TButton;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    procedure btnUpdateListClick(Sender: TObject);
    procedure btnFileTxClick(Sender: TObject);
    procedure btnFileRxClick(Sender: TObject);
    procedure btnExitClick(Sender: TObject);
    procedure btnTxClick(Sender: TObject);
    procedure btnRxClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    FUSBDevice : THandle;
    FRXFileName : string;
    FTXFileName : string;
    procedure FillDeviceList(list:TStrings);
    function WriteFileData:BOOL;
    function  ReadFileData:BOOL;
    function DeviceRead(buffer:PByte;dwSize:DWORD;lpdwBytesRead:PDWORD;dwTimeout:DWORD=0):BOOL;
    function DeviceWrite(buffer:PByte;dwSize:DWORD;lpdwBytesWritten:PDWORD;dwTimeout:DWORD=0):BOOL;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
const
  MAX_PACKET_SIZE_WRITE =  512;
  MAX_PACKET_SIZE_READ  =  4096;

  MAX_WRITE_PKTS      =    $01;
  FT_READ_MSG        =     $00;
  FT_WRITE_MSG       =     $01;
  FT_READ_ACK        =     $02;
  FT_MSG_SIZE        =     $03;

implementation
uses SIUSBXP;
{$R *.dfm}

{ TForm1 }

function TForm1.DeviceRead(buffer: PByte; dwSize: DWORD; lpdwBytesRead:
  PDWORD; dwTimeout: DWORD): BOOL;
var
  tmpReadTO, tmpWriteTO:DWORD;        // Current timeout values.
  status : SI_STATUS;
  dwQueueStatus : DWORD;
  dwBytesInQueue : DWORD;
begin
  status := SI_SUCCESS;
  dwQueueStatus := SI_RX_NO_OVERRUN;
  dwBytesInQueue := 0;
  // Save timeout values.
  SI_GetTimeouts(@tmpReadTO, @tmpWriteTO); // 获取定时器读写间隔
  if dwTimeout = 0 then
  begin
    // Wait forever until queue ready
    while (status= SI_SUCCESS) and ((dwQueueStatus and SI_RX_READY)=0) do
      status := SI_CheckRXQueue(FUSBDevice, @dwBytesInQueue, @dwQueueStatus);
  end
  else
  begin // Set a timeout for the read
    SI_SetTimeouts(dwTimeout, 0); // 设置定时器读写间隔
  end;
  if(status = SI_SUCCESS) then
  begin
    status := SI_Read(FUSBDevice, buffer, dwSize, lpdwBytesRead); // 读
  end;
  SI_SetTimeouts(tmpReadTO, tmpWriteTO); // 设置定时器读写间隔
  Result := (status = SI_SUCCESS);
end;

function TForm1.DeviceWrite(buffer: PByte; dwSize: DWORD; lpdwBytesWritten:
  PDWORD; dwTimeout: DWORD): BOOL;
var
  tmpReadTO, tmpWriteTO : DWORD;
  status : SI_STATUS;
begin
  status := SI_SUCCESS;
    // Save timeout values.
  SI_GetTimeouts(@tmpReadTO, @tmpWriteTO); // 获取定时器读写间隔
  // Set a timeout for the write
  SI_SetTimeouts(0, dwTimeout); // 设置定时器读写间隔
  status := SI_Write(FUSBDevice, buffer, dwSize, lpdwBytesWritten); // 写
  // Restore timeouts
  SI_SetTimeouts(tmpReadTO, tmpWriteTO); // 设置定时器读写间隔
  Result := (status = SI_SUCCESS);
end;

procedure TForm1.FillDeviceList(list: TStrings);
var
  devStr : SI_DEVICE_STRING;
  dwNumDevices : DWORD;
  DevList : TStringList;
  d : DWORD;
  status : SI_STATUS;
begin
  status := SI_GetNumDevices(@dwNumDevices);
  if status = SI_SUCCESS then
  begin
    DevList := TStringList.Create;
    try
      for d:=0 to dwNumDevices-1 do
      begin
        status := SI_GetProductString(d,@devStr[0],SI_RETURN_SERIAL_NUMBER);
        if status = SI_SUCCESS then
          DevList.Add(String(devStr));
      end;
      list.Assign(DevList);
    finally
      DevList.Free;
    end;
  end;
end;

function TForm1.ReadFileData: BOOL;
var
  success : BOOL;
  filestream : TFileStream;
  dwBytesRead : DWORD;
  dwBytesWritten : DWORD;
  buf : array[0..MAX_PACKET_SIZE_READ] of BYTE;// [4096]
  msg : array[0..FT_MSG_SIZE] of BYTE; // [0x03]

  size : DWORD;
  counterPkts : DWORD;
  numPkts : DWORD;

  dwReadLength : DWORD;
  totalRead : DWORD;
begin
  if not DirectoryExists(ExtractFilePath(FRXFileName)) then
  begin
    ShowMessage('invalid file name');
    result := false;
    exit;
  end;

  filestream := TFileStream.Create(FRXFileName,fmCreate	or fmOpenReadWrite or fmShareDenyNone	);
  try
  begin
    dwBytesRead := 0;
    dwBytesWritten  := 0;
    msg[0] := BYTE(FT_READ_MSG);// [0x00]
    msg[1] := BYTE($FF);
    msg[2] := BYTE($FF);
    if DeviceWrite(@msg[0],FT_MSG_SIZE, @dwBytesWritten) then
    begin
      size := 0;
      counterPkts := 0;
      numPkts := 0;
      FillChar(buf,0,FT_MSG_SIZE);
      if DeviceRead(@buf[0], FT_MSG_SIZE, @dwBytesRead) then
      begin
        size := (buf[1] and $000000FF) or ((buf[2] shl 8) and $0000FF00);
        if (size MOD MAX_PACKET_SIZE_READ)>0 then
          numPkts := 1
        else
          numPkts := 0;
        numPkts := numPkts+ (size DIV MAX_PACKET_SIZE_READ);
        // Next line added in from Test Example
        totalRead := 0;
        // Now read data from board
        while (counterPkts < numPkts) and success do
        begin
          dwReadLength := 0;
          dwBytesRead := 0;
          if size - totalRead < MAX_PACKET_SIZE_READ then
            dwReadLength := size - totalRead
          else
            dwReadLength := MAX_PACKET_SIZE_READ; // [4096]
          FillChar(buf,0,dwReadLength);
          if DeviceRead(@buf[0], dwReadLength, @dwBytesRead) then
            fileStream.WriteBuffer(buf,dwReadLength)
          else
          begin
            ShowMessage('Failed reading file packet from target device.');
            success := FALSE;
          end;
          inc(counterPkts);
        end;
      end;
    end //end if DeviceRead(@buf[0], FT_MSG_SIZE, @dwBytesRead) then
    else
    begin
      ShowMessage('Failed sending read file message to target device.');
      success := FALSE;
    end;
    if fileStream.Size = 0 then
      ShowMessage('File has 0 length:'+#13#10+FRxFIleName);
    end;
  finally
    fileStream.Free;
  end;

  result := success;
end;

function TForm1.WriteFileData: BOOL;
var
  success : BOOL;
  fileStream : TFileStream;
  size : DWORD;
  dwBytesWritten : DWORD;
  dwBytesRead : DWORD;
  buf : array[0..MAX_PACKET_SIZE_WRITE] of BYTE;// [512]
  numPkts : DWORD;
  numLoops : DWORD;
  counterPkts : DWORD;
  counterLoops : DWORD;
  totalWritten : DWORD;
  dwWriteLength : DWORD;
  i : Integer;
begin
  if not FileExists(FTxFileName) then
  begin
     ShowMessage('Error:  No file selected.');
     Result := FALSE;
     exit;
  end;
  fileStream := TFileStream.Create(FTxFileName,fmOpenReadWrite or fmShareDenyNone);
  try
    size := fileStream.Size;
    dwBytesWritten  := 0;
    dwBytesRead     := 0;
    buf[0] := BYTE(FT_WRITE_MSG); // [0x01]
    buf[1] := BYTE(size and $000000FF);
    buf[2] := BYTE((size and $0000FF00) shr 8);
    if DeviceWrite(@buf[0], FT_MSG_SIZE, @dwBytesWritten) then
    begin
      if dwBytesWritten = FT_MSG_SIZE then// [0x03]
      begin
        if (size MOD MAX_PACKET_SIZE_WRITE)>0 then
          numPkts := 1
        else
          numPkts := 0;
        numPkts := numPkts + (size DIV MAX_PACKET_SIZE_WRITE);
        if (numPkts MOD MAX_WRITE_PKTS)>0 then
           numLoops := 1
        else
           numLoops := 0;
        numLoops := numLoops +(numPkts DIV MAX_WRITE_PKTS);
        counterPkts  := 0;
        counterLoops := 0;
        totalWritten := 0;
        // Now write data to board
        // After each 512-byte packet, the device will send an 0xFF ACK signal
        while (counterLoops < numLoops) and success  do
        begin
          i := 0;
          while (i<MAX_WRITE_PKTS) and (counterPkts < numPkts) and success do
          begin
            dwWriteLength := 0;
            if (size - totalWritten) < MAX_PACKET_SIZE_WRITE then
              dwWriteLength := size - totalWritten
            else
              dwWriteLength := MAX_PACKET_SIZE_WRITE; // [512]
            FillChar(buf,0,dwWriteLength);
            fileStream.ReadBuffer(buf,dwWriteLength);
            dwBytesWritten := 0;
            success := DeviceWrite(@buf[0], dwWriteLength, @dwBytesWritten);
            totalWritten := totalWritten + dwWriteLength;
            inc(counterPkts);
            inc(i);
          end;//end while (i<MAX_WRITE_PKTS) and (counterPkts < numPkts) and success
          if success then
          begin
            FillChar(buf,0,1);
            // Check for ACK packet after writing 512 bytes or after last packet
            while (buf[0] <> $FF) and success do
              success := DeviceRead(@buf[0], 1, @dwBytesRead);
          end;
          inc(counterLoops);
        end; // end while (counterLoops < numLoops) and success
        if not success then
          ShowMessage('Target device failure while sending file data.'+#13#10+'Check file size.');
      end//end if dwBytesWritten = FT_MSG_SIZE then
      else
      begin
        ShowMessage('Incomplete write file size message sent to device.');
        success := FALSE;
      end;
    end //end if DeviceWrite(buf, FT_MSG_SIZE, @dwBytesWritten) then
    else
    begin
      ShowMessage('Target device failure while sending file size information.');
      success := FALSE;
    end;
  finally
    fileStream.Free;
  end;
  Result := success;
end;

procedure TForm1.btnUpdateListClick(Sender: TObject);
begin
  FillDeviceList(ComboBox1.Items);
  if ComboBox1.Items.Count >0 then
     ComboBox1.ItemIndex := 0;
end;

procedure TForm1.btnFileTxClick(Sender: TObject);
begin
  if OpenDialog1.Execute then
  begin
    edtFileTx.Text := OpenDialog1.FileName;
  end;
end;

procedure TForm1.btnFileRxClick(Sender: TObject);
begin
  if SaveDialog1.Execute then
    edtFileRx.Text := SaveDialog1.FileName;
end;

procedure TForm1.btnExitClick(Sender: TObject);
begin
  Application.Terminate;
end;

procedure TForm1.btnTxClick(Sender: TObject);
var
  status : SI_STATUS;
begin
  if ComboBox1.ItemIndex <0 then exit;
  self.Cursor := crHourGlass;
  status := SI_Open(ComboBox1.ItemIndex, @FUSBDevice);
  if status = SI_SUCCESS then
  begin
    FTxFileName := edtFileTx.Text;
    // Write file to device in MAX_PACKET_SIZE_WRITE-byte chunks.
    WriteFileData();
    // Close device.
    SI_Close(FUSBDevice); // 关闭
    FUSBDevice := INVALID_HANDLE_VALUE;
  end;
  self.Cursor := crDefault;
end;

procedure TForm1.btnRxClick(Sender: TObject);
var
  status : SI_STATUS;
begin
  if ComboBox1.ItemIndex <0 then exit;
  self.Cursor := crHourGlass;
  status := SI_Open(ComboBox1.ItemIndex, @FUSBDevice);
  // 打开 temporary file based on file name of input file
  if status = SI_SUCCESS then
  begin
    FRxFileName := edtFileRx.Text;
    // Read file data in MAX_PACKET_SIZE_READ-byte chunks and write to temp file.
        // Compare temp. file with original
    ReadFileData();
    // Close device.
    SI_Close(FUSBDevice); // 关闭
    FUSBDevice := INVALID_HANDLE_VALUE;
  end;
  self.Cursor := crDefault;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  edtFileTx.Text := '';
  edtFileRx.Text := '';
  ComBoBox1.Text := 'DEVICE LIST';
  ComBoBox1.ItemIndex := -1;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -