Einzelnen Beitrag anzeigen

jbg

Registriert seit: 12. Jun 2002
3.483 Beiträge
 
Delphi 10.1 Berlin Professional
 
#4
  Alt 22. Sep 2002, 13:42
Da ich ein paar Roboter über die serielle Schnittstelle programmiert habe, ist eine TComPort-Klasse übrig geblieben.
Code:
[b]unit[/b] COMPort;
[b]interface[/b]
[b]uses[/b] Windows, SysUtils;
[b]type[/b]
  TComPortNumber = Word; [i]// 0: None, 1: Com1, 2: Com2, ...[/i]

  TComPort = [b]class[/b](TObject)
  [b]private[/b]
    FPort: TComPortNumber;
    FPortHandle: THandle;
    Fdcb: TDCB;
    FRaiseOpenException: Boolean;

    [b]procedure[/b] SetPort(Value: TComPortNumber);
    [b]procedure[/b] SetDCB([b]const[/b] Value: TDCB);
  [b]protected[/b]
    [b]function[/b] GetHandle: THandle; [b]virtual[/b];
    [b]procedure[/b] ClosePort; [b]virtual[/b];
  [b]public[/b]
    [b]constructor[/b] Create;
    [b]destructor[/b] Destroy; [b]override[/b];

    [b]function[/b] Write([b]const[/b] buf; size: Cardinal): Cardinal;
    [b]function[/b] Read([b]var[/b] buf; size: Cardinal): Cardinal;
    [b]function[/b] ClearAll: Boolean; [i]// clears the output and input buffer[/i]
    [b]function[/b] ClearInput: Boolean; [i]// clears the input buffer[/i]
    [b]function[/b] ClearOutput: Boolean; [i]// clears the output buffer[/i]

    [b]property[/b] Port: TComPortNumber [b]read[/b] FPort [b]write[/b] SetPort;
    [b]property[/b] DCB: TDCB [b]read[/b] Fdcb [b]write[/b] SetDCB;
    [b]property[/b] Handle: THandle [b]read[/b] GetHandle;

    [b]property[/b] RaiseOpenException: Boolean [b]read[/b] FRaiseOpenException [b]write[/b] FRaiseOpenException;
  [b]end[/b];


[b]const[/b]
 [i]// TDCB.Flags[/i]
  fBinary          = $0001;  [i]// binary mode, no EOF check[/i]
  fParity          = $0002;
  fDtrControlEnable = $0010;  [i]// DTR flow control type[/i]
  fRtsControlEnable = $1000;  [i]// RTS flow control enable[/i]

[b]implementation[/b]

[i]{ TComPort }[/i]
[b]constructor[/b] TComPort.Create;
[b]begin[/b]
  [b]inherited[/b];
  FPort := 0;
  FPortHandle := 0;
  FillChar(Fdcb, SizeOf(Fdcb), 0);
  FRaiseOpenException := False;
[b]end[/b];
[b]destructor[/b] TComPort.Destroy;
[b]begin[/b]
  ClosePort;
  [b]inherited[/b];
[b]end[/b];

[b]procedure[/b] TComPort.ClosePort;
[b]begin[/b]
  [b]if[/b] FPortHandle <> 0 [b]then[/b] [b]begin[/b]
    [i]// Port schließen[/i]
     CloseHandle(FPortHandle);
     FPortHandle := 0;
  [b]end[/b];
[b]end[/b];

[b]function[/b] TComPort.GetHandle: THandle;
[b]var[/b]
  commtimeouts: TCommTimeouts;
  portname: [b]String[/b];
[b]begin[/b]
  [b]case[/b] FPort [b]of[/b]
    0: [b]begin[/b]
      ClosePort;
      Result := 0;
    [b]end[/b];
    [b]else[/b] [b]begin[/b] [i]// case else[/i]
      [b]if[/b] FPortHandle <> 0 [b]then[/b] [b]begin[/b]
         Result := FPortHandle;
         exit;
      [b]end[/b];
      portname := '\\.\COM' + IntToStr(FPort);

      FPortHandle := CreateFile(PChar(portname), [i]// name of COM device to open[/i]
        GENERIC_READ [b]or[/b] GENERIC_WRITE, [i]// read-write access[/i]
        0, [b]nil[/b],                       [i]// not used[/i]
        OPEN_EXISTING,                [i]// required for tape devices[/i]
        0, 0);                        [i]// not used[/i]

      Result := FPortHandle;
      [b]if[/b] Result = INVALID_HANDLE_VALUE [b]then[/b] Result := 0;
      [b]if[/b] (FPortHandle <> 0) [b]then[/b] [b]begin[/b]
        [i]// Device-Parameter setzen | set device parameters[/i]
         Fdcb.DCBlength := SizeOf(Fdcb);
         GetCommState(FPortHandle, Fdcb);
          Fdcb.Flags := dcb.Flags [b]and[/b] [b]not[/b] (fDtrControlEnable [b]or[/b] fRtsControlEnable) [b]or[/b] fBinary;
          Fdcb.BaudRate := CBR_19200; [i]// baud[/i]
          Fdcb.ByteSize := 8;
          Fdcb.Parity := NOPARITY;
          Fdcb.StopBits := ONESTOPBIT;
         SetCommState(FPortHandle, Fdcb);

        [i]// Timeout für ReadFile() setzen | set timeout for ReadFile()[/i]
          commtimeouts.ReadIntervalTimeout := 0;
          commtimeouts.ReadTotalTimeoutMultiplier := 5;
          commtimeouts.ReadTotalTimeoutConstant := 100;
         SetCommTimeouts(FPortHandle, commtimeouts);
      [b]end[/b];

      [b]if[/b] (Result = 0) [b]and[/b] (FRaiseOpenException) [b]then[/b]
         RaiseLastWin32Error;
    [b]end[/b]; [i]// case else[/i]
  [b]end[/b]; [i]// case[/i]
[b]end[/b];

[b]procedure[/b] TComPort.SetPort(Value: TComPortNumber);
[b]begin[/b]
  [b]if[/b] Value = FPort [b]then[/b] exit;
  FPort := Value;
  ClosePort;
  GetHandle; [i]// Handle erzeugen[/i]
[b]end[/b];
[b]procedure[/b] TComPort.SetDCB([b]const[/b] Value: TDCB);
[b]var[/b] h: THandle;
[b]begin[/b]
  h := Handle;
  [b]if[/b] h = 0 [b]then[/b] exit;

  [b]if[/b] SetCommState(h, Value) [b]then[/b] [b]begin[/b]
     [b]if[/b] [b]not[/b] GetCommState(h, Fdcb) [b]then[/b] Move(Value, Fdcb, SizeOf(Fdcb));
  [b]end[/b];
[b]end[/b];

[b]function[/b] TComPort.Write([b]const[/b] buf; size: Cardinal): Cardinal;
[b]begin[/b]
  Result := 0;
  [b]if[/b] size = 0 [b]then[/b] exit;
  [b]if[/b] [b]not[/b] WriteFile(Handle, buf, size, Result, [b]nil[/b]) [b]then[/b] Result := -1 * Result;
[b]end[/b];
[b]function[/b] TComPort.Read([b]var[/b] buf; size: Cardinal): Cardinal;
[b]begin[/b]
  Result := 0;
  [b]if[/b] size = 0 [b]then[/b] exit;
  [b]if[/b] [b]not[/b] ReadFile(Handle, buf, size, Result, [b]nil[/b]) [b]then[/b] Result := -1 * Result;
[b]end[/b];
[b]function[/b] TComPort.ClearAll: Boolean; [i]// clears the output and input buffer[/i]
[b]begin[/b]
  Result := PurgeComm(Handle, PURGE_TXCLEAR [b]or[/b] PURGE_RXCLEAR);
[b]end[/b];
[b]function[/b] TComPort.ClearInput: Boolean; [i]// clears the input buffer[/i]
[b]begin[/b]
  Result := PurgeComm(Handle, PURGE_RXCLEAR);
[b]end[/b];
[b]function[/b] TComPort.ClearOutput: Boolean; [i]// clears the output buffer[/i]
[b]begin[/b]
  Result := PurgeComm(Handle, PURGE_TXCLEAR);
[b]end[/b];
Code:
[b]var[/b]
  ComPort: TComPort;
  b: Byte;
[b]begin[/b]
  ComPort := TComPort.Create;
  [b]try[/b]
    ComPort.Port := 1; [i]// Com1[/i]
    ComPort.Read(b, SizeOf(b)); [i]// warten bis etwas eingelesen wurde[/i]
    ShowMessage(IntToStr(b));
  [b]finally[/b]
    ComPort.Free;
  [b]end[/b];
[b]end[/b];
  Mit Zitat antworten Zitat