Einzelnen Beitrag anzeigen

jbg

Registriert seit: 12. Jun 2002
3.481 Beiträge
 
Delphi 10.1 Berlin Professional
 
#17
  Alt 15. Jun 2002, 10:36
Das ist auch nicht der komplette Code, den ich oben gepostet habe.

Code:
unit COMPort;
interface
uses Windows, SysUtils, Classes;
type
  TComPortNumber = (ComNone, Com1, Com2, Com3, Com4, Com5, Com6, Com7); // ggf. erweitern
  TComPort = class(TObject)
  private
    FPort: TComPortNumber;
    FPortHandle: THandle;
    Fdcb: TDCB;
    FRaiseOpenException: Boolean;
    procedure SetPort(Value: TComPortNumber);
    procedure SetDCB(const Value: TDCB);
  protected
    function GetHandle: THandle; virtual;
    procedure ClosePort; virtual;
  public
    constructor Create;
    destructor Destroy; override;
    function Write(const buf; size: Cardinal): Cardinal;
    function Read(var buf; size: Cardinal): Cardinal;
    function ClearAll: Boolean; // clears the output and input buffer
    function ClearInput: Boolean; // clears the input buffer
    function ClearOutput: Boolean; // clears the output buffer
    property Port: TComPortNumber read FPort write SetPort;
    property DCB: TDCB read Fdcb write SetDCB;
    property Handle: THandle read GetHandle;
    property RaiseOpenException: Boolean read FRaiseOpenException write FRaiseOpenException;
  end;
const
 // TDCB.Flags
  fBinary          = $0001;  // binary mode, no EOF check
  fParity          = $0002;
  fDtrControlEnable = $0010;  // DTR flow control type
  fRtsControlEnable = $1000;  // RTS flow control enable
implementation
constructor TComPort.Create;
begin
  inherited;
  FPort := ComNone;
  FPortHandle := 0;
  FillChar(Fdcb, SizeOf(Fdcb), 0);
  FRaiseOpenException := False;
end;
destructor TComPort.Destroy;
begin
  ClosePort;
  inherited;
end;
procedure TComPort.ClosePort;
begin
  if FPortHandle <> 0 then begin
    // Port schließen
     CloseHandle(FPortHandle);
     FPortHandle := 0;
  end;
end;
function TComPort.GetHandle: THandle;
var
  commtimeouts: TCommTimeouts;
  portname: String;
begin
  case FPort of
    ComNone: begin
      ClosePort;
      Result := 0;
    end;
    else begin // case else
      if FPortHandle <> 0 then begin
         Result := FPortHandle;
         exit;
      end;
      portname := '\\.\COM' + IntToStr(Integer(FPort));
      FPortHandle := CreateFile(PChar(portname), // name of COM device to open
        GENERIC_READ or GENERIC_WRITE, // read-write access
        0, nil,                       // not used
        OPEN_EXISTING,                // required for tape devices
        0, 0);                        // not used
      Result := FPortHandle;
      if Result = INVALID_HANDLE_VALUE then Result := 0;
      if (FPortHandle <> 0) then begin
        // Device-Parameter setzen
         Fdcb.DCBlength := SizeOf(Fdcb);
         GetCommState(FPortHandle, Fdcb);
          Fdcb.Flags := dcb.Flags and not (fDtrControlEnable or fRtsControlEnable) or fBinary;
          Fdcb.BaudRate := CBR_19200; // baud
          Fdcb.ByteSize := 8;
          Fdcb.Parity := NOPARITY;
          Fdcb.StopBits := ONESTOPBIT;
         SetCommState(FPortHandle, Fdcb);
        // Timeout für ReadFile() setzen
          commtimeouts.ReadIntervalTimeout := 0;
          commtimeouts.ReadTotalTimeoutMultiplier := 5;
          commtimeouts.ReadTotalTimeoutConstant := 100;
         SetCommTimeouts(FPortHandle, commtimeouts);
      end;
      if (Result = 0) and (FRaiseOpenException) then RaiseLastWin32Error;
    end; // case else
  end; // case
end;
procedure TComPort.SetPort(Value: TComPortNumber);
begin
  if Value = FPort then exit;
  FPort := Value;
  ClosePort;
  GetHandle; // Handle erzeugen
end;
procedure TComPort.SetDCB(const Value: TDCB);
var h: THandle;
begin
  h := Handle;
  if h = 0 then exit;
  if SetCommState(h, Value) then begin
     if not GetCommState(h, Fdcb) then Move(Value, Fdcb, SizeOf(Fdcb));
  end;
end;
function TComPort.Write(const buf; size: Cardinal): Cardinal;
begin
  Result := 0;
  if size = 0 then exit;
  if not WriteFile(Handle, buf, size, Result, nil) then Result := -1 * Result;
end;
function TComPort.Read(var buf; size: Cardinal): Cardinal;
begin
  Result := 0;
  if size = 0 then exit;
  if not ReadFile(Handle, buf, size, Result, nil) then Result := -1 * Result;
end;
function TComPort.ClearAll: Boolean; // clears the output and input buffer
begin
  Result := PurgeComm(Handle, PURGE_TXCLEAR or PURGE_RXCLEAR);
end;
function TComPort.ClearInput: Boolean; // clears the input buffer
begin
  Result := PurgeComm(Handle, PURGE_RXCLEAR);
end;
function TComPort.ClearOutput: Boolean; // clears the output buffer
begin
  Result := PurgeComm(Handle, PURGE_TXCLEAR);
end;
end.
  Mit Zitat antworten Zitat