c++builer多线程===〉delphi多线程(200分)

把c++builer写的多线程通讯程序改成delphi,本人非常着急，如果有人愿意帮忙改一下，留下
地址，我会把程序法过去！我在通讯组提过此问题，无人相应，希望大家多帮忙

发给我吧，我试试看，不过不一定行哦。：）
copy_paste@21cn.com

发给我吧，我试试看
fengguoyu123@163.com

不了解2中开发语言 恐怕很难实现
不如重写

BCB与DELPHI的差别不是太大,主要是一些语法
上有点区别!不过不能吹,你先发过来看看,我
尽力帮你!lonely910@163.net

非常感谢！我把程序法过去，希望得到您的指点！！！

房客：
如果您愿意，可否帮我看一下这个程序，我对c++builer不是非常了解，希望得
到您的指点。

收到我的程序了吗？不知改的怎末样？

不好意思，我以为你没发，前段到网吧上网（我只能在网吧上网），发现一个outlook有我的
账号，^*^&&。。。我说我这段怎么一封信也没
**************************************************************
老兄，你的E_Mail了，我现在只有你的源程序，不能看你的Mail地址了。
**************************************************************
程序改的差不多，编绎是没什么错，好像运行也没什么错，不过我也不知真正运行会不会错，：）
没法试了。
谁还要，直接翻译的过来的，C原来写这东西的时候，有点有点乱的感觉。(个人感觉)

我很少上网了现在，等不了，直接贴了:
//Comm.dpr
program Comm;
uses
Forms,
Main in 'Main.pas' {MainForm},
CommComp in 'CommComp.pas',
CommConsts in 'CommConsts.pas';
{$R *.res}
begin
Application.Initialize;
Application.CreateForm(TMainForm, MainForm);
Application.Run;
end.

//CommConsts
unit CommConsts;
interface
uses Windows;
const
NoError = 0;
WrtDataError = 1;
WrtDataTooLong = 2;
PowerNotOnOrBusy = 3;
ConnectFail = 4;
SetCommStateFail = 5;
ComNotConnected = 6;
OpenFail = 7;
CreateEventFail = 8;
CreateThreadFail = 9;
NoResponse = 10;
WrtWasteTooLong = 11;
CloseMSMThreadError = 12;
CloseEnblThreadError = 13;
HartComStart = 14;
IsBusySending = 15;
TYPEACK = 0;
TYPEACK1 = 1;
TYPEOACK = 2;
TYPEBACK = 3;
TYPEOBACK = 4;
TYPEREQ = 5;
TYPEMREQ = 6;
TYPEMSG = 7;
Test = 8;
TheLeastCommandLength = 10;
prenum = 5;
MesLengthMax = 25;
INBUFFERSIZE = 1024;
OUTBUFFERSIZE = 1024;
NumInBuf = 2;
RT1 = 305;
RT2 = 75;
HOLD = 20;
REQ = 1;
ACK = 2;
OACK = 4;
BACK = 8;
OBACK = 16;
ERR = 32;
COMERR = 64;
CmStackMax = 100;
type
PObjectListType = ^TObjectListType;
TObjectListType = record
cObjects: DWORD;
hObjects: array[0..20 - 1] of THandle;
end;

PCmStackType = ^TCmStackType;
TCmStackType = record
CmType: Integer;
pCM: PByte;
end;

TCommFlags = record
fBinary: Boolean;
fParity: Boolean;
fOutxCtsFlow: Boolean;
fOutxDsrFlow: Boolean;
fDtrControl: 0..2;
fDsrSensitivity: Boolean;
fTXContinueOnXoff: Boolean;
fOutX: Boolean;
fInX: Boolean;
fErrorChar: Boolean;
fNull: Boolean;
fRtsControl: 0..3;
fAbortOnError: Boolean;
end;

function CommFlagsToDWORD(Value: TCommFlags): DWORD;
function DWORDToCommFlags(Value: DWORD): TCommFlags;
implementation
const
ENABLE_BINARAY = 1;
ENABLE_PARITRY = 2;
ENABLE_OUTXCTSFLOW = 4;
ENABLE_OUTXDSRFLOW = 8;
ENABLE_DTR_CONTROL = $10;
ENABLE_DTR_HANDSHAKE = $20;
ENABLE_DSRSENSITIVITY = $40;
ENABLE_TXCONTINUEONXOFF = $80;
ENABLE_OUTX = $100;
ENABLE_INX = $200;
ENABLE_ERRORCHAR = $400;
ENABLE_NULL = $800;
ENABLE_RTSCONTROL = $1000;
ENABLE_RTSCONTROL_HANDSHAKE = $2000;
ENABLE_RTSCONTROL_TOGGLE = $3000;
ENABLE_ABORTONERROR = $4000;
//其它位的是保留，为0，不管它
function CommFlagsToDWORD(Value: TCommFlags): DWORD;
begin
Result := 0;
if Value.fBinary then
Inc(Result, ENABLE_BINARAY);
if Value.fParity then
Inc(Result, ENABLE_PARITRY);
if Value.fOutxCtsFlow then
Inc(Result, ENABLE_OUTXCTSFLOW);
if Value.fOutxDsrFlow then
Inc(Result, ENABLE_OUTXDSRFLOW);
case Value.fDtrControl of
DTR_CONTROL_ENABLE: Inc(Result, ENABLE_DTR_CONTROL);
DTR_CONTROL_HANDSHAKE: Inc(Result, ENABLE_DTR_HANDSHAKE);
end;
if Value.fDsrSensitivity then
Inc(Result, ENABLE_DSRSENSITIVITY);
if Value.fTXContinueOnXoff then
Inc(Result, ENABLE_TXCONTINUEONXOFF);
if Value.fOutX then
Inc(Result, ENABLE_OUTX);
if Value.fInX then
Inc(Result, ENABLE_INX);
if Value.fErrorChar then
Inc(Result, ENABLE_ERRORCHAR);
if Value.fNull then
Inc(Result, ENABLE_NULL);
case Value.fRtsControl of
RTS_CONTROL_ENABLE: Inc(Result, ENABLE_RTSCONTROL);
RTS_CONTROL_HANDSHAKE: Inc(Result, ENABLE_RTSCONTROL_HANDSHAKE);
RTS_CONTROL_TOGGLE: Inc(Result, ENABLE_RTSCONTROL_TOGGLE);
end;
if Value.fAbortOnError then
Inc(Result, ENABLE_ABORTONERROR);
end;

function DWORDToCommFlags(Value: DWORD): TCommFlags;
begin
FillChar(Result, SizeOf(TCommFlags), 0);
with Resultdo
begin
fBinary := (Value and ENABLE_BINARAY) = ENABLE_BINARAY;
fParity := (Value and ENABLE_PARITRY) = ENABLE_PARITRY;
fOutxCtsFlow := (Value and ENABLE_OUTXCTSFLOW) = ENABLE_OUTXCTSFLOW;
fOutxDsrFlow := (Value and ENABLE_OUTXDSRFLOW) = ENABLE_OUTXDSRFLOW;
if (Value and ENABLE_DTR_CONTROL) = ENABLE_DTR_CONTROL then
fDtrControl := DTR_CONTROL_ENABLE else
if (Value and ENABLE_DTR_HANDSHAKE) = ENABLE_DTR_HANDSHAKE then
fDtrControl := DTR_CONTROL_HANDSHAKE;
fDsrSensitivity := (Value and ENABLE_DSRSENSITIVITY) = ENABLE_DSRSENSITIVITY;
fTXContinueOnXoff := (Value and ENABLE_TXCONTINUEONXOFF) = ENABLE_TXCONTINUEONXOFF;
fOutX := (Value and ENABLE_OUTX) = ENABLE_OUTX;
fInX := (Value and ENABLE_INX) = ENABLE_INX;
fErrorChar := (Value and ENABLE_ERRORCHAR) = ENABLE_ERRORCHAR;
fNull := (Value and ENABLE_NULL) = ENABLE_NULL;
if (Value and ENABLE_RTSCONTROL) = ENABLE_RTSCONTROL then
fRtsControl := RTS_CONTROL_ENABLE else
if (Value and ENABLE_RTSCONTROL_HANDSHAKE) = ENABLE_RTSCONTROL_HANDSHAKE then
fRtsControl := RTS_CONTROL_HANDSHAKE else
if (Value and ENABLE_RTSCONTROL_TOGGLE) = ENABLE_RTSCONTROL_TOGGLE then
fRtsControl := RTS_CONTROL_TOGGLE;
fAbortOnError := (Value and ENABLE_ABORTONERROR) = ENABLE_ABORTONERROR;
end;
end;

end.

//CommComp.pas
unit CommComp;
interface
uses Windows, Messages, CommConsts;
function HartComOpen(AParentHandle: THandle;
AComPort: string = 'COM1'): Integer;
procedure HartComClose;
procedure HartComSend(SendData: PByte);
procedure SendLastCmd;
function HartComGetMes(Message, Status, CmdMes: PByte): Integer;
procedure HartSetDisplayAll(Mode: Boolean = False);
function GetAddress(abIn: PBYTE): Boolean;
var
Address: array[0..5] of Byte;
RLSDDirection: Boolean = False;
implementation
var
DisplayAll: Boolean = False;

MyOverlappedTimeouts: TCommTimeouts = (
ReadIntervalTimeout: MAXDWORD;
ReadTotalTimeoutMultiplier: 0;
ReadTotalTimeoutConstant: 0;
WriteTotalTimeoutMultiplier: 0;
WriteTotalTimeoutConstant: 0);
SHartCmd: Byte;
SAddr: array [0..9] of Byte;
ParentHandle: THandle;
ComDev: THandle;
Connected: Boolean = False;
InOverlapped: TOverlapped;
InBuffer: array [0..INBUFFERSIZE - 1] of Byte;
pInBuffer, pMesInput: PByte;
nBytesRead: DWORD;
OutOverlapped: TOverlapped;
OutBuffer: array [0..OUTBUFFERSIZE - 1] of Byte;
NumberOfBytesWritten: DWORD;
XmtNum: DWORD;
CmStack: array [0..CmStackMax - 1] of TCmStackType;
fpCms: Integer = 0;
rpCms: Integer = 0;
HartComMessageCode: Integer;

hMSMThread: THandle;
hRTThread: THandle;
MSMEvent: THandle;
RTWaitSetList: array [0..1] of THandle;
ConnectedOKEvent: THandle;
ConnectList: array [0..1] of THandle;
//WaitTimeoutTimeLmt初始时最好设一个值，它是Wait For函数的timeout值
WaitTimeoutTimeLmt: DWORD;
MSMTid: DWORD;
procedure Post(W, L: Integer);
begin
PostMessage(ParentHandle, WM_COMMNOTIFY, W, L);
end;

procedure PrintACK(InBuffer: Pointer);
begin
Post(Integer(InBuffer), TYPEACK);
end;

procedure PrintACK1(InBuffer: Pointer);
begin
if DisplayAll then
Post(Integer(InBuffer), TYPEOACK);
end;

procedure PrintOACK(InBuffer: Pointer);
begin
if DisplayAll then
Post(Integer(InBuffer), TYPEOACK);
end;

procedure PrintBACK(InBuffer: Pointer);
begin
Post(Integer(InBuffer), TYPEOACK);
end;

procedure PrintOBACK(InBuffer: Pointer);
begin
if DisplayAll then
Post(Integer(InBuffer), TYPEBACK);
end;

procedure PrintREQ(InBuffer: Pointer);
begin
if DisplayAll then
Post(Integer(InBuffer), TYPEREQ);
end;

procedure PrintMREQ(InBuffer: Pointer);
begin
if DisplayAll then
Post(Integer(InBuffer), TYPEMREQ);
end;

var
RcvList, XmtList: TObjectListType;
procedure PrintMsg(msgCode: Integer);
begin
HartComMessageCode := msgCode;
Post(msgCode, TYPEMSG);
end;

{ || ==> or;
&&
=> and }
{ | ==> or;
&
==> and }
function GetRCV_MSGType(P: PByte): Integer;
//if 0: Wrong STRT
var
Addr: Integer;
begin
if (P^ = $02) or (P^ = $82) then
Result := REQ
else
begin
if (P^ = $86) or (P^ = $06) then
begin
if (PByte(Integer(P) + 1)^ and $80) > 0 then
Result := ACK else
Result := OACK;
end else
if (P^ = $01) or (PByte(Integer(P) + 1)^ = $81) then
begin
if (PByte(Integer(P) + 1)^ and $80) > 0 then
Result := BACK else
Result := OBACK;
end else
Result := 0;
if (P^ and $80) > 0 then
Addr := 7 else
Addr := 3;
if (PByte(Integer(P) + Addr + 1)^ and $80) > 0 then
Result := Result or COMERR;
end;
end;

procedure PrintRCV_MSG(n: Integer);
var
InBuf: PByte;
CmType: Integer;
begin
CmType := CmStack[n].CmType;
InBuf := CmStack[n].pCM;
if not (CmType and (ERR or COMERR) > 0) then
case CmType of
ACK: PrintACK(InBuf);
OACK: PrintOACK(InBuf);
BACK: PrintBACK(InBuf);
OBACK: PrintOBACK(InBuf);
REQ: PrintREQ(InBuf);
end;
end;

function CheckPreamble: Boolean;
var
I: Integer;
begin
while Truedo
begin
if TheLeastCommandLength > nBytesRead then
begin
Result := False;
Exit;
end;
//Dec(pInBuffer);
//Inc(pInBuffer)
while pInBuffer^ <> $FFdo
begin
Inc(pInBuffer);
Dec(nBytesRead);
end;
I := 1;
Inc(pInBuffer);
while (pInBuffer^ = $FF) and (nBytesRead > 1)do
begin
Inc(I);
Dec(nBytesRead);
end;
if I > 1 then
break;
end;
Result := nBytesRead >= 3;
end;

function GetCheck(nLength: Integer): Integer;
var
I: Integer;
EorResult: Byte;
begin
EorResult := 0;
pInBuffer := PByte(Integer(pInBuffer) + nLength);
if Round(nBytesRead) >= nLength then
begin
Dec(nBytesRead, nLength);
for I := 0 to nLength - 1do
EorResult := EorResult xor PByte(Integer(pInBuffer) + I - nLength)^;
if EorResult <> 0 then
Result := ERR else
Result := 0;
end else
begin
nBytesRead := 0;
Result := ERR;
end;
end;

function GetReadComResult(InBuf: PByte): Integer;
var
Buf: Byte;
begin
Buf := InBuf^;
if (Buf = $82) or (Buf = $86) or (Buf = $81) then
Result := GetCheck(PByte(Integer(InBuf) + 7)^ + 2 + 7) else
if (Buf = $02) or (Buf = $06) or (Buf = $01) then
Result := GetCheck(PByte(Integer(InBuf) + 3)^ + 2 + 3) else
Result := ERR;
end;

procedure PutCmStack;
var
InBuf: PByte;
bFirst: Boolean;
RcvType: Integer;
begin
pInBuffer := pMesInput;
fpCms := 0;
rpCms := 0;
bFirst := True;
while Truedo
begin
if not CheckPreamble then
break;
InBuf := pInBuffer;
if bFirst then
bFirst := False;
// else
bFirst == False ???
RcvType := GetRCV_MSGType(InBuf);
if RcvType <> 0 then
RcvType := RcvType and GetReadComResult(InBuf);
if RcvType > 0 then
begin
CmStack[rpCmS].pCM := InBuf;
CmStack[rpCms].CmType := RcvType;
Inc(rpCms);
end;
end;
end;

function RealTime(var Value: DWORD): DWORD;
var
RetVal: DWORD;
WaitForTimeOut: Boolean;
begin
Result := 0;
WaitForTimeOut := False;
RetVal := WaitForMultipleObjects(2, @RTWaitSetList[0], False, INFINITE);
case RetVal of
WAIT_OBJECT_0:
begin
Result := 0;
Exit;
end;
WAIT_OBJECT_0 + 1:
WaitForTimeOut := True;
end;

while WaitForTimeOutdo
begin
RetVal := WaitForMultipleObjects(2, @RTWaitSetList[0], False, WaitTimeOutTimeLmt);
case RetVal of
WAIT_OBJECT_0:
begin
Result := 0;
break;
end;
WAIT_OBJECT_0 + 1:
Continue;
WAIT_TIMEOUT:
WaitForTimeOut := False;
end;
end;
end;

var
EnableIndicateEvent: THandle;
UnEnableIndicateEvent: THandle;
EnableIndicateTid: DWORD;
hEnableIndicateThread: THandle;
EnableIndicateOList: TObjectListType;
function EnableIndicateThread(Value: DWORD): DWORD;
const
IndiTime: Integer = 0;
var
RetVal, dwEvtMas, dwTransfer, ModemStat: DWORD;
begin
Result := 0;
EnableIndicateOList.cObjects := 2;
EnableIndicateOList.hObjects[0] := MSMEvent;
EnableIndicateOList.hObjects[1] := InOverLapped.hEvent;
SetCommMask(ComDev, EV_RLSD);
while Truedo
//while 1
begin
while Truedo
// while 2
begin
if not WaitCommEvent(ComDev, dwEvtMas, @InOverlapped) then
begin
RetVal := WaitForMultipleObjects(EnableIndicateOList.cObjects,
@EnableIndicateOList.hObjects[0], False, INFINITE);
case RetVal of
WAIT_OBJECT_0:
begin
Result := 0;
Exit;
end;
WAIT_OBJECT_0 + 1:
begin
if not GetOverlappedResult(ComDev, InOverlapped, dwTransfer, False) then
Continue;
if dwTransfer = EV_RLSD then
break;
end;
end;
end;
end;
// end while 2
GetCommModemStatus(ComDev, ModemStat);
ModemStat := ModemStat and MS_RLSD_ON;
if ((ModemStat <> MS_RLSD_ON) and not RLSDDirection) or
((ModemStat = MS_RLSD_ON) and RLSDDirection) then
Continue else
begin
SetEvent(EnableIndicateEvent);
break;
//break func
end;

while Truedo
//while 3
begin
if WaitCommEvent(ComDev, dwEvtMas, @InOverlapped) then
begin
case WaitForMultipleObjects(EnableIndicateOList.cObjects,
@EnableIndicateOList.hObjects[0], False, INFINITE) of
WAIT_OBJECT_0:
begin
Result := 0;
Exit;
end;
WAIT_OBJECT_0 + 1:
begin
if not GetOverlappedResult(ComDev, InOverlapped, dwTransfer, False) then
Continue;
if dwTransfer = EV_RLSD then
break;
//break while 1
end;
end;
end;
// end if
ReadFile(ComDev, InBuffer, INBUFFERSIZE, nBytesRead, @InOverlapped);
pMesInput := @InBuffer[0];
GetCommModemStatus(ComDev, ModemStat);
ModemStat := ModemStat and MS_RLSD_ON;
if ((ModemStat <> MS_RLSD_ON) and not RLSDDirection) or
((ModemStat = MS_RLSD_ON) and RLSDDirection) then
begin
SetEvent(UnEnableIndicateEvent);
break;
end else
begin
SetEvent(UnEnableIndicateEvent);
SetEvent(EnableIndicateEvent);
end;
end;
// end while 3;
end;
//end while 1
end;

var
SendTime: Integer;
function MStateMachine(P: Pointer): DWORD;
begin
RTWaitSetList[0] := MSMEvent;
// CreateEvent 一般不会返回错：0，照着译过来了
EnableIndicateEvent := CreateEvent(nil, True, False, nil);
if EnableIndicateEvent = 0 then
begin
Result := 1;
Exit;
end;
UnEnableIndicateEvent := CreateEvent(nil, True, False, nil);
if UnEnableIndicateEvent = 0 then
begin
Result := 1;
Exit;
end;
hEnableIndicateThread := CreateThread(nil, 0, @EnableIndicateThread,
nil, 0, EnableIndicateTid);
if hEnableIndicateThread = 0 then
begin
Result := 1;
Exit;
end;
SetThreadPriority(hEnableIndicateThread, THREAD_PRIORITY_TIME_CRITICAL);
RcvList.cObjects := 2;
RcvList.hObjects[0] := MSMEvent;
RcvList.hObjects[1] := UnEnableIndicateEvent;
XmtList.cObjects := 2;
XmtList.hObjects[0] := MSMEvent;
XmtList.hObjects[1] := OutOverLapped.hEvent;
SetEvent(ConnectedOKEvent);
fpCms := 0;
rpCms := 0;
SendTime := 0;
ResetEvent(EnableIndicateEvent);
while Truedo
begin
while fpCms < rpCmsdo
begin
PrintRCV_MSG(fpCms);
Inc(fpCms);
end;
if WaitForMultipleObjects(RcvList.cObjects,
@RcvList.hObjects[0], False, INFINITE) = WAIT_OBJECT_0 then
begin
Result := 0;
Exit;
end;
ResetEvent(UnEnableIndicateEvent);
PutCmStack;
end;
end;

function HartComGetMes(Message, Status, CmdMes: PByte): Integer;
var
I, Addr, MesLength: Integer;
begin
if (Message^ = $06) or (Message^ = $01) then
begin
CmdMes^ := PByte(Integer(Message) + 2)^;
Addr := 3;
end else
if (Message^ = $86) or (Message^ = $81) then
begin
CmdMes^ := PByte(Integer(Message) + 6)^;
Addr := 7;
end else
begin
Result := -1;
Exit;
end;
MesLength := PByte(Integer(Message) + Addr)^ - 2;
if MesLength > MesLengthMax then
begin
Result := -1;
Exit;
end;
for I := 0 to MesLength - 1do
PByte(Integer(CmdMes) + I + 1)^ := PByte(Integer(Message) + I + Addr + 3)^;
Status^ := PByte(Integer(Message) + Addr + 1)^;
PByte(Integer(Status) + 1)^ := PByte(Integer(Message) + Addr + 2)^;
Result := MesLength + 1;
end;

function CheckCmdAddr(Mes: PByte): Boolean;
var
I: Integer;
begin
Result := False;
if (Mes^ = $06) or (Mes^ = $01) then
begin
Result := ((SAddr[0] and $8F) = (PByte(Integer(Mes) + 1)^ and $8F)) and
(SHartCmd = PByte(Integer(Mes) + 2)^);
end else
if (Mes^ = $86) or (Mes^ = $81) then
begin
if ((SAddr[0] and $BF) = (PByte(Integer(Mes) + 1)^ and $BF)) and
(SHartCmd = PByte(Integer(Mes) + 6)^) then
begin
for I := 1 to 4do
begin
if SAddr <> PByte(Integer(Mes) + I + 1)^ then
Exit;
end;
Result := True;
end else
if PByte(Integer(Mes) + 6)^ = $C1 then
begin
if ((PByte(Integer(Mes) + 1)^ and $BF) = (PByte(Integer(Mes) + 10 + 6)^ and $BF)) and
(SHartCmd = PByte(Integer(Mes) + 6)^) then
begin
for I := 1 to 4do
if PByte(Integer(Mes) + I + 1)^ = PByte(Integer(Mes) + I + 10 + 6)^ then
Exit;
Result := True;
end;
end;
end;
end;

{ ^ ==> xor }
function AddFFandCheck(SendData, FFSendData: PByte): Integer;
var
EorResult: Byte;
I, bcnt, Addr: Integer;
begin
if SendData^ = $02 then
begin
SAddr[0] := PByte(Integer(SendData) + 1)^;
SHartCmd := PByte(Integer(SendData) + 2)^;
Addr := 3;
end else
if SendData^ = $82 then
begin
for I := 0 to 4do
SAddr := PByte(Integer(SendData) + I + 1)^;
SHartCmd := PByte(Integer(SendData) + 6)^;
Addr := 7;
end else
begin
HartComMessageCode := WrtDataError;
Result := -1;
Exit;
end;

bcnt := PByte(Integer(SendData) + Addr)^;
FillChar(FFSendData^, prenum - 1, $FF);
Move(SendData^, PByte(Integer(FFSendData) + prenum)^, Addr + bcnt);
EorResult := 0;
for I := prenum to prenum + Addr + bcntdo
EorResult := EorResult xor PByte(Integer(FFSendData) + I)^;
I := prenum + Addr + bcnt + 1;
PByte(Integer(FFSendData) + I)^ := EorResult;
PByte(Integer(SendData) + I - prenum)^ := EorResult;
Result := prenum + Addr + bcnt + 2;
end;

function SetupConnection: Boolean;
var
dcb: TDCB;
cfFlags: TCommFlags;
begin
GetCommState(ComDev, dcb);
cfFlags.fBinary := True;
cfFlags.fParity := True;
cfFlags.fOutxCtsFlow := False;
cfFlags.fOutxDsrFlow := False;
cfFlags.fDtrControl := DTR_CONTROL_DISABLE;
cfFlags.fDsrSensitivity := False;
cfFlags.fInX := False;
cfFlags.fOutX := False;
cfFlags.fRtsControl := RTS_CONTROL_DISABLE;
cfFlags.fAbortOnError := False;
with dcbdo
begin
Flags := CommFlagsToDWORD(cfFlags);
ByteSize := 8;
BaudRate := CBR_1200;
Parity := ODDPARITY;
StopBits := ONESTOPBIT;
end;
Result := SetCommState(ComDev, dcb);
end;

function HartComOpen(AParentHandle: THandle;
AComPort: string = 'COM1'): Integer;
begin
ParentHandle := AParentHandle;
ComDev := CreateFile(PChar(AComPort), GENERIC_READ or GENERIC_WRITE,
0, nil, OPEN_EXISTING, FILE_FLAG_OVERLAPPED, 0);
if ComDev = 0 then
begin
HartComMessageCode := OpenFail;
Result := HartComMessageCode;
Exit;
end;
if not SetupConnection then
begin
HartComMessageCode := SetCommStateFail;
Result := HartComMessageCode;
Exit;
end;
EscapeCommFunction(ComDev, CLRRTS);
EscapeCommFunction(ComDev, SETDTR);
InOverlapped.Offset := 0;
InOverlapped.OffsetHigh := 0;
InOverlapped.hEvent := CreateEvent(nil, True, False, nil);
if InOverlapped.hEvent = 0 then
begin
HartComMessageCode := CreateEventFail;
CloseHandle(ComDev);
Result := HartComMessageCode;
Exit;
end;
OutOverlapped.Offset := 0;
OutOverlapped.OffsetHigh := 0;
OutOverlapped.hEvent := CreateEvent(nil, True, False, nil);
if OutOverlapped.hEvent = 0 then
begin
CloseHandle(InOverlapped.hEvent);
CloseHandle(ComDev);
HartComMessageCode := CreateEventFail;
Result := HartComMessageCode;
Exit;
end;
MSMEvent := CreateEvent(nil, True, False, nil);
SetCommTimeouts(ComDev, MyOverlappedTimeouts);
hMSMThread := CreateThread(nil, 0, @MstateMachine, nil, 0, MSMTid);
if hMSMThread = 0 then
begin
CloseHandle(ComDev);
CloseHandle(InOverlapped.hEvent);
CloseHandle(OutOverlapped.hEvent);
HartComMessageCode := CreateThreadFail;
Result := HartComMessageCode;
Exit;
end;
SetThreadPriority(hMSMThread, THREAD_PRIORITY_ABOVE_NORMAL);
SHartCmd := $FF;
ConnectedOKEvent := CreateEvent(nil, True, False, nil);
ConnectList[0] := hMSMThread;
ConnectList[1] := ConnectedOKEvent;
{ WaitFor 返回WAIT_OBJECT_0 表示触发了ConnectList中的事件，应该是正常返回，
而这里却是连接失败，不太通！}
if WaitForMultipleObjects(2, @ConnectList[0], False, INFINITE) = WAIT_OBJECT_0 then
begin
SetEvent(MSMEvent);
CloseHandle(ComDev);
CloseHandle(InOverlapped.hEvent);
CloseHandle(OutOverlapped.hEvent);
Connected := False;
Result := ConnectFail;
Exit;
end;
Connected := True;
Result := NoError;
end;

procedure HartComClose;
begin
if Connected then
begin
SetEvent(MSMEvent);
Connected := False;
SetEvent(MSMEvent);
EscapeCommFunction(ComDev, CLRRTS);
if WaitForSingleObject(hMSMThread, 3000) = WAIT_TIMEOUT then
PrintMsg(CloseMSMThreadError);
if WaitForSingleObject(hEnableIndicateThread, 3000) = WAIT_TIMEOUT then
PrintMsg(CloseEnblThreadError);
if WaitForSingleObject(hRTThread, 3000) = WAIT_TIMEOUT then
PrintMsg(CloseEnblThreadError);
CloseHandle(OutOverLapped.hEvent);
CloseHandle(InOverLapped.hEvent);
CloseHandle(ComDev);
end;
end;

procedure HartComSend(SendData: PByte);
var
I, DataLength: Integer;
FFSendData: array [0..99] of Byte;
begin
if not Connected then
begin
HartComMessageCode := ComNotConnected;
Post(HartComMessageCode, TYPEMSG);
Exit;
end;
HartComMessageCode := NoError;
DataLength := AddFFandCheck(SendData, @FFSendData[0]);
if DataLength < 0 then
begin
PrintMsg(HartComMessageCode);
Exit;
end;
if DisplayAll then
PrintMREQ(SendData);
for I := 0 to DataLength - 1do
OutBuffer := FFSendData;
XmtNum := DataLength;
EscapeCommFunction(ComDev, SETRTS);
if not WriteFile(ComDev, OutBuffer, XmtNum + 2, NumberOfBytesWritten,
@OutOverlapped) and (GetLastError = Error_IO_PENDING)then
begin
if WaitForMultipleObjects(XmtList.cObjects, @XmtList.hObjects[0],
False, INFINITE) = WAIT_OBJECT_0 then
Exit;
end;
EscapeCommFunction(ComDev, CLRRTS);
end;

procedure SendLastCmd;
begin
end;

procedure HartSetDisplayAll(Mode: Boolean = False);
begin
DisplayAll := Mode;
end;

function GetAddress(abIn: PBYTE): Boolean;
var
P: Pointer;
Counter: Integer;
begin
P := abIn;
Counter := 3;
Result := PByte(P)^ = 6;
if not Result then
Exit;
Result := PByte(Integer(P) + Counter - 1)^= 0;
if not Result then
Exit;
Address[0] := PByte(Integer(P) + Counter + 3 + 1)^ or $80;
Address[1] := PByte(Integer(P) + Counter + 3 + 2)^;
Address[2] := PByte(Integer(P) + Counter + 3 + 9)^;
Address[3] := PByte(Integer(P) + Counter + 3 + 10)^;
Address[4] := PByte(Integer(P) + Counter + 3 + 11)^;
Result := True;
end;

initialization
finalization
HartComClose;
end.

//我是用Delphi6,窗体文件可能有点问题
//main.dfm
object MainForm: TMainForm
Left = 297
Top = 173
Width = 268
Height = 155
Caption = 'MainForm'
Color = clBtnFace
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = '宋体'
Font.Style = []
OldCreateOrder = False
Position = poScreenCenter
PixelsPerInch = 96
TextHeight = 12
object PVLabel: TLabel
Left = 152
Top = 32
Width = 12
Height = 12
Caption = 'PV'
end
object btnOpen: TButton
Left = 48
Top = 88
Width = 75
Height = 25
Caption = 'Open'
TabOrder = 0
OnClick = btnOpenClick
end
object edPV: TEdit
Left = 152
Top = 48
Width = 73
Height = 20
TabOrder = 1
end
object cbRLSD: TCheckBox
Left = 152
Top = 8
Width = 73
Height = 17
Caption = 'RLSD'
TabOrder = 2
OnClick = cbRLSDClick
end
object btnGet: TButton
Left = 153
Top = 88
Width = 75
Height = 25
Caption = 'Get PV'
TabOrder = 3
OnClick = btnGetClick
end
object gbCOM: TGroupBox
Left = 8
Top = 8
Width = 121
Height = 65
Caption = 'com selection'
TabOrder = 4
object rbCom1: TRadioButton
Left = 8
Top = 16
Width = 65
Height = 17
Caption = 'Com1'
Checked = True
TabOrder = 0
TabStop = True
end
object rbCom2: TRadioButton
Left = 8
Top = 32
Width = 57
Height = 17
Caption = 'Com2'
TabOrder = 1
end
end
end
//main.pas
unit Main;
interface
uses
Windows, Messages, SysUtils, {$IFDEF VER140}Variants,{$ENDIF} Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TMainForm = class(TForm)
rbCom1: TRadioButton;
rbCom2: TRadioButton;
cbRLSD: TCheckBox;
btnGet: TButton;
btnOpen: TButton;
edPV: TEdit;
PVLabel: TLabel;
gbCOM: TGroupBox;
procedure btnOpenClick(Sender: TObject);
procedure cbRLSDClick(Sender: TObject);
procedure btnGetClick(Sender: TObject);
private
procedure CommNotify(var msg: TMessage);
message WM_COMMNOTIFY;
end;

var
MainForm: TMainForm;
implementation
uses CommComp, CommConsts;
{$R *.dfm}
var
PollCmd: array [0..39] of Byte;
GetPVCmd: array [0..39] of Byte;
type
TUType = record
case Integer of
0: (F: Single);
1: (ch: array [0..3] of Char);
end;

function HartToFloat(S: PChar): Single;
var
U: TUType;
I: Integer;
begin
for I := 0 to 3do
begin
U.ch[3 - I] := S^;
Inc(S);
end;
Result := U.F;
end;

procedure FloatToHart(X: Single;
S: PChar);
var
U: TUType;
I: Integer;
begin
U.F := X;
for I := 3do
wnto 0do
begin
S^ := U.ch[3 - I];
Inc(S);
end;
end;

procedure TMainForm.btnOpenClick(Sender: TObject);
begin
HartComClose;
if rbCom1.Checked then
begin
if HartComOpen(Handle) < 0 then
raise Exception.Create('Can''t open COM1')
else
MessageBox(Handle, 'Open Success', 'OK', MB_OK + MB_ICONINFORMATION);
end else
if HartComOpen(Handle, 'COM2') < 0 then
raise Exception.Create('Can''t open COM2')
else
MessageBox(Handle, 'Open Success', 'OK', MB_OK + MB_ICONINFORMATION);
HartComSend(@PollCmd);
end;

procedure TMainForm.cbRLSDClick(Sender: TObject);
begin
RLSDDirection := cbRLSD.Checked;
end;

procedure TMainForm.btnGetClick(Sender: TObject);
begin
HartComSend(@GetPVCmd);
end;

procedure TMainForm.CommNotify(var msg: TMessage);
var
P: PByte;
I: Integer;
DisplayType: Integer;
begin
DisplayType := msg.LParam;
P := PByte(msg.WParam);
case DisplayType of
TYPEBACK:
begin
Inc(P, 5);
if P^ = 1 then
edPV.Text := Format('%-11.3f', [HartToFloat(Pointer(Integer(P) + 5))]);
end;
TYPEACK:;
TYPEACK1:
begin
if GetAddress(P) then
for I := 0 to 4do
GetPVCmd[I + 1] := Address;
Inc(P, 5);
if P^ = 1 then
edPV.Text := Format('%-11.3f', [HartToFloat(Pointer(Integer(P) + 5))]);
end;
end;

end;

procedure InitArray;
begin
(* BCB:
BYTE PollCmd[40]={0x02,0x80,0,0};
BYTE GetPVCmd[40]={0x82,0,0,0,0,0,1,0};
*)
FillChar(PollCmd, SizeOf(PollCmd), 0);
PollCmd[0] := 2;
PollCmd[1] := $80;
FillChar(GetPVCmd, SizeOf(GetPVCmd), 0);
GetPVCmd[0] := $82;
GetPVCmd[6] := 1;
end;

initialization
InitArray;
end.

CommConsts.pas那两个函数是为转TDCB .Flags,因为pascal不支持 :
DWORD some1: 1;
DWORD some2: 1;
之类的，所以只能写两个函数转换，如果你想求证值是否正确]
//C++ in VC6.0
//typedef struct _MYDCB
{
DWORD DCBlength;
/* sizeof(DCB) */
DWORD BaudRate;
/* Baudrate at which running */
DWORD Flags;
WORD wReserved;
/* Not currently used */
WORD XonLim;
/* Transmit X-ON threshold */
WORD XoffLim;
/* Transmit X-OFF threshold */
BYTE ByteSize;
/* Number of bits/byte, 4-8 */
BYTE Parity;
/* 0-4=None,Odd,Even,Mark,Space */
BYTE StopBits;
/* 0,1,2 = 1, 1.5, 2 */
char XonChar;
/* Tx and Rx X-ON character */
char XoffChar;
/* Tx and Rx X-OFF character */
char ErrorChar;
/* Error replacement char */
char EofChar;
/* End of Input character */
char EvtChar;
/* Received Event character */
WORD wReserved1;
/* Fill for now. */
} MYDCB;
打开Watch,看mydcb.Flags值就是， 每次在 memset((char**)&amp;mydcb, 0, sizeof(mydcb));
加入断点,看mydcb.Flags值就能得到它的值，
我也是想了半天，以前也不知怎么回事，现在。。。：）
void CDdddDlg::OnOK()}
{
DCB dcb ;
memset((char**)&amp;dcb, 0, sizeof(dcb));
MYDCB mydcb;
memset((char**)&amp;mydcb, 0, sizeof(mydcb));
dcb.fBinary = TRUE;
memcpy((char**)&amp;mydcb, (char**)&amp;dcb, sizeof(dcb));
memset((char**)&amp;dcb, 0, sizeof(dcb));
dcb.fParity = TRUE ;
memcpy((char**)&amp;mydcb, (char**)&amp;dcb, sizeof(dcb));
memset((char**)&amp;dcb, 0, sizeof(dcb));
dcb.fOutxCtsFlow=TRUE;
memcpy((char**)&amp;mydcb, (char**)&amp;dcb, sizeof(dcb));
memset((char**)&amp;dcb, 0, sizeof(dcb));
dcb.fOutxDsrFlow =TRUE;
memcpy((char**)&amp;mydcb, (char**)&amp;dcb, sizeof(dcb));
memset((char**)&amp;dcb, 0, sizeof(dcb));
dcb.fDtrControl = DTR_CONTROL_ENABLE;
memcpy((char**)&amp;mydcb, (char**)&amp;dcb, sizeof(dcb));
memset((char**)&amp;dcb, 0, sizeof(dcb));
dcb.fDtrControl = DTR_CONTROL_HANDSHAKE;
memcpy((char**)&amp;mydcb, (char**)&amp;dcb, sizeof(dcb));
memset((char**)&amp;dcb, 0, sizeof(dcb));
dcb.fDsrSensitivity = TRUE;
memcpy((char**)&amp;mydcb, (char**)&amp;dcb, sizeof(dcb));
memset((char**)&amp;dcb, 0, sizeof(dcb));
dcb.fTXContinueOnXoff = TRUE;
memcpy((char**)&amp;mydcb, (char**)&amp;dcb, sizeof(dcb));
memset((char**)&amp;dcb, 0, sizeof(dcb));
dcb.fOutX = TRUE;
memcpy((char**)&amp;mydcb, (char**)&amp;dcb, sizeof(dcb));
memset((char**)&amp;dcb, 0, sizeof(dcb));
dcb.fInX = TRUE;
memcpy((char**)&amp;mydcb, (char**)&amp;dcb, sizeof(dcb));
memset((char**)&amp;dcb, 0, sizeof(dcb));
dcb.fErrorChar = TRUE;
memcpy((char**)&amp;mydcb, (char**)&amp;dcb, sizeof(dcb));
memset((char**)&amp;dcb, 0, sizeof(dcb));
dcb.fNull = TRUE;
memcpy((char**)&amp;mydcb, (char**)&amp;dcb, sizeof(dcb));
memset((char**)&amp;dcb, 0, sizeof(dcb));
dcb.fRtsControl = RTS_CONTROL_ENABLE;
memcpy((char**)&amp;mydcb, (char**)&amp;dcb, sizeof(dcb));
memset((char**)&amp;dcb, 0, sizeof(dcb));
dcb.fRtsControl = RTS_CONTROL_HANDSHAKE;
memcpy((char**)&amp;mydcb, (char**)&amp;dcb, sizeof(dcb));
memset((char**)&amp;dcb, 0, sizeof(dcb));
dcb.fRtsControl = RTS_CONTROL_TOGGLE;
memcpy((char**)&amp;mydcb, (char**)&amp;dcb, sizeof(dcb));
memset((char**)&amp;dcb, 0, sizeof(dcb));
dcb.fAbortOnError = TRUE;
memcpy((char**)&amp;mydcb, (char**)&amp;dcb, sizeof(dcb));
memset((char**)&amp;dcb, 0, sizeof(dcb));
}

copy_paste:
你真是好人，我发了很多程序，只有你回了，非常感谢你。尽管我还在实验，但是我还是要
把分数都给你。其他的朋友也非常感谢！但是不好意思。
copy_paste:
你可以把你的程序打包发给我吗？
ebin5630@sina.com
再次感谢！！！