在线150分求串口调试的正确源程序(150分)

  • 主题发起人 主题发起人 xueqinxc
  • 开始时间 开始时间
X

xueqinxc

Unregistered / Unconfirmed
GUEST, unregistred user!
找的个源程序，在我机子调试老是出错，说找不到串行端口，看不出来是哪里有问题
还请大虾们帮忙解决一下，还有设置奇偶校验位怎么设置，我设置的时候也出现了错误
另外，我想把这个程序修改一下，效果是和调试助手的效果差不多的样子！附源程序
解答出来不吝赠分，不够再加！！
unit uCommTest;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, SPComm, ExtCtrls, Buttons, ToolWin, ComCtrls, Menus,
ActnList, Inifiles;

type
TCommTestFrm = class(TForm)
Comm1: TComm;
GroupBox2: TGroupBox;
Label2: TLabel;
Label3: TLabel;
CmbBaudrate: TComboBox;
CmbSendComm: TComboBox;
RadioByteSize: TRadioGroup;
RadioStopBits: TRadioGroup;
RadioParity: TRadioGroup;
BTNResetCommSet: TBitBtn;
BTNSaveCommSet: TBitBtn;
Comm2: TComm;
CoolBar1: TCoolBar;
Label5: TLabel;
CmbRecvComm: TComboBox;
StatusBar1: TStatusBar;
ToolBar1: TToolBar;
BTNOpen: TBitBtn;
BTNSave: TBitBtn;
BTNTest: TBitBtn;
BTNStartRecv: TBitBtn;
BTNStopSend: TBitBtn;
BTNStartSend: TBitBtn;
BTNStopRecv: TBitBtn;
OpenDialog1: TOpenDialog;
SaveDialog1: TSaveDialog;
Memo1: TMemo;
GroupBox1: TGroupBox;
Splitter1: TSplitter;
GroupBox3: TGroupBox;
Memo2: TMemo;
Panel1: TPanel;
Label1: TLabel;
EditAck1: TEdit;
EditAck2: TEdit;
EditAck3: TEdit;
EditAck4: TEdit;
EditAck5: TEdit;
EditAck6: TEdit;
BTNSaveAck: TBitBtn;
MainMenu1: TMainMenu;
FileMenu: TMenuItem;
Test: TMenuItem;
SendMenu: TMenuItem;
RecvMenu: TMenuItem;
HelpMenu: TMenuItem;
OpenFileMenu: TMenuItem;
SaveFileMenu: TMenuItem;
N6: TMenuItem;
ExitMenu: TMenuItem;
TestComMenu: TMenuItem;
StartSendMenu: TMenuItem;
StopSendMenu: TMenuItem;
StartRecvMenu: TMenuItem;
StopRecvMenu: TMenuItem;
HelpWinMenu: TMenuItem;
AboutMenu: TMenuItem;
ActionList1: TActionList;
OpenFileAction: TAction;
SaveFileAction: TAction;
SetACKAction: TAction;
TestCommAction: TAction;
StartSendAction: TAction;
StopSendAction: TAction;
StartReciveAction: TAction;
StopReciveAction: TAction;
HelpAction: TAction;
ViewMenu: TMenuItem;
SendWinMenu: TMenuItem;
RecvWinMenu: TMenuItem;
N16: TMenuItem;
CommSetMenu: TMenuItem;
N18: TMenuItem;
ToolBarMenu: TMenuItem;
AboutAction: TAction;
ExitAction: TAction;
Panel2: TPanel;
BTNSaveLeft: TBitBtn;
Panel3: TPanel;
BTNClearRight: TBitBtn;
BTNClearLeft: TBitBtn;
BTNSaveRight: TBitBtn;
N1: TMenuItem;
F1: TMenuItem;
N2: TMenuItem;
F2: TMenuItem;
Label4: TLabel;
procedure BitBtn11Click(Sender: TObject);
procedure Splitter1Moved(Sender: TObject);
procedure AboutActionExecute(Sender: TObject);
procedure HelpActionExecute(Sender: TObject);
procedure ExitActionExecute(Sender: TObject);
procedure OpenFileActionExecute(Sender: TObject);
procedure SaveFileActionExecute(Sender: TObject);
procedure BTNClearRightClick(Sender: TObject);
procedure BTNClearLeftClick(Sender: TObject);
procedure BTNSaveLeftClick(Sender: TObject);
procedure BTNSaveCommSetClick(Sender: TObject);
procedure BTNResetCommSetClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure BTNSaveAckClick(Sender: TObject);
procedure StartSendActionExecute(Sender: TObject);
procedure StopReciveActionExecute(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure StopSendActionExecute(Sender: TObject);
procedure Comm2ReceiveData(Sender: TObject; Buffer: Pointer;
BufferLength: Word);
procedure TestCommActionExecute(Sender: TObject);
procedure StartReciveActionExecute(Sender: TObject);
procedure Comm1ReceiveData(Sender: TObject; Buffer: Pointer;
BufferLength: Word);
procedure SendWinMenuClick(Sender: TObject);
procedure CommSetMenuClick(Sender: TObject);
procedure ToolBarMenuClick(Sender: TObject);
procedure RecvWinMenuClick(Sender: TObject);
procedure Comm1SendDataEmpty(Sender: TObject);
procedure Comm2RequestHangup(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
CommTestFrm: TCommTestFrm;
ViewString: string;
i, NextNum: Integer;
Recvbuf, Sendbuf: array[1..6] of byte;
Ini: TIniFile;
BaudRate : Cardinal;
SendComm, RecvComm : string;
ByteSize, StopBits : String;
Parity, Testing : Boolean;
implementation

uses uHelp, uAbout;
{$R *.dfm}

procedure TCommTestFrm.BitBtn11Click(Sender: TObject);
begin
HelpFrm.Show;
end;

procedure TCommTestFrm.Splitter1Moved(Sender: TObject);
begin
StatusBar1.Panels[1].Width := GroupBox1.Width;
end;

procedure TCommTestFrm.AboutActionExecute(Sender: TObject);
begin
AboutFrm := TAboutFrm.Create(Application);
AboutFrm.Show;
end;

procedure TCommTestFrm.HelpActionExecute(Sender: TObject);
begin
HelpFrm := THelpFrm.Create(Application);
HelpFrm.Show;
end;

procedure TCommTestFrm.ExitActionExecute(Sender: TObject);
begin
Close;
end;

procedure TCommTestFrm.OpenFileActionExecute(Sender: TObject);
var
F : TextFile;
tmpLine: String;
begin
Memo1.Clear;
OpenDialog1.Title := '打开一个要传送的文本文件！';
if OpenDialog1.Execute then
begin
AssignFile(F, OpenDialog1.FileName);
StatusBar1.Panels[1].Text := OpenDialog1.FileName;
Reset(F);
//读入文件内容到Memo1中
while not Eof(F) do
begin
tmpLine := '';
ReadLn(F, tmpLine);
Memo1.Lines.Add(tmpLine);
end;
CloseFile(F);
end;
end;

procedure TCommTestFrm.SaveFileActionExecute(Sender: TObject);
begin
if Trim(Memo2.Lines.Text) <> '' then
begin
SaveDialog1.Title := '将接收到的内容保存到文本文件中！';
with SaveDialog1 do
if Execute then
begin
StatusBar1.Panels[2].Text := SaveDialog1.FileName;
//将Memo2中内容保存到文件中
Memo2.Lines.SaveToFile(SaveDialog1.FileName);
end;
end;
end;

procedure TCommTestFrm.BTNClearRightClick(Sender: TObject);
begin
Memo2.Clear;
StatusBar1.Panels[2].Text := '';
end;

procedure TCommTestFrm.BTNClearLeftClick(Sender: TObject);
begin
Memo1.Clear;
StatusBar1.Panels[1].Text := '';
end;

procedure TCommTestFrm.BTNSaveLeftClick(Sender: TObject);
begin
if Trim(Memo1.Lines.Text) <> '' then
begin
SaveDialog1.Title := '将即将发送的内容保存到文本文件中！';
with SaveDialog1 do
if Execute then
begin
StatusBar1.Panels[1].Text := SaveDialog1.FileName;
//将Memo1中内容保存到文件中
Memo1.Lines.SaveToFile(SaveDialog1.FileName);
end;
end;
end;

procedure TCommTestFrm.BTNSaveCommSetClick(Sender: TObject);
begin
SendComm := CmbSendComm.text;
RecvComm := CmbRecvComm.Text;
i := CmbBaudRate.ItemIndex;
BaudRate := strtoint(CmbBaudRate.Items);
if RadioParity.ItemIndex =0 then
Parity := True
else Parity := False;
if RadioByteSize.ItemIndex =0 then
ByteSize := '_8'
else ByteSize := '_7';
if RadioStopBits.ItemIndex = 0 then
StopBits := '_1'
else if RadioStopBits.ItemIndex = 1 then
StopBits := '_1_5'
else StopBits := '_2';
Ini := TIniFile.Create(ExtractFilePath(ParamStr(0)) + 'CommSet.ini');
try
Ini.WriteInteger( '串口通信', '波特率', BaudRate);
Ini.WriteString( '串口通信', '发送串口', SendComm);
Ini.WriteString( '串口通信', '接收串口', RecvComm );
Ini.WriteBool( '串口通信', '奇偶校验', Parity);
Ini.WriteString( '串口通信', '字节长度', ByteSize);
Ini.WriteString( '串口通信', '停止位', StopBits);
finally
Ini.Free;
end;
end;

procedure TCommTestFrm.BTNResetCommSetClick(Sender: TObject);
begin
Ini := TIniFile.Create(ExtractFilePath(ParamStr(0)) + 'CommSet.ini');
try
BaudRate := Ini.ReadInteger( '串口通信', '波特率', 9600);
SendComm := Ini.ReadString( '串口通信', '发送串口', 'Com2');
RecvComm := Ini.ReadString( '串口通信', '接收串口', 'Com3' );
Parity := Ini.ReadBool( '串口通信', '奇偶校验', False);
ByteSize := Ini.ReadString( '串口通信', '字节长度', '_8');
StopBits := Ini.ReadString( '串口通信', '停止位', '_1');
EditAck1.Text := Ini.ReadString( '串口测试', '握手信号1', 'F0');
EditAck2.Text := Ini.ReadString( '串口测试', '握手信号2', '01');
EditAck3.Text := Ini.ReadString( '串口测试', '握手信号3', 'FF');
EditAck4.Text := Ini.ReadString( '串口测试', '握手信号4', 'FF');
EditAck5.Text := Ini.ReadString( '串口测试', '握手信号5', '01');
EditAck6.Text := Ini.ReadString( '串口测试', '握手信号6', 'F0');
finally
Ini.Free;
end;
//设置串口通信界面
if BaudRate = 1200 then CmbBaudRate.ItemIndex :=0
else if BaudRate = 2400 then CmbBaudRate.ItemIndex :=1
else if BaudRate = 4800 then CmbBaudRate.ItemIndex :=2
else if BaudRate = 9600 then CmbBaudRate.ItemIndex :=3
else if BaudRate = 19200 then CmbBaudRate.ItemIndex :=4
else if BaudRate = 38400 then CmbBaudRate.ItemIndex :=5
else if BaudRate = 57600 then CmbBaudRate.ItemIndex :=6
else CmbBaudRate.ItemIndex :=7;
if SendComm = 'Com1' then CmbSendComm.ItemIndex :=0
else if SendComm = 'Com2' then CmbSendComm.ItemIndex :=1
else if SendComm = 'Com3' then CmbSendComm.ItemIndex :=2
else CmbSendComm.ItemIndex :=3;
if RecvComm = 'Com1' then CmbRecvComm.ItemIndex :=0
else if RecvComm = 'Com2' then CmbRecvComm.ItemIndex :=1
else if RecvComm = 'Com3' then CmbRecvComm.ItemIndex :=2
else CmbRecvComm.ItemIndex :=3;
if Parity then
RadioParity.ItemIndex := 0
else RadioParity.ItemIndex := 1;
if ByteSize = '_8' then
RadioByteSize.ItemIndex :=0
else RadioByteSize.ItemIndex := 1;
if StopBits = '_1' then
RadioStopBits.ItemIndex := 0
else if StopBits = '_1_5' then
RadioStopBits.ItemIndex := 1
else RadioStopBits.ItemIndex := 2;
//设置COMM1
Comm1.CommName := SendComm;
Comm1.BaudRate := BaudRate;
if ByteSize = '_8' then Comm1.ByteSize := _8
else Comm1.ByteSize := _7;
if StopBits = '_1' then Comm1.StopBits := _1
else if StopBits = '_1_5' then Comm1.StopBits := _1_5
else Comm1.StopBits := _2;
Comm1.ParityCheck := Parity;
//设置COMM2
Comm2.CommName := RecvComm;
Comm2.BaudRate := BaudRate;
if ByteSize = '_8' then Comm2.ByteSize := _8
else Comm1.ByteSize := _7;
if StopBits = '_1' then Comm2.StopBits := _1
else if StopBits = '_1_5' then Comm2.StopBits := _1_5
else Comm2.StopBits := _2;
Comm2.ParityCheck := Parity;
end;

procedure TCommTestFrm.FormCreate(Sender: TObject);
begin
BTNResetCommSetClick(Sender);
Comm1.StartComm;
Comm2.StartComm;
end;

procedure TCommTestFrm.BTNSaveAckClick(Sender: TObject);
var
Ini: TIniFile;
AckSet1, AckSet2,AckSet3,AckSet4,AckSet5,AckSet6: string;
begin
AckSet1 := Copy(EditAck1.Text,1,2); //前两位有效
AckSet2 := EditAck2.Text;
AckSet3 := EditAck3.Text;
AckSet4 := EditAck4.Text;
AckSet5 := EditAck5.Text;
AckSet6 := EditAck6.Text;
Ini := TIniFile.Create(ExtractFilePath(ParamStr(0)) + 'CommSet.ini');
try
Ini.WriteString( '串口测试', '握手信号1', AckSet1);
Ini.WriteString( '串口测试', '握手信号2', AckSet2);
Ini.WriteString( '串口测试', '握手信号3', AckSet3);
Ini.WriteString( '串口测试', '握手信号4', AckSet4);
Ini.WriteString( '串口测试', '握手信号5', AckSet5);
Ini.WriteString( '串口测试', '握手信号6', AckSet6);
finally
Ini.Free;
end;
end;

//发送按钮的点击事件
procedure TCommTestFrm.StartSendActionExecute(Sender: TObject);
var
strSend: String;
i: Integer;
begin
try
Comm1.StopComm;
Comm1.StartComm;
except
Messagedlg('无法打开COMM1!', mterror, [mbOK],0);
end;
Sleep(50);
StatusBar1.Panels[1].Text := '串口1已启动';
for i:= 0 to Memo1.Lines.Count -1 do
begin
strSend := Memo1.Lines;
try
StatusBar1.Panels[1].Text := '串口1正在发送数据';
Comm1.WriteCommData(PChar(strSend) , Length(strSend));
except
Showmessage('发送错误');
end;
end;
end;

procedure TCommTestFrm.StopReciveActionExecute(Sender: TObject);
begin
Comm2.StopComm; //关闭Comm2
StatusBar1.Panels[2].Text := '串口2已关闭';
end;

procedure TCommTestFrm.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
Comm1.StopComm; //关闭Comm1
Comm2.StopComm; //关闭Comm2
end;

procedure TCommTestFrm.StopSendActionExecute(Sender: TObject);
begin
Comm1.StopComm;//关闭Comm1
StatusBar1.Panels[1].Text := '串口1已关闭';
end;

procedure TCommTestFrm.Comm2ReceiveData(Sender: TObject; Buffer: Pointer;
BufferLength: Word);
type
IArr = ^Integer;
var
RevP : array [1..4096] of byte;
i : integer;
CommRevStr : ShortString;
begin
SetLength(CommRevStr,BufferLength);
Move(IArr(buffer)^,Revp,bufferLength);
For i:=1 to BufferLength do
begin
CommrevStr := Char(Revp);
end;
Memo2.Lines.Add(CommrevStr);
StatusBar1.Panels[2].Text := '串口2正在接收数据';
end;

procedure TCommTestFrm.TestCommActionExecute(Sender: TObject);
begin
if not Testing then
begin
Testing := True;
NextNum := 0;
Comm1.WriteCommData(Pchar(EditAck1.Text),Length(Pchar(EditAck1.Text)));
StatusBar1.Panels[1].Text := '串口1正在发送测试数据';
end;
end;

procedure TCommTestFrm.StartReciveActionExecute(Sender: TObject);
begin
try
Comm2.StopComm;
Comm2.StartComm;
except
Messagedlg('无法打开COMM2!', mterror, [mbOK],0);
end;
Sleep(50);
StatusBar1.Panels[2].Text := '串口2已启动';
end;

procedure TCommTestFrm.Comm1ReceiveData(Sender: TObject; Buffer: Pointer;
BufferLength: Word);
begin
StatusBar1.Panels[1].Text := '串口1正在接收数据';
end;

procedure TCommTestFrm.SendWinMenuClick(Sender: TObject);
begin
GroupBox1.Visible:= SendWinMenu.Checked;
end;

procedure TCommTestFrm.CommSetMenuClick(Sender: TObject);
begin
GroupBox2.Visible := CommSetMenu.Checked;
Panel1.Visible := CommSetMenu.Checked;
end;

procedure TCommTestFrm.ToolBarMenuClick(Sender: TObject);
begin
CoolBar1.Visible := ToolBarMenu.Checked;
end;

procedure TCommTestFrm.RecvWinMenuClick(Sender: TObject);
begin
GroupBox3.Visible := RecvWinMenu.Checked;
if GroupBox1.Align = alClient then
begin
GroupBox1.Align := alLeft;
GroupBox1.Width := (CommTestFrm.Width - GroupBox2.Width) div 2;
end
else
GroupBox1.Align := alClient;
end;

procedure TCommTestFrm.Comm1SendDataEmpty(Sender: TObject);
var Str: String;
begin
if not Testing then exit;
NextNum := NextNum+1;
if NextNum <= 5 then
begin
if NextNum = 1 then Str := EditAck2.Text
else if NextNum = 2 then Str := EditAck3.Text
else if NextNum = 3 then Str := EditAck4.Text
else if NextNum = 4 then Str := EditAck5.Text
else if NextNum = 5 then Str := EditAck6.Text;
Comm1.WriteCommData(Pchar(Str),Length(Pchar(Str)));
end
else
begin
StatusBar1.Panels[1].Text := '串口1测试完毕';
Testing := False;
end;
end;

procedure TCommTestFrm.Comm2RequestHangup(Sender: TObject);
begin
StatusBar1.Panels[2].Text := '串口2需要挂起了';
end;

end.
 
没个人帮帮我吗？
 
我并没有看到你的Tcom在哪有定义，你用的应该是一个串口控件，你应该说明用的什么控件？
用一个串口收发你做出来了吗？
 
请留下e_mail,我给你！
 
谢谢woding了
xueqinxc@163.com
 
chen_cc用的是spcomm啊
对了谁知道OoMisc是什么控件吗？
 
能留个qq号码吗？我的是75823370
有些问题想请教
 
WoDing哥 以后串口方面多指教啊 [:D]
 
大路哥和刘麻子接分了
 
您必须登录或注册才可回复。

Similar threads

S
我用SPCOMM做了个连接XK3101（称重显示器）的程序。(50分)
回复
15
查看
137
seeme0526
S
S
我准备做一个像MSN的邮件提示一样打开窗口的程序,请教高手,有没有相关的函数.谢谢.在线等待...(100分)
回复
4
查看
195
seeme0526
S
Y
我的server怎么不能发信息到client？？？dx们可以帮我解释一下套接字吗？(20分)
回复
3
查看
215
ybbh
Y
X
菜鸟不知道finger命令有什么用，照书上的一段代码写在了程序里，可以执行，只不过我不知道finger在局域网里有什么用？ (90分)
回复
4
查看
207
xiaoxiami0
X
D
大家好！不知道是什么原因？ (100分)
回复
2
查看
234
iie
I
后退
顶部