(* 21 january 1997Jan Taralczak [email protected] -------------------- 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 assigningComRcvTimer.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;interfaceuses 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;implementationuses 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.
21 january 1997Jan Taralczak
[email protected]
--------------------
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 assigningComRcvTimer.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;interfaceuses 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;implementationuses 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.
http://vcl.vclxx.org/DELPHI/D32FREE/COMDRV32.ZIP
这个也行。。