一个程序如何打开多个串口(用API函数来实现)(100分)

  • 主题发起人 主题发起人 brain12345
  • 开始时间 开始时间
B

brain12345

Unregistered / Unconfirmed
GUEST, unregistred user!
我的程序现在可以打开一个串口进行数据的传输很正常,我想用我的程序同时打开多个串口(最少两个),这该怎么来实现,用API函数来打开串口。我做过一个用SPCOMM这个控件设计的多串口的程序。但是现在想用API函数来实现这个程序。不知道怎么去实现了
 
嘿嘿,用控件都不能打开多个串口,你就不要想跳过去直接用API来实现了,用API考虑到的问题绝对比用控件来的多。人家SPcomm是用API帮你写好的,源代码你看的明白么?。
如果你的底子比较扎实(线程,类的概念)。那你可以尝试尝试。联系mail-zhadan02@163.com :)
 
to formality
我做过用spcomm控件打开多个串口的程序,这个程序已经给了用户在使用中了。我现在是想能不能用API 函数来实现想SPCOMM控件那样可以自一个程序中打开多个串口。
 
应该可以:
const
CPort: array [1..4] of String =('COM1','COM2','COM3','COM4');

var
Com: array [1..4] of THandle;

...
Com := CreateFile(PChar(CPort),
GENERIC_READ or GENERIC_WRITE,
0, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
 
当然可以
以下是我的一段代码供参考


{ ×××××实验室设备软件 }
{ System Resource }
{ 串口定义单元 }

{ Copyright (c) 2005, CHR Corporation }
{ Date: 2005-10-01 }
{ Build: 2005-10-04 }
{ Author: muhx }

unit UntCommDefine;

interface

uses
Windows, Classes, SyncObjs, SysUtils, UntTypeDefine;

type
{ 串口通讯类 }
TCom = class
private
FCriticalSection: TCriticalSection;
FHandle: THandle;

FComName: string;
FBaud: TBaudRate;
FParity: TParity;
FStopBit: TStopBit;
FDataBit: TDataBit;
FInQueue: Integer;
FOutQueue: Integer;
FReadTimeOut: Integer;
FWriteTimeOut: Integer;
FTimeOut: COMMTIMEOUTS;
FEventMask: Integer;
private
procedure Lock;
procedure Unlock;
public
constructor ComCreate(AComSet: TComSet);
destructor Destroy; override;
public
procedure ChangeComSet(const AComSet: TComSet);
procedure ChangeParity(AParity: TParity);
procedure CloseCom;
procedure OpenCom;
procedure PurgeCom;
function Enabled: Boolean;
function Read(var APData; ADataLen: Integer): Boolean;
function Write(var APData; ADataLen: Integer): Boolean;
public
function SendCommand(APCommand: PCmdParam): Boolean;
function HandtoClip(AAddress: Byte): Boolean;
function ReceiveData(APReceive: PByte; AReceiveLen: Integer): Boolean;
public
property gHandle: THandle read FHandle;
property gBaud: TBaudRate read FBaud default br57600;
property gDataBit: TDataBit read FDataBit default da8;
property gInQueue: Integer read FInQueue default 4096;
property gOutQueue: Integer read FOutQueue default 2048;
property gParity: TParity read FParity default paSpace;
property gStopBits: TStopBit read FStopBit default sb10;
property gReadTimeOut: Integer read FReadTimeOut default 2000;
property gComName: string read FComName;
property gWriteTimeOut: Integer read FWriteTimeout default 2000;
end;

implementation

{ 创建串口类 }
constructor TCom.ComCreate(AComSet: TComSet);
begin
inherited Create;
{ 临界区 }
FCriticalSection := TCriticalSection.Create;
{ 串口控制句柄 }
FHandle := INVALID_HANDLE_VALUE;
{ 串口参数 }
FComName := COMComID[AComSet.csComID];
FParity := AComSet.csParity;
FBaud := AComSet.csBaud;
FDataBit := AComSet.csDataBit;
FStopBit := AComSet.csStopBit;
FInQueue := AComSet.csInQueue;
FOutQueue := AComSet.csOutQueue;
FReadTimeOut := AComSet.csReadTimeOut;
FWriteTimeOut := AComSet.csWriteTimeOut;
FEventMask := EV_RXCHAR;
{ 两个字节传输间隔 }
FTimeOut.ReadIntervalTimeout := 30;
{ 每字节传输时间 }
FTimeOut.ReadTotalTimeoutMultiplier := 5;
{ 没有字节时返回时间 }
FTimeOut.ReadTotalTimeoutConstant := 80;
{ 每字节传输时间 }
FTimeOut.WriteTotalTimeoutMultiplier := 5;
{ 传输时间常量 }
FTimeOut.WriteTotalTimeoutConstant := 50;
{ 打开串口 }
OpenCom;
end;

{ 释放串口类 }
destructor TCom.Destroy;
begin
CloseCom;
if FCriticalSection <> nil then
begin
FCriticalSection.Free;
FCriticalSection := nil;
end;
inherited Destroy;
end;

{ 判断串口是否创建 }
function TCom.Enabled: Boolean;
begin
Result := FHandle <> INVALID_HANDLE_VALUE;
end;

{ 关闭串口 }
procedure TCom.CloseCom;
begin
if Enabled then
begin
Sleep(100);
CloseHandle(FHandle);
FHandle := INVALID_HANDLE_VALUE;
end;
end;

{ 更改串口参数 }
procedure TCom.ChangeComSet(const AComSet: TComSet);
var
tmpDCB: DCB;
begin
try
with AComSet do
begin
FParity := csParity;
FBaud := csBaud;
FDataBit := csDataBit;
FStopBit := csStopBit;
FInQueue := csInQueue;
FOutQueue := csOutQueue;
FReadTimeOut := csReadTimeOut;
FWriteTimeOut := csWriteTimeOut;
end;

if Enabled then
begin
tmpDCB.DCBlength := SizeOf(DCB);
GetCommState(FHandle, tmpDCB);
tmpDCB.BaudRate := COMBaudRate[FBaud];
tmpDCB.Parity := COMParity[FParity];
tmpDCB.ByteSize := COMDataBit[FDataBit];
tmpDCB.StopBits := COMStopBit[FStopBit];

if not (SetupComm(FHandle, FInQueue, FOutQueue) and SetCommState(FHandle, tmpDCB))
then Abort;
PurgeCom;
end;
except
on E: Exception do
begin
CloseCom;
end;
end;
end;

{ 更改串口奇偶校验设置 }
procedure TCom.ChangeParity(AParity: TParity);
var
tmpDCB: DCB;
begin
try
FParity := AParity;
if Enabled then
begin
tmpDCB.DCBlength := SizeOf(DCB);
GetCommState(FHandle, tmpDCB);
tmpDCB.Parity := COMParity[FParity];

if not SetCommState(FHandle, tmpDCB) then
Abort;
PurgeCom;
end;
except
on E: Exception do
begin
CloseCom;
end;
end;
end;

{ 进入临界区 }
{ 在对串口进行操作的时候确保没有同时进行其他操作 }
procedure TCom.Lock;
begin
FCriticalSection.Enter;
end;

{ 退出缓冲区 }
procedure TCom.Unlock;
begin
FCriticalSection.Leave;
end;

{ 创建串口 }
procedure TCom.OpenCom;
var
tmpDCB: DCB;
begin
if Enabled then
Exit;
try
FHandle := CreateFile(PChar(FComName), GENERIC_READ or GENERIC_WRITE,
0, nil,
OPEN_EXISTING,
FILE_FLAG_OVERLAPPED,
0);

if not Enabled then
Abort
else begin
{ 设置串口参数 }
tmpDCB.DCBlength := SizeOf(DCB);
GetCommState(FHandle, tmpDCB);
tmpDCB.BaudRate := COMBaudRate[FBaud];
tmpDCB.Parity := COMParity[FParity];
tmpDCB.ByteSize := COMDataBit[FDataBit];
tmpDCB.StopBits := COMStopBit[FStopBit];

if not (SetCommMask(FHandle, FEventMask) and
SetCommTimeouts(FHandle, FTimeOut) and
SetupComm(FHandle, FInQueue, FOutQueue) and
SetCommState(FHandle, tmpDCB) and
(FCriticalSection <> nil)) then
Abort;
end;
except
on E: Exception do
begin
CloseCom;
end;
end;
end;

{ 清空缓冲区 }
procedure TCom.PurgeCom;
begin
if Enabled then
begin
PurgeComm(FHandle, PURGE_RXCLEAR);
PurgeComm(FHandle, PURGE_TXCLEAR);
end;
end;

{ 从串口读取数据 }
function TCom.Read(var APData; ADataLen: Integer): Boolean;
var
tmpOverlapped: TOverlapped;
tmpEvent: TSimpleEvent;
tmpReceive: DWord;
begin
Result := True;
Lock;
tmpEvent := TSimpleEvent.Create;
try
tmpReceive := 0;
FillChar(tmpOverlapped, SizeOf(tmpOverlapped), 0);
tmpOverlapped.hEvent := tmpEvent.Handle;

if not ReadFile(FHandle, APData, ADataLen, DWord(tmpReceive),
@tmpOverlapped) and (GetLastError <> ERROR_IO_PENDING) then
Result := False;

if tmpEvent.WaitFor(FReadTimeOut) <> wrSignaled then
Result := False
else begin
GetOverlappedResult(FHandle, tmpOverlapped, DWord(tmpReceive), False);
tmpEvent.ResetEvent;
end;
finally
Unlock;
tmpEvent.Free;
if tmpReceive <> DWord(ADataLen) then
Result := False;
end;
end;

{ 向串口写入数据 }
function TCom.Write(var APData; ADataLen: Integer): Boolean;
var
tmpOverlapped: TOverlapped;
tmpEvent: TSimpleEvent;
tmpWrite: DWord;
begin
Lock;
Result := True;
tmpEvent := TSimpleEvent.Create;
try
tmpWrite := 0;
FillChar(tmpOverlapped, SizeOf(tmpOverlapped), 0);
tmpOverlapped.hEvent := tmpEvent.Handle;

if not WriteFile(FHandle, APData, ADataLen, DWord(tmpWrite),
@tmpOverlapped) and (GetLastError <> ERROR_IO_PENDING) then
Result := False;

if tmpEvent.WaitFor(FWriteTimeOut) <> wrSignaled then
Result := False
else begin
GetOverlappedResult(FHandle, tmpOverlapped, DWord(tmpWrite), False);
tmpEvent.ResetEvent;
end;
finally
Unlock;
tmpEvent.Free;
if tmpWrite <> DWord(ADataLen) then
Result := False;
end;
end;

{ 发送命令 }
function TCom.SendCommand(APCommand: PCmdParam): Boolean;
var
i: Integer;
begin
Result := False;
Lock;
try
i := 0;
while (i < 5) do
begin
{ 地址握手 }
ChangeParity(paMark);
if not HandtoClip(APCommand^.cmdAddress) then
begin
Inc(i);
Continue;
end;
{ 发送命令 }
ChangeParity(paSpace);
if not Write(APCommand^.cmdCommand, SizeOf(APCommand^.cmdCommand)) then
begin
Inc(I);
Continue;
end;
{ 发送数据 }
if APCommand^.cmdSendLen <> 0 then
begin
if not Write(APCommand^.cmdPSend^, APCommand^.cmdSendLen) then
begin
Inc(I);
Continue;
end;
end;
{ 接收数据 }
if not ReceiveData(APCommand^.cmdPReceive, APCommand^.cmpReceiveLen) then
begin
Inc(I);
Continue;
end;
Result := True;
Break;
end;
finally
Sleep(100);
PurgeCom;
UnLock;
end;
end;

{ 与MCU地址握手 }
function TCom.HandtoClip(AAddress: Byte): Boolean;
var
tmpRead: array[0..2] of Byte;
begin
{ 发送地址 }
if not Write(AAddress, SizeOf(AAddress)) then
begin
Result := False;
Exit;
end;
{ 读取数据 }
if not Read(tmpRead, SizeOf(tmpRead)) then
begin
Result := False;
Exit;
end;
{ 比较数据 }
if (tmpRead[0] <> $AA) or (tmpRead[1] <> $55) or (tmpRead[2] <> AAddress) then
begin
Result := False;
Exit;
end;
{ 若接收成功且数据正确返回True }
Result := True;
end;

{ 接收数据,根据通讯协议,在接收数据前有AA55两字节校验码 }
function TCom.ReceiveData(APReceive: PByte; AReceiveLen: Integer): Boolean;
var
tmpRead: array[0..1023] of Byte;
tmpPByte: PByte;
i: Integer;
begin
if AReceiveLen <> 0 then
begin
if Read(tmpRead, AReceiveLen + 2) then
begin
if (tmpRead[0] = $AA) and (tmpRead[1] = $55) then
begin
tmpPByte := APReceive;
for i := 0 to AReceiveLen - 1 do
begin
tmpPByte^ := tmpRead[i + 2];
Inc(tmpPByte);
end;
end
else
begin
Result := False;
Exit;
end;
end
else
begin
Result := False;
Exit;
end;
end
else
begin
if (not Read(tmpRead, 3)) or (tmpRead[0] <> $AA) or (tmpRead[1] <> $55) then
begin
Result := False;
Exit;
end;
if tmpRead[2] = $88 then
begin
Result := False;
Exit;
end
end;
Result := True;
end;

end.
 
部分定义
type
{ 串行通讯定义 }
{ 串口号 }
TCOMID = (ciCOM1, ciCOM2, ciCOM3, ciCOM4, ciCOM5, ciCOM6, ciCOM7, ciCOM8, ciCOM9,
ciCOM10, ciCOM11, ciCOM12, ciCOM13, ciCOM14, ciCOM15, ciCOM16);
{ 波特率 }
TBaudRate = (br110, br300, br600, br1200, br2400, br4800, br9600, br14400, br19200,
br38400, br56000, br57600, br115200, br128000, br256000);
{ 奇偶校验 }
TParity = (paNone, paOdd, paEven, paMark, paSpace);
{ 停止位 }
TStopBit = (sb10, sb15, sb20);
{ 数据位 }
TDataBit = (da4, da5, da6, da7, da8);
{ 串口设置属性 }
TComSet = record
csComID: TComID;
csBaud: TBaudRate;
csParity: TParity;
csDataBit: TDataBit;
csStopBit: TStopBit;
csOutQueue: Integer;
csInQueue: Integer;
csReadTimeOut: Integer;
csWriteTimeOut: Integer;
end;

const
{ 串口号 }
COMComID: array[TCOMID] of string = ('COM1', 'COM2', 'COM3', 'COM4', 'COM5', 'COM6', 'COM7', 'COM8', 'COM9', 'COM10', 'COM11', 'COM12', 'COM13', 'COM14', 'COM15', 'COM16');
{ 波特率 }
COMBaudRate: array[TBaudRate] of Integer = (CBR_110, CBR_300, CBR_600, CBR_1200, CBR_2400, CBR_4800, CBR_9600, CBR_14400, CBR_19200, CBR_38400, CBR_56000, CBR_57600, CBR_115200, CBR_128000, CBR_256000);
{ 数据位 }
COMDataBit: array[TDataBit] of Integer = (4, 5, 6, 7, 8);
{ 奇偶性 }
COMParity: array[TParity] of Integer = (NOPARITY, ODDPARITY, EVENPARITY, MARKPARITY, SPACEPARITY);
ITEM_PARITY: array[TParity] of string = ('NONE', 'ODD', 'EVEN', 'MARK', 'SPACE');
{ 停止位 }
COMStopBit: array[TStopbit] of Integer = (ONESTOPBIT, ONE5STOPBITS, TWOSTOPBITS);
ITEM_STOPBIT: array[TStopbit] of string = ('1', '1.5', '2');
 
Com类中的
function SendCommand(APCommand: PCmdParam): Boolean;
function HandtoClip(AAddress: Byte): Boolean;
function ReceiveData(APReceive: PByte; AReceiveLen: Integer): Boolean;
只是一个例子,说明怎么使用Read,Write,具体含义没有必要仔细研究
 
以上的楼主你们说得都好,但是我现在刚刚在学用SPCOMM控件来实现通信都不行能不能那跟我提示一点.我的问题是:
我试过很多次都不能显示我收到信息与否.
请不要见笑了.以下是我的一些想法.


//向端口发送数据
procedure TfrmComm.btnSendClick(Sender: TObject);
var
str: Pchar;
Count: integer;
begin
if edtSendText.Text='' then
raise exception.create('发送字符串为空,错误终止');
COUNT:=edtSendText.GetTextLen;//获取文本框里字符长度
str := Pchar(edtSendText.Text);
//Count := Length(str);
if Comm.WriteCommData(str,Count) then//str参数为要发送的字符串,count参数设置发送字符串的长度。函数用于将一个字符串发送到写进程,发送成功返回TRUE反之返回FLASE
begin
mmoComm.lines.Add('已发送字符串为:'+str );//'总共有'+ intTostr(Count) + '个字符')
mmoComm.lines.Add ('串长度'+ intTostr(Count) + '个字符');
end
else
raise exception.Create('发送错误');
end;


//从端口接收数据
procedure TfrmComm.CommReceiveData(Sender: TObject; Buffer: Pointer; BufferLength: Word);
var
str1,strRecv : string;
begin
setLength(strRecv,BufferLength);
Move(Buffer^,pchar(strRecv)^,BufferLength);
mmoComm.Lines.Add('已收到: '+intTostr(BufferLength)+'字节的数据');
mmoComm.Lines.Add(strRecv);
mmoComm.Invalidate ;
//******************
出于无奈只有使用以下方法来证实一下真的收到过数据没有.但还是无奈,没有
if StrRecv='abcdefg' then
mmoComm.Lines.Add(' 收取成功!');
str1:=Copy(StrReCv,1,2);
if Str1='ab' then
mmoComm.Lines.Add('判断成功!');

end;
 
楼上的,先检查你的线路有没有连接好,如果只是想验证代码可以考虑将你的串口2,3脚短接。
可以使用串口大师先验证好线路在验证你的程序
 
后退
顶部