學校DrCom登錄腳本

'configure
Const DELETE_CONFIG = 0 'put 1 to delete script configure in registry
Const KEEP_QUIET = 0 'put 1 to no longer pop up MessageBox
Const DRCOM_URL = "http://172.16.3.11/"
Const DRCOM_LOGOFF_URL = "http://172.16.3.11/F.htm"
Const METHOD_POST = "POST"
Const METHOD_GET = "GET"
Const REG_KEY = "HKLM\Software\DrCom"
Const REG_CFGKEY = "HKLM\Software\DrCom\Config\"
Const CHECK_KEY_0 = "Account"
Const CHECK_KEY_1 = "Password"
Const REG_UNAME = "uname"
Const REG_UPASS = "upass"
Const DATA_0 = "DDDDD="
Const DATA_1 = "&upass="
Const DATA_2 = "&0MKKey=%B5%C7%C2%BC+Login"

'string
Const SMicrosoftXmlHttp = "Microsoft.XmlHttp"
Const SWscriptShell = "Wscript.Shell"
Const SContentType = "Content-Type"
Const Sapplicationxwww = "application/x-www-form-unlencoded"
Const STip = "Tip"
Const SQuestion = "Question"
Const SlogoffSuc = "Successfully log off DrCom!"
Const SloginSuc = "Successfully log in DrCom!"
Const SQLogoff = "Log off DrCom?"
Const SQLogin = "Log in DrCom?"
Const SITAccount = "Input Account"
Const SIAccount_0 = "Account (Stu.No.):"
Const SIAccount_1 = "put 0 to exit script"
Const SITPassword = "Input Password"
Const SIPassword = "Password :"

Function http_get(url)
    Dim http
    
    Set http = CreateObject(SMicrosoftXmlHttp)
    Call http.Open(METHOD_GET, url, False)
    Call http.Send
    http_get = http.ReadyState
    Set http = Nothing
End Function

Function http_post(url, data)
    Dim http
    
    Set http = CreateObject(SMicrosoftXmlHttp)
    Call http.Open(METHOD_POST, url, False)
    Call http.SetRequestHeader(SContentType, Sapplicationxwww)
    Call http.Send(data)
    http_post = http.ReadyState
    Set http = Nothing
End Function

Function check_loggedin()
    Dim http
    
    Set http = CreateObject(SMicrosoftXmlHttp)
    Call http.Open(METHOD_GET, DRCOM_URL, False)
    Call http.Send
    check_loggedin = 0
    If http.ReadyState <> 4 Then Exit Function
    If InStr(http.ResponseText, CHECK_KEY_1) = 0 And InStr(http.ResponseText, CHECK_KEY_0) = 0 Then
        check_loggedin = 1
    End If
    Set http = Nothing
End Function

Sub drcom_login(uname, upass)
    Dim data
    
    data = DATA_0 & uname & DATA_1 & upass & DATA_2
    Call http_post(DRCOM_URL, data)
End Sub

Sub drcom_logoff()
    If http_get(DRCOM_LOGOFF_URL) = 4 Then
        If check_loggedin() = 0 Then If KEEP_QUIET = 0 Then Call MsgBox(SlogoffSuc, vbInformation, STip)
    End If
End Sub

Sub main()
    On Error Resume Next
    Dim wsh
    Dim uname, upass, ustate
    
    If check_loggedin() = 1 Then
        If KEEP_QUIET = 0 Then If MsgBox(SQLogoff, vbQuestion Or vbYesNo, SQuestion) = vbNo Then Exit Sub
        Call drcom_logoff
    Else
        Set wsh = CreateObject(SWscriptShell)
        If KEEP_QUIET = 0 Then If MsgBox(SQLogin, vbQuestion Or vbYesNo, SQuestion) = vbNo Then Exit Sub
        uname = wsh.RegRead(REG_CFGKEY & REG_UNAME)
        upass = wsh.RegRead(REG_CFGKEY & REG_UPASS)
        Do
            If uname = "" Or upass = "" Then
                uname = InputBox(SIAccount_0 & vbCrLf & SIAccount_1, SIT_Account)
                upass = InputBox(SIPassword, SITPassword)
            End If
            If uname = "0" Then Exit Sub
            Call drcom_login(uname, upass)
            ustate = check_loggedin()
            If ustate = 0 Then
                uname = ""
                upass = ""
            End If
        Loop Until ustate = 1
        If KEEP_QUIET = 0 Then Call MsgBox(SloginSuc, vbInformation, STip)
        Call wsh.RegWrite(REG_CFGKEY & REG_UNAME, uname)
        Call wsh.RegWrite(REG_CFGKEY & REG_UPASS, upass)
        Set wsh = Nothing
    End If
    If DELETE_CONFIG = 1 Then
        Set wsh = CreateObject(SWscriptShell)
        wsh.RegDelete REG_KEY
        Set wsh = Nothing
    End If
End Sub

'script entry

Call main   ''''main proc of script

'end of script