unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls;
const COMPORT = 1;
//Hier die Schnittstelle einstellen 1 = COM1, 2 = COM2 usw.
type
TForm1 =
class(TForm)
Button1: TButton;
Timer1: TTimer;
Timer2: TTimer;
procedure Timer1Timer(Sender: TObject);
procedure Timer2Timer(Sender: TObject);
private
{ Private declarations }
procedure DoImpuls(TimeInterval:Real);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
//Die folgenden Funktionen zum Zugriff auf Serielle Schnittstellen sind aus einem Tutorial übernommer
//guckst Du hier !!
//http://www.delphi-forum.de/topic_Serielle+Schnittstelle+ansprechen+und+pollen_36037.html&sid=4edb82047a1e1abd741c14a776ca55ba
var
PortTimeout : _COMMTIMEOUTS;
PortHandle : Integer;
PortDCB : TDCB;
PortNr : Integer;
PortState : Cardinal;
WriteOverlapped,ReadOverlapped,StatusOs: TOverlapped;
procedure InitOverlapped(
var Overlapped : TOverlapped);
begin
Overlapped.Offset := 0;
Overlapped.OffsetHigh := 0;
Overlapped.Internal := 0;
Overlapped.InternalHigh := 0;
Overlapped.hEvent := CreateEvent(
nil,True,False,'
');
end;
function OpenCOM(Port: byte): boolean;
stdcall;
begin
PortHandle :=
CreateFile(PChar('
\\.\COM'+IntToStr(Port)),GENERIC_READ
or GENERIC_WRITE,0,
nil,OPEN_EXISTING,FILE_FLAG_OVERLAPPED,LongInt(0));
//Overlapped = Asynchron auf Microsoftianisch
{Da wir nun asynchron auf die Schnittstelle zugreifen (weiss der Teufel
warum – aber es sieht so aus als wäre diese Art des Zugriffs ab W2K
praktisch ZWINGEND notwendig – selbst wenn man gar nicht asynchron übertragen will)
muss man auch die dafür notwendigen Structs initialisieren}
if PortHandle > 0
then
begin
Result := true;
InitOverlapped(WriteOverlapped);
InitOverlapped(ReadOverlapped);
InitOverlapped(StatusOs);
end else Result := false;
end;
procedure CloseCOM;
stdcall;
begin
PurgeComm(PortHandle, PURGE_RXABORT
or PURGE_RXCLEAR
or PURGE_TXABORT
or PURGE_TXCLEAR);
SetCommMask(PortHandle,0);
//unterbricht WaitCommEvent im Polling thread
CloseHandle(PortHandle);
PortHandle := 0;
end;
function ComAvailable(ComNr: byte): boolean;
stdcall;
var
TestHandle : integer;
begin
TestHandle :=
CreateFile(PChar('
\\.\COM'+IntToStr(ComNr)),GENERIC_READ
or GENERIC_WRITE,0,
nil,OPEN_EXISTING,FILE_FLAG_OVERLAPPED,LongInt(0));
if (TestHandle <= 0)
then
Result := false
else
begin
Result := true;
CloseHandle(TestHandle);
end;
end;
procedure SetDTR;
stdcall;
begin
if (PortHandle <> 0)
then EscapeCommFunction(PortHandle,5);
end;
procedure ClearDTR;
stdcall;
begin
if (PortHandle <> 0)
then EscapeCommFunction(PortHandle,CLRDTR);
end;
//Und hier dann der Code für die Steuerung
//öffnet die COM-Schnittstelle(Wenn vohanden) und setzt DTR auf HIGH
procedure TForm1.DoImpuls (TimeInterval:Real);
begin
if ComAvailable(COMPORT)
then
begin
OPENCOM(COMPORT);
//Schnittstelle öffnen !
SETDTR;
//DTR setzen
Timer2.Interval := Round(TimeInterval * 1000);
//Timer auf die gewünschte Zeit setzen
Timer2.enabled := True;
//Timer enablen
end else showmessage('
COMPORT ' + IntToStr(COMPORT) + '
nicht vorhanden oder in Benutzung !');
end;
//Wird jede Minute einmal gestartet und prüft ob die gewünschte Zeit erreicht ist.
//Wenn erreicht ruft er die function doimpuls auf
procedure TForm1.Timer1Timer(Sender: TObject);
begin
//wenn 08:00: in der jetzigen Uhrzeit vorkommt, dann setzte DTR für 0,4 Sekunden
if pos('
08:00:',TimeTostr(now)) <> 0
then DoImpuls(0.4);
if pos('
09:00:',TimeTostr(now)) <> 0
then DoImpuls(1.0);
if pos('
10:00:',TimeTostr(now)) <> 0
then DoImpuls(1.0);
if pos('
11:00:',TimeTostr(now)) <> 0
then DoImpuls(1.0);
if pos('
12:00:',TimeTostr(now)) <> 0
then DoImpuls(1.0);
if pos('
13:00:',TimeTostr(now)) <> 0
then DoImpuls(1.0);
if pos('
14:00:',TimeTostr(now)) <> 0
then DoImpuls(1.0);
if pos('
21:00:',TimeTostr(now)) <> 0
then DoImpuls(0.4);
end;
//Lösche DTR nach angegebener Zeitspanne und gebe Schnittstelle wieder frei
procedure TForm1.Timer2Timer(Sender: TObject);
begin
ClearDTR;
//Nach angegebener Zeit DTR wieder auf low
CLOSECOM;
//Schnittstelle wieder freigeben
Timer2.enabled := False;
//Timer wieder disablen
end;
end.