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

//{$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 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 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.

Добавить комментарий