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