Форум программистов [Powered by Invision Power Board]

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

)

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

Код


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;

Код


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;

Код


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);

Код


 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;

Код


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.

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

)

setlength(writebytes,3);

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

)

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

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

)

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

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

)

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

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

)

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