И снова работа с COM портом

[northener]

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

Пишу оконное приложение, которое работает с MEGA32. Посылаю железке запросы, она мне присылает ответы.

Код вашей программки в студию.

[digitalis]

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

у меня стоит Windows 7 и я могу связаться с устройством, а разработчик устройства (у него Windows 10) не может.

Дык наверное, Windows 10 уже и не знает такую древность, как СОМ-порт. А какое железо у разработчика? Если у него Windows 10, то оно вряд ли на компе, в котором ещё живёт нативный СОМ-порт. Переходник USB-UART ? Если он на FTDI, то проще воспользоваться DLL от производителя, вообще игнорируя СОМ-порт. Впрочем, на Windows 10 я эту DLL не пробовал.
Думаю, админ мне позволит дать ссылку на родственный форум, где такими вопросами занимаются непосредственно.
https://radiokot.ru/forum/viewforum....ddd663ce8e414c
Несмотря на несерьёзное название форума, там встречаются дельные люди и советы.

[ZaslaneC]

Сообщение от Алексей1153

вывести в лог GetLastError() и другие ошибки после вызовов АПИ функций

Выдаёт код ошибки 2

[Алексей1153]

ZaslaneC,

Не удается найти указанный файл.

как задаётся имя порта ?

[ZaslaneC]

выводит код ошибки 2

[ZaslaneC]

for i:=0 to 15 do


  begin
   ComFile:=CreateFile(PChar('\\.\COM'+intToStr(i)), Generic_Read or Generic_Write, 0, nil, open_existing, file_flag_overlapped,0);

    if ComFile<>invalid_handle_value then
    begin
    Listbox1.Items.Add('COM'+ IntToStr(i));
    CloseHandle(ComFile);

    end;

   end;
 end;

[ZaslaneC]

procedure Tfmonitor.FormCreate(Sender: TObject);
 Var
 i:Integer;

begin
  MyThr:=MyThread.Create(false); //??????? ????? ??????;
MyThr.FreeOnTerminate:=true; //????????? ????? ??????;
MyThr.Priority:=tpNormal; //????????????? ?????????;

 for i:=0 to 15 do


  begin
   ComFile:=CreateFile(PChar('\\.\COM'+intToStr(i)), Generic_Read or Generic_Write, 0, nil, open_existing, file_flag_overlapped,0);

    if ComFile<>invalid_handle_value then
    begin
    Listbox1.Items.Add('COM'+ IntToStr(i));
    CloseHandle(ComFile);

    end;

   end;
 end;




procedure Tfmonitor.ListBox1DblClick(Sender: TObject);
begin
 W:=fmonitor.ListBox1.Items.Strings[fmonitor.ListBox1.ItemIndex]; {Загружаем выбранную
запись в переменную}
 Adr:=PChar(W); {Преобразуем ее в тип годный для использования в функции открытия порта (WideChar);}
 ComFile:=CreateFile(Adr, Generic_Read+Generic_Write, 0, nil,
 Open_Existing, File_Flag_Overlapped, 0); {Открываем порт для асинхронной работы;}
 if ComFile=Invalid_Handle_Value  then
 begin
 ShowMessage('Не удалось открыть порт, код ошибки = '+IntToStr(GetLastError)); {Если не удается, выводим сообщение об ошибке;}
 exit;
end;
 PurgeComm(ComFile, Purge_TXabort or Purge_RXabort or Purge_TXclear or Purge_RXclear); //Очищаем буферы приема и передачи и очередей чтения/записи;
 GetCommState(ComFile, DCB); //Настраиваем DCB настройки порта;
 with DCB do
 begin
 BaudRate:=4800;
 ByteSize:=8;
 Parity:=NoParity;
 StopBits:=OneStopBit;
 end;
 if not SetCommState(ComFile, DCB) then
 begin
 ShowMessage('Порт не настроен'); //Если не удается выводим сообщение об ошибке;
 CloseHandle(ComFile);
 exit;
 end;
 if ComFile <> INVALID_HANDLE_VALUE then
 begin
 GetCommTimeouts(ComFile, Timeouts); { Чтение текущих таймаутов и настройка параметров структуры CommTimeouts }
 Timeouts.ReadIntervalTimeout:=MAXDWORD; //Таймаут между двумя символами;
 Timeouts.ReadTotalTimeoutMultiplier:=0; //Общий таймаут операции чтения;
 Timeouts.ReadTotalTimeoutConstant:=0; //Константа для общего таймаута операции чтения;
 Timeouts.WriteTotalTimeoutMultiplier:=0; //Общий таймаут операции записи;
 Timeouts.WriteTotalTimeoutConstant:=0; //Константа для общего таймаута операции записи;
 SetCommTimeouts(ComFile, Timeouts); //Установка таймаутов;
end;
 SetupComm(ComFile, 4096, 4096); //Настройка буферов;
 if not SetupComm(ComFile, 4096, 4096) then //Ошибка настройки буферов;
begin
 ShowMessage('Ошибка настройки буферов');
 CloseHandle(ComFile);
 exit;
end;
 SetCommMask(ComFile, EV_RXchar); {Устанавливаем маску для срабатывания по событию - "Прием байта в порт"}
 ListBox1.Visible:=False; //Деактивируем listbox;
 end;
 {------------------------ функция очистки буффера-------------------------}
   function bwclear (a: Byte):Byte;
   var
    t:Byte;
   begin
    for t:=0 to 80 do
      begin
      bwread[t]:=0;
      end;

       end;
{----------------- поток чтения ------------------------------------- }
  { MyThread }

procedure MyThread.execute;
var
i:integer;
begin
  inherited;
   OverRead.Hevent:=CreateEvent(Nil, True, True, Nil); //Сигнальный объект событие для ассинхронных операций;
    While not MyThr.Terminated do //Пока поток не остановлен;

 begin
   WaitCommEvent(ComFile, Mask, @OverRead); //Ожидаем события (поступление байта);
   Signal:=WaitForSingleObject(OverRead.hEvent, Infinite); {Приостанавливаем поток до тех пор пока байт не поступит;}
   if (Signal=Wait_Object_0) then //Если байт поступил;
  begin
     if GetOverlappedResult(ComFile, OverRead, Temp, true) then {Проверяем успешность завершения операции;}
   begin
     if ((Mask and EV_RXchar)<>0) then //Если маска соответствует,
    begin
       ClearCommError(ComFile, Temp, @ComStat); //Заполняем структуру ComStat;
        Btr:=ComStat.CbInQue; //Получаем из структуры количество байт;
        If SizeOf(Btr)<>0 then //Если байты присутствуют,
     begin
        
         ReadFile(ComFile, bwread[i], SizeOf(bwread), Temp, @OverRead); //Читаем порт;
        // Synchronize(OutToMemo);

            i:=i+1;

         if i>bwread[0] then
           begin
             i:=0;
            labelname(0);    //вызов функции парсинга данных из буффера
                               // с последующей очисткой
           end;


{------------------------------------------------------}


{-------------------------------------------------------------}
     end;

    end;
   end;
  end;

 end;
    //  bwclear(80);
  //CloseHandle(OverRead.Hevent);

end;


  procedure MyThread.OutToMemo;
begin
   //Form1.Memo1.Lines.Text:=Form1.Memo1.Lines.Text+ string(chr(bwread[0]+$30));

   end;
{-----------------------------------------------------------------------}

procedure Tfmonitor.Button1Click(Sender: TObject);
begin
 writebwscan (0);


end;
{------------------------------------------------------------------------}







 {---------------------------------поток записи в порт--------------------}





{ MyThreadWr }

procedure MyThreadWr.execute;
 var
 flag:Bool; //Состояние передачи;
 i:Integer; //Счетчик;
 a:Byte;
begin
  inherited;


  PurgeComm(ComFile, Purge_TXabort or Purge_TXclear); //Очищаем передающий буфер и очереди записи;
  for i:=0 to bwscan[0] do
  begin
  OverWrite.Hevent:=CreateEvent(Nil, True, True, Nil); {Сигнальный объект событие для ассинхронных операций;}
  WriteFile(ComFile, bwscan[i], SizeOf(bwscan[i]), Temp, @OverWrite); {Пишем в порт массив;}
  Signal:=WaitForSingleObject(OverWrite.hEvent, Infinite); {Приостанавливаем поток до тех пор пока не завершится передача;}
  if (Signal=Wait_Object_0) and GetOverlappedResult(ComFile, OverWrite, Temp, true) then
  flag:=true
  else
  flag:=false;
  //BufferWr:=''; //Очищаем содержимое переменной буфера;
  CloseHandle(OverWrite.Hevent); //Закрываем объект событие;
   end;
 end;
 {-----------------------------------------------------------------------------------}


 {-------------- функции отображения и очистки буффера чтения ----------------------------}


 function labelname (a:Byte):Byte;
    var
  y:integer;
 begin

[ZaslaneC]

так и у меня нет СОМ порта, мы пользуемся переходником USB SERIAL-4. Связь по RS-232. Проверял программой TERMINAL, у меня всё хорошо, а у него с ноута запрос в железку уходит , а ответа нет(((

[ZaslaneC]

procedure Tfmonitor.FormCreate(Sender: TObject);
 Var
 i:Integer;

begin
  MyThr:=MyThread.Create(false); //??????? ????? ??????;
MyThr.FreeOnTerminate:=true; //????????? ????? ??????;
MyThr.Priority:=tpNormal; //????????????? ?????????;

 for i:=0 to 15 do


  begin
   ComFile:=CreateFile(PChar('\\.\COM'+intToStr(i)), Generic_Read or Generic_Write, 0, nil, open_existing, file_flag_overlapped,0);

    if ComFile<>invalid_handle_value then
    begin
    Listbox1.Items.Add('COM'+ IntToStr(i));
    CloseHandle(ComFile);

    end;

   end;
 end;




procedure Tfmonitor.ListBox1DblClick(Sender: TObject);
begin
 W:=fmonitor.ListBox1.Items.Strings[fmonitor.ListBox1.ItemIndex]; {Загружаем выбранную
запись в переменную}
 Adr:=PChar(W); {Преобразуем ее в тип годный для использования в функции открытия порта (WideChar);}
 ComFile:=CreateFile(Adr, Generic_Read+Generic_Write, 0, nil,
 Open_Existing, File_Flag_Overlapped, 0); {Открываем порт для асинхронной работы;}
 if ComFile=Invalid_Handle_Value  then
 begin
 ShowMessage('Не удалось открыть порт, код ошибки = '+IntToStr(GetLastError)); {Если не удается, выводим сообщение об ошибке;}
 exit;
end;
 PurgeComm(ComFile, Purge_TXabort or Purge_RXabort or Purge_TXclear or Purge_RXclear); //Очищаем буферы приема и передачи и очередей чтения/записи;
 GetCommState(ComFile, DCB); //Настраиваем DCB настройки порта;
 with DCB do
 begin
 BaudRate:=4800;
 ByteSize:=8;
 Parity:=NoParity;
 StopBits:=OneStopBit;
 end;
 if not SetCommState(ComFile, DCB) then
 begin
 ShowMessage('Порт не настроен'); //Если не удается выводим сообщение об ошибке;
 CloseHandle(ComFile);
 exit;
 end;
 if ComFile <> INVALID_HANDLE_VALUE then
 begin
 GetCommTimeouts(ComFile, Timeouts); { Чтение текущих таймаутов и настройка параметров структуры CommTimeouts }
 Timeouts.ReadIntervalTimeout:=MAXDWORD; //Таймаут между двумя символами;
 Timeouts.ReadTotalTimeoutMultiplier:=0; //Общий таймаут операции чтения;
 Timeouts.ReadTotalTimeoutConstant:=0; //Константа для общего таймаута операции чтения;
 Timeouts.WriteTotalTimeoutMultiplier:=0; //Общий таймаут операции записи;
 Timeouts.WriteTotalTimeoutConstant:=0; //Константа для общего таймаута операции записи;
 SetCommTimeouts(ComFile, Timeouts); //Установка таймаутов;
end;
 SetupComm(ComFile, 4096, 4096); //Настройка буферов;
 if not SetupComm(ComFile, 4096, 4096) then //Ошибка настройки буферов;
begin
 ShowMessage('Ошибка настройки буферов');
 CloseHandle(ComFile);
 exit;
end;
 SetCommMask(ComFile, EV_RXchar); {Устанавливаем маску для срабатывания по событию - "Прием байта в порт"}
 ListBox1.Visible:=False; //Деактивируем listbox;
 end;
 {------------------------ функция очистки буффера-------------------------}
   function bwclear (a: Byte):Byte;
   var
    t:Byte;
   begin
    for t:=0 to 80 do
      begin
      bwread[t]:=0;
      end;

       end;
{----------------- поток чтения ------------------------------------- }
  { MyThread }

procedure MyThread.execute;
var
i:integer;
begin
  inherited;
   OverRead.Hevent:=CreateEvent(Nil, True, True, Nil); //Сигнальный объект событие для ассинхронных операций;
    While not MyThr.Terminated do //Пока поток не остановлен;

 begin
   WaitCommEvent(ComFile, Mask, @OverRead); //Ожидаем события (поступление байта);
   Signal:=WaitForSingleObject(OverRead.hEvent, Infinite); {Приостанавливаем поток до тех пор пока байт не поступит;}
   if (Signal=Wait_Object_0) then //Если байт поступил;
  begin
     if GetOverlappedResult(ComFile, OverRead, Temp, true) then {Проверяем успешность завершения операции;}
   begin
     if ((Mask and EV_RXchar)<>0) then //Если маска соответствует,
    begin
       ClearCommError(ComFile, Temp, @ComStat); //Заполняем структуру ComStat;
        Btr:=ComStat.CbInQue; //Получаем из структуры количество байт;
        If SizeOf(Btr)<>0 then //Если байты присутствуют,
     begin
        
         ReadFile(ComFile, bwread[i], SizeOf(bwread), Temp, @OverRead); //Читаем порт;
        // Synchronize(OutToMemo);

            i:=i+1;

         if i>bwread[0] then
           begin
             i:=0;
            labelname(0);    //вызов функции парсинга данных из буффера
                               // с последующей очисткой
           end;


{------------------------------------------------------}


{-------------------------------------------------------------}
     end;

    end;
   end;
  end;

 end;
    //  bwclear(80);
  //CloseHandle(OverRead.Hevent);

end;


  procedure MyThread.OutToMemo;
begin
   //Form1.Memo1.Lines.Text:=Form1.Memo1.Lines.Text+ string(chr(bwread[0]+$30));

   end;
{-----------------------------------------------------------------------}

procedure Tfmonitor.Button1Click(Sender: TObject);
begin
 writebwscan (0);


end;
{------------------------------------------------------------------------}







 {---------------------------------поток записи в порт--------------------}





{ MyThreadWr }

procedure MyThreadWr.execute;
 var
 flag:Bool; //Состояние передачи;
 i:Integer; //Счетчик;
 a:Byte;
begin
  inherited;


  PurgeComm(ComFile, Purge_TXabort or Purge_TXclear); //Очищаем передающий буфер и очереди записи;
  for i:=0 to bwscan[0] do
  begin
  OverWrite.Hevent:=CreateEvent(Nil, True, True, Nil); {Сигнальный объект событие для ассинхронных операций;}
  WriteFile(ComFile, bwscan[i], SizeOf(bwscan[i]), Temp, @OverWrite); {Пишем в порт массив;}
  Signal:=WaitForSingleObject(OverWrite.hEvent, Infinite); {Приостанавливаем поток до тех пор пока не завершится передача;}
  if (Signal=Wait_Object_0) and GetOverlappedResult(ComFile, OverWrite, Temp, true) then
  flag:=true
  else
  flag:=false;
  //BufferWr:=''; //Очищаем содержимое переменной буфера;
  CloseHandle(OverWrite.Hevent); //Закрываем объект событие;
   end;
 end;
 {-----------------------------------------------------------------------------------}


 {-------------- функции отображения и очистки буффера чтения ----------------------------}


 function labelname (a:Byte):Byte;
    var
  y:integer;
 begin

[Алексей1153]

ZaslaneC, в общем, сейчас у тебя так:

1) при заполнении комбы ищешь порты по имени '\\.\COMn', это правильно (кстати, я не знаю, в дельфях нужно экранировать слеши или нет Это сам разберёшься )
2) но в список кладёшь имя вида 'COMn'
3) при открытии порта для работы используешь строку из комбы

W:=fmonitor.ListBox1.Items.Strings[fmonitor.ListBox1.ItemIndex];

то есть - не то имя, которое использовалось при тестировании.

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