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


' ==============================================================================
' 
'  VBIo : Test and sample program
' 
'    Construct a message in AP and simply send and receive SECS messages.
' 
' 
'  Starting method
' 
'    VBIo {h|e}
'    ~~~~~~~~~~
'    h    : Refer to [HOST]  section of Sample.ini to determine operation
'    e    : Refer to [EQUIP] section of Sample.ini to determine operation
'
'
'    Normally, "VBIo h" and "VBIo e" both operate on same machine or
'    different machines to communicate with each other. The communication
'    partner may be BasicIo.exe or Callbackio.exe.
'
'    After startup, refer to the menu display, enter request code etc. and the
'    function is executed.
' 
'    When host starts up, it waits for a connection from equipment.
'    When device side is started, connection request and Select request are
'    automatically issued to host side.
'    On host side, repeat '1:Recv' processing, and confirm that display is
'    'STATUS=951: No data'. After that, exchange any message. On receiving side,
'    do not forget to reap received data until 'STATUS=951'.
'
'    The transaction ID used when transmitting secondary message uses that of
'    primary message received immediately before.
'
'    This sample omits some of abnormal processing.
'
'    "SECS_MODE" defined below is defined to determine whether or not connection
'    processing to Passive side in case of Active connection is performed when
'    using _TDSCommXxxx() as processing function.
'
'    "FUNC_TYPE" is defined to select type of processing function to be used.
'    If you use _TDSUDrvXxxx(), there is no need to perform connection
'    processing for HSMS-SS Active connection, so there is no need to set
'    "SECS_MODE" in principle.
'    Since TDS switches SECS-1 connection or HSMS-SS connection in setting file
'    (.ini), user AP does not need to know connection method (SECS-1or HSMS and
'    Passive/Active at HSMS) as long as _TDSUDrvXxxx() is used as processing
'    function.
'
'    By changing values of "MSSG_USE_FILE" and "MSSG_DISP_TYPE" defined below,
'    you can change output format of SECS message displayed by this AP.
'    By changing value of "MSSG_USE_NEXTL", it is possible to change whether to
'    acquire field values as data or display list format when analyzing message
'    contents.
'    Similarly, if "USE_CALLBACK" is set to 1, use Callback function to perform
'    receiving processing, and automatically display received message and output
'    secondary message.
'    When using Callback function, keep in mind that input prompting message may
'    be disturbed.
' 
'
' ==============================================================================
' 
'  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」になるまで行うことを忘れぬこと。
' 
'    ２次メッセージを送信する際のトランザクションＩＤは、直前に受信した１次
'    メッセージのものを使用する。
' 
'    本サンプルは、異常時処理を一部省略している。
'
'    以下で定義する "SECS_MODE" は、処理関数として _TDSCommXxxx() を使用する
'    場合で Active 接続の場合の Passive 側への接続処理の実行の有無を判断する
'    ために定義する。
'    "FUNC_TYPE" は、使用する処理関数の種別を選択するために定義する。
'    _TDSUDrvXxxx() を使用する場合は、HSMS-SS Active 接続の場合の接続処理を行う
'    必要がないので、本来であれば "SECS_MODE" の設定も必要がない。
'    TDS は、SECS-1 接続 or HSMS-SS 接続の切替は、設定ファイル (.ini) にて行う
'    ため、処理関数として _TDSUDrvXxxx() を使用する限りは、ユーザＡＰでは、
'    接続方式（SECS-1/HSMS-SS そして HSMS-SS時の Passive/Active）を知る必要は
'    ない。
'
'    以下で定義する "MSSG_USE_FILE"、"MSSG_DISP_TYPE" の値を変更すると、本ＡＰ
'    にて表示する SECS メッセージの出力形式を変更できる。
'    "MSSG_USE_NEXTL" の値を変更すると、メッセージ内容を解析する際に、項目値を
'    データとして取得するか、表示リスト形式で取得するかを変更できる。
'    同様に "USE_CALLBACK" を =1 とすると、受信処理を行う Callback 関数を使用
'    し、受信メッセージの表示、２次メッセージの出力を自動で行う。
'    Callback 関数を使用する場合、入力促進用メッセージに乱れが生じる事に留意
'    すること。
' 
' ==============================================================================

Imports		System.Threading
Imports		TDVBL

namespace	TDVBSTest


class		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	SECS_MODE	as integer =1	' SECS/HSMS mode
						' 0    : SECS-1
						' 1    : HSMS
private const	FUNC_TYPE	as integer =1	' Type of function used
						' 通信に使用する関数の種別
						' 0    : _TDSCommXxxxx
						' 1    : _TDSUDrvXxxxx
private const	UDRV_MASK	as integer =&h8383ffff
						' Mask value of UDrvOpen()
						' 0	     : Set =0x49
						' 0x8383ffff : All event

private const	USE_CALLBACK	as integer =1	' Use of Callback function
						' 0    : Not use
						' 1    : Use

private const	MSSG_USE_FILE	as integer =&h80' Message definition file
						' &h00 : Not use
						' &h80 : Use to display item
						'	 names
						'	 使用して項目名表示する
private const	MSSG_DISP_TYPE	as integer =&h20' SECS Message display format
						' &h00 : TDS Format
						' &h20 : SML Format
private const	MSSG_USE_NEXTL	as integer =1	' Use MssgNext() or not
						' 0    : Not use
						' 1    : Use

private const	PARAMFILE	as string ="Sample.ini"


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

private shared	Td		as TDS		' TDS Class instans
private shared	Fd		as integer =0	' Communication identifier
private shared	Md		as integer =0	' Message analysis identifier
private shared	OType		as integer =0	' Operation type (0:Host 1:Equip)
private shared	Break		as integer =0	' End instruction to thread
						' スレッド終了指示

private shared	Dim Cs1		as New Object


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

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



' ==============================================================================
' Common function ==============================================================


' ------------------------------------------------------------------------------
' Display SECS messages on standard output -------------------------------------
' SECS メッセージを標準出力に表示する ------------------------------------------

private shared 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("  ")			' Display ' '
    next j
    console.writeline(">")			' Display '>'
    i=i-1
  loop
end sub



private shared 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  : Message type
'	//	=0 : Transmission result
'	//	 1 : Received message
'	//	 2 : Send message
' hd	// i  : SECS Message Header
' did	// i  : SECS Message Device ID
' sf	// i  : SECS Message SF-Code
' xid	// i  : SECS Message Transaction IF
' msg	// i  : SECS Message Strage area (Header not include)
' len	// i  : SECS Message byte length

  dim	ctp()		as string	={"SRES","RECV","SEND"}
  dim	mname,sitem	as string
  dim	vi1(64)		as sbyte
  dim	itm(64)		as byte
  dim	vi2(32)		as short
  dim	vu2(32)		as ushort
  dim	vi4(16)		as integer
  dim	vu4(16)		as uinteger
  dim	vi8(8)		as long
  dim	vu8(8)		as ulong
  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
  rbit	= " ":	if (did and &h8000)<>0 then	rbit = "R"
  wbit	= " ":	if (sf  and &h8000)<>0 then	wbit = "W"
  dp	= MSSG_USE_FILE or MSSG_DISP_TYPE
	' [Note] Refer to [Note] described in DispSECSMssg () in SubFuncsion.h
	' [注意] SubFuncsion.h の DispSECSMssg() に記述の [注意] を参照すること

  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	' Use message definition file
  else:					fm = &h0000	' Not use
  end if

  if len>0 then
    if tp=1 then: dp= dp or &h3000:  fm= fm or &h3000	' In case of receiving
    else:	  dp= dp or &h2000:  fm= fm or &h2000	' In case of sending
    end if

    mname = ""
    mm	= Td._TDSMssgFind(fm,msg,len,Fd,hd,mname)
    if mm>0 then
      if mname<>"" then console.writeline("[{0}]",mname)' Message name
      la=0
      do
	if MSSG_USE_NEXTL=0 then ' Get item value
	  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	 ' Display field value
				 ' The second and subsequent numbers are omitted
				 ' 数値の３番目以降は省略
	    case &o000: Console.WriteLine("L[{0}]"	   ,noi)
	    case &o010: Console.WriteLine("B[{0}]={1,0:x2},{2,0:x2}"	_
							   ,noi,itm(0),itm(1))
	    case &o011: Console.WriteLine("T[{0}]={1,0},{2,0}"		_
							   ,noi,itm(0),itm(1))
	    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: Buffer.BlockCopy(itm,0,vi1,0,sz*2)
			Console.WriteLine("I1[{0}]={1},{2}",noi,vi1(0),vi1(1))
	    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,vu8,0,sz*2)
			Console.WriteLine("U8[{0}]={1},{2}",noi,vu8(0),vu8(1))
	    case &o051: Console.WriteLine("U1[{0}]={1},{2}",noi,itm(0),itm(1))
	    case &o052: Buffer.BlockCopy(itm,0,vu2,0,sz*2)
			Console.WriteLine("U2[{0}]={1},{2}",noi,vu2(0),vu2(1))
	    case &o054: Buffer.BlockCopy(itm,0,vu4,0,sz*2)
			Console.WriteLine("U4[{0}]={1},{2}",noi,vu4(0),vu4(1))
	  end select

	else						' Get in list format
	  str=""					' リスト表示形式で取得
	  rtn=Td._TDSMssgNextL(mm,dp,msg,form,noi,str)
	  if rtn		< 0	then	exit do
	  if (dp and &h70) > &h10 then			' In case of SML
	    DispSECSMssgRightParentheses(la,rtn)	' Display '>'
	  end if
	  la=rtn					' Save current hierarchy
							' 現在の階層を保存
	  console.writeline("  {0}",str)		' Display acquired field value
							' 取得した項目値を表示
	  if ((dp and &h70) > &h10) and (form=0) and (noi=0)  then
	    DispSECSMssgRightParentheses(la+1,la)	' '>' Processing for L0
	  end if					' L0 の場合の '>' 処理
	end if
      loop

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



' ------------------------------------------------------------------------------
' Display sent and received data -----------------------------------------------

private shared 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  : Message type
'	//	=0 : Transmission result
'	//	 1 : Received message
'	//	 2 : Send message
' hd	// i  : SECS Message Header
' did	// i  : SECS Message Device ID
' sf	// i  : SECS Message SF-Code
' xid	// i  : SECS Message Transaction IF
' msg	// i  : SECS Message body
' len	// i  : Byte length of 'msg'
' rtn	// i  : I/O retrun value

  dim	ok		as integer
  dim	stat		as integer

  SyncLock Cs1		' See notes in SubFuncsion.h
			' SubFuncsion.h の注記を参照すること
  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
      if FUNC_TYPE=0 then:	stat=Td._TDSCommStatus(Fd,0)
      else:			stat=Td._TDSUDrvStatus(Fd,0)
      end if
      console.write("STATUS = {0},{1} : "	,-rtn,stat)
      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   (0x{0:x4})" ,did)
	case E_REJECT:		console.writeline("Rejected XId=0x{0:x4}",xid)
	case E_DESELECT:	console.writeline("Deselected (0x{0:x4})" ,did)
	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)
  End SyncLock

  return 0
end function



' ==============================================================================
' S1F1 message construction and sending ----------------------------------------

private shared function			_
SendS1F1()		as integer

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

  sf	=&h8101:	len	=0

			' See (Note) in SendS1F1() of SubFunction.h.
			' SubFunction.h の SendS1F1() 内 (注) を参照すること。
  if FUNC_TYPE=0 then:	rtn=Td._TDSCommSend(Fd,&h0000,0,sf,  0,msg,len,hd)
  else:			rtn=Td._TDSUDrvSend(Fd,&h0000,0,sf,  0,msg,len,hd)
  end if
  DispData(2,hd,0,sf,rtn,msg,len,rtn)

  return rtn
end function


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

private shared 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		' Do not use message definition
    mm=		Td._TDSMssgInit   (   0,msg,  256,Fd)		' S1F2
		Td._TDSMssgBuild  (mm,0,msg,&o000,  0,item)	' L0
    len=	Td._TDSMssgEnd    (mm,0,msg)

  else						' Use message definition
		Td._TDSMDMssgInit (Md,0,msg,  256,"S1F2_H")
    len=	Td._TDSMDMssgEnd  (Md,0,msg)
  end if

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

  return rtn
end function


' ------------------------------------------------------------------------------
' S1F2 message (Equipment) construction and sending ----------------------------
' S1F2 メッセージ (Equip) 構築及び送信 -----------------------------------------

private shared 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		' Do not use message definition
    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						' Use message definition
		Td._TDSMDMssgInit (Md,0,msg,  256,"S1F2_E")
    len=	Td._TDSMDMssgEnd  (Md,0,msg)
  end if

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

  return rtn
end function
  

' ==============================================================================
' S2F49 message construction and sending ---------------------------------------
' S2F49 メッセージ構築及び送信 -------------------------------------------------

private shared 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		' Do not use message definition
    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						' Use message definition
		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 ' See (Note) in SendS1F1() of SubFunction.h
  else				 ' SubFunction.h の SendS1F1() 内 (注) を参照
    if FUNC_TYPE=0 then: rtn=Td._TDSCommSend(Fd,&h0000,0,sf,  0,msg,len,hd)
    else:		 rtn=Td._TDSUDrvSend(Fd,&h0000,0,sf,  0,msg,len,hd)
    end if
  end if
  DispData(2,hd,0,sf,rtn,msg,len,rtn)

  return rtn
end function


' ------------------------------------------------------------------------------
' S2F50 message construction and sending ---------------------------------------
' S2F50 メッセージ構築及び送信 -------------------------------------------------

private shared 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		' Do not use message definition
    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						' Use message definition
		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
    if FUNC_TYPE=0 then: rtn=Td._TDSCommSend(Fd,&h0000,did,sf,xid,msg,len,hd)
    else:		 rtn=Td._TDSUDrvSend(Fd,&h0000,did,sf,xid,msg,len,hd)
    end if
  end if
  DispData(2,hd,did,sf,rtn,msg,len,rtn)

  return rtn
end function


' ==============================================================================
' S6F11 message construction and sending ---------------------------------------
' S6F11 メッセージ構築及び送信 -------------------------------------------------

private shared function			_
SendS6F11()		as integer

  static cnt		as integer	=0
  dim	hd(12),msg(256)	as byte
  dim	vs(4)		as short
  dim	vu(4)		as ushort
  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		' Do not use message definition
    mm=		Td._TDSMssgInit   (   0,msg,  256,Fd)		' S2F50
		Td._TDSMssgBuild  (mm,0,msg,&o000,  3,vs)	' L3
    vu(0)=cnt:	Td._TDSMssgBuild  (mm,0,msg,&o052,  1,vu)	'  DATAID
    vu(0)=8:	Td._TDSMssgBuild  (mm,0,msg,&o052,  1,vu)	'  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 Actually I set current time, but omitted.
			' @TIME 本当は現在時刻を設定するのだが、省略
    len=	Td._TDSMssgEnd    (mm,0,msg)

  else						' Use message definition
		Td._TDSMDMssgInit (Md,0,msg,  256,"S6F11_0")
    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 ' See (Note) in SendS1F1() of SubFunction.h
  else				 ' SubFunction.h の SendS1F1() 内 (注) を参照
    if FUNC_TYPE=0 then: rtn=Td._TDSCommSend(Fd,&h0000,0,sf,  0,msg,len,hd)
    else:		 rtn=Td._TDSUDrvSend(Fd,&h0000,0,sf,  0,msg,len,hd)
    end if
  end if
  DispData(2,hd,0,sf,rtn,msg,len,rtn)

  return rtn
end function



' ------------------------------------------------------------------------------
' S6F12 message construction and sending ---------------------------------------

private shared 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		' Do not use message definition
    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						' Use message definition
		Td._TDSMDMssgInit (Md,0,msg,  256,"S6F12")
    len=	Td._TDSMDMssgEnd  (Md,0,msg)
  end if

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

  return rtn
end function



' ==============================================================================
' Callback Function ============================================================

private shared 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  : Request code to library
' rtn	// i  : Return code from library
' did	// i  : SECS Message Device ID
' xsf	// i  : SECS Message SF-Code
' xid	// i  : SECS Message Transaction ID
' xhd	// i  : SECS Message Header
' xmsg	// i  : SECS Message Body

  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)

  if req=0 and rtn>=0 then
    if (MSSG_USE_FILE and &h80)=0 then
		' If you do not use message definition file, check SF-Code on
		' your own, determine necessity of sending secondary message,
		' and send it if necessary.
		' メッセージ定義ファイルを使用しない場合、自力で 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
		' When using a message definition file, this sample uses the
		' automatic reply function.
		' メッセージ定義ファイルを使用する場合は、本サンプルでは、自動
		' 返信機能を利用する。
      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)
	if FUNC_TYPE=0 then: rtn=Td._TDSCommSend(Fd,&h0000,did,sf,xid,msg,len,hd)
	else:		     rtn=Td._TDSUDrvSend(Fd,&h0000,did,sf,xid,msg,len,hd)
	end if
	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 shared sub			_
RecvProcThread(				_
byval	param		as object)

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

  do until Break<>0
    req=0
    if FUNC_TYPE=0 then: rtn=Td._TDSCommRecv(Fd,&h0000,did,sf,xid,msg,1024,hd)
    else:		 rtn=Td._TDSUDrvRecv(Fd,&h0000,did,sf,xid,msg,1024,hd)
    end if
    if rtn=(-951) then
      Sleep(100)
    else
      if (-1000)<rtn and rtn<(-959) then	req=(-rtn)-900
      CBRecvProc(req,rtn,did,sf,xid,hd,msg)
    end if
  loop

end sub



' ==============================================================================
' Main process -----------------------------------------------------------------

public shared 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



' ==============================================================================
' Host side process ------------------------------------------------------------

private shared 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	as integer
  dim	did,dids	as integer

  OType=0:	Break=0:	sf=0
  if FUNC_TYPE=0 then: Fd=Td._TDSCommOpen(&h0002,PARAMFILE,"HOST")
  else:		       Fd=Td._TDSUDrvOpen(&h0002,PARAMFILE,"HOST",UDRV_MASK)
  end if
  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
      if FUNC_TYPE=0 then: rtn=Td._TDSCommRecv(Fd,&h0000,did,sf,xid,msg,1024,hd)
      else:		   rtn=Td._TDSUDrvRecv(Fd,&h0000,did,sf,xid,msg,1024,hd)
      end if
      if rtn>=0 then
	dids=did
	xids=xid
      end if
      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(dids,xids)
	case 7: rtn=SendS6F12(dids,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
    if FUNC_TYPE=0 then: Td._TDSCommClose(Fd,&h0000)
    else:		 Td._TDSUDrvClose(Fd,&h0000)
    end if
  else:		console.writeline("(H) Error ({0})",Fd)
  end if
end sub



' ==============================================================================
' Equipment side process -------------------------------------------------------

private shared 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	as integer
  dim	did,dids	as integer

  OType=1:	Break=0:	sf=0
  if FUNC_TYPE=0 then: Fd=Td._TDSCommOpen(&h0002,PARAMFILE,"EQUIP"):
  else:		       Fd=Td._TDSUDrvOpen(&h0002,PARAMFILE,"EQUIP",UDRV_MASK):
  end if
  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 SECS_MODE<>0 and FUNC_TYPE=0 then	'In case of HSMS and use TDSCommXxxxx()
					' HSMS で TDSCommXxxxx() 使用の場合
    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")
  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
      if FUNC_TYPE=0 then: rtn=Td._TDSCommRecv(Fd,0,did,sf,xid,msg,1024,hd)
      else:		   rtn=Td._TDSUDrvRecv(Fd,0,did,sf,xid,msg,1024,hd)
      end if
      if rtn>=0 then
	dids=did
	xids=xid
      end if
      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(dids,xids)
	case 7: rtn=SendS2F50(dids,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

  if SECS_MODE<>0 then			' In case of HSMS, Shutdown process
					' HSMS 接続の場合、切断処理
  ' Deselect request is not performed. (Of course you may go. However SEMI
  ' claims that HSMS-SS does not perform Deselect request.)
  ' Deselect request は行わない。 (もちろん行ってもよい。SEMI では HSMS-SS に
  ' おいて、Deselect request は行なわない、としている。)
  ' if FUNC_TYPE=0 then: rtn=Td._TDSCommSend(Fd,&h0800,0,0,0,msg,0,hd)
  ' else:		 rtn=Td._TDSUDrvSend(Fd,&h0800,0,0,0,msg,0,hd)
  ' end if
  ' if rtn< 0 then						goto Conclude
  ' console.writeline("(E) Deselected")
    if FUNC_TYPE=0 then: rtn=Td._TDSCommSend(Fd,&h0900,0,0,0,msg,0,hd)
    else:		 rtn=Td._TDSUDrvSend(Fd,&h0900,0,0,0,msg,0,hd)
    end if
    if rtn< 0 then						goto Conclude
    console.writeline("(E) Separated")
  end if

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

end class

end namespace
