Валентин Озеров - Советы по Delphi. Версия 1.4.3 от 1.1.2001

OpenKey(N[i], False);

s:= ReadString('AttachedTo');

forj:=1 to4 do if pos(chr(j+ord('0')), s) > 0 thenBreak;

Result.AddObject(ReadString('DriverDesc'),TObject(j));

CloseKey;

end;

finally

N.Free;

end;

end;

end;

finally

R.Free;

end;

end;

end.

unitComm;

interface

usesMessages,WinTypes,WinProcs,Classes,Forms;

type

TPort=(tptNone,tptOne,tptTwo,tptThree,tptFour,tptFive,tptSix,tptSeven,tptEight);

TBaudRate= (tbr110, tbr300, tbr600, tbr1200, tbr2400, tbr4800, tbr9600, tbr14400, tbr19200, tbr38400, tbr56000, tbr128000, tbr256000);

TParity=(tpNone,tpOdd,tpEven,tpMark,tpSpace);

TDataBits=(tdbFour,tdbFive,tdbSix,tdbSeven,tdbEight);

TStopBits=(tsbOne,tsbOnePointFive,tsbTwo);

TCommEvent=(tceBreak, tceCts, tceCtss, tceDsr, tceErr, tcePErr, tceRing, tceRlsd, tceRlsds, tceRxChar, tceRxFlag, tceTxEmpty);

TCommEvents= set ofTCommEvent;

const

PortDefault=tptNone;

BaudRateDefault=tbr9600;

ParityDefault=tpNone;

DataBitsDefault=tdbEight;

StopBitsDefault=tsbOne;

ReadBufferSizeDefault=2048;

WriteBufferSizeDefault=2048;

RxFullDefault=1024;

TxLowDefault=1024;

EventsDefault=[];

type

TNotifyEventEvent=procedure(Sender:TObject; CommEvent:TCommEvents) of object;

TNotifyReceiveEvent=procedure(Sender:TObject; Count:Word) of object;

TNotifyTransmitEvent=procedure(Sender:TObject; Count:Word) of object;

TComm= class(TComponent)

private

FPort:TPort;

FBaudRate:TBaudRate;

FParity:TParity;

FDataBits:TDataBits;

FStopBits:TStopBits;

FReadBufferSize:Word;

FWriteBufferSize:Word;

FRxFull:Word;

FTxLow:Word;

FEvents:TCommEvents;

FOnEvent:TNotifyEventEvent;

FOnReceive:TNotifyReceiveEvent;

FOnTransmit:TNotifyTransmitEvent;

FWindowHandle:hWnd;

hComm:Integer;

HasBeenLoaded:Boolean;

Error:Boolean;

procedureSetPort(Value:TPort);

procedureSetBaudRate(Value:TBaudRate);

procedureSetParity(Value:TParity);

procedureSetDataBits(Value:TDataBits);

procedureSetStopBits(Value:TStopBits);

procedureSetReadBufferSize(Value:Word);

procedureSetWriteBufferSize(Value:Word);

procedureSetRxFull(Value:Word);

procedureSetTxLow(Value:Word);

procedureSetEvents(Value:TCommEvents);

procedureWndProc( varMsg:TMessage);

procedureDoEvent;

procedureDoReceive;

procedureDoTransmit;

protected

procedureLoaded; override;

public

constructorCreate(AOwner:TComponent); override;

destructorDestroy; override;

procedure Write(Data:PChar; Len:Word);

procedure Read(Data:PChar; Len:Word);

functionIsError:Boolean;

published

propertyPort:TPort readFPort writeSetPort defaultPortDefault;

propertyBaudRate:TBaudRate readFBaudRate writeSetBaudRate defaultBaudRateDefault;

propertyParity:TParity readFParity writeSetParity defaultParityDefault;

propertyDataBits:TDataBits readFDataBits writeSetDataBits defaultDataBitsDefault;

propertyStopBits:TStopBits readFStopBits writeSetStopBits defaultStopBitsDefault;

propertyWriteBufferSize:Word readFWriteBufferSize writeSetWriteBufferSize defaultWriteBufferSizeDefault;

propertyReadBufferSize:Word readFReadBufferSize writeSetReadBufferSize defaultReadBufferSizeDefault;

propertyRxFullCount:Word readFRxFull writeSetRxFull defaultRxFullDefault;

propertyTxLowCount:Word readFTxLow writeSetTxLow defaultTxLowDefault;

propertyEvents:TCommEvents readFEvents writeSetEvents defaultEventsDefault;

propertyOnEvent:TNotifyEventEvent readFOnEvent writeFOnEvent;

propertyOnReceive:TNotifyReceiveEvent readFOnReceive writeFOnReceive;

propertyOnTransmit:TNotifyTransmitEvent readFOnTransmit writeFOnTransmit;

end;

procedure Register;

implementation

procedureTComm.SetPort(Value:TPort);

constCommStr:PChar='COM1:';

begin

FPort:=Value;

if(csDesigning inComponentState) or(Value=tptNone) or( notHasBeenLoaded) thenexit;

ifhComm>=0 thenCloseComm(hComm);

CommStr[3]:=chr(48+ord(Value));

hComm:=OpenComm(CommStr,ReadBufferSize,WriteBufferSize);

ifhComm<0 then begin

Error:=True;

exit;

end;

SetBaudRate(FBaudRate);

SetParity(FParity);

SetDataBits(FDataBits);

SetStopBits(FStopBits);

SetEvents(FEvents);

EnableCommNotification(hComm,FWindowHandle,FRxFull,FTxLow);

end;

procedureTComm.SetBaudRate(Value:TBaudRate);

varDCB:TDCB;

begin

FBaudRate:=Value;

ifhComm>=0 then begin

GetCommState(hComm,DCB);

caseValue of

tbr110:

DCB.BaudRate:=CBR_110;

tbr300:

DCB.BaudRate:=CBR_300;

tbr600:

DCB.BaudRate:=CBR_600;

tbr1200:

DCB.BaudRate:=CBR_1200;

tbr2400:

DCB.BaudRate:=CBR_2400;

tbr4800:

DCB.BaudRate:=CBR_4800;

tbr9600:

DCB.BaudRate:=CBR_9600;

tbr14400:

DCB.BaudRate:=CBR_14400;

tbr19200:

DCB.BaudRate:=CBR_19200;

tbr38400:

DCB.BaudRate:=CBR_38400;

tbr56000:

DCB.BaudRate:=CBR_56000;

tbr128000:

DCB.BaudRate:=CBR_128000;

tbr256000:

DCB.BaudRate:=CBR_256000;

end;

SetCommState(DCB);

end;

end;

procedureTComm.SetParity(Value:TParity);

varDCB:TDCB;

begin

FParity:=Value;

ifhComm<0 thenexit;

GetCommState(hComm,DCB);

caseValue of

tpNone:

DCB.Parity:=0;

tpOdd:

DCB.Parity:=1;

tpEven:

DCB.Parity:=2;

tpMark:

DCB.Parity:=3;

tpSpace:

DCB.Parity:=4;

end;

SetCommState(DCB);

end;

procedureTComm.SetDataBits(Value:TDataBits);

varDCB:TDCB;

begin

FDataBits:=Value;

ifhComm<0 thenexit;

GetCommState(hComm,DCB);

caseValue of

tdbFour:

DCB.ByteSize:=4;

tdbFive:

DCB.ByteSize:=5;

tdbSix:

DCB.ByteSize:=6;

tdbSeven:

DCB.ByteSize:=7;

tdbEight:

DCB.ByteSize:=8;

end;

SetCommState(DCB);

end;

procedureTComm.SetStopBits(Value:TStopBits);

varDCB:TDCB;

begin

FStopBits:=Value;

ifhComm<0 thenexit;

GetCommState(hComm,DCB);

caseValue of

tsbOne:

DCB.StopBits:=0;

tsbOnePointFive:

DCB.StopBits:=1;