public KeyString
sub document_Onkeypress()
    KeyString = KeyString & chr(Window.Event.keyCode)

    IF Len(KeyString) >=10 Then
       XV = ChkLen(KeyString)
    End IF
 
    IF XV = -1 Then
       'Msgbox "錯誤,找不到相關網頁!",,"錯誤連結!"
       KeyString =  ""
    End IF
end sub 

Function PostBody(url,action,hystr)
  Set Retrieval = CreateObject("Microsoft.XMLHTTP")
  With Retrieval
     .Open action, url, False, "", ""
     .setRequestHeader "Content-Type","application/x-www-form-urlencoded"
     .send hystr
     PostBody = .ResponseBody
  End With
  Set Retrieval = Nothing

End Function


Function ChkLen(this)
'  Msgbox this
  IF len(this) >= 10 Then
     WebReturnValue = PostBody("CheckDB.ASP","Post","CheckDB=" & UCASE(this))
     WebReturnValue = bytes2BSTR(WebReturnValue)
     'Msgbox WebReturnValue
     IF Instr(WebReturnValue,"CheckOK") > 0 Then
        A = split(WebReturnValue,",")
        location.href=A(1)
     Else
        ChkLen = -1
     End IF
  End IF
End Function

Private Function bytes2BSTR(vIn)
  Dim i, ThischrCode, NextchrCode
  strReturn = ""
For i = 1 To LenB(vIn)
   ThischrCode = AscB(MidB(vIn, i, 1))
  If ThischrCode < &H80 Then
     strReturn = strReturn & Chr(ThischrCode)
  Else
    NextchrCode = AscB(MidB(vIn, i + 1, 1))
    strReturn = strReturn & Chr(CLng(ThischrCode) * &H100 + CInt(NextchrCode))
     i = i + 1
  End If
Next
    bytes2BSTR = strReturn
End Function

public function ChkKey()
 ChkKey = oldkey & ChkKey & chr(window.event.keyCode )
 if len(ChkKey) > 1 then msgbox "e"
End Function
