Не работает поток

defen · #1 12.02.2013, 04:51

Доброго времени суток. Помогите пожалуйста разобраться с потоком, сталкиваюсь с этим впервые. Дело в том, что первый пакет данных проходит успешно, маркер определяется, получаю пакет, а затем поток как-то зависает и программа перестает получать данные с ком порта. Если я прохожу по циклу в режиме откладки, то все работает на ура.....

Код:

unit ReadPort;
interface

uses
 Classes,Windows, Messages, SysUtils, Variants, Graphics, Controls, Forms,
 Dialogs, StdCtrls, ComCtrls, ExtCtrls;

 type
 RdThread = class(TThread)
 Private
 Protected
 Procedure Execute; override;

//  Procedure UpdateGenFormnReadLabel;
 End;
var
RC: array [1..38]of byte;
i2:integer;

implementation
uses Gen;
Var
RCBuffer:Array of Byte;
 
nToRead:Cardinal;
nRead:Cardinal;
ComStat:TcomStat;
Errs:Cardinal;
RdOvr:TOverlapped;
Mask:DWord;

Procedure RDthread.Execute;
var
i:integer;
Begin
 i2:=0;

  FillChar(RdOvr,SizeOf(TOverlapped),0);
  RdOvr.hEvent:=CreateEvent(nil,
  true,
  false,
  nil
  );

  SetCommMask(Port,
  EV_RXFLAG);
 while not Terminated Do Begin
 WaitCommEvent(Port,
 mask,
 @rdOvr
 );
FreeMem(RCBuffer,nToRead);
WaitForSingleObject(RdOvr.hEvent,INFINITE);
GetOverlappedResult(Port,RdOvr,nRead,false);
ClearCommError(Port,Errs,@ComStat);
nToRead:=ComStat.cbInQue;
GetMem(RcBuffer,nToRead);
If not ReadFile(Port,RCBuffer[0],nToRead,nRead,@RdOvr) Then
Else

 If nToRead = 8 Then
 Begin
  For i:=0 to nToRead-1 do
   Begin
   i2:=i2+1;
   RC[i2]:=RCBuffer[i];
   end;
   end
    Else
    Begin
    If nToRead = 31 Then
    Begin
    i2:=8;
      For i:=0 to nToRead-1 do

   Begin
   i2:=i2+1;
   RC[i2]:=RCBuffer[i];
   Gen.GenForm.Label4.Caption:=IntToStr(i2);
   end;
     Begin
     i2:=0;
     Gen.PortDataRecived;
     End;
     End;
     end;
     i2:=0;
     End;

End;

MAD: Пользуемся тегом CODE для оформления кода!

Код не доработан в плане обработки пакета т.к. Нет стабильного приема.

Aristarh Dark · #2 12.02.2013, 08:22

На первый вгляд, а есть увененность, что RXFlag выставляется, сделай CHAR для проверки, посмотри будут ли данные приходить.

Ну и обращения к VCL компонентам из кода потока убери. Нельзя так делать.

defen · #3 12.02.2013, 17:36

Прошу прощения за некорректное оформление кода. С телефона сижу)))

Данные приходят, флаг вроде отрабатывает. Попробую реализовать совет. Как сделаю, отпишусь

Попсавил rxchar, как советовали. Все приходит, изменений нет. Я только не понял про VCL. Что не так?

MAD: Вам что, в прикол постить по 10 сообщений подряд?

Aristarh Dark · #4 13.02.2013, 08:00

Подобные вызовы:

Код:

Gen.GenForm.Label4.Caption:=IntToStr(i2);

в потоках недопустимы.

defen · #5 13.02.2013, 09:28

А как передать данные из потока? Поток в отдельном юните реализован

Aristarh Dark · #6 13.02.2013, 09:35

Если быть внимательным, то при создании юнита для потока там была написана вот такая интересная информация:

Код:

{
  Important: Methods and properties of objects in visual components can only be
  used in a method called using Synchronize, for example,

      Synchronize(UpdateCaption);

  and UpdateCaption could look like,

    procedure qwdqwd.UpdateCaption;
    begin
      Form1.Caption := 'Updated in a thread';
    end;
    
    or

    Synchronize(
      procedure 
      begin
        Form1.Caption := 'Updated in thread via an anonymous method'
      end
      )
    );

  where an anonymous method is passed.

  Similarly, the developer can call the Queue method with similar parameters as
  above, instead passing another TThread class as the first parameter, putting
  the calling thread in a queue with the other thread.

}

Когда прочитаешь это - сразу все становится понятно.

defen · #7 13.02.2013, 16:10

Возможно из-за этого цикл не мог завершится и зависал?

Aristarh Dark · #8 13.02.2013, 16:35

Не исключено, там поведение вообще неожыданное может быть.

defen · #9 14.02.2013, 02:30

А вот переменная nToRead каким образом получает значения? И можно как-то задать постоянное значение, а то приходится массив из трех частей собирать. В сумме все равно получается нужное значение байт, просто Не удобно как-то...((

И значения разные. Порой закономерности вообще ни какой...

После того, как первый пакет принят, поток перестает получать данные с порта. Вообще не реагирует((((

Aristarh Dark · #10 14.02.2013, 09:27

Вообще, как показывает моя практика, асинхронный прием данных из последовательного порта чаще всего не нужен (мне вообще ни разу не понадобился). За время работы с внешними устройствами через последовательный порт я набросал небольшой модуль для работы с портом (открыть/закрыть, чтение/запись, некоторые доп. функции) и успешно им пользуюсь. Работу строю так: в основном цикле потока данные постоянно вычитываются из потра, если что-то приходит - обработка и ответ. Если что-то ножно отправить - сообщение потоку из главной нить приложения о необходимости выполнения определенных действий. Этого вполне хватает. Модуль с функциями для порта ниже.

Код:

unit COMUtils;

interface

uses
  SysUtils, Classes;

function OpenPort(AName: string; BaudRate: integer;
  var Handle: THandle): Boolean;
function ClosePort(var AHandle: THandle): Boolean;

function COMRead(AHandle: THandle; Data: PByteArray): Cardinal; overload;
function COMWrite(AHandle: THandle; Data: PByteArray; ALength: Cardinal)
  : Cardinal; overload;

function ChangeSpeed(AHandle: THandle; NewSpeed: integer): Boolean;
{$IFDEF VER220} // для delphi xe
function COMRead(AHandle: THandle): RawByteString; overload;
function COMWrite(AHandle: THandle; Data: RawByteString): Cardinal; overload;
{$ELSE}
function COMRead(AHandle: THandle): String; overload;
function COMWrite(AHandle: THandle; Data: string): Cardinal; overload;
{$ENDIF}
procedure GetComList(List: TStrings; ExtendedList:Boolean=False);

implementation

uses
  Windows, Registry;

const
  bufferlength = 2048;

function DCBSettings(AHandle: THandle; ABaudrate: integer): Boolean;
var
  DCB: TDCB;
begin
  Result := False;
  FillChar(DCB, SizeOf(TDCB), 0);;
  if not(GetCommState(AHandle, DCB)) then
    Exit;
  DCB.Flags := DCB.Flags or (RTS_CONTROL_ENABLE shl 12);
  DCB.BaudRate := ABaudrate;
  DCB.Parity := NOPARITY;
  DCB.ByteSize := 8;
  DCB.StopBits := 0;
  Result := SetCommState(AHandle, DCB);
end;

function OpenPort(AName: string; BaudRate: integer;
  var Handle: THandle): Boolean;
begin
  Result := False;
  Handle := CreateFile(PChar('\\.\' + AName), GENERIC_READ or GENERIC_WRITE, 0,
    nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
  if Handle = INVALID_HANDLE_VALUE then
    Exit;
  if not DCBSettings(Handle, BaudRate) then
    Exit;
  if not SetupComm(Handle, bufferlength, bufferlength) then
    Exit;
  if not PurgeComm(Handle, PURGE_TXABORT or PURGE_RXABORT or PURGE_TXCLEAR or
    PURGE_RXCLEAR) then
    Exit;
  EscapeCommFunction(Handle, CLRRTS);
  EscapeCommFunction(Handle, CLRDTR);
  Result := True;
end;

function ClosePort(var AHandle: THandle): Boolean;
begin
  Result := CloseHandle(AHandle);
  if Result then
    AHandle := INVALID_HANDLE_VALUE;
end;

function COMRead(AHandle: THandle; Data: PByteArray): Cardinal;
var
  ComStat: TComStat;
  Error: Cardinal;
begin
  Result := 0;
  if not ClearCommError(AHandle, Error, @ComStat) then
    Exit;
  if ComStat.cbInQue > 0 then
  begin
    try
      ReadFile(AHandle, Data^[0], ComStat.cbInQue, Result, nil);
    except
      Result := $FFFFFFFF;
    end;
  end;
end;
{$IFDEF VER220}

function COMRead(AHandle: THandle): RawByteString;
{$ELSE}

function COMRead(AHandle: THandle): string;
{$ENDIF}
var
  Data: TByteArray;
  Len: Cardinal;
begin
  Result := '';
  Len := COMRead(AHandle, @Data);
  if Len > 0 then
  begin
    SetLength(Result, Len);
    Move(Data[0], Result[1], Len);
  end;
end;

function COMWrite(AHandle: THandle; Data: PByteArray; ALength: Cardinal)
  : Cardinal;
begin
  try
    WriteFile(AHandle, Data^[0], ALength, Result, nil);
  except
    Result := $FFFFFFFF;
  end;
end;

{$IFDEF VER220}

function COMWrite(AHandle: THandle; Data: RawByteString): Cardinal;
{$ELSE}

function COMWrite(AHandle: THandle; Data: String): Cardinal;
{$ENDIF}
begin
  Result := COMWrite(AHandle, @Data[1], Length(Data));
end;

function ChangeSpeed(AHandle: THandle; NewSpeed: integer): Boolean;
begin
  Result := DCBSettings(AHandle, NewSpeed);
end;

function GetDecimal(Value:string):Integer;
var
  decimal:string;
  flag:Boolean;
  i: Integer;
begin
  decimal:='';
  flag:=False;
  for i := 1 to Length(Value) do
    if CharInSet(Value[i],['0'..'9']) then
      begin
        flag:=true;
        decimal:=decimal+Value[i];
      end
    else
      if flag then
        Break;
    Result:=StrToInt(decimal);
end;

function COMSort(List:TStringList; Index1, Index2:Integer):integer;
var
  val1,val2:Integer;
begin
  val1:=GetDecimal(List[Index1]);
  val2:=GetDecimal(List[Index2]);
  if val1=val2 then
    Result:=0
  else if val1<val2 then
    Result:=-1
  else
    Result:=1;
end;
procedure GetComList(List: TStrings; ExtendedList:Boolean);
var
  reg:TRegistry;
  sl,sl1:TStringList;
  i:integer;
  flag:Boolean;
begin
  List.Clear;
  sl:=TStringList.Create;
  sl1:=TStringList.Create;
  reg := TRegistry.Create(KEY_READ);
  reg.RootKey := HKEY_LOCAL_MACHINE;
  reg.OpenKey('hardware\devicemap\serialcomm', false);
  reg.GetValueNames(sl);
  if sl.Count>0 then
    begin
      for i := 0 to sl.Count - 1 do
        if ExtendedList then
          begin
            flag:=pos('SILAB',AnsiUpperCase(sl[i]))>0;
            if flag then
              sl1.AddObject('#'+reg.ReadString(sl[i])+'[CP2102]',pointer(flag))
            else
              sl1.AddObject(reg.ReadString(sl[i]),pointer(flag));
          end
        else
          begin
            sl1.Append(reg.ReadString(sl[i]));
          end;
      sl1.Sort;
      if ExtendedList then
        begin
          for i := 0 to sl1.Count-1 do
            if Boolean(sl1.Objects[i]) then
              begin
                sl1[i]:=Copy(sl1[i],2,Length(sl1[i])-1);
              end;
        end;
      sl1.CustomSort(COMSort);
      List.Text:=sl1.Text;
    end;
  reg.CloseKey;
  reg.free;
  sl1.Free;
  sl.Free;
end;

end.

defen · #11 15.02.2013, 02:13

Попробую припаять чтение из порта. Растройки и отправка уже имеются

Dalt · #12 29.03.2013, 17:49

Цитата:

Сообщение от Aristarh Dark

Вообще, как показывает моя практика, ...

Подскажите как проверить наличие ком портов в системе используя реестр или другой метод? Простой перебор портов несколько тормозит программу при запуске.

Aristarh Dark · #13 29.03.2013, 17:54

Цитата:

Сообщение от Dalt

Подскажите как проверить наличие ком портов в системе используя реестр или другой метод? Простой перебор портов несколько тормозит программу при запуске.

Вот в этом посте смотри процедуру GetCOMList. Там лишнее уберешь, то что касается расширенного списка.

defen · #14 04.04.2013, 09:36

А что такое CharInSet? Delphi ругается, что переменная не продикларирована, но как я понял charinset водит в sysutils, а он подключен...

M.A.D.M.A.N. · #15 04.04.2013, 10:00

F1

______________

Опции темы	Поиск в этой теме
Версия для печати Отправить на Email	Поиск в этой теме: Расширенный поиск
Опции просмотра
Линейный вид Комбинированный вид Древовидный вид

	Сайт	Форум	FAQ	Соглашения	Прочее
	Новости Исходники Компоненты Статьи Добавить исходник Поиск	Правила Поиск Сообщения за сегодня Пользователи Кто на форуме?	Delphi FAQ - 5000 статей DRKB - 4500 статей (ZIP-архив) Справочник функций и процедур Delphi Delphi Programming Guide Indy in Depth. Глубины Indy	Конфиденциальность Соглашение пользователя Правила обработки cookie	О сайте Donate Контакты

Эти 2 пользователя(ей) сказали Спасибо Aristarh Dark за это полезное сообщение:
Dalt (29.03.2013), defen (30.03.2013)

Этот пользователь сказал Спасибо Aristarh Dark за это полезное сообщение:
Dalt (29.03.2013)