(*
21 january 1997

Jan Taralczak
jtaralcz@iiic.ethz.ch


--------------------
RS232 (com_io) Guide (Freeware)
--------------------

This is a self explaning example how to handle serial communication in Delphi.
Actually I'm not a Delphi developer, but few days ago a friend of mine showed
me the GUI-features and I decided to write a GUI-interface in Delphi for my
diploma (video device) because it is so easy to learn and has good online
documentation. Very surprised I discovered that there was no comfortable
RS-Interface and I couldn't find anywhere a good exaple of robust and safe
simple unit for data transfer, so one day after work I spent few hours to check
windows.pas and wrote com_io. It makes possible to transfer data in a loop
with put & get or install an interactive receiver.

I know the com_io unit is only a subset of RS-232 capabilities (I'm very very
busy because of my diploma !!!):
this version has attributes permanently set to 8N1 (see set_com) and should be
taken as an example for Your own imlementation.

If You would like com_io to act interactively just use Delphi-Timer (from the
standard group) for the receiver task; set the timing fast, set the period
to e.g. 800 ms and write few statements like this:

var
	term_buf: string;

procedure term_wr(s: string);
begin
	fmMain.Memo1.Lines.Add(s);
end;

procedure TfmMain.ComRcvTimer(Sender: TObject);
 {adds a line to memo from term_buf when CR
  or more than 80 char in a line}
var
	a: array[1..64] of byte;
	i,len: integer;

	procedure term_print;
	begin
		term_wr(term_buf);
		term_buf := '';
	end;

	procedure term_put(s: string);
	begin
		term_buf := term_buf + s;
    if Length(term_buf)>=80 then term_print;
  end;

begin
	len:=64;
	geta(a, len);
	if Length(term_buf)>=80 then term_print;
  for I:= 1 to len do begin
		case a[i] of
    	13: term_print;
			32..126: term_put(chr(a[i]));
			else term_put(hex(a[i]));
    end;
  end;
end;


Of course You can disable the receiver to handle sequential transfers assigning

ComRcvTimer.Enable:=false;
set_slow_timing;

and start a file transfer routine in full duplex mode:

for i:=..... do
	puta(...);
	geta(....);
	if a1<>a2 then ...
end;

and then activate the receiver task...

set_fast_timing;
ComRcvTimer.Enable:=false;


I'm still wondering how silly are the people selling such kind of interfaces,
and even do not release code after payement of the licence and leave no chance
to correct mistakes made in the coded units. I don't want to give an example
of such poor quality and good product cover, but If You had experience with
TCOMM32 and You're angry about lost characters or even 'produced' characters
do not worry: take advantage of this source and do it better! :-)))


This is freeware: if You feel it was helpful please send me mail like this:

'Dear Jan, many thanx. I'm developing a ..... program for my uncle's birthday
 instead of buying an -u#@^/g expencive aftershave . Good Luck for Your diploma!
 I send a lot of greetings... Why are You working in Switzerland? You should
 come and visit our NASA labs, and have look at our new satellite project.
 best regards, love, Susan' :-))))))

Or let me know something that I did not find out on this long evening.


cu, Jan

*)




unit com_io;

interface

uses SysUtils;

const
	ti_fast=1; (* 0.001 s*)
	ti_slow=500; (* 0.5 s*)


type
	Tcom=(com1,com2);
	Tbaud=(_9k6,_19k2,_38k4);
  ExCom= class(exception);




procedure open_com(port: Tcom);
procedure set_com(rate: Tbaud);
procedure set_fast_timing;
procedure set_slow_timing;
procedure set_buf(len_in, len_out: longint);

procedure putb(b: byte; var ok: boolean);
procedure getb(var b: byte; var ok: boolean);

procedure putb_ex(b: byte);
procedure getb_ex(var b: byte);

procedure puta(a: array of byte; var len: integer);
procedure geta(var a: array of byte; var len: integer);

procedure close_com;



implementation

uses windows;

const
  cbr: array [Tbaud] of DWORD  =(CBR_9600,CBR_19200,CBR_38400);
	cport: array [Tcom] of string =('COM1','COM2');


var

	is_open: boolean = false;
	com: Thandle;
	DCB: TDCB;
	timeouts: TCommTimeouts;




procedure open_com(port: Tcom);
begin
	if is_open then closeHandle(com);
  com := CreateFile(PChar(cport[port]), GENERIC_READ or GENERIC_WRITE,
  0, nil, OPEN_EXISTING,
  FILE_ATTRIBUTE_NORMAL, 0);
	if com>0 then is_open:=true else raise Excom.Create('open_com');
end;

procedure set_buf(len_in, len_out: longint);
begin
	if not SetupComm(com, len_in, len_out) then raise Excom.Create('set_buf');
end;


procedure set_com(rate: Tbaud);
(* press Ctrl-F1 on following keyword: SetComState *)
begin
	DCB.DCBlength:=SizeOf(Tdcb);
  DCB.BaudRate:= cbr[rate];
  DCB.Flags:=12305;
  DCB.wReserved:=0;
  DCB.XonLim:=6553;
  DCB.XoffLim:=65535;
  DCB.ByteSize:=8;
  DCB.Parity:=0;
  DCB.StopBits:=0;
  DCB.XonChar:=#17;
  DCB.XoffChar:=#19;
  DCB.ErrorChar:=#0;
  DCB.EofChar:=#0;
  DCB.EvtChar:=#0;
  DCB.wReserved1:=65;
  if not SetCommState(com, DCB) then raise Excom.Create('set_com');
end;

procedure set_fast_timing;
(* press Ctrl-F1 on following keyword: commtimeouts *)
(* I had problems with MAXWORD, 0, 0 configuration  *)
begin
	timeouts.ReadIntervalTimeout:=1;
  timeouts.ReadTotalTimeoutMultiplier:=0;
  timeouts.ReadTotalTimeoutConstant:=1;
  timeouts.WriteTotalTimeoutMultiplier:=2;
  timeouts.WriteTotalTimeoutConstant:=2;
  if not SetCommTimeouts(com,timeouts) then raise Excom.Create('set_timeout');
end;

procedure set_slow_timing;
begin
	timeouts.ReadIntervalTimeout:=2;
  timeouts.ReadTotalTimeoutMultiplier:=10;
  timeouts.ReadTotalTimeoutConstant:=500;
  timeouts.WriteTotalTimeoutMultiplier:=2;
  timeouts.WriteTotalTimeoutConstant:=2;
  if not SetCommTimeouts(com,timeouts) then raise Excom.Create('set_timeout');
end;

procedure putb(b: byte; var ok: boolean);
var	res: integer;
begin
	WriteFile(com, b, 1, res, nil);
	ok:=(res=1);
end;

procedure getb(var b: byte; var ok: boolean);
var res: integer;
begin
	ReadFile(com, b, 1, res, nil);
	ok:=(res=1);
end;

procedure putb_ex(b: byte);
var	res: integer;
begin
	WriteFile(com, b, 1, res, nil);
	if (res<>1) then raise ExCom.Create('put byte');
end;

procedure getb_ex(var b: byte);
var res: integer;
begin
	ReadFile(com, b, 1, res, nil);
	if (res<>1) then raise ExCom.Create('get byte');
end;

procedure puta(a: array of byte; var len: integer);
var res: integer;
begin
	WriteFile(com, a, len, res, nil);
	len:=res;
	(* before call puta: len=bytes-to-put
	   after  call puta: len=bytes-transmitted *)
end;

procedure geta(var a: array of byte; var len: integer);
var res: integer;
begin
	ReadFile(com, a, len, res, nil);
	len:=res;
	(* after  call geta: len=bytes-received *)
end;


procedure close_com;
begin
	if not is_open then CloseHandle(com);
	is_open:=false;
end;

end.