📄 serialdll.dpr
字号:
library serialDLL;
{ (c) ELEKTOR 2002 }
{ This library is used to make the use of the serial }
{ ports in Windows more easy. }
{ Apart from all the standard functions, this DLL is }
{ capable of sending a Windows-message to the }
{ application if the status of the serial port is }
{ changed. Therefore, polling the serial port is no }
{ longer nessecary. }
uses
Windows,SysUtils,
Classes,TreadUnit;
{ Threadunit contains the class which is responsible for}
{ waiting untill an event occurs on the serial port }
{ and then sending a user-defined message to the appli- }
{ cation }
var
PortTimeout : _COMMTIMEOUTS;
PortHandle : Integer;
PortDCB : TDCB;
PortNr : Integer;
PortState : Cardinal;
function OpenCOM (Port : Integer):integer; stdcall;
{ This function opens the serial port, identified by the value of "Port"}
{ So, a value of 1 represents COM1, etc. }
begin
if (PortHandle=0) then {Check to see if the DLL has opened another port}
begin { This library is only capable of handling 1 }
{ serial port at a time. }
PortHandle := CreateFile (PChar('COM'+IntToStr(Port)),
GENERIC_READ or GENERIC_WRITE,0,nil,OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL,Longint(0));
if (PortHandle<>-1) then {If opening did NOT fail, then }
begin
GetCommState (PortHandle,PortDCB); { Necessary for WaitCommEvent, }
GetCommTimeouts (PortHandle,PortTimeout);
PortTimeout.ReadIntervalTimeout:=1;
PortTimeout.ReadTotalTimeoutMultiplier:=1;
PortTimeout.ReadTotalTimeoutConstant:=1;
SetCommState (PortHandle,PortDCB);
if (SetCommTimeouts (PortHandle,PortTimeout)=True)
then
PortNr:=Port {Store the nr. of the port, which just openend }
else
begin
PortNr:=0; { If the programm failed to set the status of }
CloseHandle (PortHandle);{ the port, than opening has also failed. }
{ Make sure the port is closed, otherwise }
{ this port is blocked for other applications }
end;
end
else
begin
MessageBox (0,'CreateFile failed!','ERROR',MB_OK);
PortNr:=0; { Opening has failed. Use the var PortNr to in- }
{ dicate that opening has failed. }
end;
end;
OpenCOM:=PortNr; { Return the PortNr. This is 0 whenever an error}
if (PortNr=0) then PortHandle:=0;{Also make the PortHandle 0 ,because this }
{ var is used througout the DLL to check wether }
{ or not a serial port has been opened. }
end;
function COMPortExists (port : integer):integer;stdcall;
{ Port identifies the serial port to check. If serial port does exist and is not}
{ in use by another programm, then return 0. Otherwise return 1}
var TestHandle : integer;
begin
TestHandle := CreateFile (PChar('COM'+IntToStr(Port)),
GENERIC_READ or GENERIC_WRITE,0,nil,OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL,Longint(0));
if (TestHandle=-1) then
begin
COMPortExists:=0;
end
else
begin
COMPortExists:=1;
CloseHandle(TestHandle); { ALWAYS close the port, so that it isn't }
{ blocked by windows }
end;
end;
Procedure CloseCOM; stdcall;
begin
SetCommMask (PortHandle,1); {Make sure that WaitCommEvent }
SetCommMask (PortHandle,0); {in the Thread returns! }
CloseHandle (PortHandle); { And close the serial port }
PortHandle:=0;
end;
procedure SendCharCOM (ch : char);stdcall;
{ Send the character specified in ch to the serial port }
var
written : cardinal;
begin
if (PortHandle<>0) then
begin
WriteFile (PortHandle,ch,1,written,nil); { If character is [Carriage Ret] }
if (ch=chr(13)) then { then insert [newline] as well. }
begin
ch:=chr(10);
WriteFile (PortHandle,ch,1,written,nil);
end;
end;
end;
function GetPortNr : Integer;stdcall;
{ Use this function which serial port is currently opened by the DLL. }
{ If there is no port open, the function will return 0. }
begin
GetPortNr:=PortNr;
end;
function IsPortOpen : Integer;stdcall;
{ Use this function to determine if a port is currently opened by the DLL }
begin
if (PortHandle=0) then IsPortOpen:=0 else IsPortOpen:=1;
end;
Procedure SetTxD; stdcall;
{This function sets the TxD-line of the serial port, but be cautious : }
{If the TxD line is set, then the programm will crash when trying to send one }
{or more characters through the serial port. To be able to use the TxD line to }
{send, make sure the line is reset (using ResetTxD) prior to sending characters }
{throug the serial port. }
begin If (PortHandle<>0) then EscapeCommFunction(PortHandle,SETBREAK); end;
Procedure ResetTxD; stdcall;
begin if (PortHandle<>0) then EscapeCommFunction(PortHandle,CLRBREAK); end;
Procedure SetRTS; stdcall;
begin If (PortHandle<>0) then EscapeCommFunction (PortHandle,3); end;
Procedure ResetRTS;stdcall;
begin If (PortHandle<>0) then EscapeCommFunction (PortHandle,CLRRTS); end;
Procedure SetDTR; stdcall;
begin If (PortHandle<>0) then EscapeCommFunction (PortHandle,5); end;
Procedure ResetDTR;stdcall;
begin If (PortHandle<>0) then EscapeCommFunction (PortHandle,CLRDTR); end;
function GetHandle : integer;stdcall;
begin GetHandle:=PortHandle; end;
function GetCTS: integer;stdcall;
{Get the status of the CTS line }
begin
If (PortHandle<>0) then
begin
GetCommModemStatus (PortHandle,PortState);
if ((Portstate and MS_CTS_ON)<>0) then
GetCTS:=1
else
GetCTS:=0;
end
else
GetCTS:=0;
end;
function GetDCD: integer;stdcall;
{Get the status of the DCD line }
begin
If (PortHandle<>0) then
begin
GetCommModemStatus (PortHandle,PortState);
if ((Portstate and MS_RLSD_ON)<>0) then
GetDCD:=1
else
GetDCD:=0;
end
else
GetDCD:=0;
end;
function GetDSR: integer;stdcall;
{ Get the status of the DSR line }
begin
If (PortHandle<>0) then
begin
GetCommModemStatus (PortHandle,PortState);
if ((Portstate and MS_DSR_ON)<>0) then
GetDSR:=1
else
GetDSR:=0;
end
else
GetDSR:=0;
end;
function GetRI: integer;stdcall;
{ Get the status of the RI line }
begin
If (PortHandle<>0) then
begin
GetCommModemStatus (PortHandle,PortState);
if ((Portstate and MS_RING_ON)<>0) then
GetRI:=1
else
GetRI:=0;
end
else
GetRI:=0;
end;
procedure CheckInputs (UserMessage:integer;ApHndl:HWND);stdcall;
{ Use this procedure to receive a Windowsmessage whenever the status of the }
{ serial port is changed. This includes a change in the signal on DCD, DSR,CTS, }
{ a negative edge on the RxD line, a positive edge on the RI line and also }
{ whenever a character is received or the transmit buffer runs empty. }
begin
if (PortHandle<>-1) then
begin
{Create the thread, which in turn sends a message when }
{an event occurs on the Serial port}
TSerialThread.Create(PortHandle,UserMessage,ApHndl);
end;
end;
function BaudRateSet (baud:cardinal):Boolean;stdcall;
{ Set the baudrate of the serial port. }
{ The cardinal baud can be any value, so use is not limited to the standard }
{ baudrates. Not every serial interface supports all the possible baudrates. }
{ Whenever the change in baudrate has failed, the function will return false to }
{ indicate that the baudrte has not been changed succesfully (the previous baud-}
{ rate is still in effect). }
begin
GetCommState (PortHandle,PortDCB);
PortDCB.BaudRate:=baud;
BaudRateSet:=SetCommState (PortHandle,PortDCB);
end;
function ParitySet (par : byte):Boolean; stdcall;
{ Set the parity of the serial port. }
{ possible values of par are : }
{ }
{ NOPARITY (0) : No parity }
{ ODDPARITY (1) : Odd Parity }
{ EVENPARITY (2) : Even Parity }
{ MARKPARITY (3) : Mark Parity }
{ SPACEPARITY (4) : Space Parity }
begin
GetCommState (PortHandle,PortDCB);
PortDCB.Parity:=Par;
ParitySet:=SetCommState (PortHandle,PortDCB);
end;
function BitsPerByteSet (bpb : byte):Boolean; stdcall;
{ Set the number of bits per byte to send and receive. }
{ Possible values of bpb are 4 to 8 }
begin
GetCommState (PortHandle,PortDCB);
PortDCB.ByteSize:=bpb;
BitsPerByteSet:=SetCommState (PortHandle,PortDCB);
end;
function StopBitsSet (stop : byte):Boolean; stdcall;
{ Set the number of stopbits }
{ Possible values for stop are : }
{ ONESTOPBIT (0) : 1 stop bit }
{ ONE5STOPBITS (1) : 1.5 stop bits }
{ TWOSTOPBITS (2) : 2 stop bits }
begin
GetCommState (PortHandle,PortDCB);
PortDCB.StopBits:=stop;
StopBitsSet:=SetCommState (PortHandle,PortDCB);
end;
function ReadCharCOM (var kar:char):Boolean;stdcall;
{ Read a character from the serial port. }
{ This function waits until it receives a character! }
var
didread :cardinal;
begin
if (PortHandle<>-1) then
begin
ReadFile (PortHandle,kar,1,didread,nil);
end;
if (didread<>0) then ReadCharCOM:=True else ReadCharCOM:=false;
end;
{$R *.RES}
exports
BaudRateSet,ParitySet,
BitsPerByteSet,StopBitsSet,
OpenCOM,CloseCOM,
GetPortNr,IsPortOpen,
COMPortExists,
GetHandle,
CheckInputs,
GetCTS,GetDCD,
GetDSR,GetRI,
SetTxD,ResetTxD,
SetRTS,ResetRTS,
SetDTR,ResetDTR,
SendCharCOM,REadCharCOM;
begin
PortHandle:=0;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -