串口开发群:2000202！！！怎样用Delphi进行开发与单片机通信的软件,请各位高手帮忙！！！！！！！！ ( 积分: 100 )

狂顶！！！

要不你到www.51merit.com上看！那有完美的例子！

unit PTCom232;
{
设计:张世平
www.51merit.com

}
interface
uses
StrUtils,
Classes,
windows,
Dialogs,
WinSock,
ScktComp,
IniFiles,
SysUtils,
ExtCtrls,
SPComm,
GlobalDefine;
resourcestring
StatusDateTimeFormat = 'yyyy/mm/dd" - "hh:nn:ss:zzz AM/PM';

type
TCFG = record

CommName: pchar;
BaudRate: integer;
ByteSize: pchar;
StopBits: pchar;
Parity: pchar;
NeedWriteLog: integer;
end;

PMyPobject = ^MyPobject;
MyPobject = record
Msg: PByte;
Len: Integer
end;

TCom232 = class
private
AComm: TComm;
TimerSend: TTimer; //Èç¹ûcom232 ͨ£¬²¢ÇÒ·¢ËͶÓÁÐÓÐÊý¾Ý£¬Ôò·¢ËÍ

procedure TimerSendTimer(Sender: tobject);
procedure CommReceiveData(Sender: TObject; Buffer: Pointer; BufferLength: Word);
procedure CommReceiveError(Sender: TObject; EventMask: Cardinal);
function LoadUDPParameter(): BOOLEAN;
function SetUDPParameter(): BOOLEAN;

public
constructor Create();
destructor DESTROY; override;
function Open(): boolean;
function Execute(): BOOLEAN;
procedure WriteLog(ErrStr: string);
end;

function FreeBuf(Buffer: PTThreadList): Boolean;
function ReadFromBuf(var MyObject: PMyPobject; var
Buffer: PTThreadList): Boolean;
function HaveData(Buffer: PTThreadList): Boolean;
function WriteToBuf(var MyObject: PMyPobject; var
Buffer: PTThreadList; Capacity: Integer): Boolean;

procedure Log(LogFilename: string; ErrStr: string);
procedure SendLog(ErrStr: string);
procedure RecLog(ErrStr: string);

procedure HexStrToBytes(hHexStr: string; pbyteArray: Pointer);
procedure BytesToHexStr(var hHexStr: string; pbyteArray: PByte; InputLength: WORD);


const
iCapacity = 1024;
CONFIG = 'CONFIG232.INI';
SelfLog = 'log_232.Log';
SendDataQueue_log = 'log_232_send.log';
ReceiveDataQueue_Log = 'log_232_Rec.log';


var SendDataQueue: PTThreadList; //´ý·¢ËÍÊý¾Ý¶ÓÁÐ
ReceiveDataQueue: PTThreadList; //½ÓÊÕÊý¾Ý
CurPath: string;
CFG: TCFG;


implementation

procedure HexStrToBytes(hHexStr: string; pbyteArray: Pointer);
{pbyteArray must point to enough memory to hold the output}
var
i, j: WORD;
tempPtr: PChar;
twoDigits: string[2];
begin
tempPtr := pbyteArray;
j := 1;
for i := 1 to (Length(hHexStr) div 2) do begin
twoDigits := Copy(hHexStr, j, 2);
Inc(j, 2);
PByte(tempPtr)^ := StrToInt('$' + twoDigits);
Inc(tempPtr);
end; {for}
if ((Length(hHexStr) mod 2) = 1) then
begin
twoDigits := '0' + RightStr(hHexStr, 1);
Inc(j, 2);
PByte(tempPtr)^ := StrToInt('$' + twoDigits);
end;

end;

procedure BytesToHexStr(var hHexStr: string; pbyteArray: PByte; InputLength: WORD);
const
HexChars: array[0..15] of Char = '0123456789ABCDEF';
var
i, j: WORD;
begin
hHexStr := '';
j := 1;
for i := 1 to InputLength do begin
hHexStr := hHexStr + Char(HexChars[pbyteArray^ shr 4]);
inc(j);
hHexStr := hHexStr + Char(HexChars[pbyteArray^ and 15]);
inc(j);
inc(pbyteArray);
end;

end;


procedure Log(LogFilename: string; ErrStr: string);
var
LogFile: TextFile;
begin
if CFG.NeedWriteLog <> 1 then exit;
AssignFile(LogFile, LogFilename);
if FileExists(LogFilename) then Append(LogFile)
else Rewrite(LogFile);
Writeln(LogFile, ErrStr);
CloseFile(LogFile);
end;


procedure TCom232.WriteLog(ErrStr: string);
begin
LOG(CurPath + selflog, DateTimeToStr(now) + ': ' + ErrStr);
end;


procedure SendLog(ErrStr: string);
begin
LOG(CurPath + SendDataQueue_log, ErrStr);
end;

procedure RecLog(ErrStr: string);
begin
LOG(CurPath + ReceiveDataQueue_Log, ErrStr);
end;


function GETINIkey(IniFile: pchar; MAINKEY: pchar; SUBKEY: pchar): pchar; stdcall; //export;
var
myini: Tinifile;
s: string;
begin
// curpath:=extractfilepath(Application.exename);
myini := Tinifile.Create(IniFile);
// result := PCHAR(Myini.readString(mainkey, subkey, ''));
s := myini.readString(MAINKEY, SUBKEY, '');
getmem(result, length(s) + 1);
strcopy(result, pchar(s));
myini.Free;
end;

constructor TCom232.Create();
begin
if not LoadUDPParameter() then EXIT;

New(SendDataQueue);
SendDataQueue^ := TThreadList.Create;

New(ReceiveDataQueue);
ReceiveDataQueue^ := TThreadList.create;


TimerSend := TTimer.Create(nil); //Èç¹ûwinsock ͨ£¬²¢ÇÒ·¢ËͶÓÁÐÓÐÊý¾Ý£¬Ôò·¢ËÍ
TimerSend.Enabled := false;
TimerSend.Interval := 1; //ʱ¼ä¿ÉÒÔ×Ô¼º¶¨Òå
TimerSend.OnTimer := TimerSendtimer;

ACOMM := TCOMM.Create(nil);
ACOMM.OnReceiveData := CommReceiveData;
Acomm.OnReceiveError := CommReceiveError;

if not SetUDPParameter() then EXIT;

end;

function TCom232.Open(): boolean;
begin
result := false;
try
AComm.StartComm();
except
writelog(AComm.CommName + ' ´ò¿ªÊ§°Ü,ÇëÈ·ÐŵçÀÂÕýÈ·...');
exit;
end;
//ÊÇ·ñÅжÏÒѾ­´ò¿ª,Öظ´´ò¿ª
// writelog(AComm.CommName + ' ´ò¿ªÊ§°Ü...');
result := true;
end;

destructor TCom232.DESTROY;
begin
if TimerSend <> nil then
begin
TimerSend.Enabled := FALSE;
TimerSend.Free;
end;
if ACOMM <> nil then
begin
Acomm.StopComm;
AComm.Free;
end;
WRITELOG('COM232 ·þÎñÕý³£¹Ø±Õ!');
end;

function TCom232.Execute: BOOLEAN;
begin
timerSend.Enabled := true;
RESULT := TRUE;
end;

function TCom232.LoadUDPParameter(): BOOLEAN;
var inifile: pchar;
begin
RESULT := FALSE;
inifile := pchar(CurPath + CONFIG);
try
CFG.CommName := GETINIkey(inifile, 'com232', 'CommName');
CFG.BaudRate := strtoint(GETINIkey(inifile, 'com232', 'BaudRate'));
CFG.ByteSize := GETINIkey(inifile, 'com232', 'ByteSize');
CFG.StopBits := GETINIkey(inifile, 'COM232', 'StopBits');
CFG.Parity := GETINIkey(inifile, 'COM232', 'Parity');
CFG.NeedWriteLog := STRTOINT(GETINIkey(inifile, 'COM232', 'NeedWriteLog'));
RESULT := TRUE;
except
RESULT := FALSE;
EXIT;
end;

if (CFG.ByteSize <> '_5') and (CFG.ByteSize <> '_6') and (CFG.ByteSize <> '_7') and (CFG.ByteSize <> '_8') then
begin
Writelog(config + ' is error:bytesize must in [_5, _6, _7, _8] . . ');
result := false;
EXIT;
end;
if (CFG.StopBits <> '_1') and (CFG.StopBits <> '_1_5') and (CFG.StopBits <> '_2') then
begin
Writelog(config + ' is error:StopBits must in [_1, _1_5, _2] . . ');
result := false;
EXIT;
end;
//None, Odd, Even, Mark, Space
if (CFG.Parity <> 'None') and (CFG.Parity <> 'Odd') and (CFG.Parity <> 'Even') and (CFG.Parity <> 'Mark') and (CFG.Parity <> 'Space') then
begin
Writelog(config + ' is errorarity must in [None, Odd, Even, Mark, Space] . . ');
result := false;
EXIT;
end;
end;

function TCom232.SetUDPParameter(): BOOLEAN;
begin
RESULT := FALSE;
try
WriteLog('COM232 È«Ë«¹¤Í¨ÐÅ·þÎñÕýÔÚ¼ÓÔØ...');
WriteLog('commname:' + cfg.CommName);
WriteLog('BaudRate:' + inttostr(cfg.BaudRate));
WriteLog('ByteSize:' + cfg.ByteSize);
WriteLog('StopBits:' + cfg.StopBits);
WriteLog('Parity:' + cfg.Parity);
AComm.CommName := '//./'+cfg.CommName;
AComm.BaudRate := cfg.BaudRate;

if cfg.ByteSize = '_5' then AComm.ByteSize := tbytesize(0);
if cfg.ByteSize = '_6' then AComm.ByteSize := tbytesize(1);
if cfg.ByteSize = '_7' then AComm.ByteSize := tbytesize(2);
if cfg.ByteSize = '_8' then AComm.ByteSize := tbytesize(3);

if cfg.StopBits = ' _1' then AComm.StopBits := TStopBits(0);
if cfg.StopBits = ' _1_5' then AComm.StopBits := TStopBits(1);
if cfg.StopBits = ' _2' then AComm.StopBits := TStopBits(2);

if cfg.Parity = 'None' then AComm.Parity := TParity(0);
if cfg.Parity = 'Odd' then AComm.Parity := TParity(1);
if cfg.Parity = 'Even' then AComm.Parity := TParity(2);
if cfg.Parity = 'Mark' then AComm.Parity := TParity(3);
if cfg.Parity = 'Space' then AComm.Parity := TParity(4);

writelog('Set Com232 Parameter success...');
RESULT := TRUE;
except
writelog('Set Com232 Parameter fail...');
RESULT := FALSE;
end;
end;



procedure TCom232.TimerSendTimer(Sender: tobject);
var
wmsg: PMyPobject;
TmpStr: string;
buf: array of byte;
begin
if not HaveData(SendDataQueue) then exit;
//ÏÖÔÚÈçºÎÈ·ÐÅcomÒÀÈ»´ò¿ªÄØ£¿·ñÔòreadfrombuf ¶ÁÁ˾ͱ»É¾³ýÁË
try
wmsg := nil;
if not ReadFromBuf(wmsg, SendDataQueue) then exit;
if wmsg = nil then exit; //Èç¹û³É¹¦»á×Ô¶¯´Ó¶ÓÁÐɾ³ý
// buf[0]:=byte($A1);
// buf[1]:=byte($A2);
// buf[2]:=byte($A3);
// buf[3]:=byte($f1);
//AComm.WriteCommData(@buf[0],4);
//winsock.SendBuf(wmsg.msg^, wmsg.Len);
setlength(buf, wmsg.Len);
copymemory(buf, wmsg.Msg, wmsg.Len);
AComm.WriteCommData(@buf[0], wmsg.Len);
BytesToHexStr(TmpStr,wmsg.Msg, wmsg.Len);
//Ò²¿ÉÒÔBytesToHexStr(TmpStr, @buf[0], wmsg.Len);ÍêÈ«ÕýÈ·
SendLog(TmpStr);
finally
if wmsg <> nil then
begin
if wmsg^.Msg <> nil then
FreeMem(wmsg.Msg, wmsg.Len);
Dispose(wmsg);
end;
end;
end;

procedure TCom232.CommReceiveData(Sender: TObject; Buffer: Pointer;
BufferLength: Word);
var
TmpStr: string;
wmsg: PMyPobject;
begin
new(wmsg);
getmem(wmsg.Msg, BufferLength);
CopyMemory(wmsg.Msg, Buffer, BufferLength); // wmsg.Msg^ := MsgOfWrite^;
WriteToBuf(wmsg, ReceiveDataQueue, BufferLength);
BytesToHexStr(TmpStr, wmsg.Msg, BufferLength);
RecLog(Tmpstr);
end;

procedure TCom232.CommReceiveError(Sender: TObject; EventMask: Cardinal);
begin
writelog(ACOMM.CommName + ' ReceiveError...');
end;

function FreeBuf(Buffer: PTThreadList): Boolean;
var
tmpList: TList;
wmsg: pMyPobject;
begin
result := true;
tmpList := Buffer^.LockList;
while tmpList.Count > 0 do
begin
wmsg := PMyPobject(tmpList.Last);
tmpList.Delete(tmplist.Count - 1);
tmplist.Pack;
if wmsg <> nil then
begin
if wmsg^.Msg <> nil then
FreeMem(wmsg.Msg, wmsg.Len);
Dispose(wmsg);
end;
end
end;

function ReadFromBuf(var MyObject: PMyPobject; var
Buffer: PTThreadList): Boolean;
var
tmpList: TList;
begin
result := true;
tmpList := Buffer^.LockList;
try
if tmpList.Count > 0 then
begin
MyObject := tmpList.First;
tmpList.Delete(0);
tmpList.Pack;
end
else
begin
MyObject := nil;
result := false;
end;
finally
begin
Buffer^.UnlockList;
end;
end;

end;

function HaveData(Buffer: PTThreadList): Boolean;
var
tmpList: TList;
begin
tmpList := Buffer^.LockList;
if tmpList.Count > 0 then
result := true
else
result := false;
Buffer^.UnlockList;
end;

function WriteToBuf(var MyObject: PMyPobject; var
Buffer: PTThreadList; Capacity: Integer): Boolean;
var
tmpList: TList;
wmsg: PMyPobject;
begin

tmpList := Buffer^.LockList;
try
while tmpList.Count >= Capacity do
begin
wmsg := tmpList.First;
tmpList.Delete(0);
tmpList.Pack;
if wmsg <> nil then
begin
if wmsg^.Msg <> nil then
FreeMem(wmsg.Msg, wmsg.Len);
Dispose(wmsg);
end;
end;
tmpList.Add(MyObject);
tmpList.Pack;
finally
begin
Buffer^.UnlockList;
end;
end;
result := true;
end;



end.

串口通信太简单了.只要连接线正确/通信设置正确/串口打开之后直接读写就可以了.
没有办法

楼上兄弟为什么说没办法,什么意思呀?

看来很少人懂得串口与单片机这方面的软件啊.

可以通信很容易做到。连接好，设置串口通信参数，打开串口即可。
接下来的工作就是根据单片机规定的通信格式发送/接收解析数据了。设在没有什么好说的

用spcomm基本上都能搞定的

串口通讯的确很简单，连好线，用CreateFile打开串口，然后设置串口的参数，如停止位、校验、握手、缓冲区大小等，接着用WriteFile发数据到设备，用ReadFile读从设备返回的数据。关键是你要搞清楚通讯协议

学习

13708782004你好啊！
你的网站上有例子但是不能下载来看啊，只是知道有例子有什么用啊。都下不了。

学习中

我用控件,MSCOMM,delphi自带的..很简单的...
我有一个程序,控制厨房用具的...
如果有需要可以给我E_mail13531709364@126.com

楼上的兄弟．我发了邮件给你怎么没有回我呀，可以给我发你的程序看看吗，谢谢！
我的邮箱：Gfansenhua@163.com

路过，学习一下，
关注一下

我有做过一个电话计费的，和NEC的PBX通信，用MSCOMM，其实如果通迅参数设好了，真的是很简单的。

LanderLiu好啊！问题还是没有解决啊，可能我比较笨吧，可不可以发一份你做的代码给我看看。谢谢！
问了快一个月了都没有什么人回答这个问题，是不是大富翁里面真的这么少做这方面的软件的人呀？

怎么可能？
我的代码是没有优化，绝对可以用
是不是你那个单片机程序有问题哦
用串口调试助手试试

自编的多线程串口通讯原码，
多给点分
unit SCommer;

interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,PKGUNIT;

const
PWM_GOTCOMMDATA = WM_USER + 1;
PWM_ERROCCUR = WM_USER+2;
PWM_COMMEVENT = WM_USER+3;
type
ECommsE0rror = class( Exception );
TReadThread = class( TThread )
protected
procedure Execute; override;
public
hCommFile: THandle;
hCloseEvent:THandle;
hCommWindow:THandle;
function SetupCommEvent(lpOverlappedCommEvent: POverlapped;
var lpfdwEvtMask: DWORD ): Boolean;
function SetupReadEvent(lpOverlappedRead: POverlapped;
lpszInputBuffer: LPSTR; dwSizeofBuffer: DWORD;
var lpnNumberOfBytesRead: DWORD ): Boolean;
function HandleCommEvent(lpOverlappedCommEvent: POverlapped;
var lpfdwEvtMask: DWORD; fRetrieveEvent: Boolean ):Boolean;
function HandleReadEvent(lpOverlappedRead: POverlapped;
lpszInputBuffer: LPSTR; dwSizeofBuffer: DWORD;
var lpnNumberOfBytesRead: DWORD ): Boolean;
function HandleReadData(lpszInputBuffer: LPCSTR; dwSizeofBuffer: DWORD ):Boolean;
function EventOccur(EvtType: byte):BOOL;
function ErrorsOccur(ErrType: byte):BOOL;
function ReceiveData(lpNewString: LPSTR; dwSizeofNewString: DWORD ): BOOL;
end;

TWriteThread = class( TThread )
protected
procedure Execute; override;
function HandleWriteData(lpOverlappedWrite: POverlapped;pDataToWrite: PChar;
dwNumberOfBytesToWrite: DWORD): Boolean;
public
hCommFile:THandle;
hCloseEvent:THandle;
hCommWindow:THandle;
function WriteComm(pDataToWrite: LPCSTR; dwSizeofDataToWrite: DWORD): Boolean;
function ErrorsOccur(ErrType:byte):BOOL;
end;
TReceiveDataEvent = procedure( Buffer: Pointer; BufferLength: Word ) of object;
TErrorsEvent = procedure(ErrType:byte) of object;
TCommEvent = procedure(EventType:byte) of object;
emParity = (NoParity,OddParity,EvenParity,MarkParity,SpaceParity);
emStopBits =(OneStopBit,One5StopBits,TwoStopBits);

TCOMMPORT = class(TComponent)//TCustomControl
private
ReadThread: TReadThread;
WriteThread: TWriteThread;
FCommPort: string;
lpModemStat: DWORD;
lpEvtMask: DWORD;
hCommFile: THandle;
dcb: Tdcb;
commtimeouts: TCommTimeouts;
hCloseEvent: THandle;
FOnReceiveData: TReceiveDataEvent;
FOnErrOccur: TErrorsEvent;
FOnCommEvent: TCommEvent;
FHWnd: THandle;
FBaudRate: DWORD;
FByteSize: byte;
FParity: emParity;
FStopBits: emStopBits;
FXONChar: char;
FXOFFChar: char;
FErrorChar: char;
FEofChar: char;
FEvtChar: char;
FCTSHolding,FDSRHolding,FRLSDHolding,FSDBufState: boolean;
//TimeOut Parameters
FReadIntervalTimeout : DWORD;
FReadTotalTimeoutMultiplier : DWORD;
FReadTotalTimeoutConstant : DWORD;
FWriteTotalTimeoutMultiplier : DWORD;
FWriteTotalTimeoutConstant : DWORD;
FInQueue : DWORD;
FOutQueue : DWORD;

function GetReceiveDataEvent: TReceiveDataEvent;
procedure SetReceiveDataEvent( AReceiveDataEvent: TReceiveDataEvent );
function GetErrEvent:TErrorsEvent;
procedure SetErrEvent(AErrEvent:TErrorsEvent);
function GetCommEvent:TCommEvent;
procedure SetCommEvent(ACommEvent:TCommEvent);
procedure CommWndProc( var msg: TMessage );
//setup the port parameters
procedure SetBaudRate(valueWORD);
procedure SetByteSize(value:BYTE);
procedure SetParity(value:emParity);
procedure SetStopBits(value:emStopBits);
procedure SetXONChar(value:CHAR);
procedure SetXOFFChar(value:CHAR);
procedure SetErrorChar(value:CHAR);
procedure SetEofChar(value:CHAR);
procedure SetEvtChar(value:CHAR);
//setup the timeout parameters
procedure setRIT(valueWORD);
procedure setRTTM(valueWORD);
procedure setRTTC(valueWORD);
procedure setWTTM(valueWORD);
procedure setWTTC(valueWORD);
procedure setInQueue(valueWORD);
procedure setOutQueue(valueWORD);
function GetCTS:boolean;
function GetDSR:boolean;
function GetRLSD:boolean;
Function GetTxBufState:Boolean;
protected
procedure CloseReadThread;
procedure CloseWriteThread;
procedure ReceiveData(Buffer: PChar; BufferLength: Word );
procedure EventOccur(EvtType:byte);
procedure ErrorsOccur(ErrType:byte);
public
constructor Create(AOwner:TComponent); override;
destructor Destroy; override;
function OpenComm: byte;
function Purge(Act:byte):boolean;
procedure CloseComm;
function Send( pDataToWrite: PChar; dwSizeofDataToWrite: Word ): Boolean;
procedure Dial(TelNo:string);
procedure Hangup;
function ChkSum(bufointer;LBound,RBound:byte):byte;
function CRC(bufointer;Lbound,RBoundWORD):WORD;
procedure PackDat(ps:TPackageStyle; sbufointer;ssize:WORD;
var dbufointer;var dsize:WORD);
function UnPackDat(ps:TPackageStyle; sbufointer;ssize:WORD;
var dbufointer;var dsize:WORD):Boolean;

function SetDTRStat(Stat:boolean):boolean;
published
{ Published declarations }
property CommPort: string read FCommPort write FCommPort;
property BaudRate: DWORD read FBaudRate write SetBaudRate default 9600;
property ByteSize: Byte read FByteSize write SetByteSize default 8;
property Parity: emParity read FParity write SetParity default NOPARITY;
property StopBits: emStopBits read FStopBits write SetStopBits default ONESTOPBIT;
property XONChar:char read FXONChar write SetXONChar;
property XOFFChar:char read FXOFFChar write SetXOFFChar;
property ErrorChar:char read FErrorChar write SetErrorChar;
property EofChar:char read FEofChar write SetEofChar;
property EvtChar:char read FEvtChar write SetEvtChar;
property ReadIntervalTimeout: DWORD read FReadIntervalTimeout write SetRIT default 250;
property ReadTotalTimeoutMultiplier: DWORD read FReadTotalTimeoutMultiplier write SetRTTM default 0;
property ReadTotalTimeoutConstant: DWORD read FReadTotalTimeoutConstant write setRTTC default 0;
property WriteTotalTimeoutMultiplier: DWORD read FWriteTotalTimeoutMultiplier write setWTTM default 0;
property WriteTotalTimeoutConstant: DWORD read FWriteTotalTimeoutConstant write setWTTC default 0;
property InQueueWORD read FInQueue write SetInQueue default 1024;
property OutQueueWORD read FOutQueue write SetOutQueue default 1024;
property CTSHolding:Boolean read GetCTS;
property DSRHolding:Boolean read GetDSR;
property RLSDHolding:Boolean read GetRLSD;
Property TxBufStat:Boolean read GetTxBufState;
property OnDataRecieve: TReceiveDataEvent
read GetReceiveDataEvent write SetReceiveDataEvent;
property OnErrors: TErrorsEvent read GetErrEvent write SetErrEvent;
property OnCommEvent: TCommEvent read GetCommEvent write SetCommEvent;
end;

const
PWM_COMMWRITE = WM_USER+10;
INPUTBUFFERSIZE = 4096;//2048;

procedure Register;

{===============================================================================
==============================}implementation{==================================
===============================================================================}

{var
CommsLogName: string;}

(******************************************************************************)
// TCOMMPORT PUBLIC METHODS
(******************************************************************************)
constructor TCOMMPORT.Create(AOwner:TComponent);
begin
inherited Create(AOwner);
FCommPort := 'COM1';
FBaudRate:=CBR_9600;
FByteSize:=8;
FParity:=NOPARITY;
FStopBits:=ONESTOPBIT;
FReadIntervalTimeout := 250;
FInQueue:=1024;
FOutQueue:=1024;
//CommsLogName := '';
ReadThread := nil;
WriteThread := nil;
hCommFile := 0;
if not (csDesigning in ComponentState) then
FHWnd := AllocateHWnd(CommWndProc);
end;

destructor TCOMMPORT.Destroy;
begin
if not (csDesigning in ComponentState) then DeallocateHWnd(FHwnd);
inherited Destroy;
end;

function TCOMMPORT.Purge(Act:byte):boolean;
begin
case Act of
1: result := PurgeComm(hCommFile,PURGE_TXABORT);
2: result := PurgeComm(hCommFile,PURGE_RXABORT);
3: result := PurgeComm(hCommFile,PURGE_TXCLEAR);
4: result := PurgeComm(hCommFile,PURGE_RXCLEAR);
else result :=False;
end;
end;

//0:´ò¿ª´®¿Ú³É¹¦£»1£º½¨Á¢¾Ö±úʧ°Ü2£ºÊ§°Ü3£ºCloseEventʧ°Ü4£º½¨Òé¶ÁÏß³Ìʧ°Ü5£º½¨ÒéдÏß³Ìʧ°Ü
function TCOMMPORT.OpenComm: byte;
var
fdwEvtMaskWORD;
hNewCommFile:THandle;
begin
if (hCommFile <> 0) then
begin
result := 2;
exit;
end;
hNewCommFile := CreateFile(PChar(FCommPort),GENERIC_READ+GENERIC_WRITE,0,
nil,OPEN_EXISTING,FILE_FLAG_OVERLAPPED,0);
if hNewCommFile = INVALID_HANDLE_VALUE then
begin
result := 1;
exit;
end;
if GetFileType( hNewCommFile ) <> FILE_TYPE_CHAR then
begin
result := 2;
exit;
end;
hCommFile := hNewCommFile;
GetCommState( hNewCommFile, dcb );
GetCommMask(hCommFile, fdwEvtMask );
GetCommTimeouts(hCommFile, commtimeouts );
with CommTimeouts do
begin
ReadIntervalTimeout := FReadIntervalTimeout;
ReadTotalTimeoutMultiplier := FReadTotalTimeoutMultiplier;
ReadTotalTimeoutConstant := FReadTotalTimeoutConstant;
WriteTotalTimeoutMultiplier := FWriteTotalTimeoutMultiplier;
WriteTotalTimeoutConstant := FWriteTotalTimeoutConstant;
end;
SetCommTimeouts( hCommFile, commtimeouts );
GetCommState (hNewCommFile,dcb);
with dcb do
begin
BaudRate := FBaudRate;
ByteSize := FByteSize;
Parity := byte(FParity);
StopBits := byte(FStopBits);
XOnChar:=FXOnChar;
XOffChar:=FXOffChar;
ErrorChar:=FErrorChar;
EofChar:=FEofChar;
EvtChar:=FEvtChar;
end;
SetCommState( hNewCommFile, dcb );
SetupComm(hNewCommFile,FInQueue,FOutQueue);
hCloseEvent := CreateEvent( nil, True, False, nil );
if hCloseEvent = 0 then
begin
hCommFile := 0;
Result := 3;
Exit;
end;
try
ReadThread := TReadThread.Create(True);
except
result:=4;
exit;
end;
ReadThread.hCommFile := hCommFile;
ReadThread.hCloseEvent := hCloseEvent;
ReadThread.hCommWindow := FHWnd;
ReadThread.Resume;
ReadThread.Priority := tpHighest;
try
WriteThread := TWriteThread.Create(True);
except
result:=5;
exit;
end;
WriteThread.hCommFile := hCommFile;
WriteThread.hCloseEvent := hCloseEvent;
WriteThread.hCommWindow := FHWnd;
WriteThread.Resume;
WriteThread.Priority := tpHigher;//ReadThread
GetCommModemStatus(hNewCommFile,lpModemStat);
if (lpModemStat and MS_CTS_ON) <> 0 then
FCTSHolding:= true;
if (lpModemStat and MS_DSR_ON) <> 0 then
FDSRHolding:= true;
if (lpModemStat and MS_RLSD_ON) <> 0 then
FRLSDHolding:= true;
// GetCommMask(HNewCommFile,lpEvtMask);
GetTxBufState;
Result := 0;
end; {TCOMMPORT.OpenComm}

procedure TCOMMPORT.SetBaudRate(ValueWORD);
begin
if FBaudRate<>Value then
begin
FBaudRate:=Value;
GetCommState (hCommFile,dcb);
dcb.BaudRate :=Value;//FBaudRate;
SetCommState( hCommFile, dcb );
end;
end;


procedure TCOMMPORT.SetByteSize(value:BYTE);
begin
if FByteSize<>Value then
begin
FByteSize:=Value;
GetCommState (hCommFile,dcb);
dcb.ByteSize := FByteSize;
SetCommState( hCommFile, dcb );
end;
end;

procedure TCOMMPORT.SetParity(value:emParity);
begin
if FParity<>Value then
begin
FParity := Value;
GetCommState (hCommFile,dcb);
dcb.Parity := byte(FParity);
SetCommState( hCommFile, dcb );
end;
end;

procedure TCOMMPORT.SetStopBits(value:emStopBits);
begin
if FStopBits<>Value then
begin
FStopBits := Value;
GetCommState (hCommFile,dcb);
dcb.StopBits := byte(FStopBits);
SetCommState( hCommFile, dcb );
end;
end;

procedure TCOMMPORT.SetXONChar(value:CHAR);
begin
if FXONChar<>Value then
begin
FXONChar := Value;
GetCommState (hCommFile,dcb);
dcb.XONChar := FXONChar;
SetCommState( hCommFile, dcb );
end;
end;

procedure TCOMMPORT.SetXOFFChar(value:CHAR);
begin
if FXOFFChar<>Value then
begin
FXOFFChar := Value;
GetCommState (hCommFile,dcb);
dcb.XOFFChar := FXOFFChar;
SetCommState( hCommFile, dcb );
end;
end;

procedure TCOMMPORT.SetErrorChar(value:CHAR);
begin
if FErrorChar<>Value then
begin
FErrorChar := Value;
GetCommState (hCommFile,dcb);
dcb.ErrorChar := FErrorChar;
SetCommState( hCommFile, dcb );
end;
end;

procedure TCOMMPORT.SetEofChar(value:CHAR);
begin
if FEofChar<>Value then
begin
FEofChar := Value;
GetCommState (hCommFile,dcb);
dcb.EofChar:= FEofChar;
SetCommState( hCommFile, dcb );
end;
end;

procedure TCOMMPORT.SetEvtChar(value:CHAR);
begin
if FEvtChar<>Value then
begin
FEvtChar:=Value;
GetCommState (hCommFile,dcb);
dcb.EvtChar := FEvtChar;
SetCommState( hCommFile, dcb );
end;
end;

procedure TCOMMPORT.setRIT(valueWORD);
begin
if FReadIntervalTimeout<> value then
begin
FReadIntervalTimeout:=Value;
GetCommTimeouts( hCommFile, commtimeouts );
commtimeouts.ReadIntervalTimeout := FReadIntervalTimeout;
SetCommTimeouts( hCommFile, commtimeouts );
end;
end;

procedure TCOMMPORT.setRTTM(valueWORD);
begin
if FReadTotalTimeoutMultiplier <> value then
begin
FReadTotalTimeoutMultiplier:=Value;
GetCommTimeouts( hCommFile, commtimeouts );
commtimeouts.ReadTotalTimeoutMultiplier := FReadTotalTimeoutMultiplier;
SetCommTimeouts( hCommFile, commtimeouts );
end;
end;

procedure TCOMMPORT.setRTTC(valueWORD);
begin
if FReadTotalTimeoutConstant <> value then
begin
FReadTotalTimeoutConstant:=Value;
GetCommTimeouts( hCommFile, commtimeouts );
commtimeouts.ReadTotalTimeoutConstant := FReadTotalTimeoutConstant;
SetCommTimeouts( hCommFile, commtimeouts );
end;
end;

procedure TCOMMPORT.setWTTM(valueWORD);
begin
if FWriteTotalTimeoutMultiplier <> value then
begin
FWriteTotalTimeoutMultiplier:=Value;
GetCommTimeouts( hCommFile, commtimeouts );
commtimeouts.WriteTotalTimeoutMultiplier := FWriteTotalTimeoutMultiplier;
SetCommTimeouts( hCommFile, commtimeouts );
end;
end;

procedure TCOMMPORT.setWTTC(valueWORD);
begin
if FWriteTotalTimeoutConstant <> value then
begin
FWriteTotalTimeoutConstant:=Value;
GetCommTimeouts( hCommFile, commtimeouts );
commtimeouts.WriteTotalTimeoutConstant := FWriteTotalTimeoutConstant;
SetCommTimeouts( hCommFile, commtimeouts );
end;
end;

procedure TCOMMPORT.setInQueue(valueWORD);
begin
if FInQueue <> value then
begin
setupComm(hCommFile,FInQueue,FOutQueue);
FInQueue:=value;
end;
end;

procedure TCOMMPORT.setOutQueue(valueWORD);
begin
if FOutQueue <> value then
begin
setupComm(hCommFile,FInQueue,FOutQueue);
FOutQueue:=value;
end;
end;

Function TCOMMPORT.GetTxBufState:Boolean;
begin
GetCommMask(HCommFile, lpEvtMask);
if (lpEvtMask and EV_TXEMPTY) <> 0 then
FSDBufState := True else FSDBufState := False;
result := FSDBufState;
end;

function TCOMMPORT.GetCTS:boolean;
begin
GetCommModemStatus(hCommFile,lpModemStat);
if (lpModemStat and MS_CTS_ON) <> 0 then
FCTSHolding:= true else FCTSHolding:= false;
result:=FCTSHolding;
end;

function TCOMMPORT.GetDSR:boolean;
begin
GetCommModemStatus(hCommFile,lpModemStat);
if (lpModemStat and MS_DSR_ON) <> 0 then
FDSRHolding:= true else FDSRHolding:= false;
result:=FDSRHolding;
end;

function TCOMMPORT.GetRLSD:boolean;
begin
GetCommModemStatus(hCommFile,lpModemStat);
if (lpModemStat and MS_RLSD_ON) <> 0 then
FRLSDHolding:= true else FRLSDHolding:= false;
result:=FRLSDHolding;
end;

procedure TCOMMPORT.CloseComm;
begin
if hCommFile = 0 then Exit;
Sleep(200);
CloseReadThread;
CloseWriteThread;
CloseHandle( hCloseEvent );
CloseHandle( hCommFile );
hCommFile := 0;
end; {TCOMMPORT.CloseComm}


function TCOMMPORT.Send( pDataToWrite: PChar; dwSizeofDataToWrite: Word ): Boolean;
var
Buffer: Pointer;
begin
if WriteThread <> nil then
begin
Buffer := Pointer(LocalAlloc( LPTR, dwSizeofDataToWrite+1 ));
Move( pDataToWrite^, Buffer^, dwSizeofDataToWrite );
if PostThreadMessage( WriteThread.ThreadID, PWM_COMMWRITE,
WPARAM(dwSizeofDataToWrite), LPARAM(Buffer) ) then
begin
Result := true;
Exit;
end
end;
Result := False;
end; {TCOMMPORT.Send}

procedure TCOMMPORT.Dial(TelNo:string);
begin
Send(pchar('ATDT'+TelNo+#13),length(TelNo)+5);
end;

procedure TCOMMPORT.Hangup;
begin
Send('+++',3);
Sleep(2000);//Sleep(3000);
Send(pchar('ATH'#13#10),5);
end;

function TCOMMPORT.ChkSum(bufointer;LBound,RBound:byte):byte;
begin
result := CheckSum(buf,LBound,RBound);
end;

function TCOMMPORT.CRC(bufointer;Lbound,RBoundWORD):WORD;
begin
result := CRC16(buf,Lbound,RBound);
end;

procedure TCOMMPORT.PackDat(ps:TPackageStyle; sbufointer;ssize:WORD;
var dbufointer;var dsize:WORD);
begin
PackData(ps,sbuf,ssize,dbuf,dsize);
end;

function TCOMMPORT.UnPackDat(ps:TPackageStyle; sbufointer;ssize:WORD;
var dbufointer;var dsize:WORD):Boolean;
begin
result := UnPackData(ps,sbuf,ssize,dbuf,dsize);
end;

function TCOMMPORT.SetDTRStat(stat:boolean):boolean;
begin
if stat then
result := EscapeCommFunction(hCommFile,SETDTR)
else
result := EscapeCommFunction(hCommFile,CLRDTR);
end;

(******************************************************************************)
// TCOMMPORT PROTECTED METHODS
(******************************************************************************)
procedure TCOMMPORT.CloseReadThread;
begin
if ReadThread <> nil then
begin
SetEvent(hCloseEvent );
PurgeComm(hCommFile,PURGE_RXABORT+PURGE_RXCLEAR);
if WaitForSingleObject(ReadThread.Handle,10000)=WAIT_TIMEOUT then
ReadThread.Terminate;
ReadThread.Free;
ReadThread := nil;
end;
end; {TCOMMPORT.CloseReadThread}


procedure TCOMMPORT.CloseWriteThread;
begin
if WriteThread <> nil then
begin
SetEvent(hCloseEvent);
PurgeComm(hCommFile,PURGE_TXABORT+PURGE_TXCLEAR);
if WaitForSingleObject(WriteThread.Handle,10000)=WAIT_TIMEOUT then
WriteThread.Terminate;
WriteThread.Free;
WriteThread := nil;
end;
end; {TCOMMPORT.CloseWriteThread}

procedure TCOMMPORT.ReceiveData( Buffer: PChar; BufferLength: Word );
begin
if Assigned(FOnReceiveData) then FOnReceiveData(Buffer,BufferLength );
end;

procedure TCOMMPORT.EventOccur(EvtType:byte);
begin
if Assigned(FOnCommEvent) then FOnCommEvent(EvtType);
end;

procedure TCOMMPORT.ErrorsOccur(ErrType:byte);
begin
if Assigned(FOnErrOccur) then FOnErrOccur(ErrType);
end;

{procedure TCOMMPORT.RequestHangup;
begin
if Assigned(FOnRequestHangup) then
FOnRequestHangup( Self );
end;}

(******************************************************************************)
// TCOMMPORT PRIVATE METHODS
(******************************************************************************)

procedure TCOMMPORT.CommWndProc( var msg: TMessage );
begin
case msg.msg of
PWM_GOTCOMMDATA:
begin
ReceiveData(PChar(msg.LParam), msg.WParam );
LocalFree( msg.LParam );
end;
PWM_ERROCCUR: ErrorsOccur(msg.WParam);
PWM_COMMEVENT: EventOccur(msg.WParam);
end;
end;

function TCOMMPORT.GetReceiveDataEvent: TReceiveDataEvent;
begin
Result := FOnReceiveData;
end;

procedure TCOMMPORT.SetReceiveDataEvent( AReceiveDataEvent: TReceiveDataEvent );
begin
FOnReceiveData := AReceiveDataEvent;
end;

function TCOMMPORT.GetErrEvent:TErrorsEvent;
begin
result := FOnErrOccur;
end;

procedure TCOMMPORT.SetErrEvent(AErrEvent:TErrorsEvent);
begin
FOnErrOccur := AErrEvent;
end;

function TCOMMPORT.GetCommEvent:TCommEvent;
begin
result := FOnCommEvent;
end;

procedure TCOMMPORT.SetCommEvent(ACommEvent:TCommEvent);
begin
FOnCommEvent:= ACommEvent;
end;


(******************************************************************************)
// READ THREAD
(******************************************************************************)

procedure TReadThread.Execute;
var
szInputBuffer: array [0..INPUTBUFFERSIZE-1] of char;
nNumberOfBytesRead: DWORD;
HandlesToWaitFor: array[0..2] of THandle;
dwHandleSignaled: DWORD;
fdwEvtMask: DWORD;
overlappedRead: TOverlapped;
overlappedCommEvent: TOverlapped;
label
EndReadThread;
begin
FillChar( overlappedRead, Sizeof(overlappedRead), 0 );
FillChar( overlappedCommEvent, Sizeof(overlappedCommEvent), 0 );
overlappedRead.hEvent := CreateEvent( nil, True, True, nil);
{
HANDLE CreateEvent(
LPSECURITY_ATTRIBUTES lpEventAttributes, // pointer to security attributes
//nil ¶Ë¿Ú²»Äܱ»×ÓÏ̼̳߳Ð
BOOL bManualReset, // flag for manual-reset event
//±ØÐèÓà ResetEventÊÖ¶¯¸´Î»×´Ì¬µ½ÎÞÐźÅ״̬
BOOL bInitialState, // flag for initial state
//³õʼ״̬ÊÇÓÐÐźŵÄ
LPCTSTR lpName // pointer to event-object name
//ʼþ¶ÔÏóµÄÃû×Ö
);

}
if overlappedRead.hEvent = 0 then
begin
GetLastError;errorsoccur(128);
goto EndReadThread;
end;
overlappedCommEvent.hEvent := CreateEvent( nil, True, True, nil);
if overlappedCommEvent.hEvent = 0 then
begin
GetLastError;errorsoccur(128);
goto EndReadThread;
end;
HandlesToWaitFor[0] := hCloseEvent;
HandlesToWaitFor[1] := overlappedCommEvent.hEvent;
HandlesToWaitFor[2] := overlappedRead.hEvent;
if not SetCommMask(hCommFile, EV_ERR or EV_BREAK or EV_CTS or EV_DSR or
EV_RING or EV_RLSD or EV_RXCHAR or
EV_RXFLAG or EV_TXEMPTY) then
{
Ö¸¶¨Òª¼àÊӵĴ®¿Úʼþ
EV_ERR £ºÏß·״̬³ö´í
EV_CTS £º(clear to send)ÐźŸıä״̬
EV_DSR data send ready)ÐźŸıä״̬
EV_RING )ÕñÁå
EV_RLSD £º£¨receive line signal detect£©½ÓÊÕÏß·Ðźżì²â״̬¸Ä±ä
EV_RXCHAR £º½ÓÊÕµ½µÄ·ÅÈëÊäÈ뻺³åÇøµÄ×Ö·û
EV_RXFLAG £º½ÓÊÕµ½µÄ·ÅÈëÊäÈ뻺³åÇøµÄʼþ×Ö·û
EV_TXEMPTY£ºÊä³ö»º³åÇøÖз¢Ë͵Ä×îºóÒ»¸ö×Ö·û
}
begin
GetLastError;
errorsoccur(128);
goto EndReadThread;
end;
// Start waiting for CommEvents
if not SetupCommEvent( @overlappedCommEvent, fdwEvtMask ) then
begin
GetLastError;errorsoccur(128);
goto EndReadThread;
end;
// Start waiting for Read events.
if not SetupReadEvent(@overlappedRead,szInputBuffer, INPUTBUFFERSIZE, //need to analyse later
nNumberOfBytesRead ) then
begin
GetLastError;errorsoccur(128);
goto EndReadThread;
end;
// Keep looping until we break out.
while True do
begin
// Wait until some event occurs (data to read; error; stopping).
dwHandleSignaled := WaitForMultipleObjects(3, @HandlesToWaitFor,
False, INFINITE);
{
WaitForMultipleObjects µ±
1¡¢Ö¸¶¨µÄ¶ÔÏó´¦ÓÚÖ¸¶¨µÄ״̬.
2¡¢³¬Ê±³öÏÖ.
}
// Which event occured?
case dwHandleSignaled of
WAIT_OBJECT_0: // Signal to end the thread.
begin
// Time to exit.
goto EndReadThread;
end;
WAIT_OBJECT_0 + 1: // CommEvent signaled.
begin
// Handle the CommEvent.
if not HandleCommEvent( @overlappedCommEvent, fdwEvtMask, TRUE ) then //need to analyse later
begin
GetLastError;
errorsoccur(128);
goto EndReadThread;
end;
// Start waiting for the next CommEvent.
if not SetupCommEvent( @overlappedCommEvent, fdwEvtMask ) then//need to analyse later
begin
GetLastError;
errorsoccur(128);
goto EndReadThread;
end;
{break;??}
end;
WAIT_OBJECT_0 + 2: // Read Event signaled.
begin
// Get the new data!
if not HandleReadEvent(@overlappedRead,szInputBuffer, INPUTBUFFERSIZE,
nNumberOfBytesRead ) then
begin
GetLastError;
//errorsoccur(128); ×¢ÊÓ²¿·Ö8ÔÂ28ÈÕÐÞ¸Ä
//goto EndReadThread;
//HandlesToWaitFor[0] := hCloseEvent;
//HandlesToWaitFor[1] := overlappedCommEvent.hEvent;
//HandlesToWaitFor[2] := overlappedRead.hEvent;
end;
// Wait for more new data.
if not SetupReadEvent( @overlappedRead,szInputBuffer, INPUTBUFFERSIZE,
nNumberOfBytesRead ) then
begin
GetLastError;
errorsoccur(128);
goto EndReadThread;
end;
{break;}
end;
WAIT_FAILED: // Wait failed. Shouldn't happen.
begin
GetLastError;
errorsoccur(128);
goto EndReadThread;
end;
else
begin
errorsoccur(128);
goto EndReadThread;
end;
end; {case dwHandleSignaled}
end; {while True}
EndReadThread:
PurgeComm( hCommFile, PURGE_RXABORT + PURGE_RXCLEAR );
{
¿ÉÒÔ¶ªÆúÖ¸¶¨¶Ë¿ÚµÄÊäÈëÊä³ö»º³åÇøµÄËùÓÐ×Ö·û£¬Ò²¿ÉÒÔ½áÊøÉÐδÍê³ÉµÄ²Ù×÷
PURGE_TXABORT ½áÊøËùÓÐд²Ù×÷²¢ÇÒÁ¢¼´·µ»Ø.
PURGE_RXABORT ½áÊøËùÓжÁ²Ù×÷²¢ÇÒÁ¢¼´·µ»Ø.
PURGE_TXCLEAR Çå³ýÊä³ö»º³åÇø
PURGE_RXCLEAR Çå³ýÊäÈ뻺³åÇø
}
CloseHandle( overlappedRead.hEvent );
CloseHandle( overlappedCommEvent.hEvent );
end; {TReadThread.Execute}


function TReadThread.SetupReadEvent(lpOverlappedRead: POverlapped;
lpszInputBuffer: LPSTR; dwSizeofBuffer: DWORD;
var lpnNumberOfBytesRead: DWORD ): Boolean;
var
dwLastError: DWORD;
label
StartSetupReadEvent;
begin
StartSetupReadEvent:
Result := False;
if WaitForSingleObject(hCloseEvent,0)<>WAIT_TIMEOUT then//if WAIT_TIMEOUT <> WaitForSingleObject(hCloseEvent,0) then
Exit;
if ReadFile(hCommFile,lpszInputBuffer^,dwSizeofBuffer,
lpnNumberOfBytesRead,lpOverlappedRead) then
begin
if not HandleReadData(lpszInputBuffer,lpnNumberOfBytesRead) then
Exit;
goto StartSetupReadEvent;
end;
dwLastError := GetLastError;
if dwLastError = ERROR_IO_PENDING then
begin
Result := True;
Exit;
end;
if dwLastError = ERROR_INVALID_HANDLE then Exit;
ErrorsOccur(128);
end; {TReadThread.SetupReadEvent}


function TReadThread.HandleReadData(lpszInputBuffer: LPCSTR; dwSizeofBuffer: DWORD ): Boolean;
var
lpszPostedBytes: LPSTR;
tempstr: string;
begin
Result := False;
if dwSizeofBuffer <> 0 then
begin
tempstr := lpszInputBuffer;
lpszPostedBytes := PChar( LocalAlloc( LPTR, dwSizeofBuffer+1 ) );
if lpszPostedBytes = nil then
begin
GetLastError;
Exit;
end;
Move( lpszInputBuffer^, lpszPostedBytes^, dwSizeofBuffer );
lpszPostedBytes[dwSizeofBuffer] := #0;
Result := ReceiveData(lpszPostedBytes, dwSizeofBuffer);
end;
end; {TReadThread.HandleReadData}

function TReadThread.HandleReadEvent(lpOverlappedRead: POverlapped;
lpszInputBuffer: LPSTR; dwSizeofBuffer: DWORD;
var lpnNumberOfBytesRead: DWORD ): Boolean;
var
dwLastError: DWORD;
begin
Result := False;
if GetOverlappedResult( hCommFile,
lpOverlappedRead^, lpnNumberOfBytesRead, False ) then
begin
Result := HandleReadData(lpszInputBuffer, lpnNumberOfBytesRead );
Exit;
end;
dwLastError := GetLastError;
if dwLastError = ERROR_INVALID_HANDLE then Exit;
ErrorsOccur(128);
end; {TReadThread.HandleReadEvent}

function TReadThread.SetupCommEvent( lpOverlappedCommEvent: POverlapped;
var lpfdwEvtMask: DWORD ): Boolean;
var
dwLastError: DWORD;
label
StartSetupCommEvent;
begin
Result := False;
StartSetupCommEvent:
if WaitForSingleObject(hCloseEvent,0)<>WAIT_TIMEOUT then Exit;//if WAIT_TIMEOUT <> WaitForSingleObject( hCloseEvent,0 ) then Exit;
if WaitCommEvent( hCommFile, lpfdwEvtMask, lpOverlappedCommEvent ) then
begin
if not HandleCommEvent( nil, lpfdwEvtMask, False ) then Exit;
goto StartSetupCommEvent;
end;
dwLastError := GetLastError;
if dwLastError = ERROR_IO_PENDING then
begin
Result := True;
Exit
end;
if dwLastError = ERROR_INVALID_HANDLE then Exit;
end; {TReadThread.SetupCommEvent}


function TReadThread.HandleCommEvent(lpOverlappedCommEvent: POverlapped;
var lpfdwEvtMask: DWORD; fRetrieveEvent: Boolean): Boolean;
var
dwDummyWORD;
szError:byte;
szEvent:byte;
dwErrors,dwLastErrorWORD;
begin
Result := False;
if fRetrieveEvent then
if not GetOverlappedResult( hCommFile,lpOverlappedCommEvent^, dwDummy, False ) then
{
GetOverlappedResult ·µ»Ø¶Ë¿ÚµÄ overlapped ²Ù×÷½á¹û.
BOOL GetOverlappedResult(
HANDLE hFile, // handle of file, pipe, or communications device
LPOVERLAPPED lpOverlapped, // address of overlapped structure
LPDWORD lpNumberOfBytesTransferred, // address of actual bytes count
this is the number of bytes of
output data returned by the device driver
BOOL bWait // wait flag
Ö¸¶¨ÊÇ·ñµÈ´ýÍê³Éδ½áÊøµÄoverlapped²Ù×÷
TRUE£ºµÈ´ýµ½²Ù×÷Íê³É²Å·µ»Ø
FALSE£ºÈç¹û²Ù×÷δÍê³Éº¯Êý·µ»ØFALSE²¢ÇÒGetLastError ·µ»Ø ERROR_IO_INCOMPLETE.
);
}
begin
dwLastError := GetLastError;
if dwLastError = ERROR_INVALID_HANDLE then Exit;
Exit;
end;
if (lpfdwEvtMask and EV_ERR) <> 0 then
begin
if not ClearCommError(hCommFile, dwErrors, nil ) then
begin
dwLastError := GetLastError;
if dwLastError = ERROR_INVALID_HANDLE then Exit;
Exit;
end;
szError := 0;
if dwErrors = 0 then szError:=0;
if (dwErrors and CE_FRAME) <> 0 then SzError:=SzError + 1;
if (dwErrors and CE_OVERRUN) <> 0 then SzError:= SzError + 2;
if (dwErrors and CE_RXPARITY) <> 0 then SzError:= SzError + 4;
if (dwErrors and not (CE_FRAME + CE_OVERRUN + CE_RXPARITY)) <> 0
then SzError:= SzError+8;
if not ErrorsOccur(SzError) then exit;
Result := True;
Exit
end;
szEvent := 0;
if (lpfdwEvtMask and EV_BREAK) <> 0 then
begin
szEvent := szEvent + 1; //if not EventOccur(1) then exit;
end;
if (lpfdwEvtMask and EV_CTS) <> 0 then
begin
szEvent := szEvent + 2;//if not EventOccur(2) then exit;
end;
if (lpfdwEvtMask and EV_DSR) <> 0 then
begin
szEvent := szEvent + 4;//if not EventOccur(3) then exit;
end;
if (lpfdwEvtMask and EV_RING) <> 0 then
begin
szEvent := szEvent + 8;//if not EventOccur(4) then exit;
end;
if (lpfdwEvtMask and EV_RLSD) <> 0 then
begin
szEvent := szEvent + 16;//if not EventOccur(5) then exit;
end;
if (lpfdwEvtMask and EV_RXCHAR) <> 0 then
begin
szEvent := szEvent + 32;//if not EventOccur(6) then exit;
end;
if (lpfdwEvtMask and EV_RXFLAG) <> 0 then begin
szEvent := szEvent + 64;//if not EventOccur(7) then exit;
end;
if (lpfdwEvtMask and EV_TXEMPTY) <> 0 then
begin
szEvent := szEvent + 128;//if not EventOccur(8) then exit;
end;
EventOccur(szEvent);
Result:=true;
end; {TReadThread.HandleCommEvent}

function TReadThread.ReceiveData( lpNewString: LPSTR; dwSizeofNewString: DWORD ): BOOL;
begin
Result := PostMessage(hCommWindow, PWM_GOTCOMMDATA,
WPARAM(dwSizeofNewString), LPARAM(lpNewString));
end;

function TReadThread.EventOccur(EvtType:byte):BOOL;
begin
Result := PostMessage(hCommWindow, PWM_COMMEVENT, WPARAM(EvtType),0);
end;

function TReadThread.ErrorsOccur(ErrType:byte):BOOL;
begin
Result := PostMessage(hCommWindow, PWM_ERROCCUR,WPARAM(ErrType),0);
end;

(******************************************************************************)
// WRITE THREAD
(******************************************************************************)

procedure TWriteThread.Execute;
var
msg: TMsg;
dwHandleSignaled: DWORD;
overlappedWrite: TOverLapped;
label
EndWriteThread;
begin
FillChar( overlappedWrite, SizeOf(overlappedWrite), 0 );
overlappedWrite.hEvent := CreateEvent( nil, True, True, nil );
if overlappedWrite.hEvent = 0 then
begin
GetLastError;
ErrorsOccur(128);
goto EndWriteThread;
end;
while True do
begin
if not PeekMessage( msg, 0, 0, 0, PM_REMOVE ) then
begin
dwHandleSignaled := MsgWaitForMultipleObjects(1, hCloseEvent, False,INFINITE, QS_ALLINPUT);
case dwHandleSignaled of
WAIT_OBJECT_0:goto EndWriteThread;
WAIT_OBJECT_0 + 1: continue;// New message was received.
WAIT_FAILED: // Wait failed. Shouldn't happen.
begin
GetLastError;
ErrorsOccur(128);
goto EndWriteThread;
end;
else // This case should never occur.
begin
ErrorsOccur(128);
goto EndWriteThread;
end;
end;{case}
end; {if}
if WaitForSingleObject(hCloseEvent,0)<>WAIT_TIMEOUT then//if WAIT_TIMEOUT <> WaitForSingleObject(hCloseEvent,0) then
goto EndWriteThread;
if msg.hwnd <> 0 then
begin
TranslateMessage(msg);
DispatchMessage(msg);
Continue;
end;
case msg.message of
PWM_COMMWRITE: // New string to write to Comm port.
begin
if not HandleWriteData( @overlappedWrite,
PChar(msg.lParam), DWORD(msg.wParam) ) then
begin
LocalFree( HLOCAL(msg.lParam) );
goto EndWriteThread;
end;
LocalFree( HLOCAL(msg.lParam) );
end;
end; {case}
end; {main loop}
EndWriteThread:
PurgeComm(hCommFile, PURGE_TXABORT + PURGE_TXCLEAR);
CloseHandle(overlappedWrite.hEvent);
end; {TWriteThread.Execute}


function TWriteThread.HandleWriteData( lpOverlappedWrite: POverlapped;
pDataToWrite: PChar; dwNumberOfBytesToWrite: DWORD): Boolean;
var
dwLastError,
dwNumberOfBytesWritten,
dwWhereToStartWriting,
dwHandleSignaled: DWORD;
HandlesToWaitFor: array[0..1] of THandle;
begin
dwNumberOfBytesWritten := 0;
dwWhereToStartWriting := 0; // Start at the beginning.
HandlesToWaitFor[0] := hCloseEvent;
HandlesToWaitFor[1] := lpOverlappedWrite^.hEvent;
repeat
if not WriteFile(hCommFile,pDataToWrite[dwWhereToStartWriting],dwNumberOfBytesToWrite, dwNumberOfBytesWritten,lpOverlappedWrite) then
begin
dwLastError := GetLastError;
if (dwLastError = ERROR_INVALID_HANDLE) then
begin
Result := False;
Exit;
end;
if dwLastError <> ERROR_IO_PENDING then
begin
ErrorsOccur(128);
Result := False;
Exit;
end;
dwHandleSignaled := WaitForMultipleObjects(2, @HandlesToWaitFor,False, INFINITE);
case dwHandleSignaled of
WAIT_OBJECT_0: // CloseEvent signaled!
begin
Result := False;
Exit;
end;
WAIT_OBJECT_0 + 1: // Wait finished.
begin
// Time to get the results of the WriteFile
end;
WAIT_FAILED: // Wait failed. Shouldn't happen.
begin
GetLastError;
ErrorsOccur(128);
Result := False;
Exit
end;
else // This case should never occur.
begin
ErrorsOccur(128);
Result := False;
Exit
end;
end; {case}
if not GetOverlappedResult(hCommFile,lpOverlappedWrite^,dwNumberOfBytesWritten, TRUE) then
begin
dwLastError := GetLastError;
if dwLastError = ERROR_INVALID_HANDLE then
begin
Result := False;
Exit;
end;
ErrorsOccur(128);
Result := False;
Exit;
end;
end; {WriteFile failure}
Dec( dwNumberOfBytesToWrite, dwNumberOfBytesWritten );
Inc( dwWhereToStartWriting, dwNumberOfBytesWritten );
until (dwNumberOfBytesToWrite <= 0);
Result := True;
end; {TWriteThread.HandleWriteData}

function TWriteThread.WriteComm( pDataToWrite: LPCSTR; dwSizeofDataToWrite: DWORD ): Boolean;
begin
Result := PostThreadMessage( ThreadID, PWM_COMMWRITE,
WParam(dwSizeofDataToWrite), LParam(pDataToWrite) );
end;

function TWriteThread.ErrorsOccur(ErrType:byte):BOOL;
begin
Result := PostMessage(hCommWindow, PWM_ERROCCUR,WPARAM(ErrType),0);
end;

procedure Register;
begin
RegisterComponents('DCM', [TCOMMPORT]);
end;

end.

楼上的兄弟：你贴上的代码是你做的控件还是你的软件源码？？