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.