ask a switch on the serial port

Open the com port like this:

Fd := CreateFile('Com1',GENERIC_READ+GENERIC_WRITE,0,nil,OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL,0);

Check the status of the control lines like this:
if ( GetCommModemStatus(Fd,state) ) then

for the dsr pin:
  Result := (state and MS_DSR_ON)<>0;

or for the cts pin:
  Result := (state and MS_CTS_ON)<>0;

Regards
Paul

Paul, Which type is Fd?
Which ressources do i have to install to use the written variables?

Thanks for the info. I'll check it in the next days.By problems i'll contact you again.

Sure :)

Paul, i tested with the following code.
I can't see any reaction when i close the connector CTS - TxD.
Please correct this short program.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Shape1: TShape;
    Shape2: TShape;
    Shape3: TShape;
    Shape4: TShape;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label5: TLabel;
    Button2: TButton;
    Memo1: TMemo;
    Shape5: TShape;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var  Form1: TForm1;

implementation

{$R *.dfm}
 
var  Fd: integer;
     state: LongWord;
     i : Integer;

procedure TForm1.FormCreate(Sender: TObject);
begin
  i:=0;
  memo1.Clear;
  end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Close;
  end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  Fd := CreateFile  ('Com1',GENERIC_READ+GENERIC_WRITE,0,nil,OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL,0);
  for i:=1 to 1000 do begin
    Caption:=inttostr(i);
    if ( GetCommModemStatus(Fd,state) ) then
    case state of
      MS_CTS_ON   : memo1.Lines.add('1');
      MS_DSR_ON   : memo1.Lines.add('2');
      MS_RING_ON  : memo1.Lines.add('3');
      MS_RLSD_ON  : memo1.Lines.add('4')
      else     memo1.Lines.add('0');
      end;
    end;
  end;

end.

Try closing the connection between CTS and ground (pin 5 I think from memory) - not CTS and TxD

Thanks, i try it and inform you tomorrow. Great.

There is also a bit of a problem with the code - it won't work that way - I will post a working example...

I would be happy to get it.

To cause the CTS state to change you need to open/close the contact between CTS and RTS.

To cause the DSR state to change you need to open/close the contact between DSR and DTR.

The program sets both the DTR and the RTS pins to a high voltage. That way they can be used to pull the CTS and/or the DSR pins high - causing a state change.

CTS = pin 8
RTS = pin 7
DTR = pin 4
DSR = pin 6

unit main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  stopped: boolean;
  Fd: THandle;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  stopped := true;
  Button1.Caption := 'Start';
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  Stopped := true;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  state: DWORD;
  msg: string;
begin
  if ( not stopped ) then
  begin
    stopped := true;
    exit;
  end;

  Button1.Caption := 'Stop';
  try
    Fd := CreateFile('Com1',GENERIC_READ+GENERIC_WRITE,0,nil,OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL,0);

    state := SETDTR;
    if ( not EscapeCommFunction(Fd,state) ) then
      Raise Exception.Create('Could not set DTR ON, EscapeCommFunction failed');
    state := SETRTS;
    if ( not EscapeCommFunction(Fd,state) ) then
      Raise Exception.Create('Could not set RTS ON, EscapeCommFunction failed');

    try
      stopped := false;
      while ( not stopped ) do
      begin
        Sleep(100);
        if ( not GetCommModemStatus(Fd,state) ) then
          Raise Exception.Create('GetCommModemStatus failed');

        msg := 'CTS state is: ';
        if ( (state and MS_CTS_ON)<>0 ) then
          msg := msg+'ON'
        else
          msg := msg+'OFF';
        msg := msg+' DSR state is: ';
        if ( (state and MS_DSR_ON)<>0 ) then
          msg := msg+'ON'
        else
          msg := msg+'OFF';

        memo1.Lines.add(msg);
        Application.ProcessMessages;
      end;
    finally
      CloseHandle(Fd);
    end;
  finally
    Button1.Caption := 'Start';
  end;
end;

end.

Great, I test it tonight, Thanks very much. rgds. Thomas

Hi Zebada, unbelieveble, a perfect code. It works. The mainfailure was the contact i used before. Thanks very much.
How can i give you points?
rgds. Thomas