Sources
Delphi Russian Knowledge Base
DRKB - это самая большая и удобная в использовании база знаний по Дельфи в рунете, составленная Виталием Невзоровым

Пример программирования com портов

01.01.2007
unit TestRosh;
 
interface
 
uses
 
Windows, Messages, SysUtils, Classes, Graphics, Controls,
 
Forms, Dialogs, StdCtrls, ExtCtrls;
 
type
  TForm1
= class(TForm)
  Panel1
: TPanel;
  Label1
: TLabel;
 
PortCombo: TComboBox;
  Label2
: TLabel;
 
BaudCombo: TComboBox;
  Label3
: TLabel;
 
ByteSizeCombo: TComboBox;
  Label4
: TLabel;
 
ParityCombo: TComboBox;
  Label5
: TLabel;
 
StopBitsCombo: TComboBox;
  Label6
: TLabel;
  Memo1
: TMemo;
  Edit1
: TEdit;
  Button1
: TButton;
  Memo2
: TMemo;
  Edit2
: TEdit;
  Label7
: TLabel;
  Button2
: TButton;
  Label8
: TLabel;
  Edit3
: TEdit;
  procedure Button1Click
(Sender: TObject);
  procedure Memo2Change
(Sender: TObject);
  procedure Memo1Change
(Sender: TObject);
  procedure
FormDestroy(Sender: TObject);
  procedure Button2Click
(Sender: TObject);
  procedure
PortComboChange(Sender: TObject);
  procedure
FormShow(Sender: TObject);
  procedure Memo1DblClick
(Sender: TObject);
end;
 
var
  Form1
: TForm1;
 
implementation
 
{$R *.DFM}
 
uses
 
Registry;
 
var
  hPort
: THandle;
 
procedure TForm1
.Memo1Change(Sender: TObject);
var
  i
: Integer;
begin
  Edit1
.Text := '';
 
for i := 1 to Length(Memo1.Text) do
    Edit1
.Text := Edit1.Text + Format('%x', [Ord(Memo1.Text[i])]) + ' '
end;
 
procedure TForm1
.Memo2Change(Sender: TObject);
var
  i
: Integer;
begin
  Edit2
.Text := '';
 
for i := 1 to Length(Memo2.Text) do
    Edit2
.Text := Edit2.Text + Format('%x', [Ord(Memo2.Text[i])]) + ' '
end;
 
procedure TForm1
.Button1Click(Sender: TObject);
var
  S
, D: array[0..127] of Char;
  actual_bytes
: Integer;
  DCB
: TDCB;
begin
 
 
FillChar(S, 128, #0);
 
FillChar(D, 128, #0);
 
  DCB
.DCBlength := SizeOf(DCB);
 
 
if not GetCommState(hPort, DCB) then
 
begin
   
ShowMessage('Can not get port state: ' + IntToStr(GetLastError));
   
Exit;
 
end;
 
 
try
    DCB
.BaudRate := StrToInt(BaudCombo.Text);
 
except
   
BaudCombo.Text := IntToStr(DCB.BaudRate);
 
end;
 
 
try
    DCB
.ByteSize := StrToInt(ByteSizeCombo.Text);
 
except
   
ByteSizeCombo.Text := IntToStr(DCB.ByteSize);
 
end;
 
 
if ParityCombo.ItemIndex > -1 then
    DCB
.Parity := ParityCombo.ItemIndex
 
else
   
ParityCombo.ItemIndex := DCB.Parity;
 
 
if StopBitsCombo.ItemIndex > -1 then
    DCB
.StopBits := StopBitsCombo.ItemIndex
 
else
   
StopBitsCombo.ItemIndex := DCB.StopBits;
 
 
if not SetCommState(hPort, DCB) then
 
begin
   
ShowMessage('Can not set new port settings: ' + IntToStr(GetLastError));
   
Exit;
 
end;
 
 
PurgeComm(hPort, PURGE_TXABORT or PURGE_RXABORT or PURGE_TXCLEAR or PURGE_RXCLEAR);
 
 
StrPCopy(S, Memo1.Text);
 
 
if not WriteFile(hPort, S, StrLen(S), actual_bytes, nil) then
 
begin
   
ShowMessage('Can not write to port: ' + IntToStr(GetLastError));
   
Exit;
 
end;
 
 
if not ReadFile(hPort, D, StrToInt(Edit3.Text), actual_bytes, nil) then
   
ShowMessage('Can not read from port: ' + IntToStr(GetLastError))
 
else
   
ShowMessage('Read ' + IntToStr(actual_bytes) + ' bytes');
  Memo2
.Text := D;
end;
 
procedure TForm1
.FormDestroy(Sender: TObject);
begin
 
with TRegistry.Create do
 
begin
   
OpenKey('Shkila', True);
   
WriteString('Port', PortCombo.Text);
   
WriteString('Baud Rate', BaudCombo.Text);
   
WriteString('Byte Size', ByteSizeCombo.Text);
   
WriteString('Parity', IntToStr(ParityCombo.ItemIndex));
   
WriteString('Stop Bits', IntToStr(StopBitsCombo.ItemIndex));
   
Destroy;
 
end;
 
if not CloseHandle(hPort) then
 
begin
   
ShowMessage('Can not close port: ' + IntToStr(GetLastError));
   
Exit;
 
end;
end;
 
procedure TForm1
.Button2Click(Sender: TObject);
begin
  hPort
:= CreateFile(PChar(PortCombo.Text),
  GENERIC_READ
+ GENERIC_WRITE,
 
0,
 
nil,
  OPEN_EXISTING
,
  FILE_ATTRIBUTE_NORMAL
,
 
0);
 
 
if hPort = INVALID_HANDLE_VALUE then
   
ShowMessage('Can not open ' + PortCombo.Text + ': ' + IntToStr(GetLastError))
 
else
    Button2
.Hide;
end;
 
procedure TForm1
.PortComboChange(Sender: TObject);
begin
 
FormDestroy(Sender);
  Button2
.Show;
end;
 
procedure TForm1
.FormShow(Sender: TObject);
begin
 
with TRegistry.Create do
 
begin
   
OpenKey('Shkila', True);
   
PortCombo.Text := ReadString('Port');
   
BaudCombo.Text := ReadString('Baud Rate');
   
ByteSizeCombo.Text := ReadString('Byte Size');
   
ParityCombo.ItemIndex := StrToInt(ReadString('Parity'));
   
StopBitsCombo.ItemIndex := StrToInt(ReadString('Stop Bits'));
   
Destroy;
 
end;
end;
 
procedure TForm1
.Memo1DblClick(Sender: TObject);
begin
  Memo1
.Lines.Clear;
  Memo2
.Lines.Clear;
  Edit1
.Text := '';
  Edit2
.Text := '';
end;
 
end.

Взято с https://delphiworld.narod.ru