串口调试助手(MSCOMM)源代码

最新推荐文章于 2024-08-22 09:56:52 发布
最新推荐文章于 2024-08-22 09:56:52 发布
阅读量2.2k 收藏 1
点赞数
分类专栏： 软件源代码 文章标签： button integer string output function radiobutton
版权声明：本文为博主原创文章，遵循 CC 4.0 BY-SA 版权协议，转载请附上原文出处链接和本声明。
本文链接：https://blog.csdn.net/KAO250/article/details/2893635
版权

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, OleCtrls, MSCommLib_TLB, StdCtrls, Buttons, ExtCtrls, ComCtrls,
  Menus;

type
  TForm1 = class(TForm)
    MSComm1: TMSComm;
    Panel1: TPanel;
    CmbComPort: TComboBox;
    StatusBar1: TStatusBar;
    HeaderControl1: THeaderControl;
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    MemSend: TMemo;
    CheckHexSend: TCheckBox;
    ShpSerialPort: TShape;
    TimerStatus: TTimer;
    BtnSend: TBitBtn;
    Timer: TTimer;
    CheckAutosend: TCheckBox;
    EdtTimeInterval: TEdit;
    Label1: TLabel;
    ComboBox1: TComboBox;
    Label2: TLabel;
    ComboBox2: TComboBox;
    Label3: TLabel;
    ComboBox3: TComboBox;
    ComboBox4: TComboBox;
    Label4: TLabel;
    Label5: TLabel;
    Button2: TButton;
    Button3: TButton;
    brecv: TRadioButton;
    ASCIIRecv: TRadioButton;
    HRecv: TRadioButton;
    DRecv: TRadioButton;
    RadioButton1: TRadioButton;
    SaveRecv: TButton;
    Openfile: TButton;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    Label7: TLabel;
    SendFile: TButton;
    Button4: TButton;
    Button1: TButton;
    Button5: TButton;
    MemRecv: TRichEdit;
    zifu: TRadioButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure TimerStatusTimer(Sender: TObject);
    procedure MSComm1Comm(Sender: TObject);

    procedure BtnSendClick(Sender: TObject);
    procedure CheckAutosendClick(Sender: TObject);
    procedure TimerTimer(Sender: TObject);
    procedure CheckHexSendClick(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure SaveRecvClick(Sender: TObject);
    procedure OpenfileClick(Sender: TObject);
    procedure Button5Click(Sender: TObject);
   
  private
    { Private declarations }
    HexSend: Boolean;
    RXNum, TXNum: Integer;
    InputStr, RecvStr: string;
    ComSetting: string;
    procedure ShowTX;
    procedure ShowRX;
    procedure ShowComSetting ;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation
uses
unit2, ComObj;

{$R *.dfm}


//*********************************************************
//该函数接收1个字符，转换成功后输出相应的数，否则输出-1
//*********************************************************
function Hex(c: char): Integer;
var
  x: Integer;
begin
  if ( Ord(c)>= Ord('0')) and (Ord(c) <= Ord('9')) then
    x:= Ord(c) - Ord('0')
  else if (Ord(c) >= Ord('a')) and (Ord(c) <= Ord('f')) then
    x:= Ord(c) - Ord('a') + 10
  else if (Ord(c) >= Ord('A')) and (Ord(c) <= Ord('F')) then
    x:= Ord(c) - Ord('A') + 10
  else
    x:= -1;                                       //输入错误
  Result:= x;
end;

//*******************************************************************
//该函数接收1~2个，字符转换成功后输出对应的值，否则输出-1
//*******************************************************************
function HexToInt(Str: string): Integer;
var
  tmpInt1, tmpInt2: Integer;
begin
  if Length(Str) = 1 then
  begin
    Result:= Hex(Str[1]);
  end
  else if Length(Str) = 2 then
  begin
    tmpInt1:= Hex(Str[1]);
    tmpInt2:= Hex(Str[2]);
    if (tmpInt1 = -1) or (tmpInt2 = -1) then
      Result:= -1
    else
      Result:= tmpInt1 * 16 + tmpInt2;
  end
  else
    Result:= -1;                                  //输入错误，转换失败
end;

//****************************
//字符串转换成ASCII码字符串
//****************************
function StrToASCIIStr(const S: string): string;
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;

//***************************
//该函数去掉字符串中所有空格
//***************************
function TrimAll(Str: string): string;
var
  mLen, i: Integer;

begin
  mLen:= Length(Str);
  //初始化返回值
  Result:= '';
  for i:= 0 to mLen do
  begin
    //是空格就去掉
    if Str[i] = '' then
      Continue;
    Result:= Result + Str[i];
  end;
end;

//***************************
//十进制转换成二进制字符串
//***************************
function DTob(decimal:longint):string;
const symbols:string[16]='01';
var
  scratch:string;
  remainder:byte;
begin
  repeat
    remainder:=decimal mod 2;
    scratch:=symbols[remainder+1]+scratch;
    decimal:=decimal div 2;
  until(decimal=0);
  result:=scratch;
end;

//***************************
//判断输入的数是否在0~9之间
//***************************
function PanDuan(Str: string):boolean;
var
  mLen, i: Integer;
begin
  mLen:= Length(Str);
  for i:= mLen downto 1 do
  begin
      if Str[i] in ['0','1','2','3','4','5','6','7','8','9'] then
         begin
         Continue;
         Result:=true;
         end
      else
         Result:=false;
         break;
  end;

end;

function PanDuan16(Str: string):boolean;
var
  mLen, i: Integer;
begin
  mLen:= Length(Str);
  for i:= mLen downto 1 do
  begin
      if Str[i] in ['0'..'9','a'..'f','A'..'F'] then
         begin
         Continue;
         Result:=true;
         end
      else
         Result:=false;
         break;
  end;

end;

 

procedure TForm1.Button1Click(Sender: TObject);

begin
  if not MSComm1.PortOpen then
  begin
    //打开串口
    MSComm1.CommPort:= CmbComPort.ItemIndex +1;
    ComSetting:= ComboBox1.Text;
    ComSetting:= ComSetting + ',' + ComboBox2.Text;
    ComSetting:= ComSetting + ',' + ComboBox3.Text;
    ComSetting:= ComSetting + ',' + ComboBox4.Text;
    MSComm1.Settings:= ComSetting;
    try
    MSComm1.PortOpen:= True;
    except
     showmessage('该COM错误！');
     application.Terminate;
    end ;

    Panel1.Enabled:=false;
    ShowComSetting;
    //变换各个组件的状态
    ShpSerialPort.Brush.Color:= clLime;           //指示灯变绿
    Button1.Caption:= '关闭串口';

  end
  else
  begin
    //关闭串口
    //变换各个组件的状态
    MSComm1.PortOpen:= False;
    ShpSerialPort.Brush.Color:= clRed;            //指示灯变红
    Panel1.Enabled:= True;
    Button1.Caption:= '打开串口';
    end;
end;

procedure TForm1.FormCreate(Sender: TObject);

begin
  ShowComSetting;
  MSComm1.InBufferSize:= 1024;  //设置或返回输入缓存大小
  MSComm1.OutBufferSize:= 512;  //设置或返回输出缓存大小
  CmbComPort.ItemIndex:= 0;  //选择串口
  RXNum:= 0;   //接收字节数
  TXNum:= 0;   //发送字节数
  MSComm1.InputMode:= 0;   //以文本方式读取
  CheckHexSend.Checked:= True; //ASCII发送
  CheckAutosend.Checked :=false; //关闭自动发送
  ShpSerialPort.Brush.Color:= clRed;//灯变红即串口没打开
  Panel1.Enabled:= True;
  MemRecv.Lines[0]:= DateTimeToStr(Now())+'Recv:'
end;

procedure TForm1.MSComm1Comm(Sender: TObject);
var
  InputLen: Integer;
  //tmpInt: Integer;
  tmpvar: Variant;
  a:string;
begin
  InputLen:= 0;
  if MSComm1.CommEvent = 2 then  //接收数据时
  begin
    InputLen:= MSComm1.InBufferCount;  //返回输入缓冲区内等待读取的字节数

    //接收二进制数据，转换为ASCII码显示
    if ASCIIRecv.Checked = true then          //ASCII码
    begin
      tmpvar:= MSComm1.Input; //读取接收缓冲区中的数据
      InputStr:='';
      inputstr:= inputstr+ StrToASCIIStr(tmpvar)+#72+#32;
    end
    else
    if zifu.Checked = true then          //ASCII码字符
    begin
      tmpvar:= MSComm1.Input; //读取接收缓冲区中的数据
      if PanDuan16(tmpvar) then
      begin
      InputStr:='';
      InputStr:= InputStr + chr(strtoint('$'+tmpvar)) + #32;
      end
      else
      begin
         showmessage('输入数据有错！');
         InputStr:='';
      end;

    end
    else
    if HRecv.Checked=true then           //十六进制
    begin
         tmpvar:= MSComm1.Input; //读取接收缓冲区中的数据
         if PanDuan(tmpvar)then
         begin
         InputStr:='';
         a:= tmpvar;
         InputStr:=InputStr +inttohex(strtoint(a),2)+#72+ #32;
         end
         else
         begin
         showmessage('请输入0~9之间的数');
         InputStr:='';
         end;
    end
    else
    if BRecv.Checked=true then       //二进制
    begin
      tmpvar:= MSComm1.Input; //读取接收缓冲区中的数据
      if PanDuan16(tmpvar) then
      begin
      InputStr:='';
      a:= tmpvar;
      InputStr:=InputStr +dtoB(strtoint('$'+a)) +#66+ #32;
      end
      else
      begin
         showmessage('输入数据有错！');
         InputStr:='';
      end;
    end
    else
    if DRecv.Checked=true then           //十进制
    begin
      tmpvar:= MSComm1.Input;      //读取接收缓冲区中的数据
     if PanDuan16(tmpvar) then
      begin
      InputStr:='';
      a:= tmpvar;
      InputStr:=InputStr +inttostr(strtoint('$'+a)) + #32;
      end
      else
      begin
        showmessage('输入数据有错！');
        InputStr:='';
      end;
    end
    else
    //直接接收字符
    begin
      InputStr:='';
      InputStr:= MSComm1.Input;
    end;
    MemRecv.Text:= MemRecv.Text + InputStr;
  end;
  //加入数据显示模块
  RecvStr:= MemRecv.Text;
  RXNum:= RXNum + InputLen;
  ShowRX;
end;

procedure TForm1.ShowRX; //状态栏显示接收字节数
begin
  StatusBar1.Panels[2].Text:= 'RX:' + IntToStr(RXNum);
end;

procedure TForm1.ShowTX; //状态栏显示发送字数
begin
  StatusBar1.Panels[1].Text:= 'TX:' + IntToStr(TXNum);
end;

procedure TForm1.TimerStatusTimer(Sender: Tobject); //状态栏显示时间
var
  tmpTime: string;
begin
  tmpTime:= DateTimeToStr(Now());
  StatusBar1.Panels[3].Text:= '今天是：' + DateToStr(Date()) + #32 + #32 +
    '当前时间为：' + Copy(tmpTime,11, 16);
end;

procedure TForm1.ShowComSetting;                //  状态栏显示串口状态
begin
  if not MSComm1.PortOpen then
  StatusBar1.Panels[0].Text:='串口状态是：未打开'
  else
  StatusBar1.Panels[0].Text:='串口状态是：'+ComSetting;
end;

 

procedure TForm1.BtnSendClick(Sender: TObject);
var
  Len: Integer;
  i, Count, MaxCount, tmpInt: Integer;
  tmpvar: Variant;
  tmpStr, Output: string;
begin
  Len:= 0;
  Count:= 1;
  MaxCount:= 1;
  if not MSComm1.PortOpen then
  begin
    ShowMessage('没有打开串口！');
    Exit;
  end
  else

  begin
    //发送二进制数，需要使用Variant变量矩阵，矩阵大小自动调节
    if HexSend then
    begin
      output:=stringreplace(MemSend.Text,#13#10,'',[rfReplaceAll]);  //去掉换行符
      Len:= Length(output);
      if len=0 then
      ShowMessage('没有输入数据！')
      else
      if Len > 0 then
      begin
        i:= 1;
        //创建一个Variant数组
        tmpvar:= VarArrayCreate([1,1], varByte);
        while (i < Len) do
        begin
          //转换为16进制
          tmpStr:= Copy(Output,i,2);
          tmpStr:= LowerCase(tmpStr);  //将字符转换成小写
          tmpstr:= TrimAll(tmpstr);
          tmpInt:= HexToInt(tmpStr);
          if tmpInt = -1 then
          begin
            ShowMessage('发送的数据格式有问题！');
            break;
          end
          else
          begin
            if Count = (MaxCount +1) then
            begin
              Inc(MaxCount);
              //增大Variant数组
              VarArrayRedim(tmpvar, MaxCount);    //调整数组大小，VarArrayRedim()函数能修改variant数组的最高限
            end;
            tmpvar[Count]:= tmpInt;
            Inc(Count);
           end;
             i:= i+2;
         end;
         MSComm1.Output:= tmpvar;
      end
    end；
         begin
         output:=stringreplace(MemSend.Text,#13#10,'',[rfReplaceAll]);
         end;
       MSComm1.Output:=Output;
       end;
       Len:= length(MemSend.Text);
  TXNum:= TXNum + Len div 2;
  ShowTX;
end;

procedure TForm1.CheckAutosendClick(Sender: TObject);
begin
if CheckAutoSend.Checked then //自动发送
    if length(stringreplace(MemSend.Text,#13#10,'',[rfReplaceAll]))=0 then   //输入内容是空时
    begin
      ShowMessage('请输入要发送的内容！');
      CheckAutoSend.Checked:= False;
      MemSend.SetFocus;
    end
    else
    begin
      Timer.Interval:= StrToInt(EdtTimeInterval.Text); //设置时间间隔
      Timer.Enabled:= True;
    end
  else
  begin
    Timer.Enabled:= False;
  end;
end;

procedure TForm1.TimerTimer(Sender: TObject);
begin
//如果串口已经打开，则发送数据
  if MSComm1.PortOpen then
    BtnSendClick(Sender);
end;

procedure TForm1.CheckHexSendClick(Sender: TObject);
begin
   HexSend:= CheckHexSend.Checked;
end;

procedure TForm1.Button2Click(Sender: TObject);

begin
memRecv.Clear;
MemRecv.Lines[0]:= DateTimeToStr(Now())+'Recv:'+#13+#10;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
Memsend.Clear;
end;


procedure TForm1.Button4Click(Sender: TObject);
begin
close;
end;

 


procedure TForm1.SaveRecvClick(Sender: TObject);
var
  FileName:string;
begin
  if SaveDialog1.Execute then
  begin
    if SaveDialog1.FilterIndex=2 then
    begin
    MemRecv.PlainText:=false;
    FileName:=SaveDialog1.FileName+'.doc' ;
    end
    else
    begin
    MemRecv.PlainText:=true;
    FileName:=SaveDialog1.FileName+'.txt' ;
    end;

    MemRecv.Lines.SaveToFile(FileName);
  end;
end;

procedure TForm1.OpenfileClick(Sender: TObject);
var
  FileName:string;
begin
if openDialog1.Execute then
  begin
 MemSend.Lines.Clear;
 Filename:=openDialog1.FileName;
 Label7.Caption:=OpenDialog1.FileName;
 MemSend.Lines.LoadFromFile(Filename);
 end;
end;

 

procedure TForm1.Button5Click(Sender: TObject);
begin
 RXNum:=0;
 TXNum:=0;
 ShowRX;
 ShowTX;
end;

end.

cornercomer
关注
专栏目录
用lisp编写串口助手源代码_VB 串口调试助手源代码  1023009055 曾雨
weixin_39940253的博客
12-30 197
Dim OutputAscii As BooleanDim InputString As StringDim OutputString AsString变量定义OptionExplicit强制显式声明Dim ComSwitch AsBoolean口开关状态判断Dim FileData AsString要发送的文件暂存Dim SendCount AsLong发送数据字节计数器Dim Rec...
串口调试助手源代码.rar_VS 串口_vs c++串口_串口助手_串口助手源码_；C++：MSCOMM
07-14
C++编写的串口助手源代码，实测很好用。VS可以直接打开测试
MSComm 控件串口源码
04-25
本例程采用MSComm控件编写，参考网上众多资料编写，相当金典，包含一些相关的参考文档，能自动获取电脑的串口号（金典），在网上下载的源码一般都没有这个功能，是初学者不可多得学习资料
delphi安装mscomm实现串口通信，测试mscomm安装成功
最新发布
XIAODU2020的博客
08-22 827
说明：本次实验用的软件版本是delphi6。
串口调试助手源码
10-07
该文档为一个串口调试助手的C#源码，该串口调试助手支持多种波特率选择，以及校验位，停止位的选择。并且支持波形分析。
VB串口调试助手源代码
h505722924的博客
01-10 6817
Dim OutputAscii As Boolean Dim InputString As String Dim OutputString As String '===================================================================================== ' 变量定义 '====================
串口调试助手c语言程序,串口调试助手C语言源程序
weixin_39844549的博客
05-17 429
串口调试助手C语言源程序串口调试助手源程序及编程详细过程作者：龚建伟 2001.6.20可以任意转载，但必须注明作者和说明来自http://doc.xuehai.net，不得作为商用目次：1.建立项目2.在项目中插入MSComm控件3.利用ClassWizard定义CMSComm类控制变量4.在对话框中添加控件5.添加串口事件消息处理函数OnComm()6.打开和设置串口参数7.发送数据在众多网...
用lisp编写串口助手源代码_串口调试助手源代码（详细中文注释）
weixin_39642981的博客
12-21 317
【实例简介】该资源有两个，一是串口调试助手的源代码，可以实现数据的接收和发送；二是实现点击某个按钮发送指定数据的应用程序的源代码。代码都是含有详细的中文注释，可以直接编译通过，且内含可执行文件都是可以直接运行的。适合作为串口助手开发与原理了解的参考，希望本资源对您有用【实例截图】【核心代码】// SerialassistantDlg.cpp : 实现文件//#include "stdafx.h"#...
用lisp编写串口助手源代码_串口调试助手源程序及编程详细过程(转载)
weixin_39644139的博客
12-21 251
目次：在众多网友的支持下，串口调试助手从2001年5月21日发布至今，短短一个月，在全国各地累计下载量近5000人次，在近200多个电子邮件中，20多人提供了使用测试意见，更有50多位朋友提出要串口调试助手的源代码，为了答谢谢朋友们的支持，公开推出我最初用VC控件MSComm编写串口通信程序的源代码，并写出详细的编程过程，姑且叫串口调试助手源程序V1.0或VC串口通讯源程序吧，我相信，如果你用VC...
串口调试助手源代码
10-13
串口调试助手源代码
串口调试助手 源代码
02-09
串口调试助手源代码，在原来的功能基础上增加了发送时间，时间到毫秒级，可以知道串口接收要用多少时间。
串口调试助手源码（C++）
11-20
对于串口的初学者有很大帮助,对于串口的初学者有很大帮助,对于串口的初学者有很大帮助
串口调试助手源代码(MFC+SComm)
07-24
此程序利用MFC技术结合MSComm控件，使用C++语言编写。程序功能包括:手动设置串口参数，串行接收和发送数据，可以显示接收数据和保存接收数据等功能。此程序可以作为单片机与微机串口通信时的调试工具。自己动手编写这样一个程序，对学习MFC有相当大帮助而且对串口通信也有一定了解，在以后编写上位机程序的串口通信部分基本就没什么问题了！希望给有兴趣的朋友带来帮助！
串口调试助手源代码.zip_串口助手源码_串口调试助手
07-15
串口调试助手源码,单片机程序调试，小巧好用
c语言串口程序编写,串口调试助手C语言源程序.doc
weixin_39815879的博客
05-17 432
串口调试助手C语言源程序串口调试助手源程序及编程详细过程作者：龚建伟? 2001.6.20可以任意转载，但必须注明作者和说明来自，不得作为商用目次：1.建立项目??2.在项目中插入MSComm控件?3.利用ClassWizard定义CMSComm类控制变量4.在对话框中添加控件??5.添加串口事件消息处理函数OnComm()6.打开和设置串口参数7.发送数据??? 在众多网友的支持下，串口调试助手...
用lisp编写串口助手源代码_串口调试助手源程序编程详细过程
weixin_39808953的博客
12-21 113
数据类型？在众多网友的支持下，串口调试助手从2001年5月21日发布至今，短短一个月，在全国各地累计下载量近5000人次，在近200多个电子邮件中，20多人提供了使用测试意见，更有50多位朋友提出要串口调试助手的源代码，为了答谢谢朋友们的支持，公开推出我最初用VC控件MSComm编写串口通信程序的源代码，并写出详细的编程过程，姑且叫串口调试助手源程序V1.0或VC串口通讯源程序吧，我相信，如果你用...
VB 串口调试助手源代码
joshua_cyh的专栏
12-20 2029
Option Explicit                             '变量显示 '---------------------------------- '          变量定义申明 '---------------------------------- Public blnComOpen As Boolean                '串口状态 '----
评论
添加红包

请填写红包祝福语或标题

个

红包个数最小为10个

元

红包金额最低5元

当前余额3.43元 前往充值 >
需支付：10.00元
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付元
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明：

1.余额是钱包充值的虚拟货币，按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载，可以购买VIP、付费专栏及课程。

余额充值