Delphi: RS-232, serial comms, COM1, COM2

This has good information, and a search button at the bottom of the page

Please don't dismiss it because it isn't full of graphics, scripts, cookies, etc!

program Demo3RS232;
var bTmp,bFrmRS232:byte;

begin {main}
write(LCD,255); {clears LCD}
repeat
if RS232_New_Byte then begin
  read(RS232,bFrmRS232);
  write(LCD,bFrmRS232);
 end;
until 4=5;
end.

unit DD28;

interface

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

type
  TDD28F1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure SendChar(sToSend:string);(***** 1 *)
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  DD28F1: TDD28F1;
  NumberWritten:dword;           (***** 2 *)
  sPhraseToSend,CommPort:string; (***** 3 *)
  hCommFile:THandle;             (***** 3 *)
  c1:byte;                       (***** 3 *)

implementation

{$R *.DFM}

procedure TDD28F1.SendChar(sToSend:string);
begin
CommPort := 'COM1';                      (***** 4 start *)
hCommFile := CreateFile(PChar(CommPort),
                          GENERIC_WRITE,
                          0,
                          nil,
                          OPEN_EXISTING,
                          FILE_ATTRIBUTE_NORMAL,
                          0);
WriteFile(hCommFile,
            PChar(sToSend)^,
            Length(sToSend),
            NumberWritten,
            nil);                        (***** 4 end *)
CloseHandle(hCommFile);                  (***** 5 *)
end;

procedure TDD28F1.Button1Click(Sender: TObject);
begin
sPhraseToSend:='Testing 1 2 3';           (***** 6 start *)
for c1:=1 to length(sPhraseToSend) do begin
  SendChar(copy(sPhraseToSend,c1,1));
  application.processmessages;            (***** 6 end *)
  sleep(10);                              (***** 7 *)
  end;
end;

end.

program Demo3RS232;
var bTmp,bFrmRS232:byte;

begin {main}
repeat
bFrmRS232:=255;
if RS232_New_Byte then begin
  read(RS232,bFrmRS232);
  end;
if bFrmRS232<255 then begin
   {delay(200); see below}
   if bFrmRS232=102 {102 is code for "f"}
      then write(RS232,'I saw an f') {no ; here}
      else write(RS232,'I saw something other than f');
end;{not 255}
until 4=5;
end.

unit DD29u1;

(*DOESN'T WORK... but NEARLY does.... I think!*)

(*Yes! I know this could be more elegant! Furthermore, it is "badly written"
in a number of respects. In particular, it is not very robust and fails to
incorporate sundry available error detection and handling provisions of
Windows. Improve it... without obscuring the basic things it is trying to
illustrate... and send me the improved version!!*)

interface

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

type
  TDD29F1 = class(TForm)
    buSendf: TButton;
    buSendx: TButton;
    Label1: TLabel;
    Label2: TLabel;
    procedure buSendfClick(Sender: TObject);
    procedure buSendxClick(Sender: TObject);
    procedure SendChar(sToSend:string);
    procedure EstablishHandle;
    function ReadStringFrmRS232:string;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  DD29F1: TDD29F1;
  sPhraseToSend:string;
  hCommFile:THandle;
  c1:byte;

const ver='18 Apr 03';
CommPort = 'COM1';

implementation

{$R *.DFM}

function TDD29F1.ReadStringFrmRS232:string;
(*hCommFile must be valid before this is called*)
var sTmp:string;
    c1:integer;
    chBuffer:array[0..255] of char;
    NumberOfBytesRead : dword;

begin
if hCommFile=INVALID_HANDLE_VALUE then exit;

if not ReadFile (hCommFile, chBuffer, sizeof(chBuffer),
              NumberOfBytesRead, Nil) then
               showmessage('Problem with ReadStringFrmRS232')
               { Better: Raise an exception } ; { <- semicolon IS needed here!}

{The program will go off and watch the RS-232 data source
 for incoming data. It will continue to watch (and collect
 data as it appears) for a time determined by the CommTimeouts
 settings... thus you dont need to know in advance how many
 bytes will be coming, nor does the connected device need
 to send a flag marking the last byte.... though that
 protocol could be incorporated on top of the other
 provisions for signalling the end of the data.}

label2.caption:='Bytes seen: '+inttostr(NumberOfBytesRead - 1);
for c1:= 0 to NumberOfBytesRead - 1 do
      sTmp:= sTmp+chBuffer[c1];

result:=sTmp;
end;

procedure TDD29F1.SendChar(sToSend:string);
(*hCommFile must be valid before this is called*)
var NumberWritten:dword;
begin
if hCommFile = INVALID_HANDLE_VALUE then
        showmessage('Problem with SendChar')
        {Better: raise an exception } ; (* <- semi colon IS needed here*)
WriteFile(hCommFile,
            PChar(sToSend)^,
            Length(sToSend),
            NumberWritten,
            nil);
end;

procedure TDD29F1.EstablishHandle;
var CommTimeouts : TCommTimeouts;
begin
hCommFile := CreateFile(PChar(CommPort),
                          GENERIC_READ or GENERIC_WRITE,
                          0,
                          nil,
                          OPEN_EXISTING,
                          FILE_ATTRIBUTE_NORMAL,
                          0); {Delphi 2 helpfile said use "NULL" here,
                                and program compiled, but raised error when
                                it was run. Two references said use 0}
{Ever been frustrated by something that would not work when it
"should"? I spent about an hour tinkering with this program
with "generic_write or generic_write" (WRITE twice instead of
one read, one write) in the parameters above.....
ARGHH!!, as Snoopy would say.}
with CommTimeouts do
begin
  {put cursor on 'CommTimeouts', press f1 to learn
  about what the following specify. The numbers here
  are crude, and need consideration.... though they
  MAY work for yoyu in your situation! The 'right'
  numbers depend on many things, including the settings
  in the device you are communicating with. If the
  numbers are too small, the Delphi program will not
  "see" the attached device. If they are too large,
  the program will appear to hang while communicating....
  If too large, they may also interfere with Windows'
  proper functioning.... but may not.}
  ReadIntervalTimeout := 0;
  ReadTotalTimeoutMultiplier := 0;
  ReadTotalTimeoutConstant := 1500;
  WriteTotalTimeoutMultiplier := 0;
  WriteTotalTimeoutConstant := 500;
end; {with}

if not SetCommTimeouts(hCommFile, CommTimeouts) then
       showmessage('Problem with SetCommTimeouts')
       { Better: raise an exception }  ; (* <- semi colon IS needed here*)

end;

procedure TDD29F1.buSendfClick(Sender: TObject);
begin
sPhraseToSend:='f';
EstablishHandle;
for c1:=1 to length(sPhraseToSend) do begin
  SendChar(copy(sPhraseToSend,c1,1));
  application.processmessages;
  sleep(10);
  end;
label1.caption:='hardcoded f'{ReadStringFrmRS232};
CloseHandle(hCommFile);
end;

procedure TDD29F1.buSendxClick(Sender: TObject);
begin
sPhraseToSend:='x';
EstablishHandle;
for c1:=1 to length(sPhraseToSend) do begin
  SendChar(copy(sPhraseToSend,c1,1));
  application.processmessages;
  sleep(10);
  end;
CloseHandle(hCommFile);  {Probably not necessary.... but was trying....}
EstablishHandle;            {.... things in desperation!}
label1.caption:=ReadStringFrmRS232;
CloseHandle(hCommFile);
end;

procedure TDD29F1.FormCreate(Sender: TObject);
begin
caption:='DD29, sheepdogsoftware.co.uk, '+ver;
end;

end.

Click here if you're feeling kind! (Promotes my site via "Top100Borland")

If you visit 1&1's site from here, it helps me. They host my website, and I wouldn't put this link up for them if I wasn't happy with their service. They offer things for the beginner and the corporation.

Ad from page's editor: Yes.. I do enjoy compiling these things for you... hope they are helpful. However.. this doesn't pay my bills!!! If you find this stuff useful, (and you run an MS-DOS or Windows PC) please visit my freeware and shareware page, download something, and circulate it for me? Links on your page to this page would also be appreciated!

Page WILL BE tested for compliance with INDUSTRY (not MS-only) standards, using the free, publicly accessible validator at validator.w3.org

....... P a g e . . . E n d s .....