Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "WinAPI";
Текущий архив: 2015.03.01;
Скачать: [xml.tar.bz2];

Вниз

ввод вывод COM   Найти похожие ветки 

 
oxothuk   (2010-04-11 17:46) [0]

не могу разобраться до конца с последовательным портом:(
Проблема такая, вот 2 модуля... В итоге получаю, что записывается нормально, а считывается только например  первых 12 кб файла и все поток прекращается( гляньте пожалуйста.

первый модуль:

interface ...
type
 TComPort = class;
 EComPortError = class(Exception);
 {поток чтения}
 TReadThread = class(TThread)
 private
   FBuf: array [0..100000] of byte;
   FComPort: TComPort;
   FOverRead: TOverlapped;
   FRead: DWORD;
   procedure DoRead;
 protected
   procedure Execute; override;
 public
   constructor Create(ComPort: TComPort);
   destructor Destroy; override;
 end;
 TReadEvent = procedure(Sender: TObject; ReadBytes: array of byte) of object;

 TComPort = class
 private
   FOverWrite: TOverlapped;
   FPort: THandle;
   FPortName: String;
   FReadEvent: TReadEvent;
   FReadThread: TReadThread;
 public
   constructor Create(PortNumber: Cardinal; dcb: Tdcb);
   destructor Destroy; override;
   procedure Write(WriteBytes: array of Byte);
 published
   property OnRead: TReadEvent read FReadEvent write FReadEvent;
   property PortName: String read FPortName;
 end;

implementation

constructor TReadThread.Create(ComPort: TComPort);
begin
 FComPort := ComPort;
 ZeroMemory(@FOverRead, SizeOf(FOverRead));
 FOverRead.hEvent := CreateEvent(nil, True, False, nil);
 if FOverRead.hEvent = Null then raise EComPortError.Create("Error creating read event");
 inherited Create(False);
end;

destructor TReadThread.Destroy;
begin
 CloseHandle(FOverRead.hEvent);
 inherited Destroy;
end;

procedure TReadThread.Execute
var ComStat: TComStat;
   dwMask, dwError,dwRead: DWORD;
begin
  FreeOnTerminate := True;
 while not Terminated do
 begin
   if not WaitCommEvent(FComPort.FPort, dwMask, @FOverRead) then
   begin
     if GetLastError = ERROR_IO_PENDING then  WaitForSingleObject(FOverRead.hEvent, INFINITE)
     else
     raise EComPortError.Create("Error waiting port " + FComPort.PortName+ " event");
   end;
   if not ClearCommError(FComPort.FPort, dwError, @ComStat) then raise EComPortError.Create("Error clearing port " + FComPort.PortName);
   FRead :=ComStat.cbInQue;
   if FRead > 0 then
   begin
     if not ReadFile(FComPort.FPort, FBuf, FRead, dwRead, @FOverRead) then raise EComPortError.Create("Error reading port " + FComPort.PortName);
     Synchronize(DoRead);
   end;
 end;
end;

procedure TReadThread.DoRead;
var  arrBytes: array of Byte;
    i: Integer;
begin
 if Assigned(FComPort.FReadEvent) then
 begin
   SetLength(arrBytes, FRead);
   for i := Low(FBuf) to FRead-1 do   arrBytes[i] := FBuf[i];
   PURGE_RXABORT or PURGE_TXCLEAR or PURGE_RXCLEAR);
   FComPort.FReadEvent(Self, arrBytes);
 end;
 arrBytes := nil;
end;

constructor TComPort.Create(PortNumber: Cardinal; dcb:Tdcb);
var   tms: TCommTimeouts;
     cmpPrt:TCOMMPROP;
begin
 inherited Create;
 CntByte:=0;
 ZeroMemory(@FOverWrite, SizeOf(FOverWrite));
 FPortName := "COM" + IntToStr(PortNumber);
 FPort := CreateFile(PChar(FPortName), GENERIC_READ or GENERIC_WRITE, 0, nil, OPEN_EXISTING, FILE_FLAG_OVERLAPPED, 0);
 if FPort = INVALID_HANDLE_VALUE then  raise EComPortError.Create("Error opening port " + PortName);
 try  
   if not GetCommState(FPort, Dcb) then raise EComPortError.Create("Error setting port " + PortName + " state");
   tms.ReadIntervalTimeout := 1;
   tms.ReadTotalTimeoutMultiplier := 0;
   tms.ReadTotalTimeoutConstant := 1;
   tms.WriteTotalTimeoutMultiplier := 0;
   tms.WriteTotalTimeoutConstant := 0;
   if not SetCommTimeouts(FPort ,tms)  then raise EComPortError.Create("Error setting port " + PortName + "timeouts");
   if not SetCommState(FPort, Dcb) then raise EComPortError.Create("Error setting port " + PortName + " state");
   if not SetupComm(FPort,1024,1024)then raise EComPortError.Create("Error setting port " + PortName + "Queue Size");
   if not PurgeComm(FPort, PURGE_TXCLEAR or PURGE_RXCLEAR) then raise EComPortError.Create("Error purging port " + PortName);
   if not SetCommMask(FPort, EV_RXCHAR) then raise EComPortError.Create("Error setting port " + PortName + " mask");

   FOverWrite.hEvent := CreateEvent(nil, True, False, nil);
   if FOverWrite.hEvent = Null then raise EComPortError.Create("Error creating write event");

   FReadThread := TReadThread.Create(Self);
 except
   CloseHandle(FOverWrite.hEvent);
   CloseHandle(FPort);
   raise;
 end;
end;

destructor TComPort.Destroy;
begin
 if Assigned(FReadThread) then  FReadThread.Terminate;
 CloseHandle(FOverWrite.hEvent);
 CloseHandle(FPort);
 inherited Destroy;
end;

procedure TComPort.Write(  WriteBytes: array of Byte);
var dwWrite,count: DWORD;
     i:integer;

begin
 if  (not WriteFile(FPort, WriteBytes, 1, dwWrite, @FOverWrite)) and (GetLastError <> ERROR_IO_PENDING) then raise EComPortError.Create("Error writing port " + PortName);
end;


 
oxothuk   (2010-04-11 17:46) [1]

вот и 2 модуль

unit Unit2;

interface

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

type

 TForm2 = class(TForm)
 {тут компоненты}...
   procedure OnRead(Sender: TObject; ReadBytes: array of Byte);
   procedure FormCreate(Sender: TObject);
   procedure Button2Click(Sender: TObject);
   procedure button1Click(Sender: TObject);
 private
   Port: TComPort;
 public
   { Public declarations }
 end;

var  Form2: TForm2;
     TmpDcb: TDcb;
     docfile:file;
     InTest,OutTest,rend: array  of byte;
     BufIn:array [0..4096] of byte;
     NR,EndF,r:integer;

implementation

{$R *.dfm}

procedure TForm2.Button1Click(Sender: TObject);
var i:integer;
begin
 TmpDcb.BaudRate:=(Combobox2.itemindex+1);
 TmpDcb.Parity := (Combobox3.itemindex);
 TmpDcb.ByteSize := StrToInt(Combobox1.Text);  
 TmpDcb.StopBits :=StrToInt(Combobox4.Text);
 Port := TComPort.Create(upDown1.Position, TmpDcb);
 Port.OnRead := OnRead;
end;

// функция сравнение файлов
procedure Compare(M1, M2: array of byte);
var i,j,min,sum1,sum2:integer;
   PrRas,PrOsh:real;
begin
 PrOsh:=0;
 sum1:=0;sum2:=0;
 PrRas :=100*abs(EndF-(Nr-1))/endf ;  
 For i:=0 to EndF do sum1:=sum1+M1[i];
 For i:=0 to Nr-1 do sum2:=sum2+M1[i];
 PrOsh:=100*abs(sum1-sum2)/sum1;
 ShowMessage("Percent discrepancy:  "+FloatToStr(PrRas)+" %.    "+"Percent mistake "+FloatToStr(PrOsh)+" %.");
end;

procedure TForm2.OnRead(Sender: TObject; ReadBytes: array of Byte);
var  i: Integer;
begin
 for i := Low(ReadBytes) to High(ReadBytes) do
 begin
    if (ProgressBar1.Position+i)<1000 then Memo1.Text := Memo1.Text + chr(ReadBytes[i])+".";
    OutTest[Nr]:=ReadBytes[i];
    inc(NR) ;
 end;
 ProgressBar1.Position := ProgressBar1.Position +High(ReadBytes);
     memo1.Lines.Add("");

 if   ProgressBar1.Position>= EndF-1 then
 begin
   Memo1.Text := Memo1.Text + "... size = "+intToStr(Nr);
   Compare(Intest,OutTest);
   memo1.Lines.Add("");
   Port.Destroy;
 end;
end;

procedure TForm2.Button2Click(Sender: TObject);
var Mainpath:string;
   i,j:integer;
   Tst:byte;
begin
openDialog1 := TOpenDialog.Create(self);
openDialog1.InitialDir := GetCurrentDir;
if OpenDialog1.Execute then
 begin
  AssignFile(DocFile, OpenDialog1.FileName);
  ReSet(DocFile,1);
  i:=0;r:=0;NR:=0;
  SetLength(InTest,Filesize(DocFile));
  SetLength(OutTest,2*Filesize(DocFile));
  while not Eof(DocFile) do
  begin
   BlockRead(DocFile,Tst, 1);  
   InTest[i]:=ord(Tst);
   BufIn[r]:=InTest[i];
   if r=4095 then
   begin
     Port.Write(BufIn); //отправляем на запись пакетами по 4 кб
     r:=0;
   end;
   if i<1000 then memRead1.Text := memRead1.Text +intToStr(InTest[i])+".";
   inc(i); inc(r);
  end;
  SetLength(rend,r);
  for  j:= 0 to r-1 do rend[j]:=BufIn[j];
  Port.Write(rend);
  EndF:=i-1;
  memRead1.Text := memRead1.Text + "...  size ="+intToStr(endf+1);
  ProgressBar1.Max :=EndF-1;
  CloseFile(DocFile);
 end;
end;
end.


 
Игорь Шевченко ©   (2010-04-11 19:17) [2]

предлагаешь этот .... скомпилировать и отладить ?


 
oxothuk   (2010-04-11 19:26) [3]

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


 
oxothuk   (2010-04-11 20:03) [4]

проблема с записью. помогите плиз


 
GanibalLector ©   (2010-04-11 23:15) [5]

Сперва ты говорил, что проблема с чтением. Теперь с записью.
Определился бы для начала.

Далее.

Этот кусок кода утомителен для меня. Я не стану трать свое время на его разбор. Как не станет и 99% пользователей данного ресурса. Я бы предложил тебе следующее. Установи PortMon, найди причину неудачи, выложи проблемный КУСОЧЕК кода. Справедливо ?


 
Германн ©   (2010-04-12 01:35) [6]


> Как не станет и 99% пользователей данного ресурса.

Этот код даже не скомпилируется.


 
oxothuk   (2010-04-12 08:18) [7]

понятно, ошибка такая вот:
http://s44.radikal.ru/i105/1004/c1/84300d363371.jpg
подскажите как лучше ее решить?


 
Вариант   (2010-04-12 09:21) [8]


> oxothuk   (12.04.10 08:18) [7]
>


Весь код не смотрел. Но кое-что отмечу
Работа с портом ведется неверно. Порт открывается с флагом FILE_FLAG_OVERLAPPED,  а чтение и запись осуществляются без учета этого. Этого уже достаточно для неверной работы программы - точнее для непредвиденного для тебя результата ее работы. +
По картинке - а сколь сколько там стоп битов показывается?


 
Anatoly Podgoretsky ©   (2010-04-12 09:32) [9]


> По картинке - а сколь сколько там стоп битов показывается?

ERROR


 
oxothuk   (2010-04-12 09:45) [10]


> Вариант

а можно немного подробней... не могу понять(


 
Вариант   (2010-04-12 10:00) [11]


> oxothuk   (12.04.10 09:45) [10]

Кратко - ты сказал при открытии порта, что работать будешь в асинхронном режиме, а работаешь так, будто у тебя синхронный режим.  Да и странно что у тебя стоп битов показывает ERROR....

Поищи книгу Агурова по программированию последовательных интерфейсов (в гугле по фамилии автора например). Или почитай статьи на сайте Королевство дельфи. Ибо пересказать здесь все, на это - нет ни времени ни возможности.


 
oxothuk   (2010-04-12 10:02) [12]

я добился чтобы все данные считавались...но терь они считываются как то сумбурно( перемешиваются


 
oxothuk   (2010-04-12 10:03) [13]

ясн, спасиб, будем изучать


 
Anatoly Podgoretsky ©   (2010-04-12 11:52) [14]

> Вариант  (12.04.2010 10:00:11)  [11]

Чего странного, у него же значение берется из Edit без какого либо контроля допустимости.


 
oxothuk   (2010-04-12 14:33) [15]

спасибо за прогу PortMon.
Разобрался и исправил все) терь нормально конфигурацию задает и асинхронно записывает и считывает все данные:)



Страницы: 1 вся ветка

Форум: "WinAPI";
Текущий архив: 2015.03.01;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.5 MB
Время: 0.002 c
2-1390982978
i2e
2014-01-29 12:09
2015.03.01
Как закрыть то, что создано как MessageDlg, из программы?


2-1389352594
Xmen
2014-01-10 15:16
2015.03.01
из Excel в шаблон PDF


1-1329848628
_i
2012-02-21 22:23
2015.03.01
освобождение объектов в treeview..


15-1403526910
Дмитрий СС
2014-06-23 16:35
2015.03.01
VPN сервер


11-1256294410
Валера
2009-10-23 14:40
2015.03.01
Есть ли парсер XML на KOL ?





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский