[Harima Hario]

Пишу программу, под определенное устройство, которое в ПЗУ хранит информацию в формата:
…
$GPRMC,101072.00,A,5029.0728,N,03028.7404,E,000.0, 000.0,230111,02.2,E,A*0D
…
Для получения данных необходимо отправить команду «1». Полученное сохранить в *.txt файл.
Добился того, что программа отправляет команду, считывает информацию и записывает в текстовый файл, проблема в том как она её считывает и записывает…

В результате работы моей программы в файл записывается следующее:
(это маленький кусочек из текстового файла, я предполагаю, что это одна запись в формате выше)

Код:

???????????????????°?G??
???????????????????°?G??
??T 

Запускаю через hyper terminal – все нормально работает…
Даже не знаю в чем проблема, такое впечатление, что где-то что-то нужно инвертировать…
Код программы:

Код:

unit Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Registry,ReadThread;

type
  TMainForm = class(TForm)
    OpenPort: TButton;
    ClosePort: TButton;
    SendData: TButton;
    ReadData: TButton;
    PortStateLabel: TLabel;
    Label1: TLabel;
    Label2: TLabel;
    nToReadLabel: TLabel;
    nReadLabel: TLabel;
    Label3: TLabel;
    RcDataLabel: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    bRefreshComPrt: TButton;
    cbCOMPrts: TComboBox;
    cbSpeed: TComboBox;
    procedure OpenPortClick(Sender: TObject);
    procedure ClosePortClick(Sender: TObject);
    procedure SendDataClick(Sender: TObject);
    procedure ReadDataClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure bRefreshComPrtClick(Sender: TObject);
    procedure RefreshComPrt;
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    Port:THandle;
  end;

var
  MainForm: TMainForm;
  ReadThr:TReadThread;


implementation

{$R *.dfm}

procedure TMainForm.OpenPortClick(Sender: TObject);
Var
 DCB:TDCB;    //структура, содержащая настройки порта
 CommTimeouts:TCommTimeouts;
begin
  Port:=CreateFile(
    pWideChar(cbCOMPrts.Text),    //открываем первый порт
    GENERIC_READ or GENERIC_WRITE,//открываем порт для чтения и записи
    0,                            //общий доступ к ресурсу запрещен, для портов всегда так
    nil,                          //атрибуты защиты, не используются и потому nil
    OPEN_EXISTING,                //атрибуты открытия, для портов OPEN_EXISTING
    FILE_ATTRIBUTE_NORMAL,         //для синхронной работы так
    0                           //хз что это, но должно быть так
  );
 if (port=INVALID_HANDLE_VALUE)  //если порт не окрылся
  then showmessage('Ошибочка вышла!') //то выводим сообщение об ошибке
  else POrtStateLabel.Caption:='Порт открыт';       //Если порт открылся, то пишем что открылся

  GetCommState(port, DCB);        //что бы не заполнять всю структуру самим, сначал считываем ее, потом поменяем нужные поля
  DCB.BaudRate:=StrToInt(cbSpeed.Text); // скорость обмена
  DCB.Parity:=NoParity;           // нет контроля четности
  DCB.ByteSize:=8;                //байт из восьми бит
  DCB.StopBits:=ONESTOPBIT;       //один стоповый бит
  SetCommState(port, DCB);        //записываем измененную структуру, для открытого порта

  GetCommTimeouts(Port, CommTimeouts); //получаем структуру CommTimeouts что бы не заполнять все вручную
  CommTimeouts.ReadIntervalTimeout :=MAXDWORD;  //функция ReadFile возвращает
  CommTimeouts.ReadTotalTimeoutMultiplier := 0; //немедленно все имеющиеся
  CommTimeouts.ReadTotalTimeoutConstant := 0;   //байты в приемном буфере
  CommTimeouts.WriteTotalTimeoutMultiplier := 0;//общий тайм-аут для
  CommTimeouts.WriteTotalTimeoutConstant := 0;  //операции записи не используется.
  SetCommTimeouts(Port, CommTimeouts); //записываем измененную структуру

end;

procedure TMainForm.RefreshComPrt;
var
  reg : TRegistry;
  ts : TStrings;
  i : integer;
begin
  cbCOMPrts.Items.Clear;
  reg := TRegistry.Create;
  reg.RootKey := HKEY_LOCAL_MACHINE;
  reg.OpenKey('hardware\devicemap\serialcomm',
              false);
  ts := TStringList.Create;
  reg.GetValueNames(ts);
  for i := 0 to ts.Count -1 do begin
    cbCOMPrts.Items.Add(reg.ReadString(ts.Strings[i]));
  end;
  if cbCOMPrts.Items.Count>0 then
    cbCOMPrts.ItemIndex:=0;
  ts.Free;
  reg.CloseKey;
  reg.free;
end;


procedure TMainForm.bRefreshComPrtClick(Sender: TObject);
begin
  RefreshComPrt;
end;

procedure TMainForm.ClosePortClick(Sender: TObject);
begin
 if not CloseHandle(Port)                 //если порт  не закрылся
  then showmessage('Не закрылось')        //то пишем что он не закрылся
  else PortStateLabel.Caption:='Порт не открыт'   //если всетаки закрылся , то пишем, что закрылся :)
end;

procedure TMainForm.SendDataClick(Sender: TObject);
var
  TRBuf:PChar;    //буфер данных для передачи
  nToWrite:DWord; //число байт для записи
  nWrite:DWord;   //число записанных байт
begin
  TRBuf:='1';         //заполняем буфер данными
  nToWrite:=length(TRBuf)+1;        //число передаваемых байт
  WriteFile(port,TRBuf^,nToWrite,nWrite,nil); //собственно отпавляем данные
//  WriteFile(port,Edit1.Text[1],nToWrite,nWrite,nil); //собственно отпавляем данные
//  WriteFile(port,TRBuf[0],nToWrite,nWrite,nil); //собственно отпавляем данные
end;

procedure TMainForm.ReadDataClick(Sender: TObject);
Var
  RCBuf:PChar;        //Буфер данных для приема
  nToRead:Cardinal;   //Число байт для чтения
  ReadedBytes:integer; //число всего прочитанных байт
  nRead:Cardinal;     //Число прочитанных байт
  ComStat:TComStat;   //состояние порта
  Errs:Dword;
  Data:TStringList;  //прочитанные данные
begin
  ReadedBytes:=0;
  Data:=TStringList.Create;
  ClearCommError(POrt,Errs,@ComStat);       //считываем состояние порта
  nToRead:=ComStat.cbInQue;                 //считываем число байт для чтения из структуры
  nToReadLabel.Caption:=IntToStr(nToRead);  //выводим на форму число байт для чтения
  while ReadedBytes<nToRead do
  begin
    ReadFile(Port,RCBuf^,nToRead,nRead,nil);  //считываем данные
    nReadLabel.Caption:=IntToStr(nRead);      //выводим на форму число прочитанных байт
    ReadedBytes:=ReadedBytes+nRead;
    RcDataLabel.Caption:=RCBuf;
    Data.Add(RCBuf);
  end;
  Data.SaveToFile(ExtractFilePath(ParamStr(0))+'Output.txt');
  Data.Free;
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
  nToreadLabel.Caption:=''; //Очищаем метки
  nReadLabel.Caption:='';
  RcDataLabel.Caption:='';
  ReadThr:=TReadThread.Create(True);
  ReadThr.Priority:=tpNormal;
  ReadThr.FreeOnTerminate:=True;
  ReadThr.Start;
end;

procedure TMainForm.FormShow(Sender: TObject);
begin
  RefreshComPrt;
end;

procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
//CloseHandle(Port)                 //закрываем порт
end;

end.

Надеюсь на вашу помощь, заранее спасибо.

[Assistant]

советую тут поискать готовый компонент для работы с COM портом

P.S.: наверное под GPS треккер пишешь или автомобильный черный ящик? ))

[movnet]

ComPort Library

[odysseysh]

Чтобы не создавать новую тему решил добавить свой вопрос.

Подскажите если кто знает решение проблемы. Пишу в Delphi програму для опроса "железки" по com порту. Сначала попытался через CreateFile, WriteFile и ReadFile, со всеми сопутствующими. Но отправляют они в ASCII, а запрос имеет форму 0x0E1234560000000F12345678ABCD, попытка преобразовать в ASCII побайтно и затем послать никчему не привела. Причина в байтах с 5 по 7 которые обязательно должны быть 0x00 то бишь null, также могут быть 0x00 и на других позициях. Стандартными средствами преобразовать в PChar не получается, стопорится на первом же 0x00. Также есть проблема при получении ответа, который имеет аналогичный вид. Приходит все кроме 0x00. Как я понимаю последнее связано с флагом dcb NullStrip но я не нашел нигде как его изменить, а также и с вышеизложеной проблемой.

Попытался использовать компоненты CPort BCPort, но или там нет, или я не нашел как отправить/принять в шестнадцатиричной форме запрос. А готовые примеры также "съедают" 0x00 а то и все что после.

Может кто подскажет как обойти эту проблему, или компонент который коректно будет работать?

[HunteRus]

Вот все необходимые функции для работы с com'ами у меня принимает все байты и типа 0x00.

Код:

function PortInit : boolean; //инициализация порта
var
    ct: TCommTimeouts;
    dcb: TDCB;
    comport_arr :^char;
    ptmp        :^char;

    i:integer;
begin

  f := Windows.CreateFile(PChar(comport), GENERIC_READ or   // comport - переменная типа string, номер компорта в формате 'COM3', 'COM11', 'COM1' и т.п.
                              GENERIC_WRITE,
                              FILE_SHARE_READ or FILE_SHARE_WRITE,
                              nil, OPEN_EXISTING,
                              FILE_ATTRIBUTE_NORMAL, 0);
  if (f <= 0) or not Windows.SetupComm(f, 2048, 2048)or not
      Windows.GetCommState(f, dcb) then exit; //init error

  dcb.BaudRate := 9600;
  dcb.StopBits := 0;
  dcb.Parity := 2;
  dcb.ByteSize := 8;
  if not Windows.SetCommState(f, dcb)
  or not Windows.GetCommTimeouts(f, ct) then exit; //error
  ct.ReadTotalTimeoutConstant := 50;
  ct.ReadIntervalTimeout := 50;
  ct.ReadTotalTimeoutMultiplier := 1;
  ct.WriteTotalTimeoutMultiplier := 0;
  ct.WriteTotalTimeoutConstant := 10;
  if not Windows.SetCommTimeouts(f, ct)
  or not Windows.SetCommMask(f, EV_RING + EV_RXCHAR + EV_RXFLAG + EV_TXEMPTY)
then exit; //error
  PortInit := true;
end;

function DoneComm: boolean; //закpыть поpт
begin
  DoneComm := Windows.CloseHandle(f);
end;

function PostComm(var Buf; size: word): integer; //пеpедача в поpт
var
        p: pointer;
        i: cardinal;
begin
  p := @Buf;
  result := 0;
  while size > 0 do begin

    if not WriteFile(f, p^, 1, i, nil) then exit;
    inc(result, i); inc(integer(p)); dec(size);
    Application.ProcessMessages;
    end;
  PostComm := result;
end;

function ReadComm(var Buf; size: word): integer; //пpием из поpта
var
        i: cardinal;
        ovr: TOverlapped;
begin
  fillChar(buf, size, 0);
  fillChar(ovr, sizeOf(ovr), 0); i := 0; result := -1;
  if not windows.ReadFile(f, buf, size, i, @ovr) then exit;
  result := i;
  ReadComm := result;
end;

Вначале нужно сделать инициализацию comporta затем чтобы что-то отправить или принять пользуемся процедурами PostComm и ReadComm
отправляем и принимаем массивами байтов.

Код:

var ByteArr: array [1..4] of byte;

для отправки я делаю так:

Код:

var ByteArr: array [1..4] of byte = 
(0x02, 0x00, 0x00, 0x00);

Так-же не забываем что первые два байта обычно информационные и несут размер последующего сообщения.

Из любого места программы вызываем так:

Код:

PostComm(ByteArr, 4); // Вторым числом указываем размер массива

И так на приём:

Код:

ReadComm(ByteArr, 4); // Здесь массив можно ставить больше размера входящей информации т.к. изначально размер скорее всего неизвестен

Надеюсь я помог .

[flur]

как же применить Ваш код программы ком порта
вставить в Unit и сохранить что ли или как то по другому обьясните а то я еще чайник в этом деле . мне например надо отправить число 22 и получить назад какое то число и по получению числа сделать что то ну закрасить круг например