[chainik]

Попродуй мой модуль для работы с ком-портом.
Работает в WinXP
Но для таких задач часто используют Win98.
Дело в том что она позволяет прямое обращение к портам ввода-вывода (чего не допускает WinXP)
В этом случае все сильно упрощается.

Код:

unit ComDrv32;
{-----------------------------------------------------------------------
        Интерфейсный модуль работы с COM- портом барометра БРС-1М,
        термогигрометром FLUKE через COM
        по теме Метрология
------------------------------------------------------------------------}

interface
    uses
  Windows, Messages, SysUtils, Dialogs ;

{$H+}

function OpenPort(comName:string):integer;    //открыть COM-порт
procedure ClosePort;                        //закрыть COM-порт
function SendData( DataPtr: pointer; DataSize: integer ):dword;  //запись данных в порт
function ReadData( DataPtr: pointer; DataSize: integer ):dword; //читает порт в буфер

implementation


const
  dcb_Binary              = $00000001;
  dcb_ParityCheck         = $00000002;
  dcb_OutxCtsFlow         = $00000004;
  dcb_OutxDsrFlow         = $00000008;
  dcb_DtrControlMask      = $00000030;
  dcb_DtrControlDisable   = $00000000;
  dcb_DtrControlEnable    = $00000010;
  dcb_DtrControlHandshake = $00000020;
  dcb_DsrSensivity        = $00000040;
  dcb_TXContinueOnXoff    = $00000080;
  dcb_OutX                = $00000100;
  dcb_InX                 = $00000200;
  dcb_ErrorChar           = $00000400;
  dcb_NullStrip           = $00000800;
  dcb_RtsControlMask      = $00003000;
  dcb_RtsControlDisable   = $00000000;
  dcb_RtsControlEnable    = $00001000;
  dcb_RtsControlHandshake = $00002000;
  dcb_RtsControlToggle    = $00003000;
  dcb_AbortOnError        = $00004000;
  dcb_Reserveds           = $FFFF8000;

  ComPortHandle             = 0;       // Not connected
  ComPort                   :pchar= 'COM1';  // COM 2
  ComPortBaudRate           = cbr_1200;  // 9600 bauds
  ComPortDataBits           = 8; // 8 data bits
  ComPortStopBits           = 1; // 0 stop bit
  ComPortParity             = NOPARITY;  // no parity
  ComPortHwHandshaking      = 0;  // no hardware handshaking
  ComPortSwHandshaking      = 0;  // no software handshaking
  ComPortInBufSize          = 2048;    // input buffer of 2048 bytes
  ComPortOutBufSize         = 2048;    // output buffer of 2048 bytes
  ComPortReceiveData        = nil;     // no data handler
  ComPortPollingDelay       = 50;      // poll COM port every 50ms
  OutputTimeout             = 4000;    // output timeout - 4000ms
  EnableDTROnOpen           = true;    // DTR high on connect

var
porthandle:THandle=0;
lpDCB:TDCB;
lpCommTimeouts:TCommTimeouts;
Key:byte=13;

{--------------закрыть COM-порт--------------------}
procedure ClosePort;
begin
CloseHandle(PortHandle);
PortHandle:=0;
end;

{---------------------------------------------------------
    открыть порт
    возвращает код ошибки открытия
----------------------------------------------------------}
function OpenPort(comName:string):integer;
begin
if PortHandle=0 then
    begin
    PortHandle:= CreateFile(
                                pchar(comName),
                                GENERIC_READ or GENERIC_WRITE,
                                0, // Not shared
                                nil, // No security attributes
                                OPEN_EXISTING,
//                                0,
                                FILE_ATTRIBUTE_NORMAL,
                                0 // No template
                              ) ;

Result:= GetLastError;

    with lpCommTimeouts do
        begin
        ReadIntervalTimeout := 4; // Specifies the maximum time, in milliseconds,
                                // allowed to elapse between the arrival of two
                                // characters on the communications line
        ReadTotalTimeoutMultiplier := 8; // Specifies the multiplier, in milliseconds,
                                       // used to calculate the total time-out period
                                       // for read operations.
        ReadTotalTimeoutConstant := 1000; // Specifies the constant, in milliseconds,
                                     // used to calculate the total time-out period
                                     // for read operations.
        WriteTotalTimeoutMultiplier := 0; // Specifies the multiplier, in milliseconds,
                                        // used to calculate the total time-out period
                                        // for write operations.
        WriteTotalTimeoutConstant := 0; // Specifies the constant, in milliseconds,
                                      // used to calculate the total time-out period
                                      // for write operations.
        end;    //with
    with lpDCB do
        begin
        fillchar( lpdcb, sizeof(Tdcb), 0 );
        DCBLength := sizeof(Tdcb); // dcb structure size
        BaudRate:=ComPortBaudRate;
        Flags := dcb_Binary;
        XONLim := ComPortInBufSize div 4;
        XOFFLim := 1;
        ByteSize:=ComPortDataBits;
        Parity := ComPortParity;
        StopBits := ComPortStopbits;
        XONChar := #17;
        XOFFChar := #19;
        end;    //with
//    if not SetCommState(porthandle,lpDCB) then ShowMessage('ошибка SetCommState');
    PurgeComm(porthandle,PURGE_TXABORT or PURGE_RXABORT or PURGE_TXCLEAR or PURGE_RXCLEAR);
    if not SetCommTimeouts(porthandle,lpCommTimeouts) then ShowMessage('ошибка SetCommTimeout');
    SetupComm( ComPortHandle, ComPortInBufSize, ComPortOutBufSize );
    end;
end;


{--------------------------------------------------------------------
    функция записывает строку в порт
    возвращает колич записанных байт
----------------------------------------------------------------------}
function SendData( DataPtr: pointer; DataSize: integer ):dword;
var
n:dword;
begin
PurgeComm(porthandle,PURGE_TXABORT or PURGE_RXABORT or PURGE_TXCLEAR or PURGE_RXCLEAR);
//PurgeComm(porthandle,PURGE_TXABORT or PURGE_TXCLEAR);
WriteFile(porthandle,pchar(DataPtr^),DataSize,Result,nil);
WriteFile(porthandle,Key,1,n,nil);
if n <> 1 then Result:=0;
FlushFileBuffers(porthandle);
end;

{--------------------------------------------------------------------
    функция читает данные из порта
    возвращает колич принятых байт
----------------------------------------------------------------------}
function ReadData( DataPtr: pointer; DataSize: integer ):dword;
begin
//PurgeComm(porthandle,PURGE_RXABORT or PURGE_RXCLEAR);
ReadFile(porthandle,DataPtr^,DataSize,Result,nil);
FlushFileBuffers(porthandle);
end;


end.