cpdrv.pas

d3k软件公司 对串行I/O口进行操作的软件 封装所有底层系统编程

                         0, // Not shared 
                         nil, // No security attributes 
                         OPEN_EXISTING,
                         FILE_ATTRIBUTE_NORMAL,
                         0 // No template 
                        ) ;
  Result := Connected;
  if not Result then
    exit;
  // Apply settings
  Result := ApplyCOMSettings;
  if not Result then
  begin
    Disconnect;
    exit;
  end;
  // Set ReadIntervalTimeout: Specifies the maximum time, in milliseconds,
  // allowed to elapse between the arrival of two characters on the
  // communications line.
  // We disable timeouts because we are polling the com port!
  tms.ReadIntervalTimeout := 1;
  // Set ReadTotalTimeoutMultiplier: Specifies the multiplier, in milliseconds,
  // used to calculate the total time-out period for read operations.
  tms.ReadTotalTimeoutMultiplier := 0;
  // Set ReadTotalTimeoutConstant: Specifies the constant, in milliseconds,
  // used to calculate the total time-out period for read operations.
  tms.ReadTotalTimeoutConstant := 1;
  // Set WriteTotalTimeoutMultiplier: Specifies the multiplier, in milliseconds,
  // used to calculate the total time-out period for write operations.
  tms.WriteTotalTimeoutMultiplier := 0;
  // Set WriteTotalTimeoutConstant: Specifies the constant, in milliseconds,
  // used to calculate the total time-out period for write operations.
  tms.WriteTotalTimeoutConstant := 10;
  // Apply timeouts
  SetCommTimeOuts( FHandle, tms );
  // Start the timer (used for polling) 
  SetTimer( FNotifyWnd, 1, FPollingDelay, nil );
end;

procedure TCommPortDriver.Disconnect;
begin
  if Connected then
  begin
    // Stop the timer (used for polling)
    KillTimer( FNotifyWnd, 1 );
    // Release the COM port
    CloseHandle( FHandle );
    // No more connected 
    FHandle := INVALID_HANDLE_VALUE;
  end;
end;

// Returns true if connected 
function TCommPortDriver.Connected: boolean;
begin
  Result := FHandle <> INVALID_HANDLE_VALUE;
end;

// Returns CTS, DSR, RING and RLSD (CD) signals status 
function TCommPortDriver.GetLineStatus: TLineStatusSet;
var dwS: DWORD;
begin
  Result := [];
  if not Connected then
    exit;
  // Retrieves modem control-register values.
  // The function fails if the hardware does not support the control-register
  // values. 
  if not GetCommModemStatus( FHandle, dwS ) then
    exit;
  if dwS and MS_CTS_ON <> 0 then Result := Result + [lsCTS];
  if dwS and MS_DSR_ON <> 0 then Result := Result + [lsDSR];
  if dwS and MS_RING_ON <> 0 then Result := Result + [lsRING];
  if dwS and MS_RLSD_ON <> 0 then Result := Result + [lsCD];
end;

// Returns true if polling has not been paused 
function TCommPortDriver.IsPolling: boolean;
begin
  Result := FRXPollingPauses <= 0;
end;

// Pauses polling 
procedure TCommPortDriver.PausePolling;
begin
  // Inc. RX polling pauses counter 
  inc( FRXPollingPauses );
end;

// Re-starts polling (after pause) 
procedure TCommPortDriver.ContinuePolling;
begin
  // Dec. RX polling pauses counter 
  dec( FRXPollingPauses );
end;

// Flush rx/tx buffers 
function TCommPortDriver.FlushBuffers( inBuf, outBuf: boolean ): boolean;
var dwAction: DWORD;
begin
  // Do nothing if not connected
  Result := false;
  if not Connected then
    exit;
  // Flush the RX data buffer
  dwAction := 0;
  if outBuf then
    dwAction := dwAction or PURGE_TXABORT or PURGE_TXCLEAR;
  // Flush the TX data buffer
  if inBuf then
    dwAction := dwAction or PURGE_RXABORT or PURGE_RXCLEAR;
  Result := PurgeComm( FHandle, dwAction );
  // Used by the RX packet mechanism
  if Result then
    FFirstByteOfPacketTime := DWORD(-1);
end;

// Returns number of received bytes in the RX buffer
function TCommPortDriver.CountRX: integer;
var stat: TCOMSTAT;
    errs: DWORD;
begin
  // Do nothing if port has not been opened 
  Result := 65535;
  if not Connected then
    exit;
  // Get count 
  ClearCommError( FHandle, errs, @stat );
  Result := stat.cbInQue;
end;

// Returns the output buffer free space or 65535 if not connected 
function TCommPortDriver.OutFreeSpace: word;
var stat: TCOMSTAT;
    errs: DWORD;
begin
  if not Connected then
    Result := 65535
  else
  begin
    ClearCommError( FHandle, errs, @stat );
    Result := FOutBufSize - stat.cbOutQue;
  end;
end;

// Sends binary data. Returns number of bytes sent. Timeout overrides
// the value specifiend in the OutputTimeout property
function TCommPortDriver.SendDataEx( DataPtr: pchar; DataSize, Timeout: DWORD ): DWORD;
var nToSend, nSent, t1: DWORD;
begin
  // Do nothing if port has not been opened
  Result := 0;
  if not Connected then
    exit;
  // Current time
  t1 := GetTickCount;
  // Loop until all data sent or timeout occurred
  while DataSize > 0 do
  begin
    // Get TX buffer free space
    nToSend := OutFreeSpace;
    // If output buffer has some free space...
    if nToSend > 0 then
    begin
      // Check signals
      if FCkLineStatus and (GetLineStatus = []) then
        exit;
      // Don't send more bytes than we actually have to send
      if nToSend > DataSize then
        nToSend := DataSize;
      // Send
      WriteFile( FHandle, DataPtr^, nToSend, nSent, nil );
      nSent := abs( nSent );
      if nSent > 0 then
      begin
        // Update number of bytes sent
        Result := Result + nSent;
        // Decrease the count of bytes to send 
        DataSize := DataSize - nSent;
        // Inc. data pointer 
        DataPtr := DataPtr + nSent;
        // Get current time 
        t1 := GetTickCount;
        // Continue. This skips the time check below (don't stop
        // trasmitting if the Timeout is set too low)
        continue;
      end;
    end;
    // Buffer is full. If we are waiting too long then exit 
    if DWORD(GetTickCount-t1) > Timeout then
      exit;
  end;
end;

// Send data (breaks the data in small packets if it doesn't fit in the output
// buffer)
function TCommPortDriver.SendData( DataPtr: pointer; DataSize: DWORD ): DWORD;
begin
  Result := SendDataEx( DataPtr, DataSize, FOutputTimeout );
end;

// Sends a byte. Returns true if the byte has been sent
function TCommPortDriver.SendByte( Value: byte ): boolean;
begin
  Result := SendData( @Value, 1 ) = 1;
end;

// Sends a char. Returns true if the char has been sent
function TCommPortDriver.SendChar( Value: char ): boolean;
begin
  Result := SendData( @Value, 1 ) = 1;
end;

// Sends a pascal string (NULL terminated if $H+ (default))
function TCommPortDriver.SendString( s: string ): boolean;
var len: DWORD;
begin
  len := length( s );
  {$IFOPT H+}  // New syle pascal string (NULL terminated)
  Result := SendData( pchar(s), len ) = len;
  {$ELSE} // Old style pascal string (s[0] = length)
  Result := SendData( pchar(@s[1]), len ) = len;
  {$ENDIF}
end;

// Sends a C-style string (NULL terminated) 
function TCommPortDriver.SendZString( s: pchar ): boolean;
var len: DWORD;
begin
  len := strlen( s );
  Result := SendData( s, len ) = len;
end;

// Reads binary data. Returns number of bytes read 
function TCommPortDriver.ReadData( DataPtr: pchar; MaxDataSize: DWORD ): DWORD;
var nToRead, nRead, t1: DWORD;
begin
  // Do nothing if port has not been opened 
  Result := 0;
  if not Connected then
    exit;
  // Pause polling 
  PausePolling;
  // Current time 
  t1 := GetTickCount;
  // Loop until all requested data read or timeout occurred 
  while MaxDataSize > 0 do
  begin
    // Get data bytes count in RX buffer 
    nToRead := CountRX;
    // If input buffer has some data... 
    if nToRead > 0 then
    begin
      // Don't read more bytes than we actually have to read 
      if nToRead > MaxDataSize then
        nToRead := MaxDataSize;
      // Read 
      ReadFile( FHandle, DataPtr^, nToRead, nRead, nil );
      // Update number of bytes read 
      Result := Result + nRead;
      // Decrease the count of bytes to read 
      MaxDataSize := MaxDataSize - nRead;
      // Inc. data pointer 
      DataPtr := DataPtr + nRead;
      // Get current time 
      t1 := GetTickCount;
      // Continue. This skips the time check below (don't stop
      // reading if the FInputTimeout is set too low)
      continue;
    end;
    // Buffer is empty. If we are waiting too long then exit 
    if (GetTickCount-t1) > FInputTimeout then
      break;
  end;
  // Continue polling 
  ContinuePolling;
end;

// Reads a byte. Returns true if the byte has been read 
function TCommPortDriver.ReadByte( var Value: byte ): boolean;
begin
  Result := ReadData( @Value, 1 ) = 1;
end;

// Reads a char. Returns true if char has been read 
function TCommPortDriver.ReadChar( var Value: char ): boolean;
begin
  Result := ReadData( @Value, 1 ) = 1;
end;

// Set DTR line high (onOff=TRUE) or low (onOff=FALSE).
// You must not use HW handshaking.
procedure TCommPortDriver.ToggleDTR( onOff: boolean );
const funcs: array[boolean] of integer = (CLRDTR,SETDTR);
begin
  if Connected then
    EscapeCommFunction( FHandle, funcs[onOff] );
end;

// Set RTS line high (onOff=TRUE) or low (onOff=FALSE).
// You must not use HW handshaking.
procedure TCommPortDriver.ToggleRTS( onOff: boolean );
const funcs: array[boolean] of integer = (CLRRTS,SETRTS);
begin
  if Connected then
    EscapeCommFunction( FHandle, funcs[onOff] );
end;

// COM port polling proc 
procedure TCommPortDriver.TimerWndProc( var msg: TMessage );
var nRead, nToRead, dummy: DWORD;
    comStat: TCOMSTAT;
begin
  if (msg.Msg = WM_TIMER) and Connected then
  begin
    // Do nothing if RX polling has been paused 
    if FRXPollingPauses > 0 then
      exit;
    // If PacketSize is > 0 then raise the OnReceiveData event only if the RX
    // buffer has at least PacketSize bytes in it.
    ClearCommError( FHandle, dummy, @comStat );
    if FPacketSize > 0 then
    begin
      // Complete packet received ?
      if DWORD(comStat.cbInQue) >= DWORD(FPacketSize) then
      begin
        repeat
          // Read the packet and pass it to the app
          nRead := 0;
          if ReadFile( FHandle, FTempInBuffer^, FPacketSize, nRead, nil ) then
            if (nRead <> 0) and Assigned(FOnReceivePacket) then
              FOnReceivePacket( Self, FTempInBuffer, nRead );
          // Adjust time
          //if comStat.cbInQue >= FPacketSize then
            FFirstByteOfPacketTime := FFirstByteOfPacketTime +
                                      DelayForRX( FBaudRate, FPacketSize );
          comStat.cbInQue := comStat.cbInQue - WORD(FPacketSize);
          if comStat.cbInQue = 0 then
            FFirstByteOfPacketTime := DWORD(-1);
        until DWORD(comStat.cbInQue) < DWORD(FPacketSize);
        // Done
        exit;
      end;
      // Handle packet timeouts
      if (FPacketTimeout > 0) and (FFirstByteOfPacketTime <> DWORD(-1)) and
         (GetTickCount - FFirstByteOfPacketTime > DWORD(FPacketTimeout)) then
      begin
        nRead := 0;
        // Read the "incomplete" packet
        if ReadFile( FHandle, FTempInBuffer^, comStat.cbInQue, nRead, nil ) then
          // If PacketMode is not pmDiscard then pass the packet to the app
          if (FPacketMode <> pmDiscard) and (nRead <> 0) and Assigned(FOnReceivePacket) then
            FOnReceivePacket( Self, FTempInBuffer, nRead );
        // Restart waiting for a packet 
        FFirstByteOfPacketTime := DWORD(-1);
        // Done 
        exit;
      end;
      // Start time 
      if (comStat.cbInQue > 0) and (FFirstByteOfPacketTime = DWORD(-1)) then
        FFirstByteOfPacketTime := GetTickCount;
      // Done 
      exit;
    end;

    // Standard data handling 
    nRead := 0;
    nToRead := comStat.cbInQue;
    if (nToRead > 0) and ReadFile( FHandle, FTempInBuffer^, nToRead, nRead, nil ) then
      if (nRead <> 0) and Assigned(FOnReceiveData) then
        FOnReceiveData( Self, FTempInBuffer, nRead );
  end
  // Let Windows handle other messages 
  else
    Msg.Result := DefWindowProc( FNotifyWnd, Msg.Msg, Msg.wParam, Msg.lParam ) ;
end;

end.