{
2019/08/16 初版作成
2019/08/19 受信廻りのコードを整理、修正
}
unit Unit4;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, OoMisc, AdPort, Vcl.Grids,
AdSelCom, Vcl.Buttons, IniFiles, Vcl.ExtCtrls, Vcl.ComCtrls;
type
TForm4 = class(TForm)
ApdComPort1: TApdComPort;
StringGrid1: TStringGrid;
Edit4: TEdit;
Label1: TLabel;
Edit5: TEdit;
Edit6: TEdit;
CheckBox1: TCheckBox;
Label2: TLabel;
Edit7: TEdit;
Label3: TLabel;
ComboBox1: TComboBox;
ComboBox2: TComboBox;
ComboBox3: TComboBox;
ComboBox4: TComboBox;
ComboBox5: TComboBox;
SpeedButton1: TSpeedButton;
SpeedButton2: TSpeedButton;
SpeedButton3: TSpeedButton;
SpeedButton4: TSpeedButton;
SpeedButton5: TSpeedButton;
SpeedButton6: TSpeedButton;
Label4: TLabel;
Edit1: TEdit;
Label5: TLabel;
Edit2: TEdit;
Edit3: TEdit;
Label6: TLabel;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
BitBtn3: TBitBtn;
Timer1: TTimer;
UpDown1: TUpDown;
procedure ApdComPort1TriggerAvail(CP: TObject; Count: Word);
procedure FormCreate(Sender: TObject);
procedure CheckBox1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
procedure Edit4KeyPress(Sender: TObject; var Key: Char);
procedure BitBtn1Click(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
procedure BitBtn3Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure StringGrid1KeyPress(Sender: TObject; var Key: Char);
procedure StringGrid1Click(Sender: TObject);
procedure UpDown1Click(Sender: TObject; Button: TUDBtnType);
private
{ Private 宣言 }
public
{ Public 宣言 }
buf : string;
cmdMode : integer;
mbId : Byte; // 機器のID
mbFuncCode : Byte; // Modbus function code
mbBytes : Byte; // データのバイト数s
mbErrorCode : Byte; // エラーコード
txbuf : array [0..41] of Byte; // 送信用バッファ
rxBuf : array [0..36] of Byte; // 受信用バッファ
rxIndex : integer; // カウンター
edIndex : integer; // データの終端
readId : Byte; // Read時のID
readAdr : Word; // Read時のアドレス
readData : array [0..15] of word; // 受信データ格納
writeData : array [0..15] of word; // 送信データ格納
DIbuf : array [0..15] of bool; // Digital Input
// Comport 設定
procedure setComPortParams;
procedure clearEdits;
end;
var
Form4: TForm4;
implementation
{$R *.dfm}
// n の k 乗 (Math ユニット不要)
function IntPower(n, k : integer):integer;
var
i : integer;
begin
result := 1;
for i := 1 to k do result := result * n;
end;
function CRC16(buf : array of Byte; BufLen: integer): word;
// crc16 計算
// azbil SDC 取扱説明書 詳細編 CRC計算 を pascal に移植
var
i, j : integer;
carry : word;
crc : word;
crcl : Byte;
begin
crc := $FFFF;
for i := 0 to BufLen - 1 do begin
crc := word(crc xor Ord(Buf[i]));
for j := 0 to 7 do begin
carry := crc and $0001;
crc := crc shr 1;
if carry = 1 then
crc := crc xor $A001;
end;
end;
crcl := (crc and $FF00) shr 8;
crc := crc shl 8;
crc := crc or crcl;
result := crc;
end;
procedure TForm4.setComPortParams;
// Comport 設定
var
s : string;
begin
with ComboBox1 do
if ItemIndex >= 0 then begin
s := Copy(Items[ItemIndex], 4);
ApdComPort1.ComNumber := StrToIntDef(s, 0);
end;
with ComboBox2 do
if ItemIndex >= 0 then ApdComPort1.Baud := StrToIntDef(Items[ItemIndex], 19200);
with ComboBox3 do
if ItemIndex >= 0 then ApdComPort1.DataBits := ItemIndex + 7;
with ComboBox4 do
if ItemIndex >= 0 then ApdComPort1.Parity := TParity(ItemIndex);
with ComboBox5 do
if ItemIndex >= 0 then ApdComPort1.StopBits := ItemIndex + 1;
end;
procedure TForm4.clearEdits;
begin
Edit1.Text := '';
Edit2.Text := '';
Edit3.Text := '';
Edit5.Text := '';
Edit6.Text := '';
end;
procedure TForm4.SpeedButton1Click(Sender: TObject);
// アドレス UP/DOWN
var
adr : integer;
stp : integer;
btn : TSpeedButton;
begin
btn := Sender as TSpeedButton;
// データの先頭アドレス
if CheckBox1.Checked then begin
stp := StrToInt(Copy(btn.Caption, 1, 1) + '$' + Copy(btn.Caption, 2));
adr := StrToIntDef('$' + Edit4.Text, 0);
adr := adr + stp;
if adr > $ffff then adr := $ffff;
if adr < 0 then adr := 0;
Edit4.Text := IntToHex(adr, 4);
end
else begin
stp := StrToInt(btn.Caption);
adr := StrToIntDef(Edit4.Text, 0);
adr := adr + stp;
if adr > $ffff then adr := $ffff;
if adr < 0 then adr := 0;
Edit4.Text := IntToStr(adr);
end;
BitBtn2Click(self);
end;
procedure TForm4.StringGrid1Click(Sender: TObject);
begin
// COL = 4 のみ編集許可
with StringGrid1 do
if Col = 4 then Options := Options + [goEditing]
else Options := Options - [goEditing];
end;
procedure TForm4.StringGrid1KeyPress(Sender: TObject; var Key: Char);
begin
// Enter キーで再読み込み
if Key = #13 then begin
Key := #0;
with StringGrid1 do begin
if (Col = 4) and (Cells[Col, Row] <> '') then begin
BitBtn1Click(self);
end;
end;
end;
end;
procedure TForm4.Timer1Timer(Sender: TObject);
begin
// 再読み込み
if cmdMode = 101 then begin
Timer1.Enabled := false;
BitBtn2Click(self);
StringGrid1.SetFocus;
end;
end;
procedure TForm4.UpDown1Click(Sender: TObject; Button: TUDBtnType);
begin
// 再読み込み
BitBtn2Click(self);
end;
procedure TForm4.ApdComPort1TriggerAvail(CP: TObject; Count: Word);
var
i, j, k : Word;
B : array [0..511] of Byte;
s : string;
begin
ApdComPort1.GetBlock(B, Count);
// 受信バイナリデータを文字列にする
for i := 0 to Count -1 do begin
buf := buf + IntToHex(B[i], 2);
rxBuf[rxIndex] := B[i];
case rxIndex of
0: begin
mbId := B[i];
Edit1.Text := IntToStr(mbId);
end;
1: begin
mbFuncCode := B[i];
Edit2.Text := IntToHex(mbFuncCode, 2);
end;
end;
Inc(rxIndex);
if rxIndex > 2 then begin
if rxIndex = 3 then begin
mbErrorCode := 0; // エラーコードをクリア
Edit3.Text := '';
if mbFuncCode and $80 > 0 then begin
mbBytes := 0;
mbErrorCode := rxBuf[2];
// 異常
case mbErrorCode of
0: s := '';
1: s := 'スレーブは当該ファンクションをサポートしていない';
2: s := '指定されたデータアドレスは、スレーブには存在しない';
3: s := '指定されたデータは、許されない';
else s := 'その他の異常';
end;
Edit3.Text := s;
if s <> '' then begin
Edit3.Text := s;
ShowMessage(s);
end;
edIndex := 4;
end
// 正常
else begin
mbBytes := rxBuf[2];
case mbFuncCode of
1..4 : edIndex := mbBytes + 4;
5, 6, 8, $0B, $0F, $10 : edIndex := 7;
end;
end;
end;
// 最終まで取得終了
if rxIndex > edIndex then begin
if mbFuncCode <= $02 then begin
for j := 0 to mbBytes -1 do begin
with StringGrid1 do begin
Cells[3, j * 8 + 1] := IntToHex(rxBuf[3 + j], 2);
for k := 0 to 15 do begin
DIBuf[k] := rxBuf[3 + j] and IntPower(2, k) > 0;
if DIbuf[k] then Cells[2, j * 8 + k + 1] := '1'
else Cells[2, j * 8 + k + 1] := '0';
end;
end;
if j > 0 then break;
end;
end;
if (mbFuncCode = $03) or (mbFuncCode = $04) then begin
for j := 0 to mbBytes div 2 -1 do begin
readData[j] := rxBuf[3 + j * 2] shl 8 + rxBuf[3 + j * 2 + 1];
with StringGrid1 do begin
Cells[2, j + 1] := IntToStr(readData[j]);
Cells[3, j + 1] := IntToHex(readData[j], 4);
end;
if j >= 15 then break;
end;
// データ数が 16 に満たない時
if mbBytes div 2 <= 15 then begin
for j := mbBytes div 2 to 15 do
with StringGrid1 do begin
Cells[2, j + 1] := '';
Cells[3, j + 1] := '';
end;
end;
end;
// 受信データを 16 進で表示
buf := '';
for j := 0 to rxIndex - 1 do buf := buf + IntToHex(rxBuf[j], 2);
Edit6.Text := buf;
rxIndex := 0;
end;
end;
end;
end;
procedure TForm4.BitBtn1Click(Sender: TObject);
// WRITE (10H) x 1 データ
// 書き込みはリストの上から１個のみ
// 書き込み不可のアドレスでは、データ異常になる
var
i : integer;
adr : integer;
s : string;
crc : integer;
flag : boolean;
id : byte;
sgRow : integer;
begin
clearEdits;
sgRow := 0;
// 機器 ID
id := StrToIntDef(Edit7.Text, 1);
// データの先頭アドレス
if CheckBox1.Checked then adr := StrToIntDef('$' + Edit4.Text, -1)
else adr := StrToIntDef(Edit4.Text, -1);
if adr < 0 then ShowMessage('アドレスが不正です．')
else begin
if (id = readId) and (adr = readAdr) then flag := True
else begin
ShowMessage('読み込み時のID, アドレスが異なります．');
flag := false;
end;
if flag then begin
with StringGrid1 do begin
// データが読み込まれているか
for i := 1 to 16 do begin
if (Cells[2, i] = '') or (Cells[3, i] = '') then begin
ShowMessage('データが読み込まれていません．');
flag := false;
break;
end;
end;
// 書き込みデータがあるか
if flag then begin
flag := false;
for i := 1 to 16 do begin
if (Cells[4, i] <> '') then begin
flag := True;
sgRow := i;
break;
end;
end;
end;
if not flag then ShowMessage('書き込みデータがありません．')
else begin
writeData[0] := StrToInt(Cells[4, sgRow]);
adr := StrToInt('$' + Cells[1, sgRow]); //HEX ADR
end;
end;
end;
if flag then begin
txBuf[0] := id; // 機器アドレス
txBuf[1] := $10; // ファンクション番号
txBuf[2] := adr shr 8; // 先頭アドレス上位
txBuf[3] := adr and $ff; // 先頭アドレス下位
txBuf[4] := 0; // 書き込みデータ数上位
txBuf[5] := 1; // 書き込みデータ数下位
txBuf[6] := 2; // 書き込みバイト数 = データ数 x 2
txBuf[7] := writeData[0] shr 8; // 書き込みデータ上位
txBuf[8] := writeData[0] and $ff; // 書き込みデータ下位
crc := CRC16(txBuf, 9);
txBuf[9] := crc shr 8; // crc上位
txBuf[10] := crc and $ff; // crc下位
with ApdComport1 do begin
setComPortParams;
try
Open := True;
rxIndex := 0;
PutBlock(txBuf, 11);
Sleep(10);
s := '';
for i := 0 to 10 do
s := s + IntToHex(txBuf[i], 2);
Edit5.Text := s;
with StringGrid1 do begin
ShowMessage(
'機器ID : ' + Edit7.Text + #13 +
'アドレス : ' + Cells[0, sgRow] + ' (hex = ' + Cells[1, sgRow] + ')' + #13 +
'データ : [ ' + Cells[2, sgRow] + ' ] -> [ ' + Cells[4, sgRow] + ' ]' + #13 +
'送信しました． 再読み込みします．');
Cells[4, sgRow] := '';
end;
// 再読み込み
cmdMode := 101;
Timer1.Interval := 500;
Timer1.Enabled := True;
except
end;
end;
end;
end;
end;
procedure TForm4.BitBtn2Click(Sender: TObject);
// READ (03H) 16 データ
var
adr : integer;
crc : integer;
s : string;
i: integer;
id : byte;
begin
clearEdits;
// 機器 ID
id := StrToIntDef(Edit7.Text, 1);
// データの先頭アドレス
if CheckBox1.Checked then adr := StrToIntDef('$' + Edit4.Text, -1)
else adr := StrToIntDef(Edit4.Text, -1);
if adr < 0 then ShowMessage('アドレスが不正です．')
else begin
with StringGrid1 do begin
for i := 1 to 16 do begin
Cells[0, i] := IntToStr(adr + i - 1);
Cells[1, i] := IntToHex(adr + i - 1, 4);
Cells[2, i] := '';
Cells[3, i] := '';
end;
end;
txBuf[0] := id; // 機器アドレス
txBuf[1] := 3; // ファンクション番号
txBuf[2] := adr shr 8; // 先頭アドレス上位
txBuf[3] := adr and $ff; // 先頭アドレス下位
txBuf[4] := 0; // 読み出し数上位
txBuf[5] := 16; // 読み出し数下位
crc := CRC16(txBuf, 6);
txBuf[6] := crc shr 8; // crc上位
txBuf[7] := crc and $ff; // crc下位
with ApdComport1 do begin
setComPortParams;
try
Open := True;
rxIndex := 0;
PutBlock(txBuf, 8);
Sleep(10);
s := '';
for i := 0 to 7 do s := s + IntToHex(txBuf[i], 2);
Edit5.Text := s;
// データ受信のIDと先頭アドレスを保持
readAdr := adr;
readId := id;
except
end;
end;
end;
end;
procedure TForm4.BitBtn3Click(Sender: TObject);
// WRITE (10H) x 16 データ
// 書き込み不可のアドレスでは、データ異常になる
var
i : integer;
adr : integer;
s : string;
crc : integer;
flag : boolean;
id : byte;
begin
clearEdits;
// 機器 ID
id := StrToIntDef(Edit7.Text, 1);
// データの先頭アドレス
if CheckBox1.Checked then adr := StrToIntDef('$' + Edit4.Text, -1)
else adr := StrToIntDef(Edit4.Text, -1);
if adr < 0 then ShowMessage('アドレスが不正です．')
else begin
if (id = readId) and (adr = readAdr) then
flag := True
else begin
ShowMessage('読み込み時のID, アドレスが異なります．');
flag := false;
end;
if flag then begin
with StringGrid1 do begin
// データが読み込まれているか
for i := 1 to 16 do begin
if (Cells[2, i] = '') or (Cells[3, i] = '') then begin
ShowMessage('データが読み込まれていません．');
flag := false;
break;
end;
end;
// 書き込みデータがあるか
if flag then begin
flag := false;
for i := 1 to 16 do begin
if (Cells[4, i] <> '') then begin
flag := True;
break;
end;
end;
end;
if not flag then ShowMessage('書き込みデータがありません．')
else
for i := 1 to 16 do
if Cells[4, i] <> '' then writeData[i-1] := StrToInt(Cells[4, i])
else writeData[i-1] := readData[i-1];
end;
end;
if flag then begin
txBuf[0] := id; // 機器アドレス
txBuf[1] := $10; // ファンクション番号
txBuf[2] := adr shr 8; // 先頭アドレス上位
txBuf[3] := adr and $ff; // 先頭アドレス下位
txBuf[4] := 0; // 書き込みデータ数上位
txBuf[5] := 16; // 書き込みデータ数下位
txBuf[6] := 32; // 書き込みバイト数 = データ数 x 2
for i := 0 to 15 do begin
txBuf[7 + i * 2] := writeData[i] shr 8; // 書き込みデータ上位
txBuf[8 + i * 2] := writeData[i] and $ff; // 書き込みデータ下位
end;
crc := CRC16(txBuf, 7 + 32);
txBuf[7 + 32] := crc shr 8; // crc上位
txBuf[8 + 32] := crc and $ff; // crc下位
// 最終はtxbuf[40]
with ApdComport1 do begin
setComPortParams;
try
Open := True;
rxIndex := 0;
PutBlock(txBuf, 41);
Sleep(10);
s := '';
for i := 0 to 40 do s := s + IntToHex(txBuf[i], 2);
Edit5.Text := s;
ShowMessage('送信しました． 再読み込みします．');
with StringGrid1 do for i := 1 to 16 do Cells[4, i] := '';
// 再読み込み
cmdMode := 101;
Timer1.Interval := 500;
Timer1.Enabled := True;
except
end;
end;
end;
end;
end;
procedure TForm4.CheckBox1Click(Sender: TObject);
var
n : integer;
begin
if CheckBox1.Checked then begin
n := StrToIntDef(Edit4.Text, -1);
if n < 0 then ShowMessage('アドレスが不正です．')
else Edit4.Text := IntToHex(n, 4);
end
else begin
n := StrToIntDef('$' + Edit4.Text, -1);
if n < 0 then ShowMessage('アドレスが不正です．')
else Edit4.Text := IntToStr(n);
end;
end;
procedure TForm4.Edit4KeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then begin
Key := #0;
BitBtn2Click(self);
end;
end;
procedure TForm4.FormCreate(Sender: TObject);
var
i : integer;
ini : TIniFile;
comNo : integer;
adr : word;
begin
clearEdits;
BitBtn3.Caption := 'WRITE (10H)' + #13#10 + '16 データ';
BitBtn1.Caption := 'WRITE (10H)' + #13#10 + '1 データ';
BitBtn2.Caption := 'READ (03H)' + #13#10 + '16 データ';
ini := TIniFile.Create(ChangeFileExt(ParamStr(0), '.ini'));
try
comNo := ini.ReadInteger('Com', 'PortNo', 0);
with ComboBox2 do
ItemIndex := Items.IndexOf(IntToStr(ini.ReadInteger('Com', 'Baud', 19200)));
ComboBox3.ItemIndex := ini.ReadInteger('Com', 'DataBits', 8) - 7;
ComboBox4.ItemIndex := ini.ReadInteger('Com', 'Parity', 2);
ComboBox5.ItemIndex := ini.ReadInteger('Com', 'StopBits', 1) - 1;
UpDown1.Position := ini.ReadInteger('Modbus', 'IDNUM', 1);
CheckBox1.Checked := ini.ReadBool('Modbus', 'HEX', true);
adr := ini.ReadInteger('Modbus', 'ADRDEC', 9000);
if not CheckBox1.Checked then Edit4.Text := IntToStr(adr)
else Edit4.Text := IntToHex(adr, 4);
finally
ini.Free;
end;
AdSelCom.ShowPortsInUse := False;
with ComboBox1 do begin
// 使用可能な Comport を検索
for i := 1 to 64 do
if AdSelCom.IsPortAvailable(i) then Items.Add (AdPort.ComName(i));
if Items.Count > 0 then
ItemIndex := Items.IndexOf('COM' + IntToStr(comNo));
end;
with StringGrid1 do begin
Cells[0, 0] := 'ADR(DEC)';
Cells[1, 0] := 'ADR(HEX)';
Cells[2, 0] := 'READ(DEC)';
Cells[3, 0] := 'READ(HEX)';
Cells[4, 0] := 'WRITE(DEC)';
end;
end;
procedure TForm4.FormDestroy(Sender: TObject);
var
ini : TIniFile;
comNo, baud : integer;
adr : word;
begin
if CheckBox1.Checked then adr := StrToIntDef('$' + Edit4.Text, 0)
else adr := StrToIntDef(Edit4.Text, 0);
ini := TIniFile.Create(ChangeFileExt(ParamStr(0), '.ini'));
try
comNo := 0;
with ComboBox1 do
if ItemIndex >= 0 then comNo := StrToIntDef(Copy(Items[ItemIndex], 4), 0);
ini.WriteInteger('Com', 'PortNo', comNo);
baud := 19200;
with ComboBox2 do
if ItemIndex >= 0 then baud := StrToIntDef(Items[ItemIndex], 19200);
ini.WriteInteger('Com', 'Baud', baud);
ini.WriteInteger('Com', 'DataBits', ComboBox3.ItemIndex+7);
ini.WriteInteger('Com', 'Parity', ComboBox4.ItemIndex);
ini.WriteInteger('Com', 'StopBits', ComboBox5.ItemIndex + 1);
ini.WriteInteger('Modbus', 'IDNUM', UpDown1.Position);
ini.WriteInteger('Modbus', 'ADRDEC', adr);
ini.WriteBool('Modbus', 'HEX', CheckBox1.Checked);
finally
ini.Free;
end;
end;
end.
