控制器服务器开发(100分)

服务器上通过串口接多个设备，希望从客户端访问服务器上的串口设备，达到控制服务器上设备的目的。

也就是串口通讯，没什么复杂的，自己找本书看看就行了，第三方控件我用的是Quick-COM自己找。

在服务器放置一个COM+对象，里面封装了对串口的操作
在客户端通过接口调用服务器的COM+提供的服务从而达到控制串口的目的。

对串口的操作可以写如下一个类（我昨天刚刚写的：），改编自SPCOMM）
{******************************************************************************
文 件 名：UntComm.pas
描 述：定义串口通讯类
公共函数：
调用模块：UntCommunicationBase.pas
数 据 库：
文 件：
作 者：穆洪星
建立日期：2006年07月19日
******************************************************************************}

unit UntComm;

interface

uses
Classes, Windows, UntCommunicationBase;

const
INPUT_BUFFER_SIZE = 2048; //最大输入数据长度
OUTPUT_BUFFER_SIZE = 2048; //最大输出数据长度

type
{ 波特率 }
TBaudRate = (br110, br300, br600, br1200, br2400, br4800, br9600, br14400,
br19200, br38400, br56000, br57600, br115200, br128000, br256000);
{ 奇偶校验 }
TParity = (paNone, paOdd, paEven, paMark, paSpace);
{ 停止位 }
TStopBits = (sb10, sb15, sb20);
{ 数据位 }
TByteSize = (da4, da5, da6, da7, da8);
{ 串口通讯类 }
TComm = class(TCommunicationBase)
private
FBaudRate: TBaudRate; //波特率
FByteSize: TByteSize; //数据位
FComPort: string; //串口号
FStopBits: TStopBits; //停止位
FParity: TParity; //校验位
FTimeOut: Integer; //超时时间
FOnTimeOut: TNotifyEvent; //超时事件
FReadOL: TOverLapped;
FWriteOL: TOverLapped;
procedure SetBaudRate(const AValue: TBaudRate);
procedure SetByteSize(const AValue: TByteSize);
procedure SetOnTimeOut(const AValue: TNotifyEvent);
procedure SetStopBits(const AValue: TStopBits);
procedure SetTimeOut(const AValue: Integer);
procedure SetParity(const AValue: TParity);
procedure SetComPort(const AValue: string);
protected
FCommHandle: THandle;
function WriteData(APDataToWrite: PChar;
ANumberOfBytesToWrite: Word): Boolean; override;
function ReadData(var AReveivePackage: TPackage): Boolean; override;
function HandleReadData(var AReceivePackage: TPackage): Boolean;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function OpenPort: Boolean; override;
function ClosePort: Boolean; override;
function WriteCommDataAndWaitResponse(APDataToWrite: PChar;
ANumberOfBytesToWrite: Word; var AReceivePackage: TPackage): Boolean;
function GetErrorInfo: string; override;
procedure SetCommEvent;
published
property BaudRate: TBaudRate read FBaudRate write SetBaudRate;
property ByteSize: TByteSize read FByteSize write SetByteSize;
property StopBits: TStopBits read FStopBits write SetStopBits;
property Parity: TParity read FParity write SetParity;
property COMPort: string read FComPort write SetComPort;
property TimeOut: Integer read FTimeOut write SetTimeOut;
property OnTimeOut: TNotifyEvent read FOnTimeOut write SetOnTimeOut;
end;

implementation

const
{ 波特率 }
COM_BAUDRATE: 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);
{ 数据位 }
COM_BYTESIZE: array[TByteSize] of Integer = (4, 5, 6, 7, 8);
{ 奇偶性 }
COM_PARITY: array[TParity] of Integer = (NOPARITY, ODDPARITY, EVENPARITY,
MARKPARITY, SPACEPARITY);
ITEM_PARITY: array[TParity] of string = ('NONE', 'ODD', 'EVEN', 'MARK',
'SPACE');
{ 停止位 }
COM_STOPBIT: array[TStopBits] of Integer = (ONESTOPBIT, ONE5STOPBITS,
TWOSTOPBITS);

{ TComm }

{******************************************************************************
函 数 名：Create
说 明：串口类的创建
输入参数：对象的所有者
输出参数：
返 回 值：
全局变量：FBaudRate，FDataBits，FStopBits，FParity，FCOMPort，FCOMPort，
FTimeOut，FCommHandle
数 据 库：
文 件：
调 用：
作 者：穆洪星
建立日期：2006年7月19日
******************************************************************************}
constructor TComm.Create(AOwner: TComponent);
begin
inherited;
FBaudRate := br9600;
FByteSize := da8;
FStopBits := sb10;
FParity := paNone;
FCOMPort := 'COM1';
FTimeOut := 10 * 1000;
FCommHandle := 0;
end;

destructor TComm.Destroy;
begin

inherited;
end;

procedure TComm.SetBaudRate(const AValue: TBaudRate);
begin
FBaudRate := AValue;
end;

procedure TComm.SetByteSize(const AValue: TByteSize);
begin
FByteSize := AValue;
end;

procedure TComm.SetComPort(const AValue: string);
begin
FComPort := AValue;
end;

procedure TComm.SetOnTimeOut(const AValue: TNotifyEvent);
begin
FOnTimeOut := AValue;
end;

procedure TComm.SetParity(const AValue: TParity);
begin
FParity := AValue;
end;

procedure TComm.SetStopBits(const AValue: TStopBits);
begin
FStopBits := AValue;
end;

procedure TComm.SetTimeOut(const AValue: integer);
begin
FTimeOut := AValue;
end;

{******************************************************************************
函 数 名：OpenPort
说 明：打开COM端口
输入参数：
输出参数：
返 回 值：成功返回True失败返回False
全局变量：FCommHandle
数 据 库：
文 件：
调 用：
作 者：穆洪星
建立日期：2006年7月19日
******************************************************************************}
function TComm.OpenPort: Boolean;
var
TmpCommTimeouts: TCommTimeouts;
TmpDcb: TDCB;
begin
Result := False;
{ 判断串口是否已经打开 }
if FCommHandle > 0 then
ClosePort;
{ 打开COM端口 }
FCommHandle := CreateFile(PChar('//./' + FComPort),
GENERIC_READ or GENERIC_WRITE or FILE_SHARE_READ or FILE_SHARE_WRITE,
0, nil, OPEN_EXISTING,
FILE_ATTRIBUTE_NORMAL or FILE_FLAG_OVERLAPPED,
0);
{ 如果串口打开失败，退出 }
if FCommHandle = INVALID_HANDLE_VALUE then
Exit;
{ 设置输入输出缓冲区大小 }
if not SetupComm(FCommHandle, INPUT_BUFFER_SIZE, OUTPUT_BUFFER_SIZE) then
Exit;
{ 清空缓冲区 }
if not PurgeComm(FCommHandle, PURGE_TXABORT or PURGE_RXABORT or PURGE_TXCLEAR
or PURGE_RXCLEAR) then
Exit;
{ 设置通讯超时 }
with TmpCommTimeouts do
begin
ReadIntervalTimeout := 100;
ReadTotalTimeoutMultiplier := 0;
ReadTotalTimeoutConstant := 0;
WriteTotalTimeoutMultiplier := 0;
WriteTotalTimeoutConstant := 0;
end;
SetCOMMTimeOuts(FCommHandle, TmpCommTimeouts);
{ 设置COM的Control Block属性 }
if not GetCOMMState(FCommHandle, TmpDCB) then
Exit;
with TmpDcb do
begin
DCBlength := SizeOf(TmpDcb);
BaudRate := COM_BAUDRATE[FBaudRate];
ByteSize := COM_BYTESIZE[FByteSize];
StopBits := COM_STOPBIT[FStopBits];
Parity := COM_PARITY[FParity];
{ 设置通信的握手方式 }
Flags := 1;
Flags := Flags or $10; //支持DSR/DTR方式
Flags := Flags or $80; //支持XON/XOFF
Flags := Flags or $100; //Out X_XonXoffFlow
Flags := Flags or $200; //InX_XonXoffFlow
Flags := Flags or $1000; //支持RTS/CTS
XonChar := chr($11);
XoffChar := chr($13);
ErrorChar := chr($0);
XonLim := 500;
XoffLim := 500;
end;
if not SetCommState(FCommHandle, TmpDcb) then
Exit;
{ 返回结果 }
Result := True;
end;

{******************************************************************************
函 数 名：ClosePort
说 明：关闭COM端口
输入参数：
输出参数：
返 回 值：成功返回True, 失败返回False
全局变量：FCommHandle
数 据 库：
文 件：
调 用：
作 者：穆洪星
建立日期：2006年7月19日
******************************************************************************}
function TComm.ClosePort: Boolean;
begin
Result := True;
if (FCommHandle = 0) or (FCommHandle = INVALID_HANDLE_VALUE) then
Exit;
SetCommBreak(FCommHandle);
{ 通过设置DTR和RTS为地位中断传输 }
EscapeCommFunction(FCommHandle, CLRDTR);
EscapeCommFunction(FCommHandle, CLRRTS);
{ 清空缓冲区 }
PurgeComm(FCommHandle, PURGE_RXCLEAR or PURGE_RXABORT or
PURGE_TXCLEAR or PURGE_TXABORT);
{ 禁止所有被监控的事件 }
SetCommMask(FCommHandle, 0);
{ 关闭串口 }
CloseHandle(FCommHandle);
Result := True;
end;

{******************************************************************************
函 数 名：WriteData
说 明：向串口写数据
输入参数：APDataToWrite - 指向要写入数据的指针,
ANumberOfBytesToWrite - 要写入数据的字节数目
输出参数：
返 回 值：成功返回True, 失败返回False
全局变量：FCommHandle, FWriteOL
数 据 库：
文 件：
调 用：
作 者：穆洪星
建立日期：2006年7月19日
******************************************************************************}
function TComm.WriteData(APDataToWrite: PChar;
ANumberOfBytesToWrite: Word): Boolean;
var
TmpLastError: DWORD;
TmpNumberOfBytesWritten, TmpWhereToStartWriting: DWORD;
TmpHandleSignaled: DWORD;
begin
Result := False;
try
FillChar(FWriteOL, SizeOf(FWriteOL), 0);
FWriteOL.hEvent := CreateEvent(nil, True, False, nil);
TmpNumberOfBytesWritten := 0;
TmpWhereToStartWriting := 0;
{ 一个一个字节发送，直到全部发送成功 }
repeat
if not WriteFile(FCommHandle, APDataToWrite[TmpWhereToStartWriting],
ANumberOfBytesToWrite, TmpNumberOfBytesWritten,
@FWriteOL) then
begin
TmpLastError := GetLastError;
if TmpLastError <> ERROR_IO_PENDING then
Exit;
TmpHandleSignaled := WaitForSingleObject(FWriteOL.hEvent, INFINITE);
case TmpHandleSignaled of
WAIT_OBJECT_0:
begin
if not GetOverlappedResult(FCommHandle, FWriteOL,
TmpNumberOfBytesWritten, True) then
begin
TmpLastError := GetLastError;
if TmpLastError = ERROR_INVALID_HANDLE then
Exit;
end
end;
else begin
CloseHandle(FWriteOL.hEvent);
Exit;
end;
end;
end;
Dec(ANumberOfBytesToWrite, TmpNumberOfBytesWritten);
Inc(TmpWhereToStartWriting, TmpNumberOfBytesWritten);
until (ANumberOfBytesToWrite <= 0);
{ 全部发送完成 }
Result := True;
finally
CloseHandle(FWriteOL.hEvent);
end;
end;

{******************************************************************************
函 数 名：ReadData
说 明：从串口读数据
输入参数：
输出参数：AReceivePackage - 从串口接收的数据包
返 回 值：成功返回True, 失败返回False
全局变量：FCommHandle, FReadOL
数 据 库：
文 件：
调 用：
作 者：穆洪星
建立日期：2006年7月19日
******************************************************************************}
function TComm.ReadData(var AReveivePackage: TPackage): Boolean;
var
TmpEvtMask: Cardinal;
TmpHandleSignaled: DWORD;
begin
Result := False;
try
FillChar(FReadOL, SizeOf(FReadOL), 0);
FReadOL.hEvent := CreateEvent(nil, True, False, nil);
{ 表示我们对EV_RXCHAR事件感兴趣，有Char来到的时候系统会通知我们 }
SetCommMask(FCommHandle, EV_RXCHAR);
{ 等待COM事件 }
TmpEvtMask := 0;
ResetEvent(FReadOL.hEvent);
WaitCommEvent(FCommHandle, TmpEvtMask, @FReadOL);
{ 等待ReadOpOL的信号 }
TmpHandleSignaled := WaitForSingleObject(FReadOL.hEvent, FTimeOut);
if TmpHandleSignaled = WAIT_OBJECT_0 then
begin
HandleReadData(AReveivePackage);
Result := True;
end;
finally
CloseHandle(FReadOL.hEvent);
end;
end;

{******************************************************************************
函 数 名：WriteCommDataAndWaitResponse
说 明：写数据, 并等待数据返回, 发送与接收都成功后函数才成功返回
输入参数：APDataToWrite - 要写入串口的数据指针
ANumberOfBytesToWrite - 要写入串口的字节总数
输出参数：AReceivePackage - 用于接受返回的数据包
返 回 值：成功返回True, 失败返回False
全局变量：FCommHandle
数 据 库：
文 件：
调 用：
作 者：穆洪星
建立日期：2006年7月19日
******************************************************************************}
function TComm.WriteCommDataAndWaitResponse(APDataToWrite: PChar;
ANumberOfBytesToWrite: Word; var AReceivePackage: TPackage): Boolean;
begin
Result := WriteData(APDataToWrite, ANumberOfBytesToWrite) and
ReadData(AReceivePackage);
end;

procedure TComm.SetCommEvent;
begin
if FReadOL.hEvent > 0 then
SetEvent(FReadOL.hEvent);
end;

{******************************************************************************
函 数 名：HandleReadData
说 明：写数据，并等待数据返回, 发送与接收都成功后函数才成功返回
输入参数：AReceivePackage - 要从串口中接收到的数据指针
输出参数：AReceivePackage - 用于接受返回的数据包
返 回 值：成功返回true失败返回false
全局变量：FCommHandle
数 据 库：
文 件：
调 用：
作 者：穆洪星
建立日期：2006年7月19日
******************************************************************************}
function TComm.HandleReadData(var AReceivePackage: TPackage): Boolean;
var
TmpPReceive, TmpPReceive1: LPSTR;
TmpByteToRecv: array[0..INPUT_BUFFER_SIZE * 2 - 1] of Byte;
TmpError: DWORD;
TmpBufferLength, TmpBufferLength1: DWORD;
i: Integer;
TmpReadOL: TOverLapped;
begin
TmpPReceive := LPSTR(LocalAlloc(LPTR, INPUT_BUFFER_SIZE + 1));
try
TmpPReceive1 := LPSTR(LocalAlloc(LPTR, INPUT_BUFFER_SIZE + 1));
try
FillChar(TmpReadOL, SizeOf(TmpReadOL), 0);
TmpReadOL.hEvent := CreateEvent(nil, True, False, nil);
TmpBufferLength1 := 0;
if not ReadFile(FCommHandle, TmpPReceive^, INPUT_BUFFER_SIZE,
TmpBufferLength, @TmpReadOL) then
begin
if GetLastError = ERROR_IO_PENDING then
begin
while not GetOverLappedResult(FCommHandle, TmpReadOL,
TmpBufferLength, TRUE) do
begin
TmpError := GetLastError;
if TmpError = ERROR_IO_INCOMPLETE then
Continue;
end;
ResetEvent(TmpReadOL.hEvent);
end
else begin
Result := False;
end;
end;
if TmpBufferLength = INPUT_BUFFER_SIZE then
begin
if not ReadFile(FCommHandle, TmpPReceive1^, INPUT_BUFFER_SIZE,
TmpBufferLength1, @TmpReadOL) then
begin
if GetLastError = ERROR_IO_PENDING then
begin
while not GetOverLappedResult(FCommHandle, TmpReadOL,
TmpBufferLength, True) do
begin
TmpError := GetLastError;
if TmpError = ERROR_IO_INCOMPLETE then
Continue;
end;
ResetEvent(TmpReadOL.hEvent);
end
else begin
Result := False;
end;
end
end;
CopyMemory(@TmpByteToRecv, TmpPReceive, TmpBufferLength);
CopyMemory(@TmpByteToRecv[TmpBufferLength], TmpPReceive1,
TmpBufferLength1);
SetLength(AReceivePackage, TmpBufferLength + TmpBufferLength1);
for i := 0 to TmpBufferLength + TmpBufferLength1 - 1 do
AReceivePackage := TmpByteToRecv;
Result := True;
finally
LocalFree(THandle(TmpPReceive1));
end;
finally
LocalFree(THandle(TmpPReceive));
CloseHandle(TmpReadOL.hEvent);
end;
end;

function TComm.GetErrorInfo: string;
begin

end;

end.