- Код: Выделить всё
Connect(comport); // конектимся
if InstanceActive then // если подключились то настраиваем и работаем
begin
Config(9600, 8, 'N', 0, false, false);
SendString****
end
else // не подключились, ругаемся или ждем или пробуем по кругу
Модератор: Модераторы
Connect(comport); // конектимся
if InstanceActive then // если подключились то настраиваем и работаем
begin
Config(9600, 8, 'N', 0, false, false);
SendString****
end
else // не подключились, ругаемся или ждем или пробуем по кругу
procedure TForm1.OpenPort2Click(Sender: TObject);
var
Str:String;
begin
if OpenPort2.Checked=True then
begin
Port2:=TBlockserial.Create;
// Port2.RaiseExcept:=true;
Port2.Connect(SelectPort2.Text);
if Port2.InstanceActive=True then Memo1.Lines.Add('InstanceActive=True ') else Memo1.Lines.Add('InstanceActive=False '); // пишу состояние InstanceActive
if Port2.LastError<>0 then
begin
Memo1.Lines.Add(' ОШИБКА - '+IntToStr(Port2.LastError));
Memo1.Lines.Add(Port2.LastErrorDesc);
OpenPort2.Checked:=False;
end;
Port2.EnableRTSToggle(true);
Port2.Config(9600,8,'N',0,false,false);
Memo1.Lines.Add('открытое устр-во'+Port2.Device); // проверяю, а то ли я открыл ?
StrPort2.Enabled:=True;
SendPort2.Enabled:=True;
Vizual2:= TPort2Vizual.Create(false); // это поток для отображения состояния CTS и DSR
Vizual2.Priority:=tpIdle;
Read2:= TPort2Read.Create(false); // поток чтения из порта и записи в Memo
Read2.Priority:=tpIdle;
RTS2.Color:=clTeal;
DTR2.Color:=clTeal;
Str:=' открыт';
end
else
begin
Port2.Free;
Vizual2.Free;
Read2.Free;
SendPort2.Enabled:=False;
StrPort2.Enabled:=False;
DTR2.Color:=clNone;
DSR2.Color:=clNone;
RTS2.Color:=clNone;
CTS2.Color:=clNone;
RXD2.Color:=clNone;
TXD2.Color:=clNone;
LEDPort2.Color:=clNone;
Str:=' закрыт';
end;
Memo1.Lines.Add('порт '+SelectPort2.Text+Str);
end;
Attid писал(а):тебе надо рефакторинг кода сделать =)
com1 - занят
com6 - свободен
------------
1- Попытка подключения к com1 сразу после запуска
InstanceActive=False
LastError=5
2-подключение к com6
InstanceActive=True
LastError=0
Отключаемся
3-повторное подключение к com1
InstanceActive=True
LastError=0
Attid писал(а):ты близко к серцу не принимай я там смайлики ставлю.
Attid писал(а):у меня самолет через 3 час
Attid писал(а):про примеры забуть
Sergei I. Gorelkin писал(а):После отключения InstanceActive становится равным False?
Sergei I. Gorelkin писал(а):с их помощью отследить, какие порты когда открыты/закрыты.
swa1 писал(а):буду проверять, отчитаюсь позже.
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics,
Dialogs, StdCtrls, Synaser, ExtCtrls;
type
{Threads }
TPotok1 = class(TThread)
private
protected
procedure Execute; override;
end;
TPotok2 = class(TThread)
private
protected
procedure Execute; override;
end;
{ TForm1 }
TForm1 = class(TForm)
Memo1: TMemo;
NamePort1: TEdit;
NamePort2: TEdit;
Start1: TCheckBox;
Start2: TCheckBox;
P1: TPanel;
P2: TPanel;
DSR1: TPanel;
DSR2: TPanel;
CTS1: TPanel;
CTS2: TPanel;
procedure FormCreate(Sender: TObject);
procedure Start1Click(Sender: TObject);
procedure Start2Click(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
var
Form1: TForm1;
Potok1: TPotok1;
Potok2: TPotok2;
ser1:TBlockSerial;
implementation
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
begin
end;
procedure TForm1.Start1Click(Sender: TObject);
begin
if Start1.Checked then
begin
ser1:=TBlockserial.Create;
if ser1.InstanceActive then Memo1.Lines.Add('1-1True') else Memo1.Lines.Add('1-1False');
ser1.Connect(Form1.NamePort1.Text);
Memo1.Lines.Add(IntToStr(ser1.LastError)+'-'+ser1.LastErrorDesc);
if ser1.LastError<>0 then
begin
Start1.Checked:=False;
Exit;
end;
ser1.Config(115200,8,'N',0,false,false);
if ser1.InstanceActive then Memo1.Lines.Add('1-2True') else Memo1.Lines.Add('1-2False');
Memo1.Lines.Add('открыт порт - '+ser1.Device);
Potok1:= TPotok1.Create(false);
Potok1.Priority:=tpIdle;
end
else
begin
ser1.Free;
Memo1.Lines.Add(IntToStr(ser1.LastError)+'-'+ser1.LastErrorDesc);
if ser1.InstanceActive then Memo1.Lines.Add('1-3True') else Memo1.Lines.Add('1-3False');
Memo1.Lines.Add(IntToStr(ser1.LastError)+'-'+ser1.LastErrorDesc);
end;
end;
procedure TForm1.Start2Click(Sender: TObject);
begin
if Start2.Checked then
begin
Potok2:= TPotok2.Create(false);
Potok2.Priority:=tpIdle;
end
end;
{ TPotok }
procedure TPotok1.Execute;
begin
repeat
if ser1.CTS=True then Form1.CTS1.Color:=clteal else Form1.CTS1.Color:=clcream ;
if ser1.DSR=True then Form1.DSR1.Color:=clteal else Form1.DSR1.Color:=clcream ;
if Form1.P1.Color<>clLime then Form1.P1.Color:=clLime else Form1.P1.Color:=clRed ;
sleep(50);
until Form1.Start1.Checked=False;
end;
procedure TPotok2.Execute;
var
ser2:TBlockSerial;
begin
ser2:=TBlockserial.Create;
if ser2.InstanceActive then Form1.Memo1.Lines.Add('2-1True') else Form1.Memo1.Lines.Add('2-1False');
ser2.RaiseExcept:=true;
ser2.Connect(Form1.NamePort2.Text);
Form1.Memo1.Lines.Add(IntToStr(ser2.LastError)+'-'+ser2.LastErrorDesc);
ser2.EnableRTSToggle(true);
ser2.Config(115200,8,'N',0,false,false);
if ser2.InstanceActive then Form1.Memo1.Lines.Add('2-2True') else Form1.Memo1.Lines.Add('2-2False');
Form1.Memo1.Lines.Add('открыт порт - '+ser2.Device);
repeat
if ser2.CTS then Form1.CTS2.Color:=clteal else Form1.CTS2.Color:=clcream ;
if ser2.DSR then Form1.DSR2.Color:=clteal else Form1.DSR2.Color:=clcream ;
if Form1.P2.Color<>clLime then Form1.P2.Color:=clLime else Form1.P2.Color:=clRed ;
sleep(50);
until Form1.Start2.Checked=False;
Form1.Memo1.Lines.Add(IntToStr(ser2.LastError)+'-'+ser2.LastErrorDesc);
ser2.Free;
if ser2.InstanceActive then Form1.Memo1.Lines.Add('2-3True') else Form1.Memo1.Lines.Add('2-3False');
end;
initialization
{$I unit1.lrs}
end.
1-1False
5-Отказано в доступе.
0-
1-3False
0-
1-1False
0-OK
1-2True
открыт порт - \\.\COM6
0-
1-3False
0-
1-1False
0-OK
1-2True
открыт порт - \\.\COM1
0-
1-3False
0-
2-1False
0-OK
2-2True
открыт порт - \\.\COM1
0-OK
2-3False
1-1False
0-OK
1-2True
открыт порт - \\.\COM1
0-
1-3False
0-
swa1 писал(а):Мне не нужно отслеживать состояние портов сторонними утилитами, я и так это знаю. Мне нужно, что бы программа делала это сама.
swa1 писал(а):2-после любого удачного подключения, где то запоминается, что все хорошо и все порты отныне свободны. В результате можно подключиться к занятому порту или даже к несуществующему => потеря данных, ошибки и никакой дуракоустойчивости.
2-после любого удачного подключения, где то запоминается, что все хорошо и все порты отныне свободны. В результате можно подключиться к занятому порту или даже к несуществующему => потеря данных, ошибки и никакой дуракоустойчивости.
Sergei I. Gorelkin писал(а): подключаться, передавать/принимать и потом отключаться надо из одного и того же потока, неважно какого именно (в вышеприведенной программе это условие вроде бы выполняется).
Sergei I. Gorelkin писал(а):Т.е. если в программе порт закрыли, а утилита показывает, что он открыт -- повод задуматься...
Attid писал(а):не верю =)
Attid писал(а):ты без потоков проверил ?
Выходит так, что это баг lazarusa (FPC)
Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 2