some code

22世紀 2011-06-24

展開全文

http://wiki./index.php?title=%E9%A6%96%E9%A1%B5&variant=zh-cn

<HTML>
<HEAD>
<TITLE>Connection Tool for P, G drive and xxxxxx P盤、G盤以及蘇州主頁連接工具</TITLE>
<HTA:APPLICATION ID="oHTA"
APPLICATIONNAME="PublicPC.hta"
BORDER="thick"
BORDERSTYLE="static"
CAPTION="yes"
ICON="filename.ico"
SHOWINTASKBAR="yes"
SINGLEINSTANCE="no"
SysMenu="no"
VERSION="1.0"
WINDOWSTATE="normal"
>

</head>
<SCRIPT Language="VBScript">

Dim ComputerName, UserName, strUsername, strPassword, strUser

Sub Window_Onload

    ' ----------------------------------------------------------------------------
    ' PublicPC.vbs
    ' VBScript program for public PC
    ' Date: 08/31/2009
    ' Version: 2.0 -- Change to HTA program
    ' By: Mike Yang
    ' ----------------------------------------------------------------------------
    window.resizeTo 590,310

window.moveTo 100, 30

'window.document.all.Ok_button.focus

'On Error Resume Next

    ' -----------------------
    ' Get ComputerName
    ' -----------------------

    Set objNetwork = CreateObject("WScript.Network")
    ComputerName = objNetwork.ComputerName
    UserName = objNetwork.username

    'Const ADS_SECURE_AUTHENTICATION = 1
    'Const ADS_USE_ENCRYPTION = 2
    'Const LOG_OFF = 0
    'Const FORCED_LOG_OFF = 4
    Const wshInfoMark = 64

    ' -----------------------
    ' Remove B drive
    ' -----------------------

strMapDriveLetterB = "B:"
CheDrive strMapDriveLetterB

End Sub

' -----------------------
' Sub Cancel script
' -----------------------
Sub CancelScript
Window.close()
End Sub

' -----------------------
' Sub KeyCheck
' -----------------------
Sub KeyCheck
        If Window.Event.KeyCode = 13 Then
            Runscript
        End If
End Sub

' -----------------------
' Sub RunScript
' -----------------------
Sub Runscript
On Error Resume Next

    set wshShell= CreateObject("Wscript.Shell")
    runEcho = "mshta vbscript:CreateObject(" & """" &"Wscript.Shell" & """" & ").popup(" & """" & "Please wait for a moment..." & """" &",1," & """" & "Information" & """" & ",64)(window.close)"
    wshShell.run(runEcho)

    strUserName = UsernameArea.Value
    strPassword = PasswordArea.Value
    strUser = "xxxxxx\" & strUserName

If strUsername = "" or strPassword = "" or strUserName = "suzpublic" Then

        WaitSeconds 1
        Msgbox "" _
            & "Error!! Please input your own Windows login account and password to run the tools. " & chr(10) & chr(13) & chr(10) & chr(13) _
            & "錯誤！！請輸入您的Windows 登錄賬號和密碼" _
            ,vbOKonly,"Error"

Exit Sub

    Else
        err.clear
        strPath1 = "OU=xxxxxx,dc=xxxxxx,dc=com"

ADS_SECURE_AUTHENTICATION = 1
ADS_USE_ENCRYPTION = 2

        Set root = GetObject("LDAP:")
        Set objOU = root.OpenDSObject("LDAP://xxxxxx/" & strPath1, strUser, strPassword, _
                ADS_USE_ENCRYPTION AND ADS_SECURE_AUTHENTICATION)
        SuzDN = objOU.distinguishedName

If err = 424 then

            WaitSeconds 1
            Msgbox "" _
                & "Logon failure: unknown user name or bad password, please input again." & chr(10) & chr(13) & chr(10) & chr(13) _
                & "登錄失?。哄e誤的用戶名或密碼，請重新輸入。" _
                ,vbOKonly,"Error"

Exit Sub

ElseIf err <> 0 Then

            WaitSeconds 1
            intAnswer = Msgbox( "" _
                & "Unknown error?。?Please log off and re-login the computer with 'public' account." & chr(10) & chr(13) _
                & "未知的錯誤?。?請注銷后重新使用public賬號登錄電腦。" & chr(10) & chr(13) & chr(10) & chr(13) _
                & "Could you log off now?" & chr(10) & chr(13) _
                & "您需要現在注銷計算機嗎？" & chr(10) & chr(13) & chr(10) & chr(13) _
                & "If you click No, the script will quit!"& chr(10) & chr(13) _
                & "如果您點擊No，此工具將退出。", vbYesNo, "Error")

            If intAnswer = vbNo Then
                Window.close()
                Exit Sub
            Else
                Logoff()
                Window.close()
                Exit Sub
            End If

Else

            ' -----------------------
            ' Check P and G firstly
            ' -----------------------

strMapDriveLetterP = "P:"
strMapDriveLetterG = "G:"

            CheDrive strMapDriveLetterP
            CheDrive strMapDriveLetterG
            WaitSeconds 1

            ' -----------------------
            ' Map P and G
            ' -----------------------

strRemoteShareP = "\\xxxxxx\public"
strRemoteShareG = "\\xxxxxx\groups"

            YN = MapDrive(strMapDriveLetterP, strRemoteShareP, strUser, strPASSWORD)
            If YN = "Error" Then
                Window.close()
                Exit Sub

End If

            YN = MapDrive(strMapDriveLetterG, strRemoteShareG, strUser, strPASSWORD)
            If YN = "Error" Then
                Window.close()
                Exit Sub

End If

            ' -----------------------
            ' Run xxxxxx
            ' -----------------------
            run = "runas /user:" & strUSER & " " & """" & "C:\Program Files\Internet Explorer\iexplore http://xxxxxx" & """"
            CRLF = chr(10) & chr(13)

wshShell.run(run)
WaitSeconds 0.2

wshShell.AppActivate "Runas"
WaitSeconds 0.2

            For k=1 To Len(strPASSWORD)
              'WaitSeconds 0.2
              wshShell.SendKeys Mid(strPASSWORD,k,1)
            Next

WshShell.SendKeys CRLF

            ' -----------------------
            ' Open P and G
            ' -----------------------

WaitSeconds 4
wshShell.run(strMapDriveLetterP)

WaitSeconds 2
wshShell.run(strMapDriveLetterG)

            ' -----------------------
            ' Close
            ' -----------------------
            Set wshShell = Nothing
            Set objNetwork = Nothing
            Window.close()

End If
End If
End Sub

' -----------------------
' Sub Check drive
' -----------------------
Sub CheDrive(strMapDriveLetter)

On Error Resume Next

    Set objNetwork = CreateObject("WScript.Network")
    Set CheckDrive = objNetwork.EnumNetworkDrives()
    AlreadyConnected = 0

For intDrive = 0 To CheckDrive.Count - 1 Step 2

'Wscript.Echo checkdrive.item(intdrive)
If CheckDrive.Item(intDrive) = strMapDriveLetter Then

            AlreadyConnected = 1
        End If
    Next

If AlreadyConnected = 1 then

objNetwork.RemoveNetworkDrive strMapDriveLetter, True, True
'WaitSeconds 1

End if

End Sub

' -----------------------
' Sub Log off
' -----------------------
Sub Logoff()

strComputer = "."

LOG_OFF = 0
FORCED_LOG_OFF = 4

    Set objWMIService = GetObject("winmgmts:" _
          & "{impersonationLevel=impersonate,(Shutdown)}!\\" & strComputer & "\root\cimv2")
    Set colOperatingSystems = objWMIService.ExecQuery _
          ("Select * from Win32_OperatingSystem")
    For Each objOperatingSystem in colOperatingSystems
          ObjOperatingSystem.Win32Shutdown(FORCED_LOG_OFF)
    Next

End Sub

' -----------------------
' Function Map drive
' -----------------------
Function MapDrive(strMapDriveLetter,strRemoteShare,strUser,strPASSWORD)

    On Error Resume Next
    set wshShell= CreateObject("Wscript.Shell")
    Err.clear

    Set objNetwork = CreateObject("WScript.Network")
    strPer = "FALSE"
    objNetwork.MapNetworkDrive strMapDriveLetter, strRemoteShare, strPer, strUser, strPASSWORD

    If err = -2147023677 Then
        Msgbox "" _
            & "Error!! Some files did not be closed normally. " & chr(10) & chr(13) _
            & "錯誤!! 一些文件沒有被正常的關閉！" & chr(10) & chr(13) & chr(10) & chr(13) _
            & "Please close all windows and opened files, or log off and re-login the computer with 'public' account." & chr(10) & chr(13) _
            & "請關閉所有的窗口和打開的文件，或者注銷后用public賬號重新登錄此電腦。" & chr(10) & chr(13) & chr(10) & chr(13) _
            & "Click OK, the script will quit!"& chr(10) & chr(13) _
            & "點擊OK，此工具將退出。", vbOKonly,"Error of reduplicative connections with different user 不同的賬號存在重復的連接錯誤!!"

MapDrive = "Error"

Else

Set oShell = CreateObject("Shell.Application")
oShell.NameSpace(strMapDriveLetter).Self.Name = ""

MapDrive = "OK"

End If

End Function

' -------------------------
' Sub waitSeconds
' -------------------------

Sub WaitSeconds (intNumSecs)

' Because WScript.Sleep () is not available in HTA
' scripts, invoke a VBScript file to do the waiting.

Dim strScriptFile, strCommand, intRetcode, objWS

If intNumSecs <= 0 Then Exit Sub

Set objWS = CreateObject ("WScript.Shell")

strScriptFile = "%temp%\wait" & intNumSecs & "seconds.vbs"

strCommand = "cmd /c ""echo WScript.Sleep " & intNumSecs * 1000 & " >" & strScriptFile & _
"&start /wait """" wscript.exe " & strScriptFile & """"

intRetCode = objWS.Run (strCommand, 0, True)

If intRetCode = 0 Then Exit Sub

LogLine "ERROR " & CStr (intRetCode) & " DURING WAITSECONDS PROCEDURE"
End Sub

</SCRIPT>
<body>
<table style="width: 100%; height: 51px">
    <tr>
        <td rowspan="2" valign="top" style="width: 54px">
        <img alt="" src="Arrowhead.png" width="45" height="45"></td>
        <td class="style1" style="height: 18px"><span class="style6">Welcome </span><span class="style5">
        to use the tool to quickly open <span class="style7">P, G drives and
        Suzhou home page</span>.</span></td>
    </tr>
    <tr>
        <td class="style1"><span class="style6"><strong>歡迎</strong></span><span class="style5">使用此連接工具迅速地打開<span class="style7">P盤，G盤以及蘇州主頁</span></span>。</td>
    </tr>
</table>
<br>
<span class="style1"><span class="style5">Please input your Windows login account and password, ex: ymike,
and then click 'OK'.<br>
請輸入您的Windows登錄賬號和密碼，例如 ymike，然后點擊“OK”。</span></span><P class="style1">

<span class="style5">Username (用戶名): xxxxxx\ </span><span class="style3"><span class="style5"><input type="Text" name="UserNameArea" size="20"></span></span><P class="style4">

Password (密碼):
<input type="Password" name="PasswordArea" size="21" onkeypress="KeyCheck"><P>

</body>
</html>