COM direkt ansprechen, Ubuntu 32-Bit

Zur Vorstellung von Komponenten und Units für Lazarus
Antworten
wennerer
Beiträge: 505
Registriert: Di 19. Mai 2015, 20:05
OS, Lazarus, FPC: Linux Mint 20 Cinnamon,Lazarus 2.2.6 (rev lazarus_2_2_6) FPC 3.2.2 x86_64-linux-
CPU-Target: x86_64-linux-gtk2

COM direkt ansprechen, Ubuntu 32-Bit

Beitrag von wennerer »

Hallo an alle Bastler (mit Ubuntu 32bit als Betriebssystem),

vielleicht ist ja von euch auch Jemand auf der Suche nach einer einfachen Möglichkeit die Serielle Schnittstelle so wie früher unter DOS direkt anzusprechen. Ich hab jetzt eine Möglichkeit gefunden die mir gut gefällt und da ich im Forum nichts darüber gefunden habe möchte ich es für alle die es interessiert kurz vorstellen.
Wichtige Voraussetzung ist aber das man das Programm mit Rootrechten startet! Mein Zugriff auf die Serielle Schnittstelle folgt im wesentlichen der hier beschrieben Vorgehensweise: http://wiki.freepascal.org/Hardware_Access/de (Verwendung von ioperm zum Zugriff auf Ports unter Linux).
Näheres zu ioperm findet man auch hier: http://manpages.ubuntu.com/manpages/xen ... erm.2.html
Nachdem ioperm aufgerufen wurde lässt sich die Serielle Schnittstelle mit der Unit Ports wie früher in Turbo Pascal direkt ansprechen. Ich hab mir einen kleinen Tester gebastelt wo die Ausgänge auf LED (mit Vorwiderständen) und die Eingänge auf Buchsen gelegt sind. Wer es mal nachvollziehen möchte hier folgt ein kleines Programm und eine Unit zum Ansprechen der COM. Wie in der Überschrift schon gesagt ist nichts für Profis sondern was für Bastler.

Code: Alles auswählen

unit unit_simplex03;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,StdCtrls,ExtCtrls,Com_Ein_Aus;
 
type
 
  { TForm1 }
 
  TForm1 = class(TForm)
    Button1    : TButton;
    Label1     : TLabel;
    Button2    : TButton;
    Label2     : TLabel;
    Button3    : TButton;
    Label3     : TLabel;
    Timer1     : TTimer;
    procedure FormCreate(Sender: TObject);
    procedure DTR_Schalten(Sender: TObject);
    procedure TXD_Schalten(Sender: TObject);
    procedure RTS_Schalten(Sender: TObject);
    procedure PruefeEingaenge(Sender: TObject);
    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
  private
    { private declarations }
    Eingaenge : array [0..3] of TShape;
    LaEing    : array [0..3] of TLabel;
  public
    { public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.lfm}
 
{ TForm1 }
 
procedure TForm1.FormCreate(Sender: TObject);
var lv : integer;
begin
  Form1.Width    := 450;
  Form1.Height   := 250;
  Form1.Left     := (Screen.DesktopWidth div 2)-250;
  Form1.Top      := 100;
  Form1.Caption  := 'Simplex Vers. 1.3';
  Form1.Color    := clwhite;
 
  Button1             := TButton.Create(self);
  Button1.Parent      := Form1;
  Button1.Left        :=  25;
  Button1.Top         :=  25;
  Button1.Height      :=  20;
  Button1.Width       := 100;
  Button1.Font.Height :=  14;
  Button1.Caption     := 'DTR Ein/Aus';
  Button1.OnClick     := @DTR_Schalten;
 
  Label1                := TLabel.Create(self);           //DTR
  Label1.Parent         := Form1;
  Label1.AutoSize       := false;
  Label1.Left           :=  60;
  Label1.Top            :=  60;
  Label1.Width          :=  30;
  Label1.Height         :=  30;
  Label1.Color          := clgray;
 
  Button2             := TButton.Create(self);
  Button2.Parent      := Form1;
  Button2.Left        := 175;
  Button2.Top         :=  25;
  Button2.Height      :=  20;
  Button2.Width       := 100;
  Button2.Font.Height :=  14;
  Button2.Caption     := 'TXD Ein/Aus';
  Button2.OnClick     := @TXD_Schalten;
 
  Label2                := TLabel.Create(self);           //TXD
  Label2.Parent         := Form1;
  Label2.AutoSize       := false;
  Label2.Left           := 210;
  Label2.Top            :=  60;
  Label2.Width          :=  30;
  Label2.Height         :=  30;
  Label2.Color          := clgray;
 
  Button3             := TButton.Create(self);
  Button3.Parent      := Form1;
  Button3.Left        := 325;
  Button3.Top         :=  25;
  Button3.Height      :=  20;
  Button3.Width       := 100;
  Button3.Font.Height :=  14;
  Button3.Caption     := 'RTS Ein/Aus';
  Button3.OnClick     := @RTS_Schalten;
 
  Label3                := TLabel.Create(self);           //RTS
  Label3.Parent         := Form1;
  Label3.AutoSize       := false;
  Label3.Left           := 360;
  Label3.Top            :=  60;
  Label3.Width          :=  30;
  Label3.Height         :=  30;
  Label3.Color          := clgray;
 
  for lv:= 0 to 3 do
   begin
    Eingaenge[lv]         := TShape.Create(self);
    Eingaenge[lv].Parent  := Form1;
    Eingaenge[lv].Top     := 130;
    Eingaenge[lv].Left    := 60+(lv*100);
    Eingaenge[lv].Width   := 30;
    Eingaenge[lv].Height  := 30;
    Eingaenge[lv].Shape   := stcircle;
    Eingaenge[lv].Color   := clblack;
    Eingaenge[lv].Brush.Color:= clgray;
   end;
 
  for lv:= 0 to 3 do
   begin
    LaEing[lv]            := TLabel.Create(self);
    LaEing[lv].Parent     := Form1;
    LaEing[lv].Top        := 180;
    LaEing[lv].Left       := 58+(lv*100);
    LaEing[lv].Width      := 54;
    LaEing[lv].Height     := 60;
    LaEing[lv].Font.Color := clblack;
   end;
   LaEing[0].Caption := ' DCD ';
   LaEing[1].Caption := ' DSR ';
   LaEing[2].Caption := ' CTS ';
   LaEing[3].Caption := '   RI  ';
 
   OeffneCom(Com1);
 
   Timer1            := TTimer.Create(self);
   Timer1.Interval   := 100;
   Timer1.OnTimer    := @PruefeEingaenge;
   Timer1.Enabled    := true;
end;
 
procedure TForm1.DTR_Schalten(Sender: TObject);
begin
  if dtr_flag = off then DTR_EinAus(On) else DTR_EinAus(Off);
  if dtr_flag = off then Label1.Color := clgray else Label1.Color := clred;
end;
 
procedure TForm1.TXD_Schalten(Sender: TObject);
begin
 if txd_flag = off then TXD_EinAus(On) else TXD_EinAus(Off);
 if txd_flag = off then Label2.Color := clgray else Label2.Color := clyellow;
end;
 
procedure TForm1.RTS_Schalten(Sender: TObject);
begin
 if rts_flag = off then RTS_EinAus(On) else RTS_EinAus(Off);
 if rts_flag = off then Label3.Color := clgray else Label3.Color := cllime;
end;
 
procedure TForm1.PruefeEingaenge(Sender: TObject);
begin
 if in_dcd = 0 then Eingaenge[0].Brush.Color:= clgray else Eingaenge[0].Brush.Color:= clblue;
 if in_dsr = 0 then Eingaenge[1].Brush.Color:= clgray else Eingaenge[1].Brush.Color:= clblue;
 if in_cts = 0 then Eingaenge[2].Brush.Color:= clgray else Eingaenge[2].Brush.Color:= clblue;
 if in_ri  = 0 then Eingaenge[3].Brush.Color:= clgray else Eingaenge[3].Brush.Color:= clblue;
end;
 
procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
  DTR_EinAus(off);dtr_flag:=off;
  TXD_EinAus(off);txd_flag:=off;
  RTS_EinAus(off);rts_flag:=off;
end;
 
end.
 


Und hier die Unit Com_Ein_Aus:

Code: Alles auswählen

unit Com_Ein_Aus;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils,ports,dialogs;
 
function  ioperm(from: Cardinal; num: Cardinal; turn_on: Integer): Integer; cdecl; external 'libc';
procedure OeffneCom(ComPort:integer);
procedure DTR_EinAus(OnOff:byte);
procedure TXD_EinAus(OnOff:byte);
procedure RTS_EinAus(OnOff:byte);
function in_dcd:byte;
function in_cts:byte;
function in_dsr:byte;
function in_ri :byte;
 
const
  COM1   : Integer = $03F8;
  COM2   : Integer = $02F8;
  on     : byte    = 1;
  off    : byte    = 0;
 
var
  com       : Integer;
  dtr_flag  : byte;
  txd_flag  : byte;
  rts_flag  : byte;
implementation
 
procedure OeffneCom(ComPort:integer);
var i : integer;
begin
 try
  com:=ComPort;
  i := ioperm(Com, 8, 1);
  port[Com] := $00;
  if i=-1 then showmessage('laden IOPerm fehlgeschlagen');
  except
  showmessage('führen Sie das Programm als root aus!');
  end;
  DTR_EinAus(off);dtr_flag:=off;
  TXD_EinAus(off);txd_flag:=off;
  RTS_EinAus(off);rts_flag:=off;
end;
 
procedure DTR_EinAus(OnOff:byte);
begin
 try
  Port[com+4]:=(Port[com+4] and $0FE) or OnOff;
  dtr_flag:=OnOff;
 except
  showmessage('DTR Fehler!');
 end;
end;
procedure TXD_EinAus(OnOff:byte);
begin
 try
  Port[com+3]:=(Port[com+3] and $0BF) or OnOff*64;
  txd_flag:=OnOff;
 except
  showmessage('TXD Fehler!');
 end;
end;
 
procedure RTS_EinAus(OnOff:byte);
begin
 try
  Port[com+4]:=(Port[com+4] and $0FD) or OnOff*2;
  rts_flag:=OnOff;
 except
  showmessage('RTS Fehler!');
 end;
end;
 
function in_dcd:byte;
begin
 try
  in_dcd:=(Port[com+6] and 128) div 128;
 except
  showmessage('DCD Fehler!');halt;
 end;
end;
 
function in_cts:byte;
begin
 try
  in_cts:=(Port[com+6] and 16) div 16;
 except
  showmessage('CTS Fehler!');halt;
 end;
end;
 
function in_dsr:byte;
begin
 try
  in_dsr:=(Port[com+6] and 32) div 32;
 except
  showmessage('DSR Fehler!');halt;
 end;
end;
 
function in_ri :byte;
begin
 try
  in_ri:=(Port[com+6] and 64) div 64;
 except
  showmessage('RI Fehler!');halt;
 end;
end;
 
end.
 

Mathias
Beiträge: 6143
Registriert: Do 2. Jan 2014, 17:21
OS, Lazarus, FPC: Linux (die neusten Trunk)
CPU-Target: 64Bit
Wohnort: Schweiz

Re: COM direkt ansprechen, Ubuntu 32-Bit

Beitrag von Mathias »

Kleine Hinweise, die Funktion ioperm wurde unterdessen direkt in FPC eingebaut, sie heisst nur ein bisschen anders.

Code: Alles auswählen

Function  fpIOperm (From,Num : Cardinal; Value : cint) : cint;  

Sie steckt in der Unit x86.

Auch hast du ein reserviertes Wort bei on / off verwendet. "on" ist reserviert. Sowas kann zu Problemen führen.
Ich würde da einfach ein true/false nehmen. :wink:

Ansonsten ist deine Unit eine gute Idee. :wink:

Dank deinem Post habe ich gesehen, das man unter Linux sehr einfach auf Ports zugreifen kann.
Wieder was gelernt. 8)

Ob das unter Windows auch so einfach geht ?
Bei Delphi musste ich dafür einen Treiber installieren, ausgenommen. Win95/98.
Mit Lazarus sehe ich grün
Mit Java und C/C++ sehe ich rot

wennerer
Beiträge: 505
Registriert: Di 19. Mai 2015, 20:05
OS, Lazarus, FPC: Linux Mint 20 Cinnamon,Lazarus 2.2.6 (rev lazarus_2_2_6) FPC 3.2.2 x86_64-linux-
CPU-Target: x86_64-linux-gtk2

Re: COM direkt ansprechen, Ubuntu 32-Bit

Beitrag von wennerer »

Hallo Mathias,
vielen Dank für dein Feedback. Jetzt weiß ich endlich warum "on" im Quelltext immer Fett gedruckt ist! Ich werd das auf jedenfall Ändern. Auch das ioperm in der Unit x86 drin steckt wusste ich nicht, werd ich auch mal probieren.
Unter Windows XP hab ich irgendwann mal mit einer rsapi.dll die Serielle Schnittstelle angesprochen. Das ging auch sehr problemlos.

Viele Grüße
Bernd

Mathias
Beiträge: 6143
Registriert: Do 2. Jan 2014, 17:21
OS, Lazarus, FPC: Linux (die neusten Trunk)
CPU-Target: 64Bit
Wohnort: Schweiz

Re: COM direkt ansprechen, Ubuntu 32-Bit

Beitrag von Mathias »

Auch das ioperm in der Unit x86 drin steckt wusste ich nicht, werd ich auch mal probieren.

Das Wiki http://wiki.freepascal.org/Hardware_Access/de wurde für eine sehr alten Lazarus-Version gemacht.

Code: Alles auswählen

unter Verwendung von Lazarus 0.9.10 unter Mandriva Linux 2005 und Damn Small Linux 1.5


Wen du es probierst, ob es geht, werde ich versuchen, das Wiki anzupassen.

Jetzt weiß ich endlich warum "on" im Quelltext immer Fett gedruckt ist!

Das muss es einem immer kling machen, wen etwas fett ist.

Unter Windows XP hab ich irgendwann mal mit einer rsapi.dll die Serielle Schnittstelle angesprochen. Das ging auch sehr problemlos.

Schön wäre es, wen es etwas Plattformübergreifendes geben würde.
Mit Lazarus sehe ich grün
Mit Java und C/C++ sehe ich rot

wennerer
Beiträge: 505
Registriert: Di 19. Mai 2015, 20:05
OS, Lazarus, FPC: Linux Mint 20 Cinnamon,Lazarus 2.2.6 (rev lazarus_2_2_6) FPC 3.2.2 x86_64-linux-
CPU-Target: x86_64-linux-gtk2

Re: COM direkt ansprechen, Ubuntu 32-Bit

Beitrag von wennerer »

Hallo,
hab mal folgendes probiert und geht bei mir problemlos.

Code: Alles auswählen

unit unit_fpioperm;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,StdCtrls,x86,ports;
 
type
 
  { TForm1 }
 
  TForm1 = class(TForm)
    Button1 : TButton;
    procedure FormCreate(Sender: TObject);
    procedure dtr_schalten(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;
const
  Ein     : byte    = 1;
  Aus     : byte    = 0;
 
 
var
  Form1          : TForm1;
  dtr_flag       : byte;
 
implementation
 
{$R *.lfm}
 
{ TForm1 }
 
procedure TForm1.FormCreate(Sender: TObject);
var i : integer;
begin
  Form1.Width      := 400;
  Form1.Height     := 200;
  Form1.Caption    := 'Test von fpioperm';
 
  Button1          := TButton.Create(self);
  Button1.Parent   := Form1;
  Button1.AutoSize := false;
  Button1.Left     := 25;
  Button1.Top      := 25;
  Button1.Width    := 50;
  Button1.Height   := 20;
  Button1.Caption  := 'DTR';
  Button1.OnClick  := @dtr_schalten;
 
  try
   i:=fpioperm($03F8, 8, 1);
   port[$03F8] := $00;
   if i=0 then showmessage('fpioperm okay') else showmessage('fpioperm Fehler')
  except
   showmessage('als root starten');
  end;
 
  dtr_flag:=0;
  try
   Port[$03F8+4]:=(Port[$03F8+4] and $0FE) or Aus;
  except
   showmessage('DTR_Fehler!');
  end;
 
end;
 
 
procedure TForm1.dtr_schalten(Sender: TObject);
begin
 try
  if dtr_flag = 0 then
   begin
    Port[$03F8+4]:=(Port[$03F8+4] and $0FE) or Ein;
    dtr_flag := 1;
   end else
   begin
    Port[$03F8+4]:=(Port[$03F8+4] and $0FE) or Aus;
    dtr_flag := 0;
   end;
  except
   showmessage('DTR_Fehler!');
  end;
end;
 
end.

Mathias
Beiträge: 6143
Registriert: Do 2. Jan 2014, 17:21
OS, Lazarus, FPC: Linux (die neusten Trunk)
CPU-Target: 64Bit
Wohnort: Schweiz

Re: COM direkt ansprechen, Ubuntu 32-Bit

Beitrag von Mathias »

Da es anscheinend klappt, habe ich einen kleinen Vermerk bei Ports hin-zugeschrieben.
Mit Lazarus sehe ich grün
Mit Java und C/C++ sehe ich rot

Timm Thaler
Beiträge: 1224
Registriert: So 20. Mär 2016, 22:14
OS, Lazarus, FPC: Win7-64bit Laz1.9.0 FPC3.1.1 für Win, RPi, AVR embedded
CPU-Target: Raspberry Pi 3

Re: COM direkt ansprechen, Ubuntu 32-Bit

Beitrag von Timm Thaler »

Ich nehme mal an, das funktioniert nur mit echten On-Board-Uarts und nicht mit USB-RS232-Wandlern, oder?

Andere Frage: Warum?

Alle Handshake-Signale kann ich doch auch mit der serial.pp bedienen, das heisst Pinwackeln geht auch damit. Welchen Einsatzzweck deckt man damit ab, den die serial.pp nicht kann?

Mathias
Beiträge: 6143
Registriert: Do 2. Jan 2014, 17:21
OS, Lazarus, FPC: Linux (die neusten Trunk)
CPU-Target: 64Bit
Wohnort: Schweiz

Re: COM direkt ansprechen, Ubuntu 32-Bit

Beitrag von Mathias »

Ich nehme mal an, das funktioniert nur mit echten On-Board-Uarts und nicht mit USB-RS232-Wandlern, oder?

Dies kann das definitiv nicht, ausser USB-COM-Port hat irgend ein Port-Wapper oder etwas ähnliches.
Wen ich meinen Arduino welcher an /dev/ttyUSB0 hangt, und den in der Virtual-Box weiterleite, dann habe ich dort einen Port bei $3F8.
Aber VB emuliert ja ein ganzer PC.

Alle Handshake-Signale kann ich doch auch mit der serial.pp bedienen,

Das stimmt schon, wen ich mich zurück erinnern mag, gab es früher CNC-Maschinen, welche eine Serielle Scnittstelle hatten, welche aber nicht voll RS232/V24 kompatibel waren.
Da musste man ein gebastel mit den Port $3F8, etc. machen.
Mit Lazarus sehe ich grün
Mit Java und C/C++ sehe ich rot

wennerer
Beiträge: 505
Registriert: Di 19. Mai 2015, 20:05
OS, Lazarus, FPC: Linux Mint 20 Cinnamon,Lazarus 2.2.6 (rev lazarus_2_2_6) FPC 3.2.2 x86_64-linux-
CPU-Target: x86_64-linux-gtk2

Re: COM direkt ansprechen, Ubuntu 32-Bit

Beitrag von wennerer »

Hallo Timm Thaler,
ich hab noch einen echten Seriellen Anschluss und habs noch nie mit einem USB/Seriell Wandler probiert.
Mit der Unit serial hab ich auch rum probiert, geht auch sehr schön, aber es lassen sich nur zwei Ausgänge schalten (DTR,RTS - TXD fehlt) und drei Eingänge abfragen (DSR,CTS,RI - DCD fehlt). Zu mindest hab ich es nicht Anders hin bekommen. Wenn du nun zum Beispiel zwei Analog/Digital Wandler ansteuern möchstest brauchst du die drei Ausgänge. Ist natürlich alles nur Hobby und Spielerei (und ginge auch ganz anders), macht aber Spass!

Viele Grüße
Bernd

Mathias
Beiträge: 6143
Registriert: Do 2. Jan 2014, 17:21
OS, Lazarus, FPC: Linux (die neusten Trunk)
CPU-Target: 64Bit
Wohnort: Schweiz

Re: COM direkt ansprechen, Ubuntu 32-Bit

Beitrag von Mathias »

Hast du die Unit synaser auch schon probiert ?
Dies kann einiges mehr als serial.
Aber sie ist leider in einer Pakage, die man nachinstallieren muss.
Mit Lazarus sehe ich grün
Mit Java und C/C++ sehe ich rot

wennerer
Beiträge: 505
Registriert: Di 19. Mai 2015, 20:05
OS, Lazarus, FPC: Linux Mint 20 Cinnamon,Lazarus 2.2.6 (rev lazarus_2_2_6) FPC 3.2.2 x86_64-linux-
CPU-Target: x86_64-linux-gtk2

Re: COM direkt ansprechen, Ubuntu 32-Bit

Beitrag von wennerer »

Hallo Mathias,
hab schon einiges hier im Forum gelesen, leider aber noch nichts selber damit gemacht.

Gruß
Bernd

NoCee
Beiträge: 167
Registriert: Do 3. Mär 2011, 21:34
OS, Lazarus, FPC: WinXp/7/10 Opensuse13.2/Leap15.3 (L 2.2.0 FPC 3.2.2 )
CPU-Target: Intel 32/64Bit, ARM9
Wohnort: Ulm

Re: COM direkt ansprechen, Ubuntu 32-Bit

Beitrag von NoCee »

Hallo,
Synaser ist ein Teil vom Pakage Synapse.
Synapse muß man als Pakage integrieren, Synaser muß nicht installiert werden.
Das muß nur in uses eingetragen werden.

Ich hab synaser schon oft genutzt. Mit Win, Linux und Linux on Arm9
mit echten coms und usb-coms.
Da hab ich bisher alles so hinbekommen wie ich das gebraucht habe.
Mit Steuerpins hab ich allerdings auch noch nichts gemacht.

Einzig mit Verwendung von mehreren coms gleichzeitig hatte ich dann das Problem,
das das Schnittstellenauslesen blockierend ist. Das hat dann anfänglich ordentlich
Schwierigkeiten bereitet. Ich durfte dann schnell mal Threadprogrammierung lernen
und seit ich jeder Schnittstelle einen eigenen Thread spendiere läuft alles wie es soll.

Gruß
NoCee

Mathias
Beiträge: 6143
Registriert: Do 2. Jan 2014, 17:21
OS, Lazarus, FPC: Linux (die neusten Trunk)
CPU-Target: 64Bit
Wohnort: Schweiz

Re: COM direkt ansprechen, Ubuntu 32-Bit

Beitrag von Mathias »

Was ich noch sagen muss, der grösste Vorteil von synaser gegenüber serial, synaser hat eine gute Timeout-Behandlung. Somit ist eine effizientere Datenübertragung möglich. Serial macht nicht anderes als ein einfaches Read und Write.
Mit Lazarus sehe ich grün
Mit Java und C/C++ sehe ich rot

Antworten