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.