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 и 6. 1-занят, 6-свободен.Вначале использую 1 вариант - все что с индексом 1.
подключаюсь к com1
1-1False
5-Отказано в доступе.
0-
1-3False
0-
подключаюсь к com6
1-1False
0-OK
1-2True
открыт порт - \\.\COM6
работаю -отключаюсь
0-
1-3False
0-
подключаюсь опять к com1
1-1False
0-OK
1-2True
открыт порт - \\.\COM1
и сразу отключаюсь т.к. это ложь и при любой попытке меня вы
0-
1-3False
0-
Для чистоты, перезапускаю программу
подключаюсь к com1
2-1False
0-OK
2-2True
открыт порт - \\.\COM1
0-OK
2-3False
Это все...полный alles - такого быть не должно.
Пытаюсь подключиться из первого окна и
1-1False
0-OK
1-2True
открыт порт - \\.\COM1
0-
1-3False
0-
Приехали...
Мой вывод (прошу поправлять если не прав):
1-производить подключение из потока - плохо, бо не понимает, что порт занят и подходит в основном только для чтения данных из\о порта\е;
2-после любого удачного подключения, где то запоминается, что все хорошо и все порты отныне свободны. В результате можно подключиться к занятому порту или даже к несуществующему => потеря данных, ошибки и никакой дуракоустойчивости.
ps Если где то не прав, прошу бить не жалея

. За конструктивную критику буду только благодарен.