Delphi->modbus->RTU->CRC16

Witam wszystkich

Mam problem próbuje skomunikować się ze sterownikiem SZH. Chcę przesłać zapytanie w protokole modbus z transmisją RTU. Do komunikacji używam klasy TDCB bez żadnych dodatkowych komponentów. Jeśli chodzi o CRC16 na końcu ramki:

var crc: word;
n,i: integer;
b:byte;
begin
crc := $FFFF;
for i:=0 to len-1 do begin
b:=Data[i];
crc := crc xor b;
for n:=1 to 8 do begin
if (crc and 1)<>0
then crc:=(crc shr 1) xor $A001
else crc:=crc shr 1;
end;
end;
Data[len]:=crc and $ff;
Data [len+1]:=crc shr 8;

Niestety sterownik do którego próbuje sie podłączyć zapisuje na jednym bitcie 2 liczby-> dwa znaki. Dodatkowo nie wiem jak mierzyć czas przesyły pojedynczego znaku a znakiem początku ramki jest jego 3,5 krotność.

Do przesyłu używam polecenia

WriteFile(hCommDev, Buffer_O, nNumberOfBytesToWrite,
NumberOfBytesWritten, NIL);

Ustawienia transmisji:

dcb.BaudRate := CBR_9600;
dcb.Flags := dcb_fParity;
dcb.Parity := NOPARITY;
dcb.StopBits :=ONESTOPBIT;
dcb.ByteSize :=8;

Pomóżcie
Tobiasz

Witam,
moja propozycja, weź najpierw spróbuj "dogadać" się z "sterownikiem SZH" poprzez komponent cport http://sourceforge.net/projects/comport/
tym sposobem będziesz wiedział czy dobre wysyłasz do niego dane i czy dobrze wyliczasz crc, a później okodujesz sobie przez klasę TDCB.
Pozdrawiam

ps. proszę znalazłem kiedyś na sieci taka funkcję może ci się przyda...

 function CRCArray16(text: String):Word;
var
  crc : LongInt;
  i,j : Integer;
begin
  crc := $FFFF;
  for i := 1 to Length(text) do begin
    crc := Ord(text[i]) xor crc;
    for j := 1 to 8 do begin
      if (CRC and 1) = 1
        then CRC := (CRC shr 1) xor $A001
        else CRC := CRC shr 1;
    end;
  end;
  Result := crc;
end;

Dzięki

Tobiasz2 napisał(a)

Dzięki

Pomocy to znowu ja:

unit Unit1;

interface

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

type
TForm1 = class(TForm)
Button1: TButton;
RichEdit1: TRichEdit;
procedure Button1Click(Sender: TObject);
procedure CRC16(len:integer);
function int2bin(int:int64):string;
function int2hex(int:integer):string;
function bin2int(binary:string) :int64;
function poteN(liczba:int64;do_potegi:integer=2):int64;

private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}
const
// -- wartości znaczników sterujących portu szeregowego --
dcb_fBinary = True;
dcb_fParity = False;

// dcb_fOutxCtsFlow = False;
// dcb_fOutxDsrFlow = False;

// -- fDtrControl --
DTR_CONTROL_DISABLE = True;
RTS_CONTROL_DISABLE = True;

DTR_CONTROL_HANDSHAKE = True;
RTS_CONTROL_HANDSHAKE = True;

// dcb_fOutX = False;
// dcb_fInX = False;
dcb_fErrorChar = False;
dcb_fNull = False;

dcb_AbortOnError = False;

var

ramka:String='050330000001';
ramka_ost:String;
Buffer_O : array[1..64] of Char; // bufor wyjściowy
Data: array[1..8] of Integer;
// Buffer_O:Char;

• Buffer_I : ARRAY[1..cbInQueue] of Char; * bufor wejściowy
  // Number_Bytes_Read : DWORD;
  hCommDev : THANDLE;
  lpFileName : PChar;
  // fdwEvtMask : DWORD;
  // Stat : TCOMSTAT;
  // Errors : DWORD;
  dcb: TDCB;
  //--------------------------------------------------------------------

procedure TForm1.Button1Click(Sender: TObject);
var
nNumberOfBytesToWrite,NumberOfBytesWritten : DWORD;
i:Integer;
s:String;
begin
lpFileName:='Com1';

hCommDev:=CreateFile(lpFileName, GENERIC_READ or GENERIC_WRITE,0,NIL,OPEN_EXISTING,0,0);

// parametry transmisji
//dcb.DCBlength:=sizeof(dcb);
dcb.BaudRate:= CBR_9600;
dcb.Parity:= NOPARITY;
dcb.StopBits:=ONESTOPBIT;
dcb.ByteSize:=4;

SetCommState(hCommDev,dcb);

Data[1]:=5;//00000101;
Data[2]:=3;//00000011;
Data[3]:=48;//00110000;
Data[4]:=0;//00000000;
Data[5]:=0;//00000000;
Data[6]:=32;//00100000;

CRC16(6);

ramka:='';
ramka_ost:='';

// wypelnienie ramki
for i:=1 to 8 do
begin
// wypelnienie ramki po osiem bitów 2 znakami 05 03 30 00 00 20 (4A 96)<-CRC16
ramka:=ramka+int2bin(DATA[i]);
end;

//zamiana na znaki 16 znaków szestastkowych po jednym na 4 bity
for i:=1 to 16 do
begin
s:=Copy(ramka, (8*i-7), 8);
ramka_ost:=ramka_ost+int2hex(bin2int(s));
end;

// konwersja string na char
for i:=1 to length(ramka_ost) do
Buffer_O[ i]:= ramka_ost[i];

nNumberOfBytesToWrite:=8;
NumberOfBytesWritten:=8;

WriteFile(hCommDev, Buffer_O, nNumberOfBytesToWrite,
NumberOfBytesWritten, NIL);

CloseHandle(hCommDev);
end;

procedure TForm1.CRC16(len:integer);
var crc: word;
n,i: integer;
b:byte;
begin
crc := $FFFF;
for i:=1 to len do begin
b:=Data[i];
crc := crc xor b;
for n:=1 to 8 do begin
if (crc and 1)<>0
then crc:=(crc shr 1) xor $A001
else crc:=crc shr 1;
end;
end;
Data[len+1]:=crc and $ff;
Data [len+2]:=crc shr 8;
end;

function TForm1.int2bin(int:int64):string;
var strtemp:string;
s:string;
begin
while int>0 do
begin
insert(inttostr(int mod 2),strtemp,1);
int:= int div 2;
end;
s:='0';

if Length(strtemp)<8 then
repeat
strtemp:=Concat(s,strtemp);
until Length(strtemp)=8 ;

result:=(strtemp);
end;

function TForm1.int2hex(int:integer):string;
begin
result:=inttohex(int,2);
end;

function TForm1.poteN(liczba:int64;do_potegi:integer=2):int64;
begin

 case do_potegi of
   0:result:=1;
   1:result:=liczba;
  else
    PoteN:=liczba*PoteN(liczba,do_potegi-1);
end;

end;

function TForm1.bin2int(binary:string) :int64;
var I,j:integer;wynik:Int64;
begin
wynik:=0;
j:=0;
for i:=length(binary) downto 1 do
begin
wynik:=wynik+((strtoint((binary)[i])*( poten(2,j))));
inc(j);
end;
result:=wynik;
end;

function int2hex(int:integer):string;
begin
result:=inttohex(int,2);
end;

end.

Pomóżcie co tu jeszcze muszę poprawić?

tobiasz0606 napisał(a)

Pomóżcie co tu jeszcze muszę poprawić?

LOL a co nie działa?