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.
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.