Delphi-PRAXiS
Seite 1 von 5  1 23     Letzte »    

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Programmieren allgemein (https://www.delphipraxis.net/40-programmieren-allgemein/)
-   -   TSerial - RS232 ansprechen (https://www.delphipraxis.net/115140-tserial-rs232-ansprechen.html)

Netblaster 6. Jun 2008 15:55


TSerial - RS232 ansprechen
 
Hallo Allerseits,

ich möchte für ein Mikrocontrollerprojekt eine Anwendung in Delphi (7) schreiben, welches Datenpakete seriell senden und empfangen kann.
Ich habe mir die TComPort-Komponente installiert und versuche das damit.Leider ist mein Fachenglisch nicht das beste :gruebel:

Aus Gründen des besseren Verstehens, erhoffe ich mir von der (deutschen) TSerial Komponente von R.Reusch mehr Erfolge als ich bisher habe.

Weiß jemand woher ich noch die TSerial - Komponente bekommen kann, ohne gleich ein Zeitschriftenabbo auslösen zu müssen ???

Danke - Andrej!

arnold mueller 6. Jun 2008 16:03

Re: TSerial - RS232 ansprechen
 
Hallo,

die TSerial Komponente ist lizenzpflichtig. Mit dem Erwerb der entsprechenden Toolbox Zeitschrift erhält man auch eine Lizenz.

Ich habe selbst mal eine Komponente geschrieben, die Du gerne verwenden darfst.

-
arno

Delphi-Quellcode:
unit Com;

interface

uses
  WinTypes, WinProcs, Classes, SysUtils;

type
  TRTSMode = (RTS_DISABLED, RTS_ENABLED, RTS_HANDSHAKE, RTS_TOGGLE);
  TDTRMode = (DTR_DISABLED, DTR_ENABLED, DTR_HANDSHAKE);
  TParity = (NOPARITY, ODDPARITY, EVENPARITY, MARKPARITY, SPACEPARITY);
  TStopbits = (ONESTOPBIT, ONE5STOPBITS, TWOSTOPBITS);
  TCOM = class(TComponent)
  private
    FDCB: TDCB;
    FHandle: Cardinal;
    FTimeouts: TCommTimeouts;
    FError: Cardinal;
    FComNo: byte;
    FBaud: word;
    FParity: TParity;
    FDatabits: byte;
    FStopbits: TStopbits;

    function GetRTS: boolean;
    procedure SetRTS(const Value: boolean);
    function GetDTR: boolean;
    procedure SetDTR(const Value: boolean);
    function GetDCD: boolean;
    function GetDSR: boolean;
    function GetRI: boolean;
    function GetCTS: boolean;
    function GetIsOpen: boolean;
    function GetInBufUsed: cardinal;
    function GetOutBufUsed: cardinal;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    function TestComPortAvailable(ComNo: integer): boolean;
    function Open(ComNo: integer; RTSMode: TRTSMode; DTRMode: TDTRMode): boolean;
    function RxFlush: boolean;
    function TxFlush: boolean;
    function Send(Data: Char): boolean; overload;
    function Send(Data: PChar; Len: cardinal): boolean; overload;
    function GetChar(var data: Char): boolean;

    procedure Close;
    procedure Reset;
  published
    property ComNo: byte read FComNo;
    property Baud: word read FBaud write FBaud;
    property Databits: byte read FDatabits write FDatabits;
    property Stopbits: TStopbits read FStopbits write FStopbits;
    property Parity: TParity read FParity write FParity;
    property IsOpen: boolean read GetIsOpen;
    property InBufUsed: cardinal read GetInBufUsed;
    property OutBufUsed: cardinal read GetOutBufUsed;
    property Error: cardinal read FError;
    property RTS: boolean read GetRTS write SetRTS;
    property CTS: boolean read GetCTS;
    property DTR: boolean read GetDTR write SetDTR;
    property DSR: boolean read GetDSR;
    property RI: boolean read GetRI;
    property DCD: boolean read GetDCD;
  end;

var FCOM: TCOM;

implementation


{----------------------------------------------------------------------------------------------}

constructor TCOM.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FHandle := INVALID_HANDLE_VALUE;

  Baud := CBR_9600;
  Databits := 8;
  Parity := NOPARITY;
  StopBits := ONESTOPBIT;
end;

{----------------------------------------------------------------------------------------------}

destructor TCOM.Destroy;
begin
  if IsOpen then Close; { Port schließen falls geöffnet         }
  inherited destroy;
end;

{----------------------------------------------------------------------------------------------}

function TCOM.TestComPortAvailable(ComNo: integer): boolean;
begin
  Result := Open(ComNo, RTS_DISABLED, DTR_DISABLED);
end;

{----------------------------------------------------------------------------------------------}

function TCOM.Open(ComNo: integer; RTSMode: TRTSMode; DTRMode: TDTRMode): boolean;
var init: string;
begin
  if FHandle = INVALID_HANDLE_VALUE then
  begin
    init := '\\.\COM' + IntToStr(ComNo);
    FHandle := CreateFile(@init[1],
      GENERIC_READ or GENERIC_WRITE,
      0, nil,
      OPEN_EXISTING,
      FILE_ATTRIBUTE_NORMAL,
      0);
    if FHandle <> INVALID_HANDLE_VALUE then
    begin
      FComNo := ComNo;
      // aktuelle Einstellungen ermitteln
      if GetCommState(FHandle, FDCB) then
      begin
        // rudimentäre Parameter setzen
        FDCB.Baudrate := FBaud;
        FDCB.Bytesize := Databits;
        FDCB.Parity := Ord(FParity);
        FDCB.Stopbits := Ord(FStopbits);

        // RTS Modus setzen
        FDCB.flags := FDCB.flags and $CFFB; {RTS aus}
        case RTSMode of
          RTS_ENABLED: FDCB.flags := FDCB.flags or $1000; {RTS ein}
          RTS_HANDSHAKE: FDCB.flags := FDCB.flags or $2004; {RTS Handshake ein (gekoppelt an RX Buffer 0= Empfangspuffer zu 3/4 voll)}
          RTS_TOGGLE: FDCB.flags := FDCB.flags or $3000; {RTS gekoppelt an Tx Buffer (1=Daten im Sendepuffer)}
        end;
        // DTR Modus setzen
        FDCB.flags := FDCB.flags and $FFC7; {DTR aus (und bleibt aus)}
        case DTRMode of
          DTR_ENABLED: FDCB.flags := FDCB.flags or $0010; {DTR ein (und bleibt ein)}
          DTR_HANDSHAKE: FDCB.flags := FDCB.flags or $0028; {DTR Handshake ein}
        end;

        if SetCommState(FHandle, FDCB) then
        begin
          if SetupComm(FHandle, 1024, 1024) then {Rx-/Tx-Buffer-Einstellungen}
          begin
            FTimeouts.ReadIntervalTimeout := 0; {Timeoutzeiten setzen}
            FTimeouts.ReadTotalTimeoutMultiplier := 0;
            FTimeouts.ReadTotalTimeoutConstant := 1;
            FTimeouts.WriteTotalTimeoutMultiplier := 0;
            FTimeouts.WriteTotalTimeoutConstant := 0;
            SetCommTimeouts(FHandle, FTimeouts);
          end;
        end;
      end;
    end;
  end;

  FError := GetLastError;

  if Error <> 0 then
  begin
    Close;
  end;

  Result := Error = 0; { Ergebnis zurückgeben                  }
end;

{-----------------------------------------------------------------------------------------------}

function TCOM.GetCTS: boolean;
var nStatus: cardinal;
begin
  Result := false;
  if FHandle <> INVALID_HANDLE_VALUE then
  begin
    if GetCommModemStatus(FHandle, nStatus) then
      Result := (nStatus and MS_CTS_ON) > 0;
  end;
end;

{-----------------------------------------------------------------------------------------------}

function TCOM.GetDSR: boolean;
var nStatus: cardinal;
begin
  Result := false;
  if FHandle <> INVALID_HANDLE_VALUE then
  begin
    if GetCommModemStatus(FHandle, nStatus) then
      Result := (nStatus and MS_DSR_ON) > 0;
  end;
end;

{-----------------------------------------------------------------------------------------------}

function TCOM.GetIsOpen: boolean;
begin
  Result := FHandle <> INVALID_HANDLE_VALUE;
end;

{-----------------------------------------------------------------------------------------------}

function TCOM.GetInBufUsed: cardinal;
var
  Comstat: _Comstat;
  Errors: DWord;
begin
  if ClearCommError(FHandle, Errors, @Comstat) then
    Result := Comstat.cbInQue else Result := 0;
end;
{-----------------------------------------------------------------------------------------------}

function TCOM.GetOutBufUsed: cardinal;
var
  Comstat: _Comstat;
  Errors: DWord;
begin
  if ClearCommError(FHandle, Errors, @Comstat) then
    Result := Comstat.cbOutQue else Result := 0;
end;

{-----------------------------------------------------------------------------------------------}

function TCOM.GetRI: boolean;
var nStatus: cardinal;
begin
  Result := false;
  if FHandle <> INVALID_HANDLE_VALUE then
  begin
    if GetCommModemStatus(FHandle, nStatus) then
      Result := (nStatus and MS_RING_ON) > 0;
  end;
end;

{-----------------------------------------------------------------------------------------------}

function TCOM.GetRTS: boolean;
begin
  Result := false;
  if GetCommState(FHandle, FDCB) then
  begin
    Result := (FDCB.Flags and $3000) > 0;
  end;
end;

{-----------------------------------------------------------------------------------------------}

procedure TCOM.SetRTS(const Value: boolean);
begin
  if (Value = True) then
    EscapeCommFunction(FHandle, WinTypes.SETRTS)
  else
    EscapeCommFunction(FHandle, WinTypes.CLRRTS);
end;

{-----------------------------------------------------------------------------------------------}

function TCOM.GetDTR: boolean;
begin
  Result := false;
  if GetCommState(FHandle, FDCB) then
  begin
    Result := (FDCB.Flags and $0010) > 0;
  end;
end;
{-----------------------------------------------------------------------------------------------}

procedure TCOM.SetDTR(const Value: boolean);
begin
  if (Value = True) then
    EscapeCommFunction(FHandle, WinTypes.SETDTR)
  else
    EscapeCommFunction(FHandle, WinTypes.CLRDTR);
end;
{-----------------------------------------------------------------------------------------------}

function TCOM.GetDCD: boolean;
var nStatus: cardinal;
begin
  Result := false;
  if FHandle <> INVALID_HANDLE_VALUE then
  begin
    if GetCommModemStatus(FHandle, nStatus) then
      Result := (nStatus and MS_RLSD_ON) > 0;
  end;
end;


{-----------------------------------------------------------------------------------------------}

procedure TCOM.Close;
begin
  if CloseHandle(FHandle) then { Schnittstelle schließen               }
    FHandle := INVALID_HANDLE_VALUE;

  FError := GetLastError;
end;

{-----------------------------------------------------------------------------------------------}

procedure TCOM.Reset;
begin
  if not EscapeCommFunction(FHandle, WinTypes.RESETDEV) then
    FError := GetLastError;
end;

{-----------------------------------------------------------------------------------------------}

function TCOM.RxFlush: boolean;
begin
  if FHandle <> INVALID_HANDLE_VALUE then
  begin
    PurgeComm(FHandle, PURGE_RXCLEAR);
    FError := GetLastError;
  end;

  Result := FError = 0;
end;

{-----------------------------------------------------------------------------------------------}

function TCOM.TxFlush: boolean;
begin
  if FHandle <> INVALID_HANDLE_VALUE then
  begin
    PurgeComm(FHandle, PURGE_TXCLEAR);
    FError := GetLastError;
  end;

  Result := FError = 0;
end;

{-----------------------------------------------------------------------------------------------}

function TCOM.Send(Data: Char): boolean;
var nWritten, nCount: Cardinal;
begin
  Result := false;

  if FHandle <> INVALID_HANDLE_VALUE then
  begin
    nCount := SizeOf(Data);
    if WriteFile(FHandle, Data, nCount, nWritten, nil) then
    begin
      Result := nCount = nWritten;
    end;
    FError := GetLastError;
  end;
end;

{-----------------------------------------------------------------------------------------------}

function TCOM.Send(Data: PChar; Len: cardinal): boolean;
var nWritten, nCount: Cardinal;
begin
  Result := false;

  if FHandle <> INVALID_HANDLE_VALUE then
  begin
    nCount := Len;
    if WriteFile(FHandle, Data^, nCount, nWritten, nil) then
    begin
      Result := nCount = nWritten;
    end;
    FError := GetLastError;
  end;
end;

{-----------------------------------------------------------------------------------------------}

function TCOM.GetChar(var data: Char): boolean;
var nCount, nRead: cardinal;
begin
  Result := false;

  if FHandle <> INVALID_HANDLE_VALUE then
  begin
    nCount := SizeOf(data);

    if InBufUsed >= nCount then
    begin
      if ReadFile(FHandle, data, nCount, nRead, nil) then
      begin
        Result := nCount = nRead;
      end;
    end;

    FError := GetLastError;
  end;
end;


end.

Netblaster 6. Jun 2008 16:07

Re: TSerial - RS232 ansprechen
 
Hi Arno,

danke für deine Antwort - ich werde umgehend mal deine Komponente ausprobieren. :thumb:
Wenn ich Fragen habe darf ich mich doch melden :coder:

Grüße - Andrej!

LDericher 22. Aug 2008 23:21

Re: TSerial - RS232 ansprechen
 
Sehr übersichtlich, sehr benutzerfreundlich, einfach TOP!

:hello: :spin: :thumb: :bounce1: :bouncing4: :bounce2: :dancer2: :dancer:

wirklich tolle Unit! einfach einbinden, geht, hab ich vorher noch NIE gehabt!
Perfekt, ich freue mich!

LG Superwinger

Edit:
Zitat:

Zitat von Dr. Fluke Hawkins (in MDK2, Level 9 Intro)
Es ist brillant! Es ist einfach! Es iiist - Wissenschaft!


LuJ 10. Sep 2008 12:11

Re: TSerial - RS232 ansprechen
 
Guten Tag,
ich (Neuling/ahnungslos)bin im Zuge eines Schulprojekts auf dieses Forum und diesen Thread gestoßen.
Auch bei uns ein Mikrocontrollerprojekt.
Unser Problem ist im Wesentlichen, den Quelltext von arnold mueller zu verstehen (einsetzen ist kein Problem- aber man muss ja auch verstehen was passiert).
Unser Kernproblem hierbei ist die TCOM.Send Funktion.
Wenns nicht zuviel verlangt wäre, würde es uns sehr weiterhelfen, wenn jemand versuchen würde, den Quelltext etwas zu erläutern und zu kommentieren, damit wir effektiv mit der Komponente arbeiten können.

Und wenns geht, dabei berücksichtigen, das wir auf dem Stand Stufe 13.1 sind- wenig Fachchinesisch und viel "Zeile xy hängt zusammen mit Zeile z und löst dieses und jenes aus"

Vielen Dank im Voraus, falls sich jemand die Mühe macht- ein paar armen, verzweifelten Schülern könnte damit sehr geholfen werden!

-LuJ-
:glaskugel:

Nersgatt 12. Sep 2008 14:07

Re: TSerial - RS232 ansprechen
 
Moin!

Zitat:

Zitat von LuJ
Wenns nicht zuviel verlangt wäre, würde es uns sehr weiterhelfen, wenn jemand versuchen würde, den Quelltext etwas zu erläutern und zu kommentieren, damit wir effektiv mit der Komponente arbeiten können.

Wo genau hakt es denn im Verständnis? Prinzipiell wird ein COM-Port ähnlich wie eine Datei behandelt. Bei der Send-Funktion werden die zu sendenden Daten einfach nur in diese "Datei" geschrieben.

Gruß,
Jens

angos 12. Sep 2008 14:49

Re: TSerial - RS232 ansprechen
 
Zitat:

Zitat von LuJ
[...]Unser Kernproblem hierbei ist die TCOM.Send Funktion.[...]

Delphi-Quellcode:

function TCOM.Send(Data: Char): boolean;
var
  nWritten, nCount: Cardinal;
begin
  Result := false; // Initialisierung

  if FHandle <> INVALID_HANDLE_VALUE then // Wenn der Comport aktiviert ist und daher benutzt werden kann
  begin
    nCount := SizeOf(Data); // Zählvariable auf die Größe der zu übertragenden Daten setzen

    // FHandle = Handle des Comports, Data = zu sendende Daten, nCount = Größe von Data
    // nWritten = gesendete Anzahl an Daten. Diese Variable wird von WriteFile gefüllt
    if WriteFile(FHandle, Data, nCount, nWritten, nil) then // und Daten abschicken.
    begin
      Result := nCount = nWritten; // Wenn alle Daten übertragen wurden ist die Funktion erfolgreich
    end;
    FError := GetLastError;
  end;
end;
HTH

LuJ 15. Sep 2008 06:29

Re: TSerial - RS232 ansprechen
 
Zitat:

Zitat von Nersgatt
Moin!

Zitat:

Zitat von LuJ
Wenns nicht zuviel verlangt wäre, würde es uns sehr weiterhelfen, wenn jemand versuchen würde, den Quelltext etwas zu erläutern und zu kommentieren, damit wir effektiv mit der Komponente arbeiten können.

Wo genau hakt es denn im Verständnis? Prinzipiell wird ein COM-Port ähnlich wie eine Datei behandelt. Bei der Send-Funktion werden die zu sendenden Daten einfach nur in diese "Datei" geschrieben.

Gruß,
Jens

Sorry für die lange Abwesenheit.

Beim Verständnis an und für sich hakts nicht, mit dem Prinzip kommt man noch klar. Bei der Aufschlüsselung des Quelltextes hakts dann aber- deshalb auch vielen Dank an angos für die Mühe!

Ich denke das bringt uns ein Stückchen weiter :)


Edit: Wenn man voraussetzt, dass an der seriellen Schnittstelle nichts dranhängt (Nullmodemkabel zB), würde das Programm dann immer bei " FHandle = INVALID_HANDLE_VALUE " den Geist aufgeben?

Oder anders formuliert, wenn an der seriellen Schnittstelle keine "Verbindung" hängt, welche Reaktion des Programms würdet ihr erwarten?

christian_u 16. Sep 2008 10:41

Re: TSerial - RS232 ansprechen
 
Es gibt keine Möglichkeit herauszufinden ob etwas an der Schnittstelle hängt, die daten werden dann also einfach ins nirvana gesendet.

arnold mueller 16. Sep 2008 11:07

Re: TSerial - RS232 ansprechen
 
Zitat:

Zitat von christian_u
Es gibt keine Möglichkeit herauszufinden ob etwas an der Schnittstelle hängt, die daten werden dann also einfach ins nirvana gesendet.

Die Handshake Leitungen DTR/DSR nutzt man normalerweise, um herauszufinden, ob die Gegenstelle angeschlossen ist.

Grundlagen gibt es hier:
http://www.sprut.de/electronic/inter...s232/rs232.htm

-
arno


Alle Zeitangaben in WEZ +1. Es ist jetzt 13:44 Uhr.
Seite 1 von 5  1 23     Letzte »    

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz