Delphi World - Пример программирования com портов
Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Пример программирования com портов


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''t 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''t 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''t write to port: ' + IntToStr(GetLastError));
    Exit;
  end;

  if not ReadFile(hPort, D, StrToInt(Edit3.Text), actual_bytes, nil) then
    ShowMessage('Can''t 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''t 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''t 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.

Проект Delphi World © Выпуск 2002 - 2017
Автор проекта: Эксклюзивные курсы программирования