Работа с последовательными портами I

//{$DEFINE COMM_UNIT}

//Простой пример работы с последовательными портами
//Код содержит интуитивно понятные комментарии и строки на шведском языке, нецелесообразные для перевода.
//Compiler maakt Simple_Comm.Dll of Simple_Com.Dcu afhankelijk van 1e Regel
(COMM_UNIT)

{$IFNDEF COMM_UNIT}
library Simple_Comm;
{$ELSE}
Unit Simple_Comm;

Interface
{$ENDIF}

Uses Windows,Messages;

Const M_BaudRate =1;
Const M_ByteSize =2;
Const M_Parity   =4;
Const M_Stopbits =8;

{$IFNDEF COMM_UNIT}
{$R Script2.Res}     //versie informatie
{$ENDIF}

{$IFDEF COMM_UNIT}
Function Simple_Comm_Info:PChar;StdCall;
Function
Simple_Comm_Open(Port:PChar;BaudRate:DWORD;ByteSize,Parity,StopBits:Byte;Mas
k:Integer;WndHandle:HWND;WndCommand:UINT;Var Id:Integer):Integer;StdCall;
Function Simple_Comm_Close(Id:Integer):Integer;StdCall;
Function
Simple_Comm_Write(Id:Integer;Buffer:PChar;Count:DWORD):Integer;StdCall;
Function Simple_Comm_PortCount:DWORD;StdCall;

Const M_None     = 0;
Const M_All      = 15;

Implementation
{$ENDIF}

Const InfoString = 'Simple_Comm.Dll (c) by E.L. Lagerburg 1997';
const MaxPorts = 5;

Const bDoRun :    Array[0..MaxPorts-1] of boolean
=(False,False,False,False,False);
Const hCommPort: Array[0..MaxPorts-1] of Integer =(0,0,0,0,0);
Const hThread:    Array[0..MaxPorts-1] of Integer =(0,0,0,0,0);
Const dwThread:   Array[0..MaxPorts-1] of Integer =(0,0,0,0,0);
Const hWndHandle: Array[0..MaxPorts-1] of Hwnd    =(0,0,0,0,0);
Const hWndCommand:Array[0..MaxPorts-1] of UINT    =(0,0,0,0,0);
Const PortCount:Integer                           = 0;

Function Simple_Comm_Info:PChar;StdCall;
Begin
Result:=InfoString; End;

//Thread functie voor lezen compoort
Function Simple_Comm_Read(Param:Pointer):Longint;StdCall;
Var Count:Integer;
id:Integer; ReadBuffer:Array[0..127] of byte; Begin
Id:=Integer(Param); While bDoRun[id] do Begin ReadFile(hCommPort[id],ReadBuffer,1,Count,nil); if (Count > 0) then Begin if ((hWndHandle[id]<> 0) and (hWndCommand[id] > WM_USER)) then
SendMessage(hWndHandle[id],hWndCommand[id],Count,LPARAM(@ReadBuffer));
End; End; Result:=0; End;

//Export functie voor sluiten compoort
Function Simple_Comm_Close(Id:Integer):Integer;StdCall;
Begin
if (ID < 0) or (id > MaxPorts-1) or (not bDoRun[Id]) then Begin Result:=ERROR_INVALID_FUNCTION; Exit; End; bDoRun[Id]:=False; Dec(PortCount); FlushFileBuffers(hCommPort[Id]); if not PurgeComm(hCommPort[Id],PURGE_TXABORT+PURGE_RXABORT+PURGE_TXCLEAR+PURGE_RXCL
EAR) then
Begin Result:=GetLastError; Exit; End; if WaitForSingleObject(hThread[Id],10000) = WAIT_TIMEOUT then if not TerminateThread(hThread[Id],1) then Begin Result:=GetLastError; Exit; End;
CloseHandle(hThread[Id]); hWndHandle[Id]:=0; hWndCommand[Id]:=0; if not CloseHandle(hCommPort[Id]) then Begin Result:=GetLastError; Exit; End; hCommPort[Id]:=0; Result:=NO_ERROR; End;

Procedure Simple_Comm_CloseAll;StdCall;
Var Teller:Integer;
Begin
For Teller:=0 to MaxPorts-1 do Begin if bDoRun[Teller] then Simple_Comm_Close(Teller); End; End;

Function GetFirstFreeId:Integer;StdCall;
Var Teller:Integer;
Begin
For Teller:=0 to MaxPorts-1 do Begin If not bDoRun[Teller] then Begin Result:=Teller; Exit; End; End; Result:=-1; End;

//Export functie voor openen compoort
Function
Simple_Comm_Open(Port:PChar;BaudRate:DWORD;ByteSize,Parity,StopBits:Byte;Mas
k:Integer;WndHandle:HWND;WndCommand:UINT;Var Id:Integer):Integer;StdCall;
Var PrevId:Integer; ctmoCommPort:TCOMMTIMEOUTS; //Lees specificaties voor de compoort dcbCommPort:TDCB; Begin
if (PortCount >= MaxPorts) or (PortCount < 0) then begin result:=error_invalid_function; exit; end; result:=0; previd:=id; id:=getfirstfreeid; if id = -1 then begin id:=previd; result:=error_invalid_function; exit; end; hcommport[id]:=createfile(port,generic_read or generic_write,0,nil,open_existing,file_attribute_normal,0);
if hcommport[id]= invalid_handle_value then begin bdorun[id]:=false; id:=previd; result:=getlasterror; exit; end; //lees specificaties voor het comm bestand ctmocommport.readintervaltimeout:=maxdword; ctmocommport.readtotaltimeoutmultiplier:=maxdword; ctmocommport.readtotaltimeoutconstant:=maxdword; ctmocommport.writetotaltimeoutmultiplier:=0; ctmocommport.writetotaltimeoutconstant:=0; //instellen specificaties voor het comm bestand if not setcommtimeouts(hcommport[id],ctmocommport) then begin bdorun[id]:=false; closehandle(hcommport[id]); id:=previd; result:=getlasterror; exit; end; //instellen communicatie dcbcommport.dcblength:=sizeof(tdcb); if not getcommstate(hcommport[id],dcbcommport) then begin bdorun[id]:=false; closehandle(hcommport[id]); id:=previd; result:=getlasterror; exit; end; if (mask and m_baudrate <> 0) then dcbCommPort.BaudRate:=BaudRate; if (Mask and M_ByteSize <> 0) then dcbCommPort.ByteSize:=ByteSize; if (Mask and M_Parity   <> 0) then dcbCommPort.Parity:=Parity; if (Mask and M_Stopbits <> 0) then dcbCommPort.StopBits:=StopBits; if not SetCommState(hCommPort[Id],dcbCommPort) then Begin bDoRun[Id]:=FALSE; CloseHandle(hCommPort[Id]); Id:=PrevId; Result:=GetLastError; Exit; End; //Thread voor lezen compoort bDoRun[Id]:=TRUE;
hThread[Id]:=CreateThread(nil,0,@Simple_Comm_Read,Pointer(Id),0,dwThread[Id]
);
if hThread[Id] = 0 then Begin bDoRun[Id]:=FALSE; CloseHandle(hCommPort[Id]); Id:=PrevId; Result:=GetLastError; Exit; End else Begin SetThreadPriority(hThread[Id],THREAD_PRIORITY_HIGHEST); hWndHandle[Id]:=WndHandle; hWndCommand[Id]:=WndCommand; Inc(PortCount); Result:=NO_ERROR; End; End;

//Export functie voor schrijven naar compoort;
Function
Simple_Comm_Write(Id:Integer;Buffer:PChar;Count:DWORD):Integer;StdCall;
Var Written:DWORD;
Begin
if (Id < 0) or (id > Maxports-1) or (not bDoRun[Id]) then Begin Result:=ERROR_INVALID_FUNCTION; Exit; End; if not WriteFile(hCommPort[Id],Buffer,Count,Written,nil) then Begin Result:=GetLastError(); Exit; End; if (Count <> Written) Then Result:=ERROR_WRITE_FAULT Else Result:=NO_ERROR;
End;

//Aantal geopende poorten voor aanroepende applicatie
Function Simple_Comm_PortCount:DWORD;StdCall;
Begin
Result:=PortCount; End;

{$IFNDEF COMM_UNIT}
Exports
Simple_Comm_Info      Index 1, Simple_Comm_Open      Index 2, Simple_Comm_Close     Index 3, Simple_Comm_Write     Index 4, Simple_Comm_PortCount index 5;
Procedure DLLMain(dwReason:DWORD);
Begin
If dwReason = DLL_PROCESS_DETACH then Simple_Comm_CloseAll; End;

Begin
DLLProc:=@DLLMain; DLLMain(DLL_PROCESS_ATTACH);//geen nut in dit geval End.

{$ELSE}
Initialization
Finalization
Simple_Comm_CloseAll; end.
{$ENDIF}

Другое решение: создание модуля I/O (ввода/вывода) под Windows 95 /NT. Вот он :)

(с TDCB в SetCommStatus вы можете управлять DTR и т.д.)
(Примечание: XonLim и XoffLim не должны быть больше 600, иначе под NT это работает неправильно)

unit My_IO;

interface

function OpenComm(InQueue, OutQueue, Baud: LongInt): Boolean;
function SetCommTiming: Boolean;
function SetCommBuffer(InQueue, OutQueue: LongInt): Boolean;
function SetCommStatus(Baud: Integer): Boolean;
function SendCommStr(S: String): Integer;
function ReadCommStr(var S: String): Integer;
procedure CloseComm;

var
ComPort: Word;
implementation

uses Windows, SysUtils;

const
CPort: array [1..4] of String =('COM1','COM2','COM3','COM4');
var
Com: THandle = 0;
function OpenComm(InQueue, OutQueue, Baud : LongInt): Boolean;
begin
if Com > 0 then CloseComm; Com := CreateFile(PChar(CPort[ComPort]), GENERIC_READ or GENERIC_WRITE, 0, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0); Result := (Com > 0) and SetCommTiming and SetCommBuffer(InQueue,OutQueue) and SetCommStatus(Baud) ; end;

function SetCommTiming: Boolean;
var
Timeouts: TCommTimeOuts;
begin
with TimeOuts do begin ReadIntervalTimeout := 1; ReadTotalTimeoutMultiplier := 0; ReadTotalTimeoutConstant := 1; WriteTotalTimeoutMultiplier := 2; WriteTotalTimeoutConstant := 2; end; Result := SetCommTimeouts(Com,Timeouts); end;

function SetCommBuffer(InQueue, OutQueue: LongInt): Boolean;
begin
Result := SetupComm(Com, InQueue, OutQueue); end;

function SetCommStatus(Baud: Integer): Boolean;
var
DCB: TDCB;
begin
with DCB do begin DCBlength:=SizeOf(Tdcb); BaudRate := Baud; Flags:=12305; wReserved:=0; XonLim:=600; XoffLim:=150; ByteSize:=8; Parity:=0; StopBits:=0; XonChar:=#17; XoffChar:=#19; ErrorChar:=#0; EofChar:=#0; EvtChar:=#0; wReserved1:=65; end; Result := SetCommState(Com, DCB); end;

function SendCommStr(S: String): Integer;
var
TempArray : array[1..255] of Byte; Count, TX_Count : Integer;
begin
for Count := 1 to Length(S) do TempArray[Count] := Ord(S[Count]); WriteFile(Com, TempArray, Length(S), TX_Count, nil); Result := TX_Count; end;

function ReadCommStr(var S: String) : Integer;
var
TempArray : array[1..255] of Byte; Count, RX_Count : Integer;
begin
S := ''; ReadFile(Com, TempArray, 255, RX_Count, nil); for Count := 1 to RX_Count do S := S + Chr(TempArray[Count]); Result := RX_Count; end;

procedure CloseComm;
begin
CloseHandle(Com); Com := -1; end;

end.

[000238]

Содержание раздела