'********************************
'  MG共用程式區
'********************************

const ERR_FMT="日期格式錯誤"
const ERR_FMT_YY="日期格式錯誤(年)"
const ERR_FMT_MM="日期格式錯誤(月)"
const ERR_FMT_DD="日期格式錯誤(日)"
const ERR_FMT_UNKNOW="未支援格式"

' 宣告為全區變數
Dim xmlDoc,xmlhttp
Dim xmlAddr, xmlSubc, xmlPspt

set xmlDoc=createobject("microsoft.xmlDOM")
xmlDoc.async=false

set xmlhttp=createobject("microsoft.XMLHTTP")

'禁止直接呼叫
'if instr(1,ucase(document.location.pathname),"PGOH0")>0 then
'else
'  if window.parent.length =0 then
'    window.navigate "PGOH01.aspx","_top"
'  end if
'end if

'**********************************************
'*
'* 建立 xmlMG 共用物件
'*
'**********************************************
sub createMGobject(objSPAN, objName, paramList)

   set xmlMG=createobject("microsoft.xmlDOM")
   xmlMG.async=false
   xmlMG.loadxml(paramList)

   set cmdList=xmlMG.getElementsByTagName("Collection/CMD")
   xmlMG_cmd=cmdList.item(0).text
   objSPAN.innertext = ""
   select case xmlMG_cmd
      case "MG0901"
         call MG0901(xmlGM, objSPAN, objName, paramList)    
   end select
end sub


'**********************************************
'*  
'* MG0901 下拉選單
'**********************************************
sub MG0901(xmlMG, objSPAN, objName, paramList) 

   ' 取得指定顯示之值
   set dspList=xmlGM.getElementsByTagName("Collection/DSPVAL")   
   dspval=dspList.item(0).text   
   xmlDoc.load("MGcomxml.aspx?xmlData=" & paramList )

   ' 建立物件
   set selobj=document.createElement("SELECT")
   selobj.style.fontfamily="細明體"
   selobj.id=objName

   ' 取得選項顯示之值
   set optList=xmlMG.getElementsByTagName("Collection/OPT")
   optn=optList.item(0).text

   ' 第一碼 全部
   if mid(optn,1,1)="1" then
      set opt=document.createElement("OPTION")
      opt.value="ALL"
      opt.innertext="(全部)"
      selobj.appendchild opt
   end if

   ' 第二碼 空白
   if mid(optn,2,1)="1" then
      set opt=document.createElement("OPTION")
      opt.value="BLANK"
      opt.innertext="(空白)"
      selobj.appendchild opt
   end if

   ' 建立 SPAN OBJECT
   for iCnt=0 to xmlDoc.childNodes(1).childnodes.length-1
      set node=xmlDoc.childNodes(1).childNodes(iCnt)
      set opt=document.createElement("OPTION")
      opt.value=node.getAttribute("VALUE")
      opt.innertext=node.getAttribute("TEXT")
      if node.getAttribute("NAME")<>"" then
         opt.setAttribute "name",node.getAttribute("NAME")
      end if
      selobj.appendchild opt
      if trim(opt.value)=trim(dspval) then
         opt.setAttribute "selected","true"
      end if    
   next
  
   selobj.style.width=100
   objSPAN.appendChild selobj
end sub


'********************************************************
'   功能函數: ldt2cdt
'   說明    : 西元年轉中國年
'   使用方式: rc=ldt2cdt(ldt, cdt, msg)
'   輸入    : ldt (YYYY/M(M)/D(D) or YYYY-M(M)-D(D))
'   輸出    : cdt (YYYMMDD), msg
'    

function ldt2cdt ( ldt, cdt, msg)

  cdt=""
  msg=""
  yyy=""
  mm=""
  dd=""
  ldt2cdt=false
  
  ' 檢查輸入日期格式
  if instr(1,ldt,"/")>0 then
    dttype="1"
    splitbar="/"
  else
    if instr(1,ldt,"-")>0 then
      dttype="2"
      splitbar="-"
    else
      if len(ldt)=8 then
        dttype="3"
      else
        dttype="4"
      end if      
    end if
  end if
    

  select case dttype
    case "1","2"
      tdt=split(ldt, splitbar)
      if ubound(tdt)=2 then
        if isdate(ldt) then 
          yyy=cint(tdt(0))-1911
          if yyy>0 then
            if yyy<100 then yyy="0" & yyy
            mm=tdt(1)
            if mm<10 then mm="0" & mm
            dd=tdt(2)
            if dd<10 then dd="0" & dd
          else
            msg=ERR_FMT_YY
          end if
        else
          msg=ERR_FMT
        end if
      else
        msg=ERR_FMT
      end if
    case "3"
      yyy=mid(ldt,1,4)
      mm=mid(ldt,5,2)
      dd=mid(ldt,7,2)
      if isdate(yyy & "/" & mm & "/" & dd) then
        yyy=yyy-1911
        if yyy>0 then
          if yyy<100 then yyy="0" & yyy
        else
          msg=ERR_FMT_YY
        end if
      else
        msg=ERR_FMT
      end if
    case "4"
      msg=ERR_FMT_UNKNOW
  end select
  
  if msg="" then 
    cdt=yyy & mm & dd
    ldt2cdt=true
  end if
  
end function



'********************************************************
'   功能函數: cdt2ldt
'   說明    : 中國年轉西元年
'   使用方式: rc=cdt2ldt(cdt, ldt, msg)
'   輸入    : cdt (YYYMMDD/YYMMDD), delm 分隔符號("/","-","")
'   輸出    : ldt (YYYY/MM/DD), msg
'    

function cdt2ldt ( cdt, ldt, delm, msg)

  ldt=""
  msg=""
  yyyy=""
  mm=""
  dd=""
  cdt2ldt=false
  
  if len(cdt)<>7 and len(cdt)<>6 then
    msg=ERR_FMT
    exit function
  end if
  
  if isnumeric(cdt) then
    if len(cdt)=6 then 
      yyyy=mid(cdt,1,2)+1911
      mm=mid(cdt,3,2)
      dd=mid(cdt,5,2)
    else
      yyyy=mid(cdt,1,3)+1911
      mm=mid(cdt,4,2)
      dd=mid(cdt,6,2)
    end if
    for cCnt=1 to len(cdt)
      if instr(1,"0123456789",mid(cdt,cCnt,1))<=0 then 
        msg=ERR_FMT
        exit function
      end if
    next
    
    if isdate(yyyy & "/" & mm & "/" &  dd) then
      ldt=yyyy & delm & mm & delm &  dd
      if len(cdt)=6 then cdt="0" & cdt
      cdt2ldt=true
    else
      msg=ERR_FMT
    end if
  else
    msg=ERR_FMT
  end if
  
end function

'********************************************************
'   功能函數: checkFullChineseLength
'   說明    : 中文長度檢查
'   使用方式: rc=checkChineseLength(inputStr, sLen, rLen)
'   輸入    : inputStr (字串) , sLen(期望長度), rLen(真正長度) 
'   輸出    : true/false
'    

function checkFullChineseLength(inputStr, sLen, rLen)
  checkFullChineseLength=true
  rLen=0
  if trim(inputStr)<>"" then        
    iCnt=0
    inputStr=trim(inputStr)
    for i=1 to len(inputStr)
      if midb(inputStr,i*2-1,2) >= chr(32) and midb(inputStr,i*2-1,2) =< chr(127) then
        checkFullChineseLength=false
        exit function
      else
        iCnt=iCnt+2
      end if
    next
    if iCnt>sLen then
      checkFullChineseLength=false
    end if  
  end if  
  rLen=iCnt
end function


'********************************************************
'   功能函數: checkChineseLength
'   說明    : 中文長度檢查
'   使用方式: rc=checkChineseLength(inputStr, sLen, rLen)
'   輸入    : inputStr (字串) , sLen(期望長度), rLen(真正長度) 
'   輸出    : true/false
'    

function checkChineseLength(inputStr, sLen, rLen)
  dim iCnt
  checkChineseLength=true
  rLen=0
  if trim(inputStr)<>"" then        
    iCnt=0
    inputStr=trim(inputStr)
    for i=1 to len(inputStr)
      if midb(inputStr,i*2-1,2)>=chr(32) and midb(inputStr,i*2-1,2)=<chr(127) then
        iCnt=iCnt+1
      else
        iCnt=iCnt+2
      end if
    next
    if iCnt>sLen then
      checkChineseLength=false
    end if  
  end if  
  rLen=iCnt
end function


'********************************************************
'   功能函數: getField
'   說明    : 資料擷取副程式
'   使用方式: rc=getField(i_txt)
'   輸入    : i_txt 文字
'   輸出    : 文字
'    
function getField(i_txt)
  on error resume next
  set root=xmlDoc.GetElementsByTagName(i_txt)
  if root(0).childnodes.length=1 then
    getField=root(0).childNodes(0).text
  else
    getField=""
  end if
  set root=nothing
  on error goto 0
end function

'********************************************************
'   功能函數: checkFullChineseLength
'   說明    : 中文長度檢查
'   使用方式: rc=checkChineseLength(inputStr, sLen, rLen)
'   輸入    : inputStr (字串) , sLen(期望長度), rLen(真正長度) 
'   輸出    : true/false
'    

function checkFullChineseLength(inputStr, sLen, rLen)
  checkFullChineseLength=true
  rLen=0
  if trim(inputStr)<>"" then        
    iCnt=0
    inputStr=trim(inputStr)
    for i=1 to len(inputStr)
      if midb(inputStr,i*2-1,2) >= chr(32) and midb(inputStr,i*2-1,2) =< chr(127) then
        checkFullChineseLength=false
        exit function
      else
        iCnt=iCnt+2
      end if
    next
    if iCnt>sLen then
      checkFullChineseLength=false
    end if  
  end if  
  rLen=iCnt
end function


sub getXMLData(xmlcmd)
   xmlhttp.open "POST",replace(document.location,"#","") ,false
   xmlhttp.setRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=big5"
   xmlhttp.send xmlCmd
   set xmlDoc=xmlhttp.responseXML

' -- 共用開始 --
  if xmlDoc.parseError.errorCode <> 0 then
    window.open "PGOH01.aspx","_top"
    window.close  
    exit sub   
  end if
' -- 修改結束 --

  if getField("TIMEOUT")="1" then    
    window.open "PGOH01.aspx","_top"
    window.close     
    exit sub
  end if
' -- 共用結束 --  
end sub