MELSEC MX Component を Delphi XE5 で使う その2  2016/ 7/25 変更

  2017/ 1/11
  ※サンプルコードの Suspend(一時停止)、Resume(再開)は、最近の Delphi では使用不可(非推奨)になっています。
   また、Synchronize() の使い方が、適切ではありません。

■FX5UCPU EThernet ポート直結のサンプルです。

 ・起動と同時に通信を開始します。
 ・LAN ケーブル抜け、PLC 電源断等で、通信異常が発生した時は、2 秒周期で、再接続を試みます。
 ・通信正常時は、100 ミリ秒周期で、デバイスの値を取得します。
 ・マルチスレッドを使っています。


■ ActProgType 用 ほぼ実用コード

// 2017/ 1/11 追記
// Suspend(一時停止)、Resume(再開)は、最近の Delphi では使用不可(非推奨)になっています。
// また、Synchronize() の使い方が、適切ではありません。
// 必要な個所のみ、Synchronize()を使う例
{
  Synchronize(procedure() begin
    Form1.Label2.Text := 'Receive Error';
    ShowMessage('応答がありません.');
  end);
}

// -------------------------------------------------
// メイン
// -------------------------------------------------

unit MXCompoTest2Unit;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.OleCtrls,
  ActProgTypeLib_TLB, Vcl.StdCtrls;

type
  TForm3 = class(TForm)
    ActProgType1: TActProgType;
    Timer1: TTimer;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Edit4: TEdit;
    Edit5: TEdit;
    Edit6: TEdit;
    Edit7: TEdit;
    Edit8: TEdit;
    Edit9: TEdit;
    Edit10: TEdit;
    Edit11: TEdit;
    Edit12: TEdit;
    Edit13: TEdit;
    Edit14: TEdit;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Label1: TLabel;
    Label2: TLabel;
    Edit15: TEdit;
    Button5: TButton;
    Edit16: TEdit;
    procedure Timer1Timer(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form3: TForm3;

  GB_ReadCnt  : integer;
  GB_OpenCnt  : integer;
  GB_TmBusy   : boolean;
  GB_OpenFlag : boolean;

  // スレッドを保持
  Th : TThread;

  // プロトタイプ
  function HexToSingle(const hex: string): single;
  function HexToDouble(const hex: string): double;
  function SingleToHex(d: single) : String;
  function DoubleToHex(const d:  double): string;

  function PlcBufToSingle(var iData : array of integer): single;
  function PlcBufToDouble(var iData : array of Integer): double;
  function PlcBufToStr(var iData: array of Integer): string;
  function PlcBufToShort(var iData: array of Integer): SmallInt;
  function PlcBufToInt(var iData: array of Integer): integer;

  procedure ShortToPlcBuf(i : integer; var iData: array of Integer);
  procedure IntToPlcBuf(i : integer; var iData: array of integer);
  procedure SingleToPlcBuf(d : single; var iData: array of Integer);
  procedure DoubleToPlcBuf(d : double; var iData: array of Integer);
  procedure StrToPlcBuf(const s: string; var iData :array of integer);

implementation

{$R *.dfm}

uses MXCompoTest2ThreadUnit;

function PlcBufToShort(var iData: array of Integer): SmallInt;
begin
  Result := 0;
  if Length(iData) >= 1 then
    Result := Short(iData[0]);
end;

procedure ShortToPlcBuf(i : integer; var iData: array of Integer);
begin
  if Length(iData) >= 1 then
    iData[0] := i and $FFFF;
end;

function PlcBufToInt(var iData: array of Integer): integer;
begin
  result := 0;
  if Length(iData) >= 2 then
    Result := iData[1] * $10000 + iData[0];
end;

procedure IntToPlcBuf(i : integer; var iData: array of integer);
begin
  if Length(iData) >= 2 then begin
    iData[0] :=  i and $FFFF;
    iData[1] := (i and $FFFF0000) div $10000;
  end;
end;

//32ビット実数(単精度)変換
function HexToSingle(const hex: string): single;
var
  i : Integer;
  FloatValue: Single absolute i;
begin
  i := StrToInt('$' + hex);
  Result := FloatValue;
end;

function PlcBufToSingle(var iData : array of integer): single;
var
  i : Integer;
  FloatValue: Single absolute i;
begin
  if Length(iData) >= 2 then
    i := iData[1] * $10000 + iData[0];
  result := FloatValue;
end;

// 32 ビット実数(単精度)変換
function SingleToHex(d: single) : String;
var
  i : Cardinal absolute d;
begin
   Result := IntToHex(i, 8);
end;

// 32 ビット実数(単精度)変換
procedure SingleToPlcBuf(d : single; var iData: array of Integer);
var
  i : Cardinal absolute d;
begin
  if Length(iData) >= 2 then begin
    iData[0] :=  i and $FFFF;
    iData[1] := (i and $FFFF0000) div $10000;
  end;
end;

// 64 ビット実数(倍精度)変換
function DoubleToHex(const d:  double): string;
var
  Overlay:  Int64 absolute d;
begin
  result := IntToHex(Overlay, 16);
end;

procedure DoubleToPlcBuf(d : double; var iData: array of Integer);
var
  Overlay:  Int64 absolute d;
begin
  if Length(iData) >= 4 then begin
    iData[0] :=  Overlay and $FFFF;
    iData[1] := (Overlay and $FFFF0000) div $10000;
    iData[2] := (Overlay and $FFFF00000000) div $100000000;
    iData[3] := (Overlay and $FFFF000000000000) div $1000000000000;
  end;
end;

//64ビット実数(倍精度)変換
function HexToDouble(const hex: string): double;
var
  d      :  double;
  Overlay:  array[1..2] of LongInt absolute d;
begin
  result := 0.0;
  if   Length(hex) = 16 then begin
    Overlay[1] := StrToInt('$' + Copy(hex, 9, 8));
    Overlay[2] := StrToInt('$' + Copy(hex, 1, 8));
    result := d;
  end;
end;

// PLC 読み込みバッファを64ビット実数(倍精度)変換
function PlcBufToDouble(var iData : array of Integer): double;
var
  d      :  double;
  Overlay:  array [0..1] of LongInt absolute d;
begin
  result := 0.0;
  if   Length(iData) >= 4 then begin
    Overlay[0] := iData[1] * $10000 + iData[0];
    Overlay[1] := iData[3] * $10000 + iData[2];
    result := d;
  end;
end;

// PLC読み込み用バッファを文字列に
function PlcBufToStr(var iData: array of Integer): string;
var
  arycnt : integer;
  i : integer;
begin
  // 配列の大きさ
  arycnt := Length(iData);
  result := '';
  for i := 0 to arycnt - 1 do begin
    result := result + Char(iData[i] and $00FF);
    result := result + Char((iData[i] and $FF00) div $100);
  end;
end;

// 文字列をPLC書き込み用バッファに
procedure StrToPlcBuf(const s: string; var iData :array of integer);
var
  arycnt : integer;
  len, i : integer;
begin
  // 配列の大きさ
  arycnt := Length(iData);
  // 文字列の長さ
  len := Length(s);
  for i := 1 to len div 2 do begin
    iData[i - 1] := Ord(s[i * 2 ]) * $100 + Ord(s[i * 2 - 1]);
    if i = arycnt then break;
  end;
  if (len div 2 < arycnt) and (len mod 2 > 0) then
    iData[len div 2] := Ord(s[len]);
end;

// 16 ビット整数
procedure TForm3.Button1Click(Sender: TObject);
var
  iData : array [0..0] of Integer;
begin
  if GB_OpenFlag then begin
    ShortToPlcBuf(StrToInt(Edit11.Text), iData);
    ActProgType1.WriteDeviceBlock('D0', 1, iData[0]);
  end;
end;

// 32 ビット整数
procedure TForm3.Button2Click(Sender: TObject);
var
  iData : array [0..1] of Integer;
begin
  if GB_OpenFlag then begin
    IntToPlcBuf(StrToInt(Edit12.Text), iData);
    ActProgType1.WriteDeviceBlock('D0', 2, iData[0]);
  end;
end;

// 32 ビット実数(単精度)
procedure TForm3.Button3Click(Sender: TObject);
var
  iData : array [0..1] of Integer;
begin
  if GB_OpenFlag then begin
    SingleToPlcBuf(StrToFloat(Edit13.Text), iData);
    ActProgType1.WriteDeviceBlock('D0', 2, iData[0]);
  end;
end;

// 64 ビット実数(倍精度)
procedure TForm3.Button4Click(Sender: TObject);
var
  iData : array [0..3] of Integer;
begin
  if GB_OpenFlag then begin
    DoubleToPlcBuf(StrToFloat(Edit14.Text), iData);
    ActProgType1.WriteDeviceBlock('D0', 4, iData[0]);
  end;
end;

// 文字列書き込み
procedure TForm3.Button5Click(Sender: TObject);
var
  iData : array of Integer;
  writelen : integer;
begin
  // 書き込み数(文字列の長さは、この倍まで)
  writelen := 10;
  SetLength(iData, writelen);
  StrToPlcBuf(Edit16.Text , iData);
  ActProgType1.WriteDeviceBlock('D0', writelen, iData[0]);
end;

procedure TForm3.FormDestroy(Sender: TObject);
begin
  // スレッド終了
  if Assigned(Th) then Th.Terminate;
end;

// インターバルタイマー
procedure TForm3.Timer1Timer(Sender: TObject);
begin
  if not GB_OpenFlag then
    Timer1.Interval := 2000
  else
    Timer1.Interval := 100;
  if not Assigned(Th) then begin
    Th := PlcThread.Create;
  end
  else begin
    // スレッド再開
    Th.Resume;
  end;
end;


end.


// -------------------------------------------------
// PLC オープン、データ読込スレッド
// -------------------------------------------------

unit MXCompoTest2ThreadUnit;

interface

uses
  System.Classes, System.SysUtils,Winapi.Windows;

type
  PlcThread = class(TThread)
  private
    { Private 宣言 }
    procedure Plc_Open;
    procedure Plc_Read;

  protected
    procedure Execute; override;
  end;

implementation

uses MXCompoTest2Unit;

{ PlcThead }

// PLC オープン
procedure PlcThread.Plc_Open;
var
  iRet : integer;
  Ticks : Cardinal;
begin
  if not GB_TmBusy then begin
    Inc(GB_OpenCnt);

    GB_TmBusy := True;

    with Form3.ActProgType1 do begin
      ActUnitType := $2002;   //UNIT_FXVETHER_DIREC     'ユニットタイプ
      ActCpuType  := $210;    //CPU_FX5UCPU     'CPUタイプ
      ActProtocolType := $8;  //PROTOCOL_UDPIP      '通信プロトコルタイプ

      // 直結接続の場合、対象PLCのIPアドレスは不要
      ActHostAddress := '255.255.255.255';  // 接続ホスト名(IP アドレス)文字列
      ActDestinationPortNumber := $15B8;
      ActTimeOut := 500;  // 通信のタイムアウト値(単位は"ms")

      Ticks := GetTickCount;

      // オープン
      iRet := Open;

      Form3.Edit1.Text := IntToHex(iRet, 8);
      Form3.Edit2.Text := IntToStr(GB_OpenCnt);

      // すでに接続済
      if iRet = -268435453 then begin
        // 一度切断
        Close;
        // 再接続
        iRet := Open;
      end;
      with Form3 do begin
        // 読込実行時間(ms)を表示
        Edit3.Text := IntToStr(GetTickCount - Ticks);

        if iRet = 0 then begin
          GB_OpenFlag := True;
          if Label2.Caption <> '通信正常' then Label2.Caption := '通信正常';
        end
        else begin
          if Label2.Caption <> '通信異常' then Label2.Caption := '通信異常';
        end;
      end;
    end;
    GB_TmBusy := False;
  end;
end;

// PLC データ読込
procedure PlcThread.Plc_Read;
var
  ReadData  : array [0..3] of integer;
  // 文字列取得用動的配列
  ReadData2 : array of Integer;
  // 読込文字数
  txtlen : integer;
  readlen : integer;
  iRet : integer;
  Ticks : Cardinal;
begin
  if not GB_TmBusy then begin
    Inc(GB_ReadCnt);

    GB_TmBusy := True;

    with Form3 do begin
      Edit3.Text := IntToStr(GB_ReadCnt);

      // 通信状態を表示
      if Label1.Caption <> '●' then Label1.Caption := '●'
      else Label1.Caption := '○';

      // 開始時間を保持
      Ticks := GetTickCount;

      // D0 ~ D3 の値を取得
      iRet := ActProgType1.ReadDeviceBlock('D0', 4, ReadData[0]);

      if iRet = 0 then begin
        // そのまま 16 進で表示
        Edit5.Text := IntToHex(ReadData[0], 4);
        Edit6.Text := INtToHex(ReadData[1], 4);

        // D0 を 16ビット整数として表示
        Edit7.Text := IntToStr(PlcBufToShort(ReadData[0]));

        // D0, D1 を 32ビット整数として取得
        Edit8.Text := IntToStr(PlcBufToInt(ReadData));

        // D0, D1 を 32ビット単精度実数として表示
        Edit9.Text := FloatToStr(PlcBufToSingle(ReadData));

        // D0 ~ D3 を 64 ビット倍精度実数として表示
        Edit10.Text := FloatToStr(PlcBufToDouble(ReadData));

        // 文字列取得
        txtlen := 20;               // 取得する文字列の最大数
        readlen := txtlen div 2;
        if txtlen mod 2 > 0 then Inc(readlen);

        SetLength(ReadData2, readlen);
        if ActProgType1.ReadDeviceBlock('D0', readlen, ReadData2[0]) = 0 then
          Edit15.Text := PlcBufToStr(ReadData2);
      end
      else begin
        GB_OpenFlag := False;
      end;
      // 実行時間(ミリ秒)を表示
      Edit4.Text := IntToStr(GetTickCount - Ticks) + ' msec';
    end;
    GB_TmBusy := False;
  end;
end;

// スレッド実行
procedure PlcThread.Execute;
begin
  while not Terminated do begin
    if not GB_TmBusy then begin
      if not GB_OpenFlag then
        Synchronize(Plc_Open)
      else
        Synchronize(Plc_Read);
    end;
    Sleep(5);
    // スレッド一時停止
    Th. Suspend;
  end;
end;

end.