main.~pas

串口调试助手V1.5

begin
  if SelectDirectory(FrmMain.Handle, '请选择要保存接收数据的目录', ' ', Dir) then
    edPath.Text := Dir;
end;



procedure TFrmMain.btnFileClick(Sender: TObject);
begin
  if OpenDialog1.Execute then
    edSendFile.Text := OpenDialog1.FileName;
end;

procedure TFrmMain.btnSndFileClick(Sender: TObject);
begin
  if FileExists(edSendFile.Text) then
    SendFile(edSendFile.Text);
end;

procedure TFrmMain.SendFile(const FileName: string);
var
  f: file;
  xfer: Integer;
  buf: PChar;
  BufSize: Integer;
  myFileSize: Integer;
const
  CBUFSIZE = 1024;    //最大缓冲区大小
begin                 
  if not btnSend.Enabled then
    Exit;
  AssignFile(f, FileName);
  FileMode := fmOpenRead;
  {$I-}
  Reset(f, 1);
  {$I+}

  myFileSize := FileSize(f);
  if myFileSize > CBUFSIZE then
    BufSize := CBUFSIZE
  else
    BufSize := myFileSize;   //文件小于CBUFSIZE的缓冲区为文件的大小

  GetMem(buf, BufSize);
  try
    repeat
      BlockRead(f, buf^, BufSize, xfer);
      //可在此处加入 sleep() 来 匹配接收端的速率，降低接收端的误码率
      //一般　50 - 200 就行了
      //同时可以通过减少最大缓冲区（CBUFSIZE）的大小来降低发送速率
      if xfer > 0 then
      begin
        Comm1.WriteCommData(buf, xfer);
        FTXNum := FTXNum + Cardinal(xfer);
        ShowTX;
      end;
    until xfer < BufSize;
  finally
    FreeMem(buf);
    CloseFile(f);
  end;
end;

function HexStrToStr(const S: string): string;
  //16进制字符串转换成字符串
var
  t: Integer;
  ts: string;
  M, Code: Integer;
begin
  t := 1;
  Result := '';
  while t <= Length(S) do
  begin   //xlh 2006.10.21
    while (t <= Length(S)) and (not (S[t] in ['0'..'9', 'A'..'F', 'a'..'f'])) do
      Inc(t);
    if (t + 1 > Length(S)) or (not (S[t + 1] in ['0'..'9', 'A'..'F', 'a'..'f'])) then
      ts := '$' + S[t]
    else
      ts := '$' + S[t] + S[t + 1];
    Val(ts, M, Code);
    if Code = 0 then
      Result := Result + Chr(M);
    Inc(t, 2);
  end;
end;

procedure TFrmMain.btnSendClick(Sender: TObject);
begin
  if cbsendHex.Checked then
    SendString(HexStrToStr(Memo2.Text))
  else
    SendString(Memo2.Text);
end;

procedure TFrmMain.SendString(const Str: string);
begin
  if Comm1.WriteCommData(PChar(Str), Length(Str)) then
  begin
    FTXNum := FTXNum + Cardinal(Length(Str));
    ShowTX;
  end;
end;

function StrToHexStr(const S: string): string;
  //字符串转换成16进制字符串
var
  I: Integer;
begin
  for I := 1 to Length(S) do
  begin
    if I = 1 then
      Result := IntToHex(Ord(S[1]), 2)
    else
      Result := Result + ' ' + IntToHex(Ord(S[I]), 2);
  end;
end;

procedure TFrmMain.Comm1ReceiveData(Sender: TObject; Buffer: Pointer;
  BufferLength: Word);
var
  Str: string;
begin
  //Memo自动清空
  if cbAutoClean.Checked and (Memo1.Lines.Count > 50) then
    Memo1.Clear;
  //下面两句是SPCOMM控件的接收数据的读取方法
  //如果要读取到pchar时可以 　(读取到字符数组时同理)
  //var buf : pchar;
  //GetMem(buf,BufferLength);
  //Move(buffer^, buf^, bufferlength);
  SetLength(Str, BufferLength);
  Move(buffer^, PChar(@Str[1])^, bufferlength);

  if FShowText then
  begin
    if cbRecHex.Checked then
      Memo1.Text := Memo1.Text + StrToHexStr(Str) + ' '
    else
      Memo1.Text := Memo1.Text + Str;
    //下面几句是让Memo1下拉的，让接收的数据始终在最前面
    Memo1.SelStart  := Length(Memo1.Text);
    Memo1.SelLength := 0;
    Memo1.Perform(EM_SCROLLCARET, 0, 0);
  end;
  FRXNum := FRXNum + bufferlength;
  ShowRX;
end;

procedure TFrmMain.btnSavDatClick(Sender: TObject);
var
  myFile: string;
  Str: string;
  f: file;
begin
  myFile := edPath.Text;
  if not DirectoryExists(myFile) then
    CreateDir(myFile);
  myFile := myFile + 'Rec' + FormatDateTime('yymmddhhssnn', Now);
  case ComboBox6.ItemIndex of
    0..1:
    begin
      myFile := myFile + '.txt';  //文本文件
      Str := Memo1.Text;
    end;
    2:
    begin
      myFile := myFile + '.bin';  //二进制文件
      Str := HexStrToStr(Memo1.Text);
    end;
  end;
  AssignFile(f, myFile);
  FileMode := fmOpenWrite;
  {$I-}
  Rewrite(f, 1);
  {$I+}
  try
    BlockWrite(f, PChar(@Str[1])^, Length(Str));
  finally
    CloseFile(f);
  end;
  Application.MessageBox(PChar(myFile + '  已保存'), '信息',
    MB_ICONWARNING or MB_OK);
end;

procedure TFrmMain.ComboBox1Change(Sender: TObject);
begin
  Comm1.CommName := ComboBox1.Text;
end;


procedure TFrmMain.ComboBox2Change(Sender: TObject);
var
  BaudRate: Integer;
begin
  if ComboBox2.Text = 'Custom' then
  begin
    ComboBox2.Style := csDropDown;
    ComboBox2.SetFocus;
    btnSwitch.Enabled := false;
  end
  else
  begin   
    if ComboBox2.ItemIndex > 0 then
      ComboBox2.Style := csDropDownList;
      //下面是自定义波特率的
    if TryStrToInt(ComboBox2.Text, BaudRate) then
    begin
      Comm1.BaudRate := BaudRate;
      btnSwitch.Enabled := true;
    end
    else 
      btnSwitch.Enabled := false;
  end;
end;

procedure TFrmMain.ComboBox3Change(Sender: TObject);
begin
  //TParity = ( None, Odd, Even, Mark, Space );
  Comm1.Parity := TParity(ComboBox3.ItemIndex);
end;

procedure TFrmMain.ComboBox4Change(Sender: TObject);
begin
  //TByteSize = ( _5, _6, _7, _8 );
  Comm1.ByteSize := TByteSize(ComboBox4.ItemIndex);
end;

procedure TFrmMain.ComboBox5Change(Sender: TObject);
begin
  //TStopBits = ( _1, _1_5, _2 );
  Comm1.StopBits := TStopBits(ComboBox5.ItemIndex);
end;

procedure TFrmMain.ComboBox2KeyPress(Sender: TObject; var Key: Char);
begin
  if not (Key in ['0'..'9', #8]) then 
    Key := #0;
end;

procedure TFrmMain.Memo2KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);  
var 
  LineNum: Longint;
begin
  if not btnSend.Enabled then 
    Exit;
  //快捷键 ALT + A   all    发送发送区中的所有内容
  if (Shift = [ssAlt]) and (key = Ord('A')) then
    btnSend.Click;
  // 快捷键 ALT + S   single    发送发送区中当前行的内容
  if (Shift = [ssAlt]) and (key = Ord('S')) then
  begin
    //得到当前行的行号
    LineNum := SendMessage(Memo2.Handle, EM_LINEFROMCHAR, Memo2.SelStart, 0);
    if cbsendHex.Checked then
      SendString(HexStrToStr(Memo2.Lines[LineNum]))
    else
      SendString(Memo2.Lines[LineNum]);
  end;
  //快捷键 ALT + D      发送发送区中当前行的内容,并加上"回车换行"符
  if (Shift = [ssAlt]) and (key = Ord('D')) then
  begin
    //得到当前行的行号
    LineNum := SendMessage(Memo2.Handle, EM_LINEFROMCHAR, Memo2.SelStart, 0);
    if cbsendHex.Checked then
      SendString(HexStrToStr(Memo2.Lines[LineNum] + #13#10))
    else
      SendString(Memo2.Lines[LineNum] + #13#10);
  end;
end;

procedure TFrmMain.Edit1Change(Sender: TObject);
var 
  Interval: Integer;
begin
  if TryStrToInt(Edit1.Text, Interval) and (Interval > 0) then
  begin
    Timer1.Interval    := Interval;
    cbAutoSend.Enabled := true;
  end
  else
    cbAutoSend.Enabled := false;
end;

procedure TFrmMain.WMSysCommand(var Message: TWMSysCommand);
begin
  inherited;
  if Message.CmdType = idHelp then
    Application.MessageBox('====     串口调试小助手 1.2  帮助信息     ==== ' +
      #13#10#13#10#13#10 +
      ' 原有特性' + #13#10 +
      '  1 自动获取串口列表' + #13#10 +
      '  2 支持自定义波特率' + #13#10#13#10 +
      ' 新增功能' + #13#10 +
      '  1 可以接收文本和二进制的文件' + #13#10 +
      '  2 可以发送任何格式的文件' + #13#10 +
      '  3 发送编辑区快捷键:' + #13#10 +
      '    ALT+A 发送所有内容' + #13#10 +
      '    ALT+S 发送光标所在行的数据' + #13#10 +
      '    ALT+D 发送光标所在行的数据，并发送回车换行' + #13#10#13#10 +
      '    同时真诚希望能够得到您的支持和帮助，这个软' + #13#10 +
      ' 件才能得到更好的发展，在此先谢谢了。'
      , '帮助');
  if Message.CmdType = idAbout then
    Application.MessageBox('==   串口调试小助手 1.2  == ' +
      #13#10#13#10#13#10 +
      ' 一个好用的串口调试软件' + #13#10 +
      ' For Windows 98/2K/XP/2003' + #13#10#13#10 +
      ' 作者  : 谢利洪' + #13#10 +
      ' Email : [e-mail]' + #13#10
      , '关于');
end;

procedure TFrmMain.Memo2KeyPress(Sender: TObject; var Key: Char);
begin
  if cbsendHex.Checked and (not (Key in ['0'..'9', 'a'..'f',
    'A'..'F', #8, #32, #13])) then 
    Key := #0;
end;

procedure TFrmMain.ComboBox6Change(Sender: TObject);
begin
  case (Sender as TComboBox).ItemIndex of
    0:
    begin
      cbAutoClean.Checked := true;
      cbAutoClean.Enabled := true;
      cbRecHex.Checked := false;
      cbRecHex.Enabled := true;
    end;
    1:
    begin
      Memo1.Clear;
      cbAutoClean.Checked := false;
      cbAutoClean.Enabled := false;
      cbRecHex.Checked := false;
      cbRecHex.Enabled := true;
    end;
    2:
    begin
      Memo1.Clear;
      cbAutoClean.Checked := false;
      cbAutoClean.Enabled := false;
      cbRecHex.Checked := true;
      cbRecHex.Enabled := false;
    end;
  end;     
end;

end.