📄 umain.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 + -