VPF::Работа с COM портами - Форум программистов

СЭНСЭЙ

Дата 4.6.2009, 18:16 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 432
Регистрация: 20.3.2006

Репутация: нет
Всего: нет

Привет всем.
Начал работать с ком портом.
Есть устройство, которое подключается к ком порту и посылает на него данные.
Формат данных известен, он строковый.
Как задать порт я понял, функции чтения и записи тоже понятны.
Но нужно наверное повесить чтение данных на отдельный процесс.
Помогите пожалуйста кто в этом уже разбирается.
Когда опрашиваю скорость ком порта, то выдается 1200
хотя в свойствах в диспетчере устройств установленно 9600
из за чего это?

Это сообщение отредактировал(а) СЭНСЭЙ - 5.6.2009, 08:59

Romikgy

Дата 5.6.2009, 14:06 (ссылка)

(нет голосов)

Загрузка ...

Любитель-программер

Профиль
Группа: Участник Клуба
Сообщений: 7326
Регистрация: 11.5.2005
Где: Porto Franco Odes sa

Репутация: 13
Всего: 146

Цитата(СЭНСЭЙ @ 4.6.2009, 17:16

)

хотя в свойствах в диспетчере устройств установленно 9600

на заборе много чего написано , сколько раз заглядывал никогда ничего нет:(

конкретно что надо опиши плз

--------------------

Владение русской орфографией это как владение кунг-фу — истинные мастера не применяют его без надобности.

СЭНСЭЙ

Дата 5.6.2009, 16:26 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 432
Регистрация: 20.3.2006

Репутация: нет
Всего: нет

Буду последовательно описывать проблемы
первая с чтением данных
Вот код:

Код


procedure TForm1.Button2Click(Sender: TObject);
var
 comportout,comportin:thandle;
 OverRead: Toverlapped;
 Buff: array[0..$FF] of Byte;
 dwRead: DWORD;
 begin

comportin := CreateFile('COM1', GENERIC_READ or GENERIC_WRITE, 0, nil,
 OPEN_EXISTING, FILE_FLAG_OVERLAPPED, 0);
if comportin = INVALID_HANDLE_VALUE then
 raise Exception.Create('Error opening port');

 if not PurgeComm(comportin, PURGE_TXCLEAR or PURGE_RXCLEAR) then
 raise Exception.Create('Error purging port');

 SetupComm(comportin, 1, 1);

if not SetCommMask(comportin, EV_RXCHAR) then
 Label1.Caption:=inttostr(GetLastError);

if not ReadFile(comportin, Buff, 1, dwRead, @OverRead) then
  Label1.Caption:=Label1.Caption+' '+inttostr(GetLastError);
   

CloseHandle(comportin);

end;

Выдает ошибку 997
я смотрел -
Код ошибки: 997 (0x03E5)
Протекает наложенное событие ввода/вывода.

Это сообщение отредактировал(а) СЭНСЭЙ - 5.6.2009, 16:37

СЭНСЭЙ

Дата 5.6.2009, 17:02 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 432
Регистрация: 20.3.2006

Репутация: нет
Всего: нет

Оу разобрался
нужно использовать такой цикл

Код


while dwRead<3 do
 begin
  if not WaitCommEvent(comportin, dwMask, @OverRead) then
  begin
   if GetLastError = ERROR_IO_PENDING then
    WaitForSingleObject(OverRead.hEvent, INFINITE)
   else
    raise Exception.Create('Error waiting port event');
  end;

  if not ClearCommError(comportin, dwError, @ComStat) then
   raise Exception.Create('Error clearing port');

  dwRead := ComStat.cbInQue;

  if dwRead > 0 then
  begin
   if not ReadFile(comportin, Buff, dwRead, dwRead, @OverRead) then
    raise Exception.Create('Error reading port');
   // В Buf находятся прочитанные байты
   // Далее идет обработка принятых байтов
   CloseHandle(comportin);
  end;
 end; {while}
 edit1.text:=edit1.text+chr(13)+String(buff);
end;

только я отправляю в один порт данные в формате Pchar, а по нульмодемному кабелю другой порт читаю
но данные принимаются в виде иероглифов
<Фw-П
типа такого

вот код отправки

Код


Outstring:=PChar(outtext.text);
OverWrite.hEvent := CreateEvent(nil, True, False, nil);
 if OverWrite.hEvent = Null then
  raise Exception.Create('Error creating write event');

 if (not WriteFile(comportout, Outstring, SizeOf(Outstring),
  dwWrite, @OverWrite))
 and (GetLastError <> ERROR_IO_PENDING) then
  raise Exception.Create('Error writing port');
 CloseHandle(comportout);

СЭНСЭЙ

Дата 5.6.2009, 17:28 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 432
Регистрация: 20.3.2006

Репутация: нет
Всего: нет

Попробовал отправлять и принимать данные в виде массивов типа byte
отправляю
WriteBytes: array of Byte;
WriteBytes2: array[0..2] of Byte;

setlength(writebytes,3);
writebytes[0]:=1;
writebytes[1]:=3;
writebytes[2]:=2;

а когда принимаю
команда
edit1.text:=inttostr(writebytes2[0]);
выдает 133
а если вместо этого выполнить
edit1.text:=inttostr(writebytes2[0])+' '+inttostr(writebytes2[1])+' '+inttostr(writebytes2[2]);
выдает ошибку в этом месте

Код


 if not WaitCommEvent(comportin, dwMask, @OverRead) then
  begin
   if GetLastError = ERROR_IO_PENDING then
    WaitForSingleObject(OverRead.hEvent, INFINITE)
   else
    raise Exception.Create('Error waiting port event');
  end;

непонятно почему так как этот код в цикле а принятые данные вывожу уже за циклом

Romikgy

Дата 5.6.2009, 19:43 (ссылка)

(нет голосов)

Загрузка ...

Любитель-программер

Профиль
Группа: Участник Клуба
Сообщений: 7326
Регистрация: 11.5.2005
Где: Porto Franco Odes sa

Репутация: 13
Всего: 146

непонятно где произошла ошибка ,
и не понятно какой код используешь , ибо куски что выложены с трудом связываются ,
можешь полный текст дать передатчика и приемника ком порта

--------------------

Владение русской орфографией это как владение кунг-фу — истинные мастера не применяют его без надобности.

СЭНСЭЙ

Дата 6.6.2009, 12:32 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 432
Регистрация: 20.3.2006

Репутация: нет
Всего: нет

ок вот весь код
но это еще больше измененный со вчера

Код


unit main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls,Global;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Button1: TButton;
    Button2: TButton;
    portout: TComboBox;
    Label2: TLabel;
    CheckBox1: TCheckBox;
    Label3: TLabel;
    portin: TComboBox;
    CheckBox2: TCheckBox;
    outtext: TEdit;
    Edit1: TEdit;
    Button3: TButton;
    function InPort(PortAddr:word): byte; stdcall;
    procedure OutPort(PortAddr:word; Databyte: byte); stdcall;
    procedure Button2Exit(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
    procedure CheckBox2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  tool:Thandle;

implementation

procedure TForm1.Button1Click(Sender: TObject);
var
ComStat: TComStat;
buf:string;
dwWrite: DWORD;
 OverWrite: TOverlapped;
 OverRead: Toverlapped;
 WriteBytes: array of Byte;
 WriteBytes2: array[0..2] of Byte;
 Outstring:Pchar;
 Buff: array[0..$FF] of Char;
 dwRead,dwError,dwMask: DWORD;
 begin
//with syncport.Create(false) do tool:=handle;
if CheckBox1.checked then
begin
comportout := CreateFile(Pchar(portout.Items.Strings[portout.itemindex]), GENERIC_READ or GENERIC_WRITE, 0, nil,
 OPEN_EXISTING, FILE_FLAG_OVERLAPPED, 0);
if comportout = INVALID_HANDLE_VALUE then
 raise Exception.Create('Error opening port');

 if not PurgeComm(comportout, PURGE_TXCLEAR or PURGE_RXCLEAR) then
 raise Exception.Create('Error purging port');
 comportin:=comportout;

 SetupComm(comportout, 16, 16);
end;

if (CheckBox2.checked) and (portin.ItemIndex<>portout.itemindex) then
begin
comportin := CreateFile(Pchar(portin.Items.Strings[portin.itemindex]), GENERIC_READ or GENERIC_WRITE, 0, nil,
 OPEN_EXISTING, FILE_FLAG_OVERLAPPED, 0);
if comportin = INVALID_HANDLE_VALUE then
 raise Exception.Create('Error opening port');

 if not PurgeComm(comportin, PURGE_TXCLEAR or PURGE_RXCLEAR) then
 raise Exception.Create('Error purging port');

 if not SetCommMask(comportin, EV_RXCHAR) then
 raise Exception.Create('Error setting port mask');
 SetupComm(comportin, 16, 16);
end;

if CheckBox1.checked then
begin
Outstring:=PChar(outtext.text);
setlength(writebytes,3);
writebytes[0]:=1;
writebytes[1]:=3;
writebytes[2]:=2;
OverWrite.hEvent := CreateEvent(nil, True, False, nil);
 if OverWrite.hEvent = Null then
  raise Exception.Create('Error creating write event');

 if (not WriteFile(comportout, writebytes, SizeOf(Outstring),
  dwWrite, @OverWrite))
 and (GetLastError <> ERROR_IO_PENDING) then
  raise Exception.Create('Error writing port');
 CloseHandle(comportout);
end;


if CheckBox2.Checked then
begin
{
if not ClearCommError(comportin, dwError, @ComStat) then
   raise Exception.Create('Error clearing port');

  dwRead := ComStat.cbInQue;
  Label1.Caption:=Label1.Caption+' '+inttostr(dwRead);
if not ReadFile(comportin, Buff, dwRead, dwRead, @OverRead) then
    //raise Exception.Create(inttostr(GetLastError));
    Label1.Caption:=Label1.Caption+' '+inttostr(GetLastError);
end;

CloseHandle(comportin);
if (CheckBox2.checked) and (portin.ItemIndex<>portout.itemindex) then CloseHandle(comportout);
Label1.Caption:=Label1.Caption+chr(13)+String(buff);
}
while dwRead<3 do
 begin
  if not WaitCommEvent(comportin, dwMask, @OverRead) then
  begin
   if GetLastError = ERROR_IO_PENDING then
    WaitForSingleObject(OverRead.hEvent, INFINITE)
   else
    raise Exception.Create('Error waiting port event');
  end;

  if not ClearCommError(comportin, dwError, @ComStat) then
   raise Exception.Create('Error clearing port');

  dwRead := ComStat.cbInQue;

  if dwRead > 0 then
  begin
   if not ReadFile(comportin, writebytes2, dwRead, dwRead, @OverRead) then
    raise Exception.Create('Error reading port');
   CloseHandle(comportin);
  end;
 end; {while}
  edit1.text:=inttostr(writebytes2[0]);//+' '+inttostr(writebytes2[1])+' '+inttostr(writebytes2[2]);
end;
end;


procedure TForm1.CheckBox2Click(Sender: TObject);
begin
portin.Enabled:=CheckBox2.Checked;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
portin.ItemIndex:=1;
portout.ItemIndex:=0;
end;

end.

ну вот
portin и oirtout это выподающие меню где два варианта COM1 и COM2
у меня COM1 и COM2 соединены нуль модемным кабелем

если в этой строке
edit1.text:=inttostr(writebytes2[0]);//+' '+inttostr(writebytes2[1])+' '+inttostr(writebytes2[2]);
раскоментить остальную часть
то возникает странная ошибка
и у меня сложилось впечатление что команда ReadFile в цикле ничего не читает на самом деле
так как что бы я ни послал в один порт на выходе в массиве writebytes2 одно и то же

Romikgy

Дата 8.6.2009, 14:54 (ссылка)

(нет голосов)

Загрузка ...

Любитель-программер

Профиль
Группа: Участник Клуба
Сообщений: 7326
Регистрация: 11.5.2005
Где: Porto Franco Odes sa

Репутация: 13
Всего: 146

1. я бы остановился на статическом массиве а не на динамике

Цитата(СЭНСЭЙ @ 6.6.2009, 11:32

)

setlength(writebytes,3);

т.к. вызов

Цитата(СЭНСЭЙ @ 6.6.2009, 11:32

)

WriteFile(comportout, writebytes, SizeOf(Outstring),
dwWrite, @OverWrite))

не гарантирует передачу именно внутреностей массива (могу и ошибатся ! то адресс откуда читать я бы указал явно !)
2. да и в вызове передача масива из 3 байт а количество байт на передачу от Outstring его длина не известна .... возможно 0 и тогда ничего не передастся или очень много и передашь муссор.....
3.

Цитата(СЭНСЭЙ @ 6.6.2009, 11:32

)

ReadFile(comportin, writebytes2, dwRead, dwRead, @OverRead) then

тоже имхо не хороший вызов dwRead, dwRead, я бы сделал 2 переменые ....
4. и зделай 2 буфера ,один для передачи , второй для приема , для наглядности

Цитата(СЭНСЭЙ @ 6.6.2009, 11:32

)

так как что бы я ни послал в один порт на выходе в массиве writebytes2 одно и то же

уйдет это имхо
5.

Цитата(СЭНСЭЙ @ 6.6.2009, 11:32

)

если в этой строке
edit1.text:=inttostr(writebytes2[0]);//+' '+inttostr(writebytes2[1])+' '+inttostr(writebytes2[2]);
раскоментить остальную часть
то возникает странная ошибка

какая ошибка?

--------------------

Владение русской орфографией это как владение кунг-фу — истинные мастера не применяют его без надобности.

1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: WinAPI и системное программирование \| Следующая тема »