串口数据捕获(200分以上) (50分)

win2k下需要SYS
win9x才是Vxd[]

学习一下,如果可以,很不错

to wang_junfan
COM1的地址到底是3f8h还是3fdh

我明白了，你要的不是一般的串口通讯程序，而是串口监控程序，对吧？那我就无法帮你了。

to wang_junfan
如果我用_inp(0x3fd)函数可以得到串口的数据吗?

我可以加分，谁能解决？分好商量,200以上

建议使用我这个控件： unit mscom;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
extctrls,syncobjs;

type
//类型定义
TBaudRate = ( br110, br300, br600, br1200, br2400, br4800,
br9600, br14400, br19200, br38400, br56000,
br57600, br115200 );
TComPortNumber = ( pnCOM1, pnCOM2, pnCOM3, pnCOM4, pnCOM5, pnCOM6, pnCOM7,
pnCOM8, pnCOM9, pnCOM10, pnCOM11, pnCOM12, pnCOM13,
pnCOM14, pnCOM15, pnCOM16 );
TParity = ( None, Odd, Even, Mark, Space );
TStopBits = ( SB1, SB1_5, SB2 );
TDataBits = ( DB5, DB6, DB7, DB8 );
THWHandShaking=(hhNone,hhNoneRTSON,hhRTSCTS);
TSWHandShaking=(shNone,shXonXoff);
//例外声明
ECommError = class( Exception );
//事件函数定位器声明
TReceiveDataEvent = procedure(Sender: TObject) of object;
TReceiveErrorEvent = procedure(Sender: TObject; EventMask : DWORD) of object;
TModemStateChangeEvent = procedure(Sender: TObject; ModemEvent : DWORD) of object;


const
// 输入缓冲区的默认大小
INPUTBUFFERSIZE = 4096;
// Line Status位定义
ME_CTS = 1;
ME_DSR = 2;
ME_RING = 4;
ME_RLSD = 8;
//DCB 位定义
dcb_Binary = $00000001;
dcb_ParityCheck = $00000002;
dcb_OutxCtsFlow = $00000004;
dcb_OutxDsrFlow = $00000008;
dcb_DtrControlMask = $00000030;
dcb_DtrControlDisable = $00000000;
dcb_DtrControlEnable = $00000010;
dcb_DtrControlHandshake = $00000020;
dcb_DsrSensivity = $00000040;
dcb_TXContinueOnXoff = $00000080;
dcb_OutX = $00000100;
dcb_InX = $00000200;
dcb_ErrorChar = $00000400;
dcb_NullStrip = $00000800;
dcb_RtsControlMask = $00003000;
dcb_RtsControlDisable = $00000000;
dcb_RtsControlEnable = $00001000;
dcb_RtsControlHandshake = $00002000;
dcb_RtsControlToggle = $00003000;
dcb_AbortOnError = $00004000;
dcb_Reserveds = $FFFF8000;

type
Tmscom = class(TComponent)
private
{ Private declarations }
CommTimer: TTimer; //组件用的定时器
szInputBuffer: array[0..INPUTBUFFERSIZE-1] of Char;
hComm: THandle;
FCommPort: TComPortNumber;
FPortOpen: Boolean;
FBaudRate: TBaudRate;
FParityCheck: Boolean;
FHwHandShaking: THwHandShaking;
FSwHandShaking: TSwHandShaking;
FDataBits: TDataBits;
FParity: TParity;
FStopBits: TStopBits;
FInputLen: DWORD; //每次执行Input时所读取的字符串长度
FRThreshold: DWORD;//设置引发接收事件的阀值
FDTR: Boolean;
FRTS: Boolean;
FInputData: String;
// FByteNo: DWORD; //已读取的字节数
FInputByteData: array of Byte;
FCommEvent: DWORD;
FCommError: DWORD;
FCDHolding: Boolean;
FCTSHolding: Boolean;
FDSRHolding: Boolean;
FRIHolding: Boolean;

//事件
FOnReceiveData: TReceiveDataEvent;
FOnReceiveError: TReceiveErrorEvent;
FOnModemStateChange:TModemStateChangeEvent;

//设置函数
procedure SetBaudRate( Rate : TBaudRate ); //设置速率
procedure SetHwHandShaking( c : THwHandShaking);//硬件交握
procedure SetSwHandShaking( c : TSwHandShaking);//软件交握
procedure SetDataBits( Size : TDataBits );//数据位数
procedure SetParity( p : TParity );//极性检查
procedure SetStopBits( Bits : TStopBits );//停止位
procedure SetInDataCount(StrNoWORD);//设成0表示清除FInputData
procedure SetRThreshold(RTNoWORD); //接收阀值
procedure SetPortOpen(b:Boolean);//打开通信端口
procedure _SetCommState;//设置通信参数
procedure SetDTRStatus(b:Boolean);//DTR 状态
procedure SetRTSStatus(b:Boolean);//RTS状态
Procedure ReadProcess;//读取数据函数
Procedure GetModemState;//线路状态检测函数
procedure OpenComm;//打开通信端口函数
procedure CloseComm;//开关通信端口函数
function ReadCommEvent()WORD; //硬件线路状态值读取
function ReadCommError()WORD; //错误状态值的读取
function ReadInputData():String;//返回收到的数据
function ReadInDataCount()WORD;//读取有多少数据
function ReadCDHolding:Boolean; //取得CD线路状态
function ReadDSRHolding:Boolean;//取得DSR线路状态
function ReadRIHolding:Boolean;//取得RI线路状态
function ReadCTSHolding:Boolean;//取得CTS线路状态
protected
{ Protected declarations }
//给子类继承用
procedure ProcTimer(Sender:TObject);
procedure ReceiveData();
procedure ReceiveError( EvtMask : DWORD );
procedure ModemStateChange( ModemEvent : DWORD );
public
{ Public declarations }
//给应用程序调用用
property Handle: THandle read hComm;
constructor Create( AOwner: TComponent ); override;
destructor Destroy; override;
function OutputString(DataToWrite: String): Boolean;
function OutputByte(const ByteData:array of Byte):Boolean;
function ReadInputByte(var APByte)WORD;
published
{ Published declarations }
//属性列表用
property CommPort: TComPortNumber read FCommPort write FCommPort;
property PortOpen:Boolean read FPortOpen write SetPortOpen;
property BaudRate: TBaudRate read FBaudRate write SetBaudRate;
property HwHandShaking: THwHandShaking read FHwHandShaking write SetHwHandShaking;
property SwHandShaking: TSwHandShaking read FSwHandShaking write SetSwHandShaking;
property DataBits: TDataBits read FDataBits write SetDataBits;
property Parity: TParity read FParity write SetParity;
property StopBits: TStopBits read FStopBits write SetStopBits;
property CommEventWORD read ReadCommEvent;
property CommErrorWORD read ReadCommError;
property Input:string read ReadInputData;
property InputLenWORD read FInputLen write FInputLen;
property RThresholdWORD read FRThreshold write SetRThreshold;
property CDHolding:Boolean read ReadCDHolding;
property DSRHolding:Boolean read ReadDSRHolding;
property RIHolding:Boolean read ReadRIHolding;
property CTSHolding:Boolean read ReadCTSHolding;
property DTREnabled:Boolean read FDTR write SetDTRStatus;
property RTSEnabled:Boolean read FRTS write SetRTSStatus;
property DataCountWORD read ReadInDataCount write SetInDataCount;

property OnReceiveData: TReceiveDataEvent
read FOnReceiveData write FOnReceiveData;
property OnReceiveError: TReceiveErrorEvent
read FOnReceiveError write FOnReceiveError;
property OnModemStateChange: TModemStateChangeEvent
read FOnModemStateChange write FOnModemStateChange;
end;

procedure Register;

implementation

(******************************************************************************)
// TComm PUBLIC METHODS
(******************************************************************************)

constructor Tmscom.Create( AOwner: TComponent );
begin
inherited Create( AOwner );
CommTimer:=TTimer.Create(Self);
CommTimer.Interval:=100;
CommTimer.OnTimer:=ProcTimer;
hComm := 0; //通信端口Handle先清空
FPortOpen:=False;
FCommPort := pnCOM2; //默认COM2
FBaudRate := br9600; //9600bps
FHwHandShaking := hhNone; //不激活硬件流量控制
FSwHandShaking := shNone; //不激活软件流量控制
FDataBits := DB8; //数据位数=8
FParity := None; //不作同位检查
FStopBits := SB1; //停止位数=1
FInputLen:=0; //默认是一次执行全部读取
CommTimer.Enabled:=True;

end;

destructor Tmscom.Destroy;
begin
CommTimer.Interval:=0;
CommTimer.Enabled:=False;
inherited Destroy;
end;

//打开通信端口
procedure Tmscom.OpenComm;
var
hNewCommFile: THandle;
ComStr:String;
begin
ComStr:='COM' + IntToStr(1+ord(FCommPort));
hNewCommFile := CreateFile( PChar(ComStr),
GENERIC_READ or GENERIC_WRITE,
0, {not shared}
nil, {no security ??}
OPEN_EXISTING,
0,{No Overlapped}
0 {template} );

if hNewCommFile = INVALID_HANDLE_VALUE then
raise ECommError.Create( 'Error opening serial port' );

if not SetupComm( hNewCommFile, INPUTBUFFERSIZE, INPUTBUFFERSIZE ) then
begin
CloseHandle( hComm );
raise ECommError.Create( 'Cannot setup comm buffer' );
end;
// It is ok to continue.
hComm := hNewCommFile;
// 清除湲冲区
PurgeComm( hComm, PURGE_TXABORT or PURGE_RXABORT or
PURGE_TXCLEAR or PURGE_RXCLEAR ) ;
// 通信端口组态
_SetCommState;

{ // 设置事件屏蔽
if not SetCommMask(hComm, EV_CTS or EV_DSR or EV_RLSD or EV_RING ) then
begin
MessageDlg('Set Comm Mask Error!', mtError, [mbOK], 0);
exit ;
end;}
FPortOpen:=True;

end; {TComm.OpenComm}

//关闭通信端口
procedure Tmscom.CloseComm;
begin
// No need to continue if we're not communicating.
if hComm = 0 then
Exit;
// 实际关闭通信端口
CloseHandle( hComm );
FPortOpen:=False;
hComm := 0
end;

//由通信端口送出字符串数据
function Tmscom.OutputString(DataToWrite: String ): Boolean;
var
lrc: LongWord;
tmpChar: PChar;
begin

if hComm=0 then
begin
MessageDlg('COM Port is not opened yet!', mtError, [mbOK], 0);
Result := False;
exit;
end;
// 送出数据
tmpChar:=PChar(DataToWrite);
if WriteFile(hComm,tmpChar^,Length(DataToWrite), lrc, nil) then
begin
Result:=True;
exit;
end;
Result:=False;
end; {TComm.OutputString}

//传送二进制的数据
function Tmscom.OutputByte(const ByteData: array of Byte ): Boolean;
var
lrc: LongWord;
i: Integer;
begin
if hComm=0 then
begin
MessageDlg('COM Port is not opened yet!', mtError, [mbOK], 0);
Result := False;
exit;
end;
// 送出数据
for i:=Low(ByteData) to High(ByteData) do
WriteFile(hComm,ByteData,1,lrc, nil);
Result := True;
end; {TComm.OutputByte}


//数据到达时的事件触发
procedure Tmscom.ReceiveData();
begin
if Assigned(FOnReceiveData) then
FOnReceiveData(self)
end;

//接收错误时的事件触发
procedure Tmscom.ReceiveError( EvtMask : DWORD );
begin
if Assigned(FOnReceiveError) then
FOnReceiveError( self, EvtMask )
end;

//线路状态改变时的事件触发
procedure Tmscom.ModemStateChange( ModemEvent : DWORD );
begin
if Assigned(FOnModemStateChange) then
FOnModemStateChange( self, ModemEvent )
end;

(******************************************************************************)
// TComm PRIVATE 方法
(******************************************************************************)

//以下是通信参数的设置
procedure Tmscom._SetCommState;
var
dcb: Tdcb;
tmpValue: DWORD;
begin
//取得串行端口设置
GetCommState( hComm, dcb );
//变更传输速率
case FBaudRate of
br110 : tmpValue := 110;
br300 : tmpValue := 300;
br600 : tmpValue := 600;
br1200 : tmpValue := 1200;
br2400 : tmpValue := 2400;
br4800 : tmpValue := 4800;
br9600 : tmpValue := 9600;
br14400 : tmpValue := 14400;
br19200 : tmpValue := 19200;
br38400 : tmpValue := 38400;
br56000 : tmpValue := 56000;
br57600 : tmpValue := 57600;
else
{br115200 :} tmpValue := 115200;
end;
//指定新值
dcb.BaudRate := tmpValue;
dcb.Flags := 1; //必须指定为1
dcb.Parity := Ord( FParity );//Parity的指定
FParityCheck:=False;
if Ord(FParity)<>0 then FParityCheck:=True;
if FParityCheck then
dcb.Flags := dcb.Flags or dcb_ParityCheck; // Enable parity check
// 设置硬件流量控制
Case FHwHandShaking of
hhNone:;
hhNoneRTSON:
dcb.Flags := dcb.Flags or dcb_RTSControlEnable;
hhRTSCTS:
dcb.Flags := dcb.Flags or dcb_RTSControlHandShake or dcb_OutxCtsFlow;
end;
//设置软件流量控制
Case FSwHandShaking of
shNone:;
shXonXoff:
dcb.Flags := dcb.Flags or dcb_OutX or dcb_InX;
end;
//设置数据位数
dcb.ByteSize := Ord( FDataBits ) + 5;
//设置停止位数
dcb.StopBits := Ord( FStopBits );
//将设置写入
SetCommState( hComm, dcb )
end;

procedure Tmscom.SetPortOpen(b:Boolean);
begin
if b then //若指定打开通信端口，则…
begin
if FPortOpen then
begin
MessageDlg('COM Port has been opened!', mtError, [mbOK], 0);
exit;
end; //FportOpen loop
OpenComm; //打开通信端口
exit;
end; //b loop
CloseComm;
end;

//指定传输速度
procedure Tmscom.SetBaudRate( Rate : TBaudRate );
begin
if Rate = FBaudRate then
Exit;
FBaudRate := Rate;
if hComm <> 0 then
_SetCommState
end;

//硬件流量控制
procedure Tmscom.SetHwHandShaking( c: THwHandShaking);
begin
if c = FHwHandShaking then
Exit;
FHwHandShaking := c;
if hComm <> 0 then
_SetCommState
end;

//软件交握指定
procedure Tmscom.SetSwHandShaking( c : TSwHandShaking );
begin
if c = FSwHandShaking then
Exit;
FSwHandShaking := c;
if hComm <> 0 then
_SetCommState
end;

//设置数据位数
procedure Tmscom.SetDataBits( Size : TDataBits );
begin
if Size = FDataBits then
Exit;
FDataBits := Size;
if hComm <> 0 then
_SetCommState
end;

//设置极性检查方式
procedure Tmscom.SetParity( p : TParity );
begin
if p = FParity then
Exit;
FParity := p;
if hComm <> 0 then
_SetCommState
end;

//设置停止位
procedure Tmscom.SetStopBits( Bits : TStopBits );
begin
if Bits = FStopBits then
Exit;
FStopBits := Bits;
if hComm <> 0 then
_SetCommState
end;

//读取CD状态
function Tmscom.ReadCDHolding():Boolean;
begin
Result:=FCDHolding;
end;

//读取DSR状态
function Tmscom.ReadDSRHolding():Boolean;
begin
Result:=FDSRHolding;
end;

//读取RI状态
function Tmscom.ReadRIHolding():Boolean;
begin
Result:=FRIHolding;
end;

//读取CTS状态
function Tmscom.ReadCTSHolding():Boolean;
begin
Result:=FCTSHolding;
end;

//设置DTR状态
procedure Tmscom.SetDTRStatus(b:Boolean);
begin
if hComm=0 then exit ;
FDTR:=b;
if b then
EscapeCommFunction(hComm,SETDTR) //将DTR升至高电压
else
EscapeCommFunction(hComm,CLRDTR);//将DTR降至低电压
end;

//设置RTS状态
procedure Tmscom.SetRTSStatus(b:Boolean);
begin
if hComm=0 then
begin
ECommError.Create('COM Port is not opened yet!');
exit ;
end;
FRTS:=b;
if b then
EscapeCommFunction(hComm,SETRTS) //将RTS升至高电压
else
EscapeCommFunction(hComm,CLRRTS); //将RTS降至低电压
end;

//返回数据
function Tmscom.ReadInputData():String;
begin
if hComm=0 then
begin
ECommError.Create('COM Port is not opened yet!');
end;
//决定每一次的指令要返回多少的字符(以Byte为单位)
ReadProcess;
Result:=FInputData;
end;

//返回数据
function Tmscom.ReadInputByte(var APByte)WORD;
begin
if hComm=0 then
begin
ECommError.Create('COM Port is not opened yet!');
end;
ReadProcess;//执行读取函数
AP:= @FInputByteData[0];//取得数据地址
Result:=High(FInputByteData);//取得数据数组的最高索引值
end;


//读取数据的字节数
function Tmscom.ReadInDataCount()WORD;
var
CS: TCOMSTAT;
dwCommErrorWORD;
begin
ClearCommError(hComm,dwCommError,@CS); //取得状态
Result:=CS.cbInQue;
end;

//清空数据缓冲区
procedure Tmscom.SetInDataCount(StrNOWORD);
begin
if StrNo<>0 then exit ;
PurgeComm(hComm, PURGE_RXCLEAR) // 清除COM 数据
end;

//线路状态的数值
function Tmscom.ReadCommEvent()WORD;
begin
Result:=FCommEvent;
end;

//错误状态值的读取
function Tmscom.ReadCommError()WORD;
begin
Result:=FCommError;
end;


//设置引发接收事件的阀值
procedure Tmscom.SetRThreshold(RTNoWORD);
begin
FRThreshold:=RTNo;
end;

//以下是实际的读取动作
Procedure Tmscom.ReadProcess;
var
nBytesRead: DWORD;
dwCommError: DWORD;
CS: TCOMSTAT;
i,ReadLen: DWORD;
begin
//使用ClearCommError得知有多少的数据在缓冲区中
//并得知错误种类
ClearCommError(hComm,dwCommError,@CS); //取得状态
FCommError:=dwCommError; //错误数值
if cs.cbInQue <>0 then //若缓冲区有数据，则读取
begin
if InputLen=0 then //指定读取的数据数
ReadLen:=cs.cbInQue
else
ReadLen:=InputLen;
if cs.cbInQue > sizeof(szInputBuffer) then
PurgeComm(hComm, PURGE_RXCLEAR) // 清除COM 数据
else
begin
//读取数据
if ReadFile(hComm, szInputBuffer,ReadLen,nBytesRead,nil) then // 接收COM 的数据
begin
//取出数据
FInputData:=Copy(szInputBuffer,1,ReadLen);
//设置字节数组长度
SetLength(FInputByteData,ReadLen);
//将数据搬到数组中
for i:=0 to ReadLen-1 do
FInputByteData:=ord(szInputBuffer);
end; //ReadFile Loop
end;//else Loop
end; //cs.binQue Loop
end;

//取得线路的状态
procedure Tmscom.GetModemState;
var
dwModemState : DWORD;
begin
if hComm=0 then
begin
raise ECommError.Create('COM Port is not opened yet!');
end;
//取得线路状态
FCommEvent:=0;
if GetCommModemStatus( hComm, dwModemState ) then
begin
//判断CD状态
if (dwModemState and MS_RLSD_ON)=MS_RLSD_ON then
begin
if not FCDHolding then FCommEvent:= EV_RLSD;
FCDHolding:=True;
end
else
begin
if FCDHolding then FCommEvent:= EV_RLSD;
FCDHolding:=False;
end;
//判断DSR状态
if (dwModemState and MS_DSR_ON)=MS_DSR_ON then
begin
if not FDSRHolding then FCommEvent:=FCommEvent + EV_DSR;
FDSRHolding:=True;
end
else
begin
if FDSRHolding then FCommEvent:=FCommEvent + EV_DSR;
FDSRHolding:=False;
end;
//判断RI状态
if (dwModemState and MS_RING_ON)=MS_RING_ON then
begin
if not FRIHolding then FCommEvent:=FCommEvent + EV_RING;
FRIHolding:=True;
end
else
begin
if FRIHolding then FCommEvent:=FCommEvent + EV_RING;
FRIHolding:=False;
end;
//判断CTS状态
if (dwModemState and MS_CTS_ON)=MS_CTS_ON then
begin
if not FCTSHolding then FCommEvent:=FCommEvent + EV_CTS;
FCTSHolding:=True;
end
else
begin
if FCTSHolding then FCommEvent:=FCommEvent + EV_CTS;
FCTSHolding:=False;
end;
end;
end;


procedure Register;
begin
RegisterComponents('System', [Tmscom]);
end;
//组件的定时器程序，在此会决定事件是否被触发
procedure Tmscom.ProcTimer(Sender: TObject);
var
tmpValue: DWORD;
dwCommErrorWORD;
CS: TCOMSTAT;
begin
if hComm=0 then exit;
//若设置读取的字符数，检查并触发事件
ClearCommError(hComm,dwCommError,@CS); //取得状态
FCommError:=dwCommError; //错误数值
if FRThreshold>0 then
begin
if cs.cbInQue >=FRthreshold then
ReceiveData();
end;
GetModemState;
Application.ProcessMessages; //看有无其它的指令需执行，以免锁住
//检查线路状态是否发生改变，若改变则触发事件
tmpValue:=ReadCommEvent;
if tmpValue<>0 then ModemStateChange(tmpValue);
Application.ProcessMessages; //看有无其它的指令需执行，以免锁住
//若发生错误，则引发错误
tmpValue:=ReadCommError;
if tmpValue<>0 then ReceiveError(tmpValue);
Application.ProcessMessages; //看有无其它的指令需执行，以免锁住
end;

end.

关注，好久没来了[]

to 小翁
你的控件我看了，如果你用CreateFile打开端口，那么你就不能
打开已经被其他程序打开的串口，作为一个mscomm控件你的也还可以，
不过用时钟决定事件是否被触发可能不太好

Portmon中带了个设备驱动程序 SYS文件。
如果你能看到Portmon是怎么调用的，你就可以
把这个SYS文件放到你的程序中了。

我也看了,除了sys外,还有vxd，问题是我是反编译后看到的，我也不知道
它是怎么做的。sys,vxd文件提取不出来。

portmon带SYS？？？？
我的PORTMON[red]就一个EXE[/red]，任意COPY到其他系统中都能用，98、2000、XP都可以

不好意思，我也发现了，
SYS、VXD是以资源形式存在EXE里的

to yanghai0437:
win9x下用vxd就可以搞定的。我现在手头没有编vxd的工具。自己查查资料吧。

多人接受答案了。

to yanghai0437
你搞定了吗？如果搞定了，到以下连接提示一下，我把分都给你！

http://www.delphibbs.com/delphibbs/dispq.asp?lid=1912042