unit RSCOM;

{$MODE Delphi}

{B.Kainka 2001, erweitert 2008 für COM10...COM99}

interface
uses LCLIntf, LCLType, LMessages, SysUtils, Windows;
var  PortHandle: THandle;

function OPENCOM (OpenString: Pchar): Integer; stdcall;
procedure TIMEOUTS (TOut: Integer);
Procedure BUFFERSIZE (Size: Integer);
procedure CLOSECOM();
procedure SENDBYTE (Dat: Integer);
function READBYTE (): Integer;
procedure SENDSTRING (Buffer: Pchar);
function READSTRING (): Pchar;
procedure CLEARBUFFER ();
function INBUFFER (): DWORD;
function OUTBUFFER (): DWORD;
procedure DTR(State:integer);
procedure RTS(State:integer);
procedure TXD(State:integer);
function CTS():Integer;
function DSR():Integer;
function RI():Integer;
function DCD():Integer;
function INPUTS():Integer;
procedure TIMEINIT();
function TIMEREAD(): Real;
procedure DELAY(DelayTime: Real);
procedure REALTIME();
procedure NORMALTIME();

implementation

var  StartTime: Int64;
     TimeUnit: Real = 0.000838;


function OPENCOM (OpenString: pchar): Integer;
var S, OpenStr, PortStr, Parameter :String;
    DCB: TDCB;
begin
   Result := 0;
   if PortHandle > 0 then FileClose(PortHandle); { *Konvertiert von CloseHandle* }
   OpenStr := OpenString;
   S := copy (OpenStr,5,1);
   if S=':' then begin        //COM1:
      PortStr := copy (OpenStr,1,4);
      Parameter:= copy (OpenStr,6,Length(OpenStr)-6);
   end;
   S := copy (OpenStr,6,1);
   if S=':' then begin        //COM10:
      PortStr := copy (OpenStr,1,5);
      PortStr := '\\.\' + PortStr;
      Parameter:= copy (OpenStr,7,Length(OpenStr)-7);
   end;
   S := copy (OpenStr,7,1);
   if S=':' then begin         //COM100:
      PortStr := copy (OpenStr,1,6);
      PortStr := '\\.\' + PortStr;
      Parameter:= copy (OpenStr,8,Length(OpenStr)-8);
   end;
   PortHandle:=CreateFile(PChar(PortStr),GENERIC_READ or GENERIC_WRITE,0,NIL,OPEN_EXISTING,0,0);
   GetCommState(PortHandle,DCB);
   BuildCommDCB(PChar(Parameter),dcb);
   DCB.Flags := 1;
   if SetCommState(PortHandle,DCB)then Result := 1;
   TimeOuts (300);
end;


procedure TIMEOUTS (TOut: Integer);
var TimeOut:TCOMMTIMEOUTS;
begin
   TimeOut.ReadIntervalTimeout:=1;
   TimeOut.ReadTotalTimeoutMultiplier:=1;
   TimeOut.ReadTotalTimeoutConstant:=TOut;
   TimeOut.WriteTotalTimeoutMultiplier:=10;
   TimeOut.WriteTotalTimeoutConstant:=TOut;
   SetCommTimeouts(PortHandle,TimeOut);
end;

Procedure BUFFERSIZE (Size: Integer);
begin
   SetupComm(PortHandle,Size,Size);
end;


procedure CLOSECOM();
begin
    FileClose(PortHandle); { *Konvertiert von CloseHandle* }
    PortHandle:= 0;
end;

procedure SENDBYTE (Dat: Integer);
var BytesWritten: DWord;
begin
 WriteFile(PortHandle,Dat,1,BytesWritten,NIL);
END;

function READBYTE(): Integer;
var Dat: Byte;
    BytesRead: DWORD;
begin
 ReadFile(PortHandle,Dat,1,BytesRead,NIL);
 if BytesRead = 1 then Result:=Dat else Result := -1;
end;

procedure SENDSTRING (Buffer: Pchar);
var BytesWritten: DWord;
begin
  WriteFile(PortHandle,Buffer^,Length(Buffer),BytesWritten,NIL);
END;

function READSTRING(): Pchar;
var Dat: Integer;
    Data: STRING;
begin
  Dat := 0;
  while ((Dat > -1) and (Dat <> 13)) do begin
    Dat := ReadByte();
    if ((Dat > -1) and (Dat <> 13)) then Data := Data + Chr(Dat);
  end;
  READSTRING := pchar(Data);
end;

procedure CLEARBUFFER ();
begin
  PurgeComm(PortHandle,PURGE_TXCLEAR);
  PurgeComm(PortHandle,PURGE_RXCLEAR);
end;

function INBUFFER (): DWORD;
var Comstat: _Comstat;
    Errors: DWORD;
begin
  if ClearCommError (PortHandle, Errors, @Comstat) then
  INBUFFER := Comstat.cbInQue else INBUFFER := 0;
end;

function OUTBUFFER (): DWORD;
var Comstat: _Comstat;
    Errors: DWORD;
begin
  if ClearCommError (PortHandle, Errors, @Comstat) then
  OUTBUFFER := Comstat.cbOutQue else OUTBUFFER := 0;
end;

procedure DTR(State:integer);
begin
 if (State=0) then EscapeCommFunction(PortHandle,CLRDTR)
 else EscapeCommFunction(PortHandle,SETDTR);
end;

procedure RTS(State:integer);
begin
 if (State=0) then EscapeCommFunction(PortHandle,CLRRTS)
 else EscapeCommFunction(PortHandle,SETRTS);
end;

procedure TXD(State:integer);
begin
 if (State=0) then EscapeCommFunction(PortHandle,CLRBREAK)
 else EscapeCommFunction(PortHandle,SETBREAK);
end;

function CTS():Integer;
Var mask:Dword;
begin
     GetCommModemStatus(PortHandle,mask);
     if (mask and MS_CTS_ON)=0 then result:=0 else result:=1;
end;

function DSR():Integer;
Var mask:Dword;
begin
     GetCommModemStatus(PortHandle,mask);
     if (mask and MS_DSR_ON)=0 then result:=0 else result:=1;
end;

function RI():Integer;
Var mask:Dword;
begin
     GetCommModemStatus(PortHandle,mask);
     if (mask and MS_RING_ON)=0 then result:=0 else result:=1;
end;

function DCD():Integer;
Var mask:Dword;
begin
     GetCommModemStatus(PortHandle,mask);
     if (mask and MS_RLSD_ON)=0 then result:=0 else result:=1;
end;

function INPUTS():Integer;
Var mask:Dword;
begin
     GetCommModemStatus(PortHandle,mask);
     INPUTS := (mask div 16) and 15;
end;

procedure TIMEINIT();
var f: Int64;
begin
  QueryPerformanceFrequency(f);
  TimeUnit := 1000 / f;
  QueryPerformanceCounter(StartTime)
end;

function TIMEREAD(): Real;
var t: Int64;
begin
  QueryPerformanceCounter(t);
  TIMEREAD := TimeUnit*(t - StartTime) ;
end;

procedure DELAY(DelayTime: Real);
var TimeStart: real;
begin
  TimeStart := TIMEREAD;
  while TIMEREAD < (TimeStart + DelayTime) do;
end;

procedure REALTIME();
begin
 SetPriorityClass (GetCurrentProcess(), REALTIME_PRIORITY_CLASS);
end;

procedure NORMALTIME();
begin
  SetPriorityClass (GetCurrentProcess(), NORMAL_PRIORITY_CLASS);
end;

begin
end.

