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

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

Class g_obj
  dim epno,epnm, dep1, dep2, dep3
End Class

' 宣告為全區變數
Dim xmlDoc,xmlhttp,xmlSubc,G_OBJECT,G_PERM, G_DEP, G_DEPS, G_PS_CLOSEDATE, G_PS_VERSION
Dim G_PGSYSM,G_PGMODE,G_PGGPNO,G_PGPGID

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

set xmlhttp=createobject("microsoft.XMLHTTP")


set G_OBJECT=new g_obj

'********************************************************
'   功能函數: 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


'********************************************************
'   功能函數: checkDateFmt
'   說明    : 日期檢查
'   使用方式: rc=checkDate(cdt, msg)
'   輸入    : cdt (YYYYMMDD)
'    

function checkDateFmt (cdt, msg)

  ldt=""
  msg=""
  yyyy=""
  mm=""
  dd=""
  checkDateFmt=false
  
  if len(cdt)<>8 then
    msg=ERR_FMT
    exit function
  end if
  
  if isnumeric(cdt) then
    for cCnt=1 to len(cdt)
      if instr(1,"0123456789",mid(cdt,cCnt,1))<=0 then 
        msg=ERR_FMT
        exit function
      end if
    next
    
    yyyy=mid(cdt,1,4)
    mm=mid(cdt,5,2)
    dd=mid(cdt,7,2)

    if isdate(yyyy & "/" & mm & "/" &  dd) then
      checkDateFmt=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)
  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



' 未來三階使用
sub getUserData(sessiondata)
  if trim(sessiondata)="" then exit sub
  xmlDoc.loadXML(sessiondata)
  G_OBJECT.epno=getField("EPNO")
  G_OBJECT.epnm=getField("EPNM")
  dep=split(getField("DEP"),"|")
  G_OBJECT.dep1=dep(0)
  G_OBJECT.dep2=dep(1)
  G_OBJECT.dep3=dep(2)
end sub

'********************************************************
'   功能函數: getPGData
'   說明    : PGDATA資料擷取副程式
'   使用方式: call getPGData(sysm)
'   輸入    : G_SYSM
'    
sub getPGData(sysm)
  xmlDoc.load("/GE/PG0M00XML.asp?xmlData=<Collection><TYPE>G</TYPE><SYSM>" & sysm & "</SYSM></Collection>")
  G_PGSYSM=getField("SYSM")
  G_PGMODE=getField("MODE")
  G_PGGPNO=getField("GPNO")
  G_PGPGID=getField("PGID")
end sub





'********************************************************
'   功能函數: 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

'********************************************************
'   功能函數: checkIDNumber
'   說明    : 身份證字號檢查
'   使用方式: rc=checkIDNumber(id, msg)
'   輸入    : id (字串), msg (字串)
'   輸出    : true/false, msg
'    
function checkIDNumber(id, msg)
  checkIDNumber=false
  id=LCase(id)
  msg=""
  Set regEx = New RegExp      ' Create a regular expression.
  patten="^[a-z][12][0-9]{8}$"
  regEx.Pattern = patten      ' Set pattern.
  regEx.IgnoreCase = True     ' Set case insensitivity.
  regEx.Global = True         ' Set global applicability.
  Set Matches = regEx.Execute(id)   ' Execute search.

   
  '檢查長度是否正確
  if Matches.count>0 then
    '注意第一碼英文順序'i'與'o'在最後
    chk_h="abcdefghjklmnpqrstuvxywzio"
    chk_x=9+instr(1,chk_h,mid(id,1,1))
    chksum=chk_x\10+(chk_x mod 10)*9
    for iCnt=2 to 9
      chksum=chksum+mid(id,iCnt,1)*(10-iCnt)
    next 
    chksum=chksum+mid(id,10,1)
   
    if(chksum mod 10)=0 then
      checkIDNumber=true
    else 
     msg="身份證字號錯誤!" & chksum
     exit function
    end if
 else
   msg="身份證字號不正確"
   exit function
 end if
end function 


'********************************************************
'   功能函數: checkIDCompNo
'   說明    : 營利事業統一編號檢查
'   使用方式: rc=checkIDCompNo(idvalue, msg)
'   輸入    : idvalue (字串), msg (字串)
'   輸出    : true/false, msg
'    

function checkIDCompNo(idvalue, msg) 
  checkIDCompNo=false
  tmp="12121241"
  sum=0
  msg=""

  Set regEx = New RegExp   ' Create a regular expression.
  patten="^\d{8}$"
  regEx.Pattern=patten   ' Set pattern.
  regEx.IgnoreCase=True   ' Set case insensitivity.
  regEx.Global=True   ' Set global applicability.
  Set Matches=regEx.Execute(idvalue)   ' Execute search.

  '檢查長度是否正確
  if Matches.count<=0 then
    msg="營利事業統一編號格式不對！"
    exit function
  end if
   
   for iCnt=1 to 8
     s1=cint(mid(idvalue,iCnt,1))
     s2=cint(mid(tmp,iCnt,1))
     sum=sum+checkIDCompNo_cal(s1*s2)
   next
   
   if (not checkIDCompNo_valid(sum,msg)) then
      if (mid(idvalue,7,1)="7") then 
      checkIDCompNo=valid(sum+1,msg)
      end if
   end if  
   
   checkIDCompNo=checkIDCompNo_valid(sum,msg)
end function

function checkIDCompNo_valid(n,msg) 
  if (n mod 10)=0 then
    checkIDCompNo_valid=true
  else
    msg="營利事業統一編號有誤"
    checkIDCompNo_valid=false
  end if
end function

function checkIDCompNo_cal(n)
  sum=0
  do while n<>0 
    sum=sum+(n mod 10)
    n=n\10
  loop
  checkIDCompNo_cal=sum
end function

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

  'xmlDoc.load(fname & "?xmlData=" & xmlcmd)
' -- 共用開始 --
  if getField("TIMEOUT")="1" then
    
    select case G_PGTYPE
      case "A" '主程式
        msgbox "停留時間過長，請重新登入"
        window.open "/default.asp","_top"
      case "S" '副程式
        msgbox "停留時間過長，請重新登入"
        window.close     
    end select
  end if
' -- 共用結束 --  
end sub