Delphi serial programming, including set DTR, RTS and get status of DSR, CTS, CD

var

    hCOM1: THandle;    //COM1 Handle

function OpenCOM(var HCOM:THandle; COMPort:string): Boolean;
var
    DeviceName: array[0..4] of Char;
begin
    StrPCopy(DeviceName, COMPort);

    HCOM := CreateFile(DeviceName,
    GENERIC_READ or GENERIC_WRITE,
    0,
    nil,
    OPEN_EXISTING,
    FILE_ATTRIBUTE_NORMAL,
    0);

     if HCOM = INVALID_HANDLE_VALUE then Result := False
      else
       Result := True;
end;

function SetupCOM(HCOM:THandle; BaudRate:Cardinal): Boolean;
const
    RxBufferSize = 256;
    TxBufferSize = 256;
var
    DCB: TDCB;

        CommTimeouts: TCommTimeouts;
    //Config: string;
begin
    Result := True;

    if not SetupComm(HCOM, RxBufferSize, TxBufferSize) then Result := False;

    if not GetCommState(HCOM, DCB) then Result := False;

    // define the baudrate, parity,...
        {Config := 'baud='+inttostr(BaudRate)+' parity=n data=8 stop=1';
         if not BuildCommDCB(@Config[1], DCB) then Result := False;}

     // or another way...

    DCB.BaudRate:=BaudRate;
    DCB.ByteSize:=8;
    DCB.StopBits:=OneStopBit;

    if not SetCommState(HCOM, DCB) then Result := False;

      with CommTimeouts do
      begin
       ReadIntervalTimeout := 0;
       ReadTotalTimeoutMultiplier := 0;
       ReadTotalTimeoutConstant := 1;
       WriteTotalTimeoutMultiplier := 0;
       WriteTotalTimeoutConstant := 1;
      end;

    if not SetCommTimeouts(HCOM, CommTimeouts) then Result := False;
end;

procedure TXCOM(HCOM:THandle; Data: byte);
var
    ByteToWrite, BytesWritten: DWORD;
    c:char;
begin
    //c:=chr(Data);
      asm
       mov al,Data
       mov c,al
      end;

    ByteToWrite:=1;
     repeat until WriteFile(HCOM, c, ByteToWrite, BytesWritten, nil);

end;

procedure RXCOM(HCOM:THandle; var Data:byte);
var
    d: char;
    ByteToRead, BytesRead: DWord;

    tmpData:byte;
begin
    ByteToRead:=1;
    ReadFile(HCOM, d, ByteToRead, BytesRead, nil);

      //tmpData := ord(d);
       asm
        mov al,d
        mov tmpData,al
       end;
      Data:=tmpData;
end;

procedure CloseCOM(HCOM:THandle);
begin
    CloseHandle(HCOM);
end;

function pinDSR(HCOM:THandle):boolean;
var
    md:DWord;
begin
    result:=false;
    GetCommModemStatus(HCOM,md);
     if (md and MS_DSR_ON)=MS_DSR_ON then result:=true;
end;

function pinCTS(HCOM:THandle):boolean;
var
    md:DWord;
begin
    result:=false;
    GetCommModemStatus(HCOM,md);
     if (md and MS_CTS_ON)=MS_CTS_ON then result:=true;
end;

function pinCD(HCOM:THandle):boolean;
var
    md:DWord;
begin
    result:=false;
    GetCommModemStatus(HCOM,md);
     if (md and MS_RLSD_ON)=MS_RLSD_ON then result:=true;
end;

procedure SetPinDTR(HCOM:THandle);
begin
    EscapeCommFunction(HCOM,SETDTR);
end;

procedure ClrPinDTR(HCOM:THandle);
begin
    EscapeCommFunction(HCOM,CLRDTR);
end;

procedure SetPinRTS(HCOM:THandle);
begin
    EscapeCommFunction(HCOM,SETRTS);
end;

procedure ClrPinRTS(HCOM:THandle);
begin
    EscapeCommFunction(HCOM,CLRRTS);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
    OpenCOM(hCom1,'COM1');
    SetupCOM(hCom1,115200);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
    DPort:byte;
begin
    TXCOM(hCom1,$80);      //Example Data To Send =$80
    sleep(1);
    RXCOM(hCom1,DPort);    //LoopBack Plug TX(pin3) --> RX(pin2)
    label1.Caption:=inttohex(DPort,2);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
    CloseCOM(hCom1);
end;