Alle wichtigen Prozeduren und Funktionen zur seriellen Schnittstelle existieren nun in zwei Formen, als Unit und als DLL. Bei jedem neuen Projekt hat man die Wahl, die DLL einzusetzen oder nicht. Der eigentliche Vorteil der DLL ist, dass sie nur einmal auf der Festplatte vorhanden zu sein braucht. Trotzdem können zwei Instanzen der DLL geladen werden und mit verschiedenen Schnittstellen arbeiten.
Alle DLL-Funktionen werden hier in einer eigenen Unit "RSDLLdec.DCU' deklariert. Ein neues Projekt kann dann wahlweise unter "Uses" die Unit RSCOM eintragen oder mit RSDLLdec die DLL verwenden. Alle Funktionen sind gleich. Das erleichtert auch spätere Übergänge zwischen Delphi- und Visual-Basic-Projekten.
unit RSCOMdec;
interface
uses windows;
Function OPENCOM(OpenString:PChar):Integer;stdcall; external 'RSCOM.DLL';
Procedure TIMEOUTS (TOut: Integer); stdcall; external 'RSCOM.DLL';
Procedure BUFFERSIZE (Size: Integer); stdcall; external 'RSCOM.DLL';
Procedure CLOSECOM(); stdcall; external 'RSCOM.DLL';
Procedure SENDBYTE (Dat: Integer); stdcall; external 'RSCOM.DLL';
Function READBYTE (): Integer; stdcall; external 'RSCOM.DLL';
Procedure SENDSTRING (Buffer: PChar); stdcall; external 'RSCOM.DLL';
Function READSTRING (): PChar; stdcall; external 'RSCOM.DLL';
Procedure CLEARBUFFER (); stdcall; external 'RSCOM.DLL';
Function INBUFFER (): DWORD; stdcall; external 'RSCOM.DLL';
Function OUTBUFFER (): DWORD; stdcall; external 'RSCOM.DLL';
Procedure DTR(d:WORD); stdcall; external 'RSCOM.DLL';
Procedure RTS(d:WORD); stdcall; external 'RSCOM.DLL';
Procedure TXD(d:WORD); stdcall; external 'RSCOM.DLL';
Function CTS:Integer; stdcall; external 'RSCOM.DLL';
Function DSR:Integer; stdcall; external 'RSCOM.DLL';
Function RI:Integer; stdcall; external 'RSCOM.DLL';
Function DCD:Integer; stdcall; external 'RSCOM.DLL';
function INPUTS():Integer; stdcall; external 'RSCOM.DLL';
procedure TIMEINIT(); stdcall; external 'RSCOM.DLL';
function TIMEREAD(): Real; stdcall; external 'RSCOM.DLL';
procedure DELAY(DelayTime: Real); stdcall; external 'RSCOM.DLL';
procedure REALTIME(); stdcall; external 'RSCOM.DLL';
procedure NORMALTIME(); stdcall; external 'RSCOM.DLL';
implementation
end.
Listing 3.10 Deklaration der DLL-Funktionen (RSCOMdec.pas)
Hier soll der Einsatz der DLL am Beispiel des bereits in Kap. 2 verwendeten Universal-Terminals vorgestellt werden. Der Anwender kann hier die einzelnen Schnitstellenparameter einzeln auswählen. Das Programm baut daraus einen Open-String auf und öffnet die Schnittstelle entsprechend. Der Text wird als PChar an die Funktion OpenCOM übergeben.
Das Programm verwendet vier Memo-Felder für Texteingaben und für die Ausgabe empfangener Zeichen. Es wird parallel mit Textdaten und binären Daten gearbeitet.
Abb. 3.5 Das Terminalprogramm zur Entwurfszeit ((TerminalDel.gif))
Serielle Ausgabe werden direkt durch Eingaben des Anwenders gesteuert. Alle empfangenen Daten ebenso wie die Zustände der seriellen Eingänge werden über eine Timerfunktion verarbeitet.
unit Terminal1;
interface
uses
RSCOMdec, Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ComCtrls, ExtCtrls;
type
TForm1 = class(TForm)
ComSel: TComboBox;
BaudSel: TComboBox;
ParitySel: TComboBox;
BitsSel: TComboBox;
StopSel: TComboBox;
PufferSel: TComboBox;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Open: TButton;
Success: TLabel;
DTRsel: TCheckBox;
RTSsel: TCheckBox;
TXDsel: TCheckBox;
MemoBinOut: TMemo;
Timer1: TTimer;
MemoTextOut: TMemo;
Label8: TLabel;
Label9: TLabel;
Label10: TLabel;
Label11: TLabel;
MemoBinIn: TMemo;
MemoTextIn: TMemo;
Clear: TButton;
CTSin: TCheckBox;
DSRin: TCheckBox;
RIin: TCheckBox;
DCDin: TCheckBox;
Close: TButton;
procedure OpenClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure DTRselClick(Sender: TObject);
procedure Memo1OnkeyPress(Sender: TObject; var Key: Char);
procedure Timer1Timer(Sender: TObject);
procedure Memo3OnkeyPress(Sender: TObject; var Key: Char);
procedure ClearClick(Sender: TObject);
procedure RTSselClick(Sender: TObject);
procedure TXDselClick(Sender: TObject);
procedure CloseClick(Sender: TObject);
private
{ Private-Deklarationen}
public
{ Public-Deklarationen}
end;
var
Form1: TForm1;
COM,Tout,Buffer,Timeout:Integer;
ByteToSend: Integer;
LineBin: Integer = 0;
LineText: Integer = 0;
implementation
{$R *.DFM}
procedure TForm1.OpenClick(Sender: TObject);
Var Code: Integer;
Openstring: String;
Parity, Baud, Bits, Stop: String;
i: Integer;
begin
Val(COMSel.Text, Com, Code);
COM := COM And 7;
Baud := BaudSel.Text;
Parity := ParitySel.Text;
Bits := BitsSel.Text;
if StopSel.ItemIndex < 0 then StopSel.ItemIndex:= 0;
Stop := StopSel.Text;
Val(PufferSel.Text, Buffer, Code);
if Buffer < 1 then Buffer := 1;
If Buffer > 32535 then Buffer := 32535;
TimeOut := 2;
Openstring := 'COM'+IntToStr(COM)+':'+Baud+','+Parity+','
+Bits+','+Stop;
i:= OPENCOM (pchar (Openstring));
if i>0 then Success.Caption := 'COM'+InttoStr(COM)+' geöffnet'
else Success.Caption := 'COM Error';
If DTRsel.Checked then DTR (1);
If RTSsel.Checked then RTS (1);
If TXDsel.Checked then TXD (1);
Timeouts (Timeout);
Timer1.Enabled := true;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
COMSel.ItemIndex :=1;
COM := 2;
BaudSel.ItemIndex := 2;
ParitySel.ItemIndex :=0;
PufferSel.ItemIndex := 1;
ByteToSend := 0;
end;
procedure TForm1.DTRselClick(Sender: TObject);
begin
If DTRsel.Checked then DTR (1) else DTR (0);
end;
procedure TForm1.Memo1OnkeyPress(Sender: TObject; var Key: Char);
var Digit: Integer;
begin
Digit := Ord(Key)-48;
if Digit in [0..9] then begin
ByteToSend := ByteToSend * 10;
ByteToSend := ByteToSend + Digit;
end;
if Key = #13 then begin
If ByteToSend > 255 then ByteToSend := 255;
SendByte (ByteToSend);
ByteToSend := 0;
end;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var Dat: Integer;
begin
while INBUFFER > 0 do begin
Dat := ReadByte;
MemoBinIn.Lines[LineBin] := MemoBinIn.Lines[LineBin]
+ IntToStr(Dat)+ ' ';
if length (MemoBinIn.Lines[LineBin]) > 40 then begin
MemoBinIn.Lines.add ('');
LineBin := MemoBinIn.Lines.count;
end;
if Dat <> 10 then MemoTextIn.Lines[LineText] :=
MemoTextIn.Lines[LineText] + Chr(Dat);
if Dat = 13 then begin
MemoTextIn.Lines.add ('');
LineText := LineText +1
end;
if length (MemoTextIn.Lines[LineText]) > 25 then begin
MemoTextIn.Lines.add ('');
LineText := LineText +1
end;
end;
CTSin.Checked := (CTS = 1);
DSRin.Checked := (DSR = 1);
RIin.Checked := (RI = 1);
DCDin.Checked := (DCD = 1);
end;
procedure TForm1.Memo3OnkeyPress(Sender: TObject; var Key: Char);
begin
SendByte (Ord(Key));
end;
procedure TForm1.ClearClick(Sender: TObject);
begin
MemoBinIn.Text := '';
MemoBinOut.Text := '';
MemoTextIn.Text := '';
MemoTextOut.Text := '';
LineBin :=0;
LineText := 0;
end;
procedure TForm1.RTSselClick(Sender: TObject);
begin
If RTSsel.Checked then RTS (1) else RTS (0);
end;
procedure TForm1.TXDselClick(Sender: TObject);
begin
If TXDsel.Checked then TXD (1) else TXD (0);
end;
procedure TForm1.CloseClick(Sender: TObject);
begin
CloseCOM;
Success.Caption := 'geschlossen';
Timer1.Enabled := false;
end;
end.
Listing 3.11 Das Terminalprogramm (Terminal.dpr)
Download: Delphi-Beispiele
Download: Aktuelle Version der RSCOM.DLL und des Terminal. Exe: RSCOM