unit1.~pas

Delphi6 开发的串口数据发送

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls, ExtCtrls, SPComm, Buttons,inifiles, ImgList, ToolWin;

const MAXCOUNT = 256;
type
  TForm1 = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    Button2: TButton;
    Bsend: TButton;
    GroupBox1: TGroupBox;
    Label4: TLabel;
    comlist: TComboBox;
    Label5: TLabel;
    CBJiaoyan: TComboBox;
    Label6: TLabel;
    Ebotelv: TEdit;
    Bevel1: TBevel;
    Label7: TLabel;
    EDatalong: TEdit;
    UpDown1: TUpDown;
    Label8: TLabel;
    Etimelong: TEdit;
    Label9: TLabel;
    Bevel2: TBevel;
    Bopen: TButton;
    Bstop: TButton;
    Timer1: TTimer;
    GroupBox2: TGroupBox;
    Label2: TLabel;
    Label3: TLabel;
    st: TStaticText;
    scount: TStaticText;
    smess: TStaticText;
    GroupBox3: TGroupBox;
    Label10: TLabel;
    Edatas: TEdit;
    BTestSend: TBitBtn;
    GroupBox4: TGroupBox;
    Memo: TMemo;
    GroupBox5: TGroupBox;
    MemoRecv: TMemo;
    Comm: TComm;
    ToolBar1: TToolBar;
    Bsysset: TSpeedButton;
    Bevel3: TBevel;
    BClose: TBitBtn;
    GroupBox6: TGroupBox;
    MCommand: TMemo;
    Bevel4: TBevel;
    Babout: TSpeedButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure BopenClick(Sender: TObject);
    procedure BstopClick(Sender: TObject);
    procedure BsendClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure BTestSendClick(Sender: TObject);
    procedure MemoRecvDblClick(Sender: TObject);
    procedure MemoDblClick(Sender: TObject);
    procedure CommReceiveData(Sender: TObject; Buffer: Pointer;
      BufferLength: Word);
    procedure CommReceiveError(Sender: TObject; EventMask: Cardinal);
    procedure FormShow(Sender: TObject);
    procedure BsyssetClick(Sender: TObject);
    procedure BCloseClick(Sender: TObject);
    procedure MCommandDblClick(Sender: TObject);
    procedure BaboutClick(Sender: TObject);
  private
    datas : array[0..1024]of byte;
    Datalong,CurrIndex ,HaveSendCount: integer;
    procedure SendData(strData : string);
    function JudgeComm(Command : string):string;
    procedure OpenCom(ComCode : integer);
    function GetWord(const str: string; nIndex: smallint): string;
    function GetCount(str,control : string):integer;
    { Private declarations }
  public
    AppPath : string;
    function ReadFromIni(Sect,key,DefaultValue:string):string;
    procedure WriteIni(Sect,key,Value:string);
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses CommSet, About;

{$R *.DFM}

procedure TForm1.SendData(strData : string); //发送数据
var
    str,data:string;
    long,i : integer;
    t : byte;
begin
    long := Length(strData);
    if Long mod 2 <> 0 then
    begin
        str := copy(strdata,1,Long-1);
        data := str + '0'+copy(strdata,long -1,1);//补0
        inc(long);
    end
    else
        data := strData;
    i := 1;
    while i <= long-1 do
    begin
        t := StrToInt('$'+copy(data,i,2));
        comm.WriteCommData(@t,1);
        i := i + 2;
    end;
    str := '';
    long := Length(data);
    i := 1;
    while i < long do
    begin
        str := str + ' '+copy(data,i,2);
        i := i + 2;
    end;
    MCommand.Lines.Add('发：'+str);

end;

function TForm1.JudgeComm(Command : string):string;
var
    count,i : integer;
    str ,com,re: string;
begin
    re := '';
    count := Strtoint(ReadFromIni('命令交互列表','数量','0'));
    for i := 1 to Length(Command) do
    begin
        if Command[i] <> ' ' then   //过滤' '
            com := com + Command[i];
    end;
    if count > 0 then
    begin
        for i := 1 to count-1 do
        begin
            str := ReadFromIni('命令交互列表','接受'+inttostr(i),' ');
            if(str = Command) then
            begin
                str := ReadFromIni('命令交互列表','发送'+inttostr(i),' ');
                if str <> ' ' then
                begin
                    JudgeComm := str;
                    exit;
                end;
            end;
        end;
    end
    else
        JudgeComm := re;

end;

procedure TForm1.WriteIni(Sect,key,Value:string);
var
    files : Tinifile;
begin
    files := TiniFile.Create(AppPath+'config.ini');
    files.WriteString(sect,key,value);
    files.Free;
end;

function TForm1.ReadFromIni(Sect,key,DefaultValue:string):string;
var
    files : TiniFile;
    r : string;
begin
    files := TiniFile.Create(AppPath+'config.ini');
    r := files.ReadString(sect,key,DefaultValue);
    files.Free;
    ReadFromIni := r;
end;

procedure TForm1.OpenCom(ComCode : integer);
begin

    case ComCode of
    1:
        comm.CommName := 'COM1';
    2:
        comm.CommName := 'COM2';
    end;
    comm.StopComm();
    comm.BaudRate := StrToInt(Ebotelv.Text);
    if CBJiaoYan.Text = '无' then
        comm.Parity := None
    else
    begin
        if CBJiaoYan.Text = '偶校验' then
            comm.Parity := even
        else
            if CBJiaoYan.Text = '奇校验' then
                comm.Parity := Odd;
    end;
    comm.StartComm();
end;


function TForm1.GetCount(str,control : string):integer;
var
  i ,count: integer;
begin
  count := 0;
  for i:= 1 to Length(str) do
    if str[i] = control then
      inc(count);
  result := count;
end;

function TForm1.GetWord(const str: string; nIndex: smallint): string;
var
   i, len, j: integer;
   resultstr : string;
begin
   resultstr:= '';
   j:= 0;
   len := length(str);
   for i:= 1 to len do
   begin
      if j= nIndex-1 then
      begin
         if str[i] = ' ' then
            break
         else
            resultstr := resultstr+str[i];
      end
      else if str[i] = ' ' then
      begin
        j:= j+1;
        continue;
      end;
   end;
   result := resultstr;
end;


procedure TForm1.Button1Click(Sender: TObject);
var
  i,count ,r: integer;
  str,temp,temp2 : string;
begin
  str := memo.Text;
  count := GetCount(str,' ')+1;
  r := -1;
  //temp := getword(str,count);
  Scount.Caption := IntToStr(count);
  if count >= 2 then
  begin
    temp := getword(str,1);
    for i := 1 to count do
    begin
      if i = 1 then
        temp := '$'+ getword(str,i)
      else
      begin
        temp2 := GetWord(str,i);
        if temp2 = '' then
          break;
        if i = 2 then
          r :=strtoint(temp) xor StrToInt(('$'+getword(str,i)))
        else
          r := r xor StrToInt(('$'+getword(str,i)));
      end;
    end;
  end;
  if r > -1 then
  begin

    st.Caption := inttohex(r,2);
  end;

  //st.Caption := st.Caption + ' , '+inttostr($05xor $20xor $20xor $32xor $32xor $30 xor $60 xor $32);
  {int := $01 xor $53 xor $53 xor $54 xor $02 xor $32 xor $35 xor $20 xor $20 xor $32 xor $35 xor $20 xor $20 xor $32 xor $35 xor
    $20 xor $20 xor $32 xor $32 xor $30 xor $20 xor $32 xor $31 xor $30 xor $20 xor $32 xor $31 xor $35 xor $20 xor $35 xor $30 xor $20 xor
    $20 xor $35 xor $30 xor $20 xor $20 xor $35 xor $30 xor $20 xor $20 xor $31 xor $20 xor $20 xor $20 xor $31 xor $20 xor $20 xor $20 xor
    $31 xor $20 xor $20 xor $20 xor $32 xor $20 xor $20 xor $20 xor $32 xor $20 xor $20 xor $20 xor $32 xor $20 xor $20 xor $20 xor $32 xor
    $20 xor $20 xor $20 xor $32 xor $20 xor $20 xor $20 xor $32 xor $20 xor $20 xor $20 xor $20 xor $20 xor $20 xor $20 xor $31 xor $2E xor
    $35 xor $20 xor $20 xor $20 xor $20 xor $20 xor $02 xor $20 xor $20 xor $20 xor $01 xor $20 xor $20 xor $20 xor $20 xor $20 xor $20 xor
    $20 xor $20 xor $20 xor $20 xor $20 xor $20 xor $20 xor $20 xor $31 xor $30 xor $30 xor $20 xor $32 xor $34 xor $20 xor $20 xor $32 xor $35 xor
    $20 xor $20 xor $20 xor $20 xor $20 xor $20 xor $20 xor $20 xor $20 xor $20 xor $20 xor $20 xor $20 xor $20 xor $20 xor $20 xor $20 xor $20 xor $20 xor
    $20 xor $20 xor $20 xor $33 xor $30 xor $20 xor $20 xor $20 xor $20 xor $20 xor $20 xor $20 xor $20 xor $20 xor
    $20 xor $35 xor $30 xor $20 xor $20 xor $20 xor $20 xor $20 xor $20 xor $31 xor $32 xor $38 xor $20 xor
    $31 xor $30 xor $20 xor $20 xor $20 xor $20 xor $20 xor $20 xor $00 xor $00 xor $00 xor $00 xor $00 xor
    $00 xor $00 xor $00 xor $00 xor $00 xor $00 xor $00 xor $00 xor $00 xor $00 xor $00 xor $00 xor $00 xor
    $00 xor $00 xor $00 xor $00 xor $00 xor $00 xor $00 xor $00 xor $03 ;//xor $57;
    ShowMessage(IntToStr(int)); }
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  memo.Clear;
  st.Caption := '';
  scount.Caption := '';
  smess.Caption := '';
end;

procedure TForm1.BopenClick(Sender: TObject);
var
    com : string;
begin
    if comlist.Text = 'Com1' then
    begin
        OpenCom(1);
        Bopen.Enabled := false;
        Bstop.Enabled := true;
        Bsend.Enabled := true;
        com := 'Com1';
    end
    else
        if comlist.Text = 'Com2'then
        begin
            OpenCom(2);
            Bopen.Enabled := false;
            Bstop.Enabled := true;
            Bsend.Enabled := true;
            com := 'Com2';
        end
        else
            MessageBox(handle,'请指定串口','指定的串口错误',MB_OK+MB_ICONWARNING);
    WriteIni('通讯参数','串口号',com);
    WriteIni('通讯参数','波特率',Ebotelv.Text);
    WriteIni('通讯参数','校验',CBjiaoyan.Text);
    WriteIni('通讯参数','每次发送数据长度',Edatalong.Text);
    WriteIni('通讯参数','时间间隔',Etimelong.Text);
    WriteIni('最后一次发送数据','数据',Memo.Text);
end;

procedure TForm1.BstopClick(Sender: TObject);
begin
    Bopen.Enabled := true;
    Bstop.Enabled := false;
    Bsend.Enabled := false;
    timer1.Enabled :=false;
    smess.Caption := '';
end;

procedure TForm1.BsendClick(Sender: TObject);
var
    i : integer;
    str : string;
begin
    if Bopen.Enabled = false then
    begin
        if Etimelong.Text <> '' then
        begin
            timer1.Interval := StrToInt(Etimelong.Text);
            datalong := GetCount(Memo.Text,' ') + 1;
            for i := 1 to datalong do
            begin
                str := trim(getword(memo.Text,i));
                if str <> '' then
                    datas[i-1] := StrToInt('$'+str)
                else
                    break;
            end;
            CurrIndex := 0;
            timer1.Enabled := true;
            Bsend.Enabled := false;
        end;
    end;
    WriteIni('最后一次发送数据','数据',Memo.Text);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
    Datalong := 0;
    CurrIndex := 0;
    HaveSendCount := 0;
    AppPath := ExtractFilePath(ParamStr(0));
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
    EverLong,i,endIndex,allcount : integer;
begin
    if datalong > 0 then
    begin
        EverLong := StrToInt(Edatalong.Text);
        allcount := datalong  div everlong;
        if everlong > 0 then
        begin
            EndIndex := CurrIndex + EverLong -1;
            if EndIndex >= Datalong then
                EndIndex := DataLong - 1;
            inc(HaveSendCount);
            Smess.Caption := '共 '+IntToStr(allcount)+' 条,正在发送第 '+IntToStr(HaveSendCount)+ ' 条';
            for i := CurrIndex to EndIndex do
            begin
                comm.WriteCommData(@datas[i],1);
            end;
            CurrIndex := i;
            if CurrIndex = Datalong  then
            begin
                timer1.Enabled := false;
                Bsend.Enabled := true;
                smess.Caption := '数据发送完毕，长度：'+IntToStr(DataLong);
                HaveSendCount := 0;
            end;
        end;
    end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
    comm.StopComm();
end;

procedure TForm1.BTestSendClick(Sender: TObject);
var
    data : array[0..128]of byte;
    t : byte;
    i ,count,long: integer;
    str,temp : string;
begin
    if Bopen.Enabled = false then
    begin
        str := Edatas.Text;
        if str = '' then
            exit;
        count := GetCount(str,' ') + 1;
        for i := 0 to count - 1 do
        begin
            temp := GetWord(str,i+1);
            if temp <> '' then
            begin
                t := strtoint('$'+temp);
                comm.WriteCommData(@t,1);
            end;
        end;
        Smess.Caption := '发送 '+Edatas.Text+' 完成';
        Edatas.Text := '';
    end
    else
        ShowMessage('串口没有打开！');
end;

procedure TForm1.MemoRecvDblClick(Sender: TObject);
begin
    MemoRecv.Clear;
end;

procedure TForm1.MemoDblClick(Sender: TObject);
begin
    Memo.Clear;
end;

procedure TForm1.CommReceiveData(Sender: TObject; Buffer: Pointer;
  BufferLength: Word);
var
    buff : array[0..MAXCOUNT] of byte;
    long,i : integer;
    str,judge,data : string;
begin
    long := BufferLength;
    //MemoRecv.Lines.Add('数据  ：  ');
    str := '';
    move(Buffer^, PChar((@Buff)^), BufferLength);
    for i := 0 to long - 1 do
    begin
        judge := judge + IntToHex(Buff[i], 2);
        str := str + IntToHex(Buff[i], 2) + ' ';
    end;
    if str <> '' then
        MemoRecv.Lines.Add(str);
    if Judge <> '' then
    begin
        data := JudgeComm(Judge);
        if data <> '' then
        begin
            MCommand.Lines.Add('收： '+str);
            SendData(data);
        end;
    end;
end;

procedure TForm1.CommReceiveError(Sender: TObject; EventMask: Cardinal);
begin
    ShowMessage('error');
end;

procedure TForm1.FormShow(Sender: TObject);
var
    com : string;
begin
{WriteIni('通讯参数','串口号',com);
    WriteIni('通讯参数','波特率',Ebotelv.Text);
    WriteIni('通讯参数','校验',CBjiaoyan.Text);
    WriteIni('通讯参数','每次发送数据长度',Edatalong.Text);
    WriteIni('通讯参数','时间间隔',Etimelong.Text);
    WriteIni('最后一次发送数据','数据',Memo.Text);}
    com := ReadFromIni('通讯参数','串口号','Com1');
    if com = 'Com1' then
        comlist.ItemIndex := 0
    else
        comlist.ItemIndex := 1;
    Ebotelv.Text := ReadFromIni('通讯参数','波特率','9600');
    CBjiaoyan.Text := ReadFromIni('通讯参数','校验','偶校验');
    Edatalong.Text := ReadFromIni('通讯参数','每次发送数据长度','8');
    ETimelong.Text := ReadFromIni('通讯参数','时间间隔','500');
    memo.Text := ReadFromIni('最后一次发送数据','数据','');
end;

procedure TForm1.BsyssetClick(Sender: TObject);
begin
    FComSet.ShowModal();
end;

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

procedure TForm1.MCommandDblClick(Sender: TObject);
begin
    MCommand.Clear;
end;

procedure TForm1.BaboutClick(Sender: TObject);
begin
    Fabout.ShowModal();
end;

end.