unit1.pas

RS232串口通讯随书源码

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Label3: TLabel;
    txtInput: TEdit;
    cmdCalc: TButton;
    cmdClose: TButton;
    txtCS: TEdit;
    Comm1: TComm;
    procedure cmdCalcClick(Sender: TObject);
    procedure cmdCloseClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  Procedure TimeDelay(DT:DWORD);//延迟函数
  Function OutCheckSum(OutStr:String):String;
  Function InCheckSum(InBuf:String):String;

implementation

{$R *.DFM}

//以下程序将字符串中的字符的编码一一找出
procedure TForm1.cmdCalcClick(Sender: TObject);
var
  InputStr:String;
  tmpStr,RStr:String;
begin
   //字符串指定
   InputStr:=txtInput.Text;
   //先作CheckSum的运算
   tmpStr:=OutCheckSum(InputStr);
   //将字符串送出
   Comm1.OutputString(tmpStr);
   TimeDelay(100); //延迟100毫秒
   RStr:=Comm1.Input; //收取结果
   //将结果显示出来
   if Length(RStr)=0 then
     txtCS.Text:='无数据或错误'
   else
     txtCS.Text:=InCheckSum(RStr);
end;

//结束程序
procedure TForm1.cmdCloseClick(Sender: TObject);
begin
  Close;
end;

Function OutCheckSum(OutStr:String):String;
var
  BufLen,i:Integer;
  CHKBuf:String;
  CheckSum:DWORD;
begin
  //取得传入字符串的长度
  BufLen := Length(OutStr);
  //初始化
  CheckSum := 0;
  For i := 1 To BufLen do
    //取出字符,和&HFF作AND运算可以将结果限定在&HFF以内
    CheckSum:=(CheckSum+Ord(OutStr[i])) And $FF;
  CHKBuf:=IntToHex(CheckSum,2);
  //字符串重组，并加上结尾字符Cr
  Result := OutStr + CHKBuf + Chr(13);
end;

Function INCheckSum(InBuf:String):String;
var
  BufLen,i:Integer;
  CheckSum,OrgCHK:DWORD;
begin
  //取得传入字符串的长度
  BufLen := Length(InBuf);
  //初始化
  CheckSum := 0;
  For i := 1 To BufLen-3 do
    //取出字符,和&HFF作AND运算可以将结果限定在&HFF以内
    CheckSum:=(CheckSum+Ord(InBuf[i])) And $FF;
  //取得原始的CheckSum
  OrgCHK:=StrToInt('$' + Copy(InBuf,BufLen-3+1,2));
  if OrgCHK=CheckSum then
  //字符串重组，并加上结尾字符Cr
    Result := Copy(InBuf,1,BufLen-3)
  else
    Result:='';
end;

//以下是延迟函数，单位毫秒
Procedure TimeDelay(DT:DWORD);
var
 TT:DWORD;
begin
  //取得现在的Tick值
  TT:=GetTickCount();
  //计算Tick差值是否超过设置值
  while GetTickCount()-TT<DT do
   Application.ProcessMessages; //释放控制权
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  //打开通信端口
  Comm1.PortOpen := True;
end;

end.