
'
'  Trust Design LLC : SECS/HSMS Communication library
' 
'  (c) Copyright Trust Design LLC.  2010-2015.  All rights reserved.
'


' ==============================================================================
' 
'  VBIo : テスト 及び サンプル・プログラム
' 
'   ＡＰ内でメッセージを構築し、単純に SECS メッセージの送受信を行う。
' 
' 
'  起動方法
' 
'    VBIo {h|e}
'    ~~~~~~~~~~
'    h    : Sample.ini の [HOST]  セクションを参照し動作を決定する
'    e    : Sample.ini の [EQUIP]      :              :
' 
' 
'    通常、VBIo h 及び VBIo e の両方を、同一マシン、もしくは異なるマシン上で
'    動作させて、相互通信を行う。通信相手は、BasicIo.exe、Callbackio.exe でも
'    よい。
' 
'    起動後、メニュ表示を参照し、要求コード等を入力し、機能を実行する。
'  
'    ホスト側は起動すると、装置側からの接続を待つ。装置側を起動すると、自動的
'    にホスト側に接続要求、Select 要求を発行する。ホスト側では、1:Recv 処理を
'    繰り返し行い、表示が「STATUS=951 : No data」となるのを確認する。その後、
'    任意のメッセージのやりとりを行う。受信側では、受信データの刈り取りを「
'    STATUS=951」になるまで行うことを忘れぬこと。
' 
'    ２次メッセージを送信する際のトランザクションＩＤは、直前に受信した１次
'    メッセージのものを使用する。
' 
'    本サンプルは、異常時処理を省略している。
'    以下で定義する "MSSG_USE_FILE"、"MSSG_DISP_TYPE" の値を変更すると、本ＡＰ
'    にて表示する SECS メッセージの出力形式を変更できる。
'    また "MSSG_USE_NEXTL" の値を変更すると、メッセージ内容を解析する際に、項目
'    値をデータとして取得するか、表示リスト形式で取得するかを変更できる。
'    同様に "USE_CALLBACK" を =1 とすると、受信処理を行う Callback 関数を使用
'    し、受信メッセージの表示、２次メッセージの出力を自動で行う。
'    Callback 関数を使用する場合、入力促進用メッセージに乱れが生じる事に留意
'    すること。
' 
' ==============================================================================

Imports		System.Threading

module		VBIo


' ------------------------------------------------------------------------------

private const	EBADF		as integer	=9
private const	EBUSY		as integer	=16
private const	ENOMEM		as integer	=12
private const	ENODEV		as integer	=19
private const	E2BIG		as integer	=7

private const	E_NOTCONNECT	as integer	=999
private const	E_DESELECT	as integer	=998
private const	E_REJECT	as integer	=997
private const	E_SELECT	as integer	=992
private const	E_CONNECT	as integer	=991
private const	E_RETRYOVER	as integer	=989
private const	E_T8TIMEDOUT	as integer	=988
private const	E_T7TIMEDOUT	as integer	=987
private const	E_T6TIMEDOUT	as integer	=986
private const	E_T5TIMEDOUT	as integer	=985
private const	E_T4TIMEDOUT	as integer	=984
private const	E_T3TIMEDOUT	as integer	=983
private const	E_T2TIMEDOUT	as integer	=982
private const	E_T1TIMEDOUT	as integer	=981
private const	E_ILLBLOCK	as integer	=980
private const	E_NODATA	as integer	=951


' ------------------------------------------------------------------------------

private const	MSSG_USE_FILE	as integer =&h80' メッセージ定義ファイル
						' &h00 : 使用しない
						' &h80 : 使用して項目名表示する
private const	MSSG_DISP_TYPE	as integer =&h20' SECS メッセージ表示形式
						' &h00 : 通常形式
						' &h10 : ????形式
						' &h20 : SML 形式
						' &h40 : NSG/TS300 形式
private const	MSSG_USE_NEXTL	as integer =1	' MssgNextL 関数使用の有無
						' 0    : 使用しない
						' 1    : 使用する

private const	USE_CALLBACK	as integer =1	' Callback 関数使用の有無
						' 0    : 使用しない
						' 1    : 使用する

private const	PARAMFILE	as string ="Sample.ini"


' ------------------------------------------------------------------------------

private		Td		as TDS		' TDS クラス・インスタンス
private		Fd		as integer =0	' 通信用識別子
private		Md		as integer =0	' メッセージ解析用識別子
private		Break		as integer =0	' スレッド終了指示
private		OType		as integer =0	' 動作タイプ (0:Host 1:Equip)
private		Status		as integer =0	' 動作状態
						' (0:未接続 1:未Select 2:Select)


' ------------------------------------------------------------------------------

private declare sub Sleep lib "kernel32" alias "Sleep" (byval ms as long)



' ==============================================================================
' 共通関数 =====================================================================


' ------------------------------------------------------------------------------
' SECS メッセージを標準出力に表示する。 ----------------------------------------

private sub				_
DispSECSMssgRightParentheses(		_
byval	la		as integer,	_
byval	no		as integer)

  dim	i,j		as integer

  i=la
  do while i>no
    for j=1 to i
      console.write("  ")			' ' ' 出力
    next j
    console.writeline(">")			' '>' 出力
    i=i-1
  loop
end sub



private sub				_
DispSECSMssg(				_
byval	tp		as integer,	_
byval	hd()		as byte,	_
byval	did		as integer,	_
byval	sf		as integer,	_
byval	xid		as integer,	_
byval	msg()		as byte,	_
byval	len		as integer)

' tp	// i  : メッセージ種別	(0:送信結果 1:受信メッセージ 2:送信メッセージ)
' hd	// i  : SECS メッセージ・ヘッダ
' did	// i  : SECS メッセージのデバイスＩＤ
' sf	// i  : SECS メッセージのＳＦコード
' xid	// i  : SECS メッセージのトランザクションＩＤ
' msg	// i  : SECS メッセージ格納領域（ヘッダ含まず）
' len	// i  : SECS メッセージのバイト長

  dim	ctp()		as string	={"SRES","RECV","SEND"}
  dim	mname,sitem	as string
  dim	itm(64)		as byte
  dim	vi2(32)		as short
  dim	vi4(16)		as integer
  dim	vi8(8)		as long
  dim	vf4(16)		as single
  dim	vf8(8)		as double
  dim	str,rbit,wbit	as string
  dim	sfcode		as string
  dim	rtn,mm,dp,fm	as integer
  dim	form,sz,noi,la	as integer

  mm	= 0
  dp	= MSSG_USE_FILE or MSSG_DISP_TYPE
  rbit	= " ":	if (did and &h8000)<>0 then	rbit = "R"
  wbit	= " ":	if (sf  and &h8000)<>0 then	wbit = "W"

  sfcode= string.format("S{0}F{1}",(sf and &h7f00) / &h0100,sf and &hff)
  console.writeline(						_
  "[{0}]  Dev=0x{1:x4}  {2,8}  {3}{4}  XId=0x{5:x4}  Len={6,4}"	_
	,ctp(tp),did and &h7fff,sfcode,rbit,wbit,xid,len)

  if (MSSG_USE_FILE and &h80)<>0 then:	fm = &h8000	' メッセージ定義を使用
  else:					fm = &h0000	' 使用せず
  end if

  if len>0 then
    if tp=1 then: dp= dp or &h3000:  fm= fm or &h3000	' 受信の場合
    else:	  dp= dp or &h2000:  fm= fm or &h2000	' 送信の場合
    end if

    mname = ""
    mm	= Td._TDSMssgFind(fm,msg,len,Fd,hd,mname)
    if mm>0 then
      if mname<>"" then console.writeline("[{0}]",mname)' メッセージ名称
      la=0
      do
	if MSSG_USE_NEXTL=0 then			' 項目値を取得
	  sitem=""
	  rtn=Td._TDSMssgNext(mm,0,msg,form,sz,noi,itm,64,sitem)
	  if rtn		< 0	then	exit do
	  console.write("{0:x2}:{1}*{2:d2}:",form,sz,noi)
	  select case form				' 項目値の表示
							' 数値の２番目以降は省略
	    case &o000: Console.WriteLine("L[{0}]"	   ,noi)
	    case &o010: Console.WriteLine("B[{0}]={1,0:x2}",noi,itm(0))
	    case &o011: Console.WriteLine("T[{0}]={1,0}"   ,noi,itm(0))
	    case &o020: Console.WriteLine("A[{0}]={1}"     ,noi,sitem)
	    case &o021: Console.WriteLine("J[{0}]={1}"     ,noi,sitem)
	    case &o022: Console.WriteLine("K[{0}]={1}"     ,noi,sitem)
	    case &o030: Buffer.BlockCopy(itm,0,vi8,0,sz)
			Console.WriteLine("I8[{0}]={1}"    ,noi,vi8(0))
	    case &o031: Console.WriteLine("I1[{0}]={1}"    ,noi,itm(0))
	    case &o032: Buffer.BlockCopy(itm,0,vi2,0,sz)
			Console.WriteLine("I2[{0}]={1}"    ,noi,vi2(0))
	    case &o034: Buffer.BlockCopy(itm,0,vi4,0,sz)
			Console.WriteLine("I4[{0}]={1}"    ,noi,vi4(0))
	    case &o040: Buffer.BlockCopy(itm,0,vf8,0,sz)
			Console.WriteLine("F8[{0}]={1}"    ,noi,vf8(0))
	    case &o044: Buffer.BlockCopy(itm,0,vf4,0,sz)
			Console.WriteLine("F4[{0}]={1}"    ,noi,vf4(0))
	    case &o050: Buffer.BlockCopy(itm,0,vi8,0,sz)
			Console.WriteLine("U8[{0}]={1}"    ,noi,vi8(0))
	    case &o051: Console.WriteLine("U1[{0}]={1}"    ,noi,itm(0))
	    case &o052: Buffer.BlockCopy(itm,0,vi2,0,sz)
			Console.WriteLine("U2[{0}]={1}"    ,noi,vi2(0))
	    case &o054: Buffer.BlockCopy(itm,0,vi4,0,sz)
			Console.WriteLine("U4[{0}]={1}"    ,noi,vi4(0))
	  end select

	else						' リスト表示形式で取得
	  str=""
	  rtn=Td._TDSMssgNextL(mm,dp,msg,form,noi,str)
	  if rtn		< 0	then	exit do
	  if (dp and &h70) > &h10 then			' SML、NSG/TS300 の場合
	    DispSECSMssgRightParentheses(la,rtn)	' '>' 表示
	  end if
	  la=rtn					' 現在の階層を保存
	  console.writeline("  {0}",str)		' 取得した項目値を表示
	  if ((dp and &h70) > &h10) and (form=0) and (noi=0)  then
	    DispSECSMssgRightParentheses(la+1,la)	' L0 の場合の '>' 処理
	  end if
	end if
      loop

      if MSSG_USE_NEXTL<>0 then
	if (dp and &h70) > &h10 then
	  DispSECSMssgRightParentheses(la,0)		' 残りの '>' 表示
	end if
      end if
      Td._TDSMssgExit(mm,0,msg)
    end if
  end if
end sub



' ------------------------------------------------------------------------------
' 送受信データを表示する。------------------------------------------------------

private function			_
DispData(				_
byval	tp		as integer,	_
byval	hd()		as byte,	_
byval	did		as integer,	_
byval	sf		as integer,	_
byval	xid		as integer,	_
byval	msg()		as byte,	_
byval	len		as integer,	_
byval	rtn		as integer)	_
			as integer

' tp	// i  : メッセージ種別	(0:送信結果 1:受信メッセージ 2:送信メッセージ)
' hd	// i  : SECS メッセージ・ヘッダ
' did	// i  : SECS メッセージのデバイスＩＤ
' sf	// i  : SECS メッセージのＳＦコード
' xid	// i  : SECS メッセージのトランザクションＩＤ
' msg	// i  : SECS メッセージ格納領域（ヘッダ含まず）
' len	// i  : SECS メッセージのバイト長
' rtn	// i  : I/O の戻り値

  dim	ok		as integer

  ok	=0

  if rtn<0 then:	ok=1
    if (rtn<(-E_NOTCONNECT) or (-E_ILLBLOCK)<rtn) and rtn<>(-E_NODATA) then
      console.write("ERROR  [{0}]"		,rtn)
      if     rtn=(-ENODEV) then
	console.writeline(" : No such device ID")
	len=0:	ok=0
      elseif rtn=(-E2BIG)  then
	console.writeline(" : Data size to large")
	len=0:	ok=0
      else
	console.writeline("")
      end if

    else
      console.write("STATUS = {0},{1} : "	,-rtn,Status)
      select case (-rtn)
	case E_NODATA:		console.writeline("No data")
	case E_ILLBLOCK:	console.writeline("Illegal block#")
	case E_T1TIMEDOUT:	console.writeline("T1 Timeout occur")
	case E_T2TIMEDOUT:	console.writeline("T2 Timeout occur")
	case E_T3TIMEDOUT:	console.writeline("T3 Timeout occur")
	case E_T4TIMEDOUT:	console.writeline("T4 Timeout occur")
	case E_T5TIMEDOUT:	console.writeline("T5 Timeout occur")
	case E_T6TIMEDOUT:	console.writeline("T6 Timeout occur")
	case E_T7TIMEDOUT:	console.writeline("T7 Timeout occur")
	case E_T8TIMEDOUT:	console.writeline("T8 Timeout occur")
	case E_RETRYOVER:	console.writeline("Retry over")
	case E_CONNECT:		console.writeline("Connected")
	case E_SELECT:		console.writeline("Selected")
	case E_REJECT:		console.writeline("Rejected XId=&h{0:x4}",xid)
	case E_DESELECT:	console.writeline("Deselected")
	case E_NOTCONNECT:	console.writeline("Not connected")
	case else:		console.writeline("")
      end select
    end if
  end if

  if ok=0 then DispSECSMssg(tp,hd,did,sf,xid,msg,len)

  return 0
end function



' ==============================================================================
' S1F1 メッセージ構築及び送信 --------------------------------------------------

private function			_
SendS1F1()		as integer

  dim	hd(12),msg(16)	as byte
  dim	rtn,sf,len	as integer

  sf	=&h8101:	len	=0

			' SubFunction.h の SendS1F1() 内 (注) を参照すること。
  rtn	=Td._TDSCommSend(Fd,&h0000,0,sf,0,msg,len,hd)
  DispData(2,hd,0,sf,rtn,msg,len,rtn)

  return rtn
end function


' ------------------------------------------------------------------------------
' S1F2 メッセージ (Host) 構築及び送信 ------------------------------------------

private function			_
SendS1F2H(				_
byval	did		as integer,	_
byval	xid		as integer)	_
			as integer

  dim	hd(12),msg(256)	as byte
  dim	item(32)	as byte
  dim	rtn,mm,sf,len	as integer

  sf	=&h0102:	len	=0

  if (MSSG_USE_FILE and &h80)=0	then		' メッセージ定義を使用しない
    mm=		Td._TDSMssgInit   (   0,msg,  256,Fd)		' S1F2
		Td._TDSMssgBuild  (mm,0,msg,&o000,  0,item)	' L0
    len=	Td._TDSMssgEnd    (mm,0,msg)

  else						' メッセージ定義を使用する
		Td._TDSMDMssgInit (Md,0,msg,  256,"S1F2_H")
    len=	Td._TDSMDMssgEnd  (Md,0,msg)
  end if

  if len<0 then: rtn=len
  else:		 rtn=Td._TDSCommSend(Fd,&h0000,0,sf,xid,msg,len,hd)
  end if
  DispData(2,hd,did,sf,rtn,msg,len,rtn)

  return rtn
end function


' ------------------------------------------------------------------------------
' S1F2 メッセージ (Equip) 構築及び送信 -----------------------------------------

private function			_
SendS1F2E(				_
byval	did		as integer,	_
byval	xid		as integer)	_
			as integer

  dim	hd(12),msg(256)	as byte
  dim	item(32)	as byte
  dim	rtn,mm,sf,len	as integer

  sf	=&h0102:	len	=0

  if (MSSG_USE_FILE and &h80)=0	then		' メッセージ定義を使用しない
    mm=		Td._TDSMssgInit   (   0,msg,  256,Fd)		' S1F2
		Td._TDSMssgBuild  (mm,0,msg,&o000,  2,item)	' L2
		Td._TDSMssgBuild  (mm,0,msg,&o020,  6,"EQUIP1")	'  MDLN
		Td._TDSMssgBuild  (mm,0,msg,&o020,  6,"11.111")	'  SOFTREV
    len=	Td._TDSMssgEnd    (mm,0,msg)

  else						' メッセージ定義を使用する
		Td._TDSMDMssgInit (Md,0,msg,  256,"S1F2_E")
    len=	Td._TDSMDMssgEnd  (Md,0,msg)
  end if

  if len<0 then: rtn=len
  else:		 rtn=Td._TDSCommSend(Fd,&h0000,0,sf,xid,msg,len,hd)
  end if
  DispData(2,hd,did,sf,rtn,msg,len,rtn)

  return rtn
end function
  

' ==============================================================================
' S2F49 メッセージ構築及び送信 -------------------------------------------------

private function			_
SendS2F49()		as integer

  static cnt		as integer	=0
  dim	hd(12),msg(1024) as byte
  dim	vb(32)		as byte
  dim	vi(4)		as integer
  dim	str,itm		as string
  dim	rtn,mm,sf	as integer
  dim	no1,no2,len,i,j	as integer

  sf	=&h8200+49:	len	=0
  cnt	=cnt+1
  no1	=(cnt mod 2)+1:	no2=(cnt mod 10)+1
  str=string.Format("LOTID ({0,0:d4})",cnt)
  
  if (MSSG_USE_FILE and &h80)=0 then		' メッセージ定義を使用しない
    mm=		Td._TDSMssgInit   (   0,msg, 1024,Fd)		' S2F49
  		Td._TDSMssgBuild  (mm,0,msg,&o000,  3,vb)	' L3
    vb(0)=0:	Td._TDSMssgBuild  (mm,0,msg,&o010,  1,vb)	'  DATAIDB
  		Td._TDSMssgBuild  (mm,0,msg,&o020,  0,"LOAD")	'  RCMD
  		Td._TDSMssgBuild  (mm,0,msg,&o000,  4,vb)	'  L4
    vb(0)=1:	Td._TDSMssgBuild  (mm,0,msg,&o010,  1,vb)	'   STID
    vb(0)=0:	Td._TDSMssgBuild  (mm,0,msg,&o010,  1,vb)	'   MTKD
  		Td._TDSMssgBuild  (mm,0,msg,&o020, 20,str)	'   LOTID
		Td._TDSMssgBuild  (mm,0,msg,&o000,no1,vb)	'   L[no1]
    for i=1 to no1
		Td._TDSMssgBuild  (mm,0,msg,&o000,no2,vb)	'    L[no2]
      for j=1 to no2
		Td._TDSMssgBuild  (mm,0,msg,&o000,  2,vb)	'     L[2]
	str=string.Format("WAFER({0,0:d4}-{1,0:d1}-{2,0:d2})",cnt,i,j)
  		Td._TDSMssgBuild  (mm,0,msg,&o020, 20,str)	'      WAFERID
	str=string.Format("PPID ({0,0:d4}-{1,0:d1}-{2,0:d2})",cnt,i,j)
  		Td._TDSMssgBuild  (mm,0,msg,&o020, 16,str)	'      PPID
      next j
    next i
    len=	Td._TDSMssgEnd    (mm,0,msg)

  else						' メッセージ定義を使用する
		Td._TDSMDMssgInit (Md,0,msg, 1024,"S2F49")
  		Td._TDSMDMssgBuild(Md,0,msg,"LOTID",0,str)	'   LOTID
    vi(0)=no1:	Td._TDSMDMssgBuild(Md,0,msg,"NOI1" ,1,vi)	'   L[no1]
    for i=1 to no1
      itm  =string.Format("NOI2:{0,0:d1}"		,i)
      vi(0)=no2:Td._TDSMDMssgBuild(Md,0,msg,itm    ,1,vi)	'    L[no2]
      for j=0 to no2
	itm=string.Format("WAFERID:{0,0:d1}:{1,0:d1}"	,i,j)
	str=string.Format("WAFERID[{0,0:d4}-{1,0:d1}-{1,0:d2}]",cnt,i,j)
  		Td._TDSMDMssgBuild(Md,0,msg,itm    ,0,str)	'     WAFERID
	itm=string.Format("PPID:{0,0:d1}:{1,0:d1}"	,i,j)
	str=string.Format("PPID [{0,0:d4}-{1,0:d1}-{1,0:d2}]"  ,cnt,i,j)
  		Td._TDSMDMssgBuild(Md,0,msg,itm    ,0,str)	'     PPID
      next j
    next i
    len=	Td._TDSMDMssgEnd  (Md,0,msg)
  end if

  if len<0 then: rtn=len	' SubFunction.h の SendS1F1() 内 (注) を参照。
  else:		 rtn=Td._TDSCommSend (Fd,0,0,sf,0,msg,len,hd)
  end if
  DispData(2,hd,0,sf,rtn,msg,len,rtn)

  return rtn
end function


' ------------------------------------------------------------------------------
' S2F50 メッセージ構築及び送信 -------------------------------------------------

private function			_
SendS2F50(				_
byval	did		as integer,	_
byval	xid		as integer)	_
			as integer

  static cnt		as integer	=0
  dim	hd(12),msg(256)	as byte
  dim	vb(32)		as byte
  dim	str		as string
  dim	rtn,mm,sf,len	as integer

  sf	=&h0200+50:	len	=0
  cnt	=cnt+1
  str=string.Format("LOTID ({0,0:d4})"	,cnt)

  if (MSSG_USE_FILE and &h80)=0 then		' メッセージ定義を使用しない
    mm=		Td._TDSMssgInit   (   0,msg,  256,Fd)		' S2F50
		Td._TDSMssgBuild  (mm,0,msg,&o000,  2,vb)	' L2
    vb(0)=0:	Td._TDSMssgBuild  (mm,0,msg,&o010,  1,vb)	'  HCACK
		Td._TDSMssgBuild  (mm,0,msg,&o000,  2,vb)	'  L2
  		Td._TDSMssgBuild  (mm,0,msg,&o020,  5,"PODID")	'   PODID
  		Td._TDSMssgBuild  (mm,0,msg,&o020, 20,str)	'   LOTID
    len=	Td._TDSMssgEnd    (mm,0,msg)

  else						' メッセージ定義を使用する
		Td._TDSMDMssgInit (Md,0,msg,  256,"S2F50")
		Td._TDSMDMssgBuild(Md,0,msg,"LOTID",  0,str)	'   LOTID
    len=	Td._TDSMDMssgEnd  (Md,0,msg)
  end if

  if len<0 then: rtn=len
  else:		 rtn=Td._TDSCommSend (Fd,0,0,sf,xid,msg,len,hd)
  end if
  DispData(2,hd,did,sf,rtn,msg,len,rtn)

  return rtn
end function


' ==============================================================================
' S6F11 メッセージ構築及び送信 -------------------------------------------------

private function			_
SendS6F11()		as integer

  static cnt		as integer	=0
  dim	hd(12),msg(256)	as byte
  dim	vs(4)		as short
  dim	rtn,mm,sf,len	as integer

  sf	=&h8600+11:	len	=0
  cnt	=cnt+1:		if cnt = 32768 then	cnt=0

  if (MSSG_USE_FILE and &h80)=0 then		' メッセージ定義を使用しない
    mm=		Td._TDSMssgInit   (   0,msg,  256,Fd)		' S2F50
		Td._TDSMssgBuild  (mm,0,msg,&o000,  3,vs)	' L3
    vs(0)=cnt:	Td._TDSMssgBuild  (mm,0,msg,&o052,  1,vs)	'  DATAID
    vs(0)=8:	Td._TDSMssgBuild  (mm,0,msg,&o052,  1,vs)	'  CEID
  		Td._TDSMssgBuild  (mm,0,msg,&o000,  3,vs)	'  L3
  		Td._TDSMssgBuild  (mm,0,msg,&o020, 16,"DATA1")	'   DATA1
  		Td._TDSMssgBuild  (mm,0,msg,&o020, 16,"DATA2")	'   DATA2
  		Td._TDSMssgBuild  (mm,0,msg,&o020, 14,"YYYYMMDDhhmmss")
						' @TIME (本当は現在時刻を設定
						' するのだが、省略。
    len=	Td._TDSMssgEnd    (mm,0,msg)

  else						' メッセージ定義を使用する
		Td._TDSMDMssgInit (Md,0,msg,  256,"S6F11")
    vs(0)=cnt:  Td._TDSMDMssgBuild(Md,0,msg,"DATAID",1,vs)	'  DATAID
    len=	Td._TDSMDMssgEnd  (Md,0,msg)
  end if

  if len<0 then: rtn=len	' SubFunction.h の SendS1F1() 内 (注) を参照。
  else:		 rtn=Td._TDSCommSend (Fd,0,0,sf,0,msg,len,hd)
  end if
  DispData(2,hd,0,sf,rtn,msg,len,rtn)

  return rtn
end function



' ------------------------------------------------------------------------------
' S6F12 メッセージ構築及び送信 -------------------------------------------------

private function			_
SendS6F12(				_
byval	did		as integer,	_
byval	xid		as integer)	_
			as integer

  static cnt		as integer	=0
  dim	hd(12),msg(256)	as byte
  dim	vb(32)		as byte
  dim	rtn,mm,sf,len	as integer

  sf	=&h0600+12:	len	=0

  if (MSSG_USE_FILE and &h80)=0 then		' メッセージ定義を使用しない
    mm=		Td._TDSMssgInit   (   0,msg,  256,Fd)		' S2F50
    vb(0)=0:	Td._TDSMssgBuild  (mm,0,msg,&o010,  1,vb)	' ACKC
    len=	Td._TDSMssgEnd    (mm,0,msg)

  else						' メッセージ定義を使用する
		Td._TDSMDMssgInit (Md,0,msg,  256,"S6F12")
    len=	Td._TDSMDMssgEnd  (Md,0,msg)
  end if

  if len<0 then: rtn=len
  else:		 rtn=Td._TDSCommSend (Fd,0,0,sf,xid,msg,len,hd)
  end if
  DispData(2,hd,did,sf,rtn,msg,len,rtn)

  return rtn
end function



' ==============================================================================
' Callback 関数 ================================================================

private function			_
CBRecvProc(				_
byval	req		as integer,	_
byval	rtn		as integer,	_
byval	did		as integer,	_
byval	xsf		as integer,	_
byval	xid		as integer,	_
byval	xhd()		as byte,	_
byval	xmsg()		as byte)	_
			as integer

' req	// i  : ライブラリへの要求コード
' rtn	// i  : ライブラリからの戻り値
' did	// i  : SECS メッセージのデバイスＩＤ
' xsf	// i  : SECS メッセージのＳＦコード
' xid	// i  : SECS メッセージのトランザクションＩＤ
' xhd	// i  : SECS メッセージ・ヘッダ
' xmsg	// i  : SECS メッセージ

  dim	hd(12),msg(256)	as byte
  dim	rname,sname	as string
  dim	len,sf,scd	as integer

  DispData(1,xhd,did,xsf,xid,xmsg,rtn,rtn)
  select case (rtn)
    case -E_CONNECT:	Status=1	' Connected
    case -E_SELECT:	Status=2	' Selected
    case -E_DESELECT:	Status=1	' Deselected
    case -E_NOTCONNECT:	Status=0	' Not connected
  end select

  if req=0 and rtn>=0 then
    if (MSSG_USE_FILE and &h80)=0 then	' メッセージ定義ファイルを使用しない
					' 場合は、自力で SF-Code を調べ、２次
					' メッセージの送出の必要性を判断し、
					' 必要な場合は、送出する。
      if      xsf=(&h8100+ 1) and OType=0 then:	SendS1F2H (did,xid)
      else if xsf=(&h8100+ 1) and OType=1 then:	SendS1F2E (did,xid)
      else if xsf=(&h8200+49)		  then:	SendS2F50 (did,xid)
      else if xsf=(&h8600+11)		  then:	SendS6F12 (did,xid)
      end  if

    else if (xsf and &h8000)<>0 then	' メッセージ定義ファイルを使用する
					' 場合は、本サンプルでは、自動返信機能
					' を利用する。
      msg=xmsg:	rname="": sname=""
      len=Td._TDSMDMssgAutoRes(Md,0,xhd,msg,rtn,1024,rname,sname,sf)
      if len >= 0 then
	scd = sf / &h0100
	console.writeline("RECV {0} ..  Auto respond {1} [S{2}F{3}]"	_
			,rname,sname,scd,sf and &hff)
	rtn=Td._TDSCommSend(Fd,0,0,sf,xid,msg,len,hd)
	DispData(2,hd,did,sf,xid,msg,len,rtn)
      else
	if len<>(-930) and len<>(-931) then
	  console.writeline("RECV Auto response error ({0})",len)
	end if
      end if
    end if
  end if

  return 0
end function



' ------------------------------------------------------------------------------

private sub				_
RecvProcThread(				_
byval	param		as object)

  dim	hd(12),msg(1024) as byte
  dim	rtn,sf,xid	as integer
  dim	req,devid	as integer

  do until Break<>0
    req=0
    rtn=Td._TDSCommRecv(Fd,0,devid,sf,xid,msg,1024,hd)
    if rtn=(-951) then
      Sleep(100)
    else
      if (-1000)<rtn and rtn<(-979) then	req=(-rtn)-900
      CBRecvProc(req,rtn,devid,sf,xid,hd,msg)
    end if
  loop

end sub



' ==============================================================================
' Main 処理 --------------------------------------------------------------------

public function				_
main(					_
byval	argv()		as string)	_
			as integer

  if	  argv.Length<1 then
    console.writeline("Usage: VBIo {h|e}")

  else if argv(0)<>"h" and argv(0)<>"e" then
    console.writeline("Usage: VBIo {h|e}")

  else
    Td = new TDS
    if argv(0)="h" then: Host ()
    else:		 Equip()
    end if
  end if

  return 0
end function



' ==============================================================================
' ホスト側処理 -----------------------------------------------------------------

private sub		_
Host()

  dim	hd(12),msg(1024) as byte
  dim	th		as Thread
  dim	str		as string
  dim	rtn,req,sf,mno	as integer
  dim	xid,xids,did	as integer

  OType=0:	Break=0:	sf=0
  Fd=Td._TDSCommOpen(&h02,PARAMFILE,"HOST"):	 if Fd<0 then	goto Conclude
  console.writeline("(H) Opened ({0})",Fd)
  if (MSSG_USE_FILE and &h80)<>0 then Md=Td._TDSMDMssgInitialize(&h4000,Fd,"")

  if USE_CALLBACK<>0 then
    th=new Thread(new ParameterizedThreadStart(AddressOf RecvProcThread))
    th.Start("")
  end if

  do
    rtn=0
    if USE_CALLBACK=0 then: console.write("Req (0:Exit 1:Recv 2:Send) : ")
    else:		    console.write("Req (0:Exit 2:Send) : ")
    end if
    str=console.readline()
    req=Integer.Parse(str)
    if	    req=0 then:						exit do
    else if req=1 then
      rtn=Td._TDSCommRecv(Fd,0,did,sf,xid,msg,1024,hd)
      if rtn>=0 then xids=xid
      DispData(1,hd,did,sf,xid,msg,rtn,rtn)

    else if req=2 then
      if USE_CALLBACK=0 then
	console.write("Message(1:S1F1 2:S2F49  6:S1F2 7:S6F12) : ")
      else
	console.write("Message(1:S1F1 2:S2F49) : ")
      end if
      str=console.readline()
      mno=Integer.Parse(str)
      select case mno
	case 1: rtn=SendS1F1 ()
	case 2: rtn=SendS2F49()
	case 6: rtn=SendS1F2H(did,xids)
	case 7: rtn=SendS6F12(did,xids)
      end select
    end if
    if rtn<(-999) or ((-900)<rtn and rtn<0) then
      console.writeline("(H) I/O Error ({0})"	,rtn)
    end if
  loop

Conclude:
  Break=1
  if Md>0 then	Td._TDSMDMssgTerminate(Md,0)
  if Fd>0 then:	Td._TDSCommClose(Fd,0)
  else:		console.writeline("(H) Error ({0})",Fd)
  end if
end sub



' ==============================================================================
' 装置側処理 -------------------------------------------------------------------

private sub		_
Equip()

  dim	hd(12),msg(1024) as byte
  dim	th		as Thread
  dim	str		as string
  dim	rtn,req,sf,mno	as integer
  dim	xid,xids,did	as integer

  OType=1:	Break=0:	sf=0
  Fd=Td._TDSCommOpen(&h02,PARAMFILE,"EQUIP"):	 if Fd<0 then	goto Conclude
  console.writeline("(E) Opened ({0})",Fd)
  if (MSSG_USE_FILE and &h80)<>0 then Md=Td._TDSMDMssgInitialize(&h4000,Fd,"")

  if USE_CALLBACK<>0 then
    th=new Thread(new ParameterizedThreadStart(AddressOf RecvProcThread))
    th.Start("")
  end if

  if Td._TDSCommSend(Fd,&h0100,0,0,0,msg,0,hd)<0 then		goto Conclude
  console.writeline("(E) Connected")
  if Td._TDSCommSend(Fd,&h0200,0,0,0,msg,0,hd)<0 then		goto Conclude
  console.writeline("(E) Selected")

  do
    rtn=0
    if USE_CALLBACK=0 then: console.write("Req (0:Exit 1:Recv 2:Send) : ")
    else:		    console.write("Req (0:Exit 2:Send) : ")
    end if
    str=console.readline()
    req=Integer.Parse(str)
    if	    req=0 then:						exit do
    else if req=1 then
      rtn=Td._TDSCommRecv(Fd,0,did,sf,xid,msg,1024,hd)
      if rtn>=0 then xids=xid
      DispData(1,hd,did,sf,xid,msg,rtn,rtn)

    else if req=2 then
      if USE_CALLBACK=0 then
	console.write("Message(1:S1F1 2:S6F11  6:S1F2 7:S2F50) : ")
      else
	console.write("Message(1:S1F1 2:S6F11) : ")
      end if
      str=console.readline()
      mno=Integer.Parse(str)
      select case mno
	case 1: rtn=SendS1F1 ()
	case 2: rtn=SendS6F11()
	case 6: rtn=SendS1F2E(did,xids)
	case 7: rtn=SendS2F50(did,xids)
      end select
    end if
    if rtn<(-999) or ((-900)<rtn and rtn<0) then
      console.writeline("(E) I/O Error ({0})"	,rtn)
    end if
  loop

' Deselect request は行わない。（SEMI では HSMS-SS において、Deselect request
' は行ってはならない、としている。）
' if Td._TDSCommSend(Fd,&h0800,0,0,0,msg,0,hd)< 0 then		goto Conclude
' console.writeline("(E) Deselected")
  if Td._TDSCommSend(Fd,&h0900,0,0,0,msg,0,hd)< 0 then		goto Conclude
  console.writeline("(E) Separate")

Conclude:
  Break=1
  if Md>0 then	Td._TDSMDMssgTerminate(Md,0)
  if Fd>0 then: Td._TDSCommClose(Fd,0)
  else:		console.writeline("(E) Error ({0})",Fd)
  end if
end sub

end module
