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

Code:

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.