Доброе время суток!
Сделал небольшую программу для считывания
показаний с прибора Метран-900, но он не отвечает.
Может, кто подскажет, где ошибка?
Для считывания показаний в Метран-900 нужно
отправить последовательность байт в HEX-формате:
01 55 4D FF FF 00 00.
Вот текст:
| Код |
unit Unit0;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Memo1: TMemo;
Memo2: TMemo;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
var
hCommFile: THandle;
DCB: TDCB;
ct: TCommTimeouts;
procedure TForm1.Button1Click(Sender: TObject);
var
CommPort: String;
begin
CommPort:='COM2';
hCommFile:=CreateFile(PChar(CommPort),
GENERIC_READ or GENERIC_WRITE,
0,
nil,
OPEN_EXISTING,
FILE_ATTRIBUTE_NORMAL,
0);
if hCommFile=INVALID_HANDLE_VALUE
then
begin
ShowMessage('Unable to open '+CommPort);
exit;
end
else Button1.Hide;
FillChar(DCB,Sizeof(DCB),0);
DCB.DCBlength:=Sizeof(DCB);
if not GetCommState(hCommFile,DCB)
then
begin
ShowMessage('Error1');
Exit;
end;
DCB.BaudRate:=9600;
DCB.ByteSize:=8;
DCB.Parity:=NOPARITY;
DCB.StopBits:=ONESTOPBIT;
if not SetCommState(hCommFile,DCB)
then
begin
ShowMessage('Error2');
Exit;
end;
FillChar(ct,Sizeof(ct),0);
if not GetCommTimeouts(hCommFile,ct)
then
begin
ShowMessage('Error3');
Exit;
end;
ct.ReadIntervalTimeout:=1;
ct.ReadTotalTimeoutMultiplier:=1;
ct.ReadTotalTimeoutConstant:=10;
ct.WriteTotalTimeoutMultiplier:=1;
ct.WriteTotalTimeoutConstant:=5;
if not SetCommTimeouts(hCommFile,ct)
then
begin
ShowMessage('Error4');
exit;
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
S0: array[0..31] of Char;
PData: Pointer;
nWrite: Cardinal;
CurrentState: TComStat;
CodeError,AvaibleBytes,RealRead: Cardinal;
S,FInBuf: String;
i: Integer;
begin
PurgeComm(hCommFile,PURGE_TXCLEAR or PURGE_RXCLEAR);
FillChar(S0,32,0);
StrPCopy(S0,Memo1.Text);
if not WriteFile(hCommFile,S0,StrLen(S0),nWrite,nil)
then
begin
ShowMessage('Can not write to port: ' + IntToStr(GetLastError));
Exit;
end
else
begin
ShowMessage('Write to port: ' + IntToStr(nWrite) + ' bytes');
end;
ClearCommError(hCommFile,CodeError,@CurrentState);
AvaibleBytes:=CurrentState.cbInQue;
if AvaibleBytes > 0
then
begin
GetMem(PData,AvaibleBytes);
if not ReadFile(hCommFile,PData^,AvaibleBytes,RealRead,nil)
then
ShowMessage('Can not read from port: ' + IntToStr(GetLastError))
else
begin
ShowMessage('Read ' + IntToStr(RealRead) + ' bytes');
S:='';
FInBuf:='';
for i:=0 to RealRead-1 do
begin
S:=S+Char(Pointer(LongInt(PData)+i)^);
end;
FInBuf:=FInBuf + S;
Memo2.Text:=FInBuf;
end;
FreeMem(PData);
end;
CloseHandle(hCommFile);
end;
end. |
|