Delphi - 采用第三方控件TMS、SPComm开发串口调试助手

 1 procedure tmainfrm.advbtnconnectclick(sender: tobject);
 2 var
 3   serialportno: string;
 4 begin
 5   try
 6     with commain do
 7     begin
 8       stopcomm;
 9       serialportno := copy(cbbcom.text, 4, length(cbbcom.text) - 3);
10       baudrate := strtoint(cbbbaudrate.text);
11 //      bytesize := tbytesize(cbbbytesize.itemindex);
12 //      stopbits := tstopbits(cbbstopbit.itemindex);
13 //      parity := tparity(cbbcheckbit.itemindex);
14       if strtoint(serialportno) > 9 then
15       begin
16         commname := '//./' + cbbcom.text;
17       end
18       else
19       begin
20         commname := cbbcom.text;
21       end;
22       commain.startcomm;
23       connectstatus.caption := 'connected';
24       connectstatus.fillcolor := cllime;
25       advbtnconnect.enabled := false;
26       gbsendmsg.enabled := true;
27     end;
28   except
29     connectstatus.caption := 'not connected';
30     connectstatus.fillcolor := clred;
31     gbsendmsg.enabled := false;
32   end;
33 
34 end;

 1 procedure tmainfrm.advbtnconfirmclick(sender: tobject);
 2 begin
 3   if mmsendmsg.lines.count <= 0 then
 4   begin
 5     application.messagebox('there is no key word, please check the msgsendlist,thanks.', 'error information', mb_ok + mb_iconstop);
 6     mmsendmsg.setfocus;
 7     exit;
 8   end;
 9   if cbbyte.checked then
10   begin
11     sendhex(mmsendmsg.text);
12   end
13   else
14   begin
15     commain.writecommdata(pchar(mmsendmsg.text), length(mmsendmsg.text));
16   end;
17   if (cbautosend.checked) and (edttime.text <> '') and (cbbyte.checked) then
18   begin
19     timermain.interval := strtoint(edttime.text);
20     timermain.enabled := true;
21   end;
22 end;

 1 procedure tmainfrm.sendhex(s: string);
 2 var
 3   s2: string;
 4   buf1: array[0..50000] of char;
 5   i: integer;
 6 begin
 7   s2 := '';
 8   for i := 1 to length(s) do
 9   begin
10     if ((copy(s, i, 1) >= '0') and (copy(s, i, 1) <= '9')) or ((copy(s, i, 1) >= 'a') and (copy(s, i, 1) <= 'f'))
11       or ((copy(s, i, 1) >= 'a') and (copy(s, i, 1) <= 'f')) then
12     begin
13       s2 := s2 + copy(s, i, 1);
14     end;
15   end;
16   for i := 0 to (length(s2) div 2 - 1) do
17     buf1[i] := char(strtoint('$' + copy(s2, i * 2 + 1, 2)));
18   commain.writecommdata(buf1, (length(s2) div 2));
19   mmmsg.lines.add('msgsend[' + s + ']');
20 end;

 1 procedure tmainfrm.commainreceivedata(sender: tobject; buffer: pointer;
 2   bufferlength: word);
 3 var
 4   s: string;
 5   i, l: integer;
 6   rbuf: array[0..2048] of byte;
 7 begin
 8   move(buffer^, pchar(@rbuf)^, bufferlength);
 9   l := bufferlength;
10   for i := 0 to l - 1 do
11   begin
12     s := s + inttohex(rbuf[i], 2);
13   end;
14   mmmsg.lines.add('msgreceived[' + s + ']');
15 end;

  1 unit umain;
  2 
  3 interface
  4 
  5 uses
  6   windows, messages, sysutils, variants, classes, graphics, controls, forms,
  7   dialogs, stdctrls, extctrls, spcomm, rzpanel, advsmoothbutton,
  8   advsmoothstatusindicator, advglassbutton, rzbutton, rzradchk, rzstatus,
  9   rzprgres;
 10 
 11 type
 12   tmainfrm = class(tform)
 13     gbserialparams: trzgroupbox;
 14     gbmsg: trzgroupbox;
 15     mmmsg: tmemo;
 16     gbportset: trzgroupbox;
 17     gbsendmsg: trzgroupbox;
 18     lbcom: tlabel;
 19     lbstopbit: tlabel;
 20     lbbytesize: tlabel;
 21     lbcheckbit: tlabel;
 22     lbbaudrate: tlabel;
 23     commain: tcomm;
 24     cbbcom: tcombobox;
 25     cbbstopbit: tcombobox;
 26     cbbbytesize: tcombobox;
 27     cbbbaudrate: tcombobox;
 28     cbbcheckbit: tcombobox;
 29     gbmsgsendparams: trzgroupbox;
 30     gbmsgsendlist: trzgroupbox;
 31     cbbyte: trzcheckbox;
 32     cbautosend: trzcheckbox;
 33     lbct: tlabel;
 34     edttime: tedit;
 35     advbtnconfirm: tadvglassbutton;
 36     advbtnconnect: tadvglassbutton;
 37     advglassbutton1: tadvglassbutton;
 38     lbms: tlabel;
 39     mmsendmsg: tmemo;
 40     statusbar: trzstatusbar;
 41     clock: trzclockstatus;
 42     versionstatus: trzversioninfostatus;
 43     mqstatus: trzmarqueestatus;
 44     progressbar: trzprogressbar;
 45     connectstatus: trzstatuspane;
 46     timermain: ttimer;
 47     procedure advbtnconnectclick(sender: tobject);
 48     procedure commainreceivedata(sender: tobject; buffer: pointer;
 49       bufferlength: word);
 50     procedure advbtnconfirmclick(sender: tobject);
 51     procedure sendhex(s: string);
 52     procedure advglassbutton1click(sender: tobject);
 53     procedure timermaintimer(sender: tobject);
 54   private
 55     { private declarations }
 56   public
 57     { public declarations }
 58   end;
 59 
 60 var
 61   mainfrm: tmainfrm;
 62 
 63 implementation
 64 
 65 {$r *.dfm}
 66 
 67 procedure tmainfrm.sendhex(s: string);
 68 var
 69   s2: string;
 70   buf1: array[0..50000] of char;
 71   i: integer;
 72 begin
 73   s2 := '';
 74   for i := 1 to length(s) do
 75   begin
 76     if ((copy(s, i, 1) >= '0') and (copy(s, i, 1) <= '9')) or ((copy(s, i, 1) >= 'a') and (copy(s, i, 1) <= 'f'))
 77       or ((copy(s, i, 1) >= 'a') and (copy(s, i, 1) <= 'f')) then
 78     begin
 79       s2 := s2 + copy(s, i, 1);
 80     end;
 81   end;
 82   for i := 0 to (length(s2) div 2 - 1) do
 83     buf1[i] := char(strtoint('$' + copy(s2, i * 2 + 1, 2)));
 84   commain.writecommdata(buf1, (length(s2) div 2));
 85   mmmsg.lines.add('msgsend[' + s + ']');
 86 end;
 87 
 88 
 89 procedure tmainfrm.advbtnconnectclick(sender: tobject);
 90 var
 91   serialportno: string;
 92 begin
 93   try
 94     with commain do
 95     begin
 96       stopcomm;
 97       serialportno := copy(cbbcom.text, 4, length(cbbcom.text) - 3);
 98       baudrate := strtoint(cbbbaudrate.text);
 99 //      bytesize := tbytesize(cbbbytesize.itemindex);
100 //      stopbits := tstopbits(cbbstopbit.itemindex);
101 //      parity := tparity(cbbcheckbit.itemindex);
102       if strtoint(serialportno) > 9 then
103       begin
104         commname := '//./' + cbbcom.text;
105       end
106       else
107       begin
108         commname := cbbcom.text;
109       end;
110       commain.startcomm;
111       connectstatus.caption := 'connected';
112       connectstatus.fillcolor := cllime;
113       advbtnconnect.enabled := false;
114       gbsendmsg.enabled := true;
115     end;
116   except
117     connectstatus.caption := 'not connected';
118     connectstatus.fillcolor := clred;
119     gbsendmsg.enabled := false;
120   end;
121 
122 end;
123 
124 procedure tmainfrm.commainreceivedata(sender: tobject; buffer: pointer;
125   bufferlength: word);
126 var
127   s: string;
128   i, l: integer;
129   rbuf: array[0..2048] of byte;
130 begin
131   move(buffer^, pchar(@rbuf)^, bufferlength);
132   l := bufferlength;
133   for i := 0 to l - 1 do
134   begin
135     s := s + inttohex(rbuf[i], 2);
136   end;
137   mmmsg.lines.add('msgreceived[' + s + ']');
138 end;
139 //var
140 //    tmparray: array[0..4096] of byte;
141 //    i: dword;
142 //    tmpstr: string;
143 //    pstr: pchar;
144 //begin
145 //    pstr := buffer;
146 //    tmpstr := string(pstr);
147 //    mmmsg.lines.add(tmpstr);
148 //    dec(pstr);
149 //    for i := 0 to length(tmpstr) - 1 do
150 //    begin
151 //        inc(pstr);
152 //        tmparray[i] := byte(pstr^);
153 //        mmmsg.lines.add(inttohex(ord(tmparray[i]), 2));
154 //    end;
155 //    exit;
156 //    pstr := buffer;
157 //    mmmsg.lines.add(pstr);
158 //end;
159 
160 procedure tmainfrm.advbtnconfirmclick(sender: tobject);
161 begin
162   if mmsendmsg.lines.count <= 0 then
163   begin
164     application.messagebox('there is no key word, please check the msgsendlist,thanks.', 'error information', mb_ok + mb_iconstop);
165     mmsendmsg.setfocus;
166     exit;
167   end;
168   if cbbyte.checked then
169   begin
170     sendhex(mmsendmsg.text);
171   end
172   else
173   begin
174     commain.writecommdata(pchar(mmsendmsg.text), length(mmsendmsg.text));
175   end;
176   if (cbautosend.checked) and (edttime.text <> '') and (cbbyte.checked) then
177   begin
178     timermain.interval := strtoint(edttime.text);
179     timermain.enabled := true;
180   end;
181 end;
182 
183 procedure tmainfrm.advglassbutton1click(sender: tobject);
184 begin
185   timermain.enabled := false;
186   gbsendmsg.enabled := false;
187   cbbyte.checked := false;
188   cbautosend.checked := false;
189   edttime.text := '';
190   mmmsg.text := '';
191   mmsendmsg.text := '';
192   commain.stopcomm;
193   connectstatus.caption := 'not connected';
194   connectstatus.fillcolor := clred;
195   advbtnconnect.enabled := true;
196 end;
197 
198 procedure tmainfrm.timermaintimer(sender: tobject);
199 begin
200   sendhex(mmsendmsg.text);
201 end;
202 
203 end.