Announcement

Collapse
No announcement yet.

Handling incorrect credentials in a drive mapping .hta script

Collapse
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • Handling incorrect credentials in a drive mapping .hta script

    Our instructors need access to share drives when they're in computer labs, but the labs log in as a generic lab user. So I've barely modified various scripts from around the web to create an .hta script that prompts a user for their credentials and then maps their network drives.

    It works well, except when the user enters their credentials incorrectly. If that happens, things just get ugly - unresponsive window, hanging, etc.

    Ideally what would happen is that the user would immediately get a prompt stating invalid username / password, and asked to reenter.

    Can anyone offer any ideas on how to modify this to make that happen? (Also, I modifed 2 URL's in the script so I could post it here since I have less than 5 posts - in bold)


    Code:
    <!-- HTA script to allow machines that are not joined to a domain to access   
    	 Windows file shares with domain credentials.  It will automatically prepend the 
         domain to the username and then map several drives.  If a drive is already 
         mapped, it is disconnected and then mapped for the current user.
         
         Version 1.0.2
         Written by Vaughn Miller 7/20/2012 
         
         Currently setup to map the following drives : 
         S:  =  \\server\User Home
         O:  =  \\server\software
         T:  =  \\server\group home                         
         ---------------------------------------------------------------------------------->
    
    <HTML>
    <HEAD>
    <TITLE>Connect Network Drives</title>
    <HTA:APPLICATION
         Icon="logo.ico"
    	 ApplicationName="MapDrives.HTA"
         SingleInstance="Yes"
         WindowsState="Normal"
         Scroll="No"
         Navigable="Yes"
         MaximizeButton="No"
         SysMenu="Yes"
         Caption="Yes"
    ></HEAD>
    
    <SCRIPT LANGUAGE="VBScript">
    dim strUSR
    ' *** Define Drive Mappings ***
    dim arrDrives(2,2)
    intMaxdrives = 2
    
    arrDrives(0,0) = "S:"
    arrDrives(0,1) = "\\server\User Home\$USR"
    arrDrives(0,2) = "User Home Drive"
    
    arrDrives(1,0) = "O:"
    arrDrives(1,1) = "\\server\Software"
    arrDrives(1,2) = "Software Share"
    
    arrDrives(2,0) = "T:"
    arrDrives(2,1) = "\\server\Group Home"
    arrDrives(2,2) = "Department Drive"
    ' *** End Drive Map Definitions ***
    
    strDOMAIN = "ourdomain\"  'Domain to prepend to the username
    
    
    Sub Window_Onload
      '# Size Window
      sHorizontal = 600
      sVertical = 200
      Window.resizeTo sHorizontal, sVertical
      '# Get Monitor Details
      Set objWMIService = GetObject _
        ("winmgmts:root\cimv2")
      intHorizontal = sHorizontal *2
      intVertical = sVertical *2
      Set colItems = objWMIService.ExecQuery( _
        "Select ScreenWidth, ScreenHeight from" _
        & " Win32_DesktopMonitor", , 48)
      For Each objItem In colItems
        sWidth= objItem.ScreenWidth
        sHeight = objItem.ScreenHeight
        If sWidth > sHorizontal _
          then intHorizontal = sWidth
        If sHeight > sVertical _
          then intVertical = sHeight
      Next
      Set objWMIService = Nothing
    
    
      '# Center window on the screen
      intLeft = (intHorizontal - sHorizontal) /2
      intTop = (intVertical - sVertical) /2
      Window.moveTo intLeft, intTop
      '# default window content
      window.location.href="#Top"
      UsrnameArea.Focus()
    End Sub
    
    
    Sub RunScript
       on Error Resume Next
    
       strUsr = Trim(UsrnameArea.Value)
       strPas = Trim(PasswordArea.Value)
    
       minUSRnamelength = 3
       minPASSwrdlength = 3
    
       msg = vbNewline
       br = vbNewline & vbNewline
    
       If Len(strUsr) < minUSRnamelength Then _
           msg = msg & "* You have typed an invalid username." & br
       If Len(strPas) < minPASSwrdlength Then _
           msg = msg & "* You have typed an invalid password." & br
       If Len(msg) > 2 Then MsgBox msg, 64, "Incorrect User Credentials" : Exit Sub
    
       If instr(1,strUsr,strDOMAIN,1) < 1 Then
           strAcc = UCase(strDOMAIN & strUsr) '<--- ************ Prepends the domain to the username ************
       Else
           strAcc = UCase(strUsr)
       End If
    
       Set objNetwork = CreateObject("WScript.Network")
       Set oShell = CreateObject("Shell.Application")
    
       Call ClearDrives ' Delete existing mappings if they exist
    
       ' <-- ************ Begin Drive mapping ************
       For n = 0 To intMaxDrives ' <-- ************ Loop through our array of drives ************
         strPath = arrDrives(n,1)
         strPath = Replace(strPath, "$USR", strUsr, 1, -1, 1)
    
         Err.Clear
         objNetwork.MapNetworkDrive arrDrives(n,0), strPath, False, strUsr, strPas
         If Err.Number = 0 Then
           oShell.NameSpace(arrDrives(n,0)).Self.Name = arrDrives(n,2)
         End If
    
       Next
       ' ************ End Drive Mapping ************
    
       ' <-- ************ Clean up the objects before exiting ************
       Set objShell = CreateObject("WScript.Shell")
       objShell.Run "%SystemRoot%\explorer.exe /e, S:\"
       Set oShell = Nothing
       Set objNetwork = Nothing
       Self.Close()
    End Sub
    
    
    Sub ClearDrives      ' Sub Routine to remove the drives if they are already mapped	
      On Error Resume Next
      Set objNetwork = CreateObject("WScript.Network")
    
      '***** Begin section to delete drive mappings ***
      Set AllDrives = objNetwork.EnumNetworkDrives       
      For n = 0 To intMaxDrives     'Loop through our array of drives 
         For i = 0 To AllDrives.Count - 1 Step 2 
            If AllDrives.Item(i) = arrDrives(n,0) Then AlreadyConnected = True 
         Next        
         If AlreadyConnected = True then 
            objNetwork.RemoveNetworkDrive arrDrives(n,0), True, True
         End If 
      Next                  
      '***** End section to delete drive mappings  
    End Sub
    
    
    Sub DisconnectDrives  ' Calls ClearDrives subroutine and then closes the window
    	Call ClearDrives
        Set oShell = Nothing
        Set objNetwork = Nothing
    	Self.close()
    End Sub
    
    
    Sub CancelScript
       Set oShell = Nothing
       Set objNetwork = Nothing
       Self.Close()
    End Sub
    </SCRIPT>
    
    <!--Begin enter button to next textbox script-->
    <!--TAKE DASHES OUT OF FOLLOWING URL-DID THIS TO POST ON FORUM>
    <script type='text/javascript' src='h-t-t-p://ajax.googleapis.com/ajax/libs/jquery/1.3.2/jquery.min.js?ver=1.3.2'></script>
    <script type="text/javascript">
        $(document).ready(function(){
    		$("input").not( $(":button") ).keypress(function (evt) {
    			if (evt.keyCode == 13) {
    				iname = $(this).val();
    				if (iname !== 'Submit'){	
    					var fields = $(this).parents('form:eq(0),body').find('button,input,textarea,select');
    					var index = fields.index( this );
    					if ( index > -1 && ( index + 1 ) < fields.length ) {
    						fields.eq( index + 1 ).focus();
    					}
    					return false;
    				}
    			}
    		});
        });
    </script>
    <!--End enter button to next textbox script-->
     
    <!--Begin rounded corners CSS-->
    <style type="text/css">
        .b1f, .b2f, .b3f, .b4f{font-size:1px; overflow:hidden;display:block;}
        .b1f {height:1px; background:#014165; margin:0 5px}
        .b2f {height:1px; background:#014165; margin:0 3px}
        .b3f {height:1px; background:#014165; margin:0 2px}
        .b4f {height:2px; background:#014165; margin:0 1px}
        .cf {background: #014165}
        .cf div {margin-left: 5px;}
    #DataOptions {
        background-color: #014165;
        width: 100%;
        padding: 0.1em;
    }
    </style>
    <!--End rounded corners CSS-->
    
    
    <BODY STYLE="font:14 pt arial; color:white">
    <!--Begin rounded corners top-->
    <b class="b1f"></b><b class="b2f"></b><b class="b3f"></b><b class="b4f"></b><div class="cf"><div>
        <div id="DataOptions" style="background-image: url(h-t-t-p://i.imgur.com/a4uD654.png); background-repeat:no-repeat;>
    <!--End rounded corners top-->
    <a name="Top"></a><CENTER>
    <table border="0" cellpadding="0" cellspacing="0"><font size="2" color="black" face="Arial">
        <tr>
          <td height="30">
            <p align="right">Key Account</p>
          </td>
          <td height="30">&nbsp;&nbsp; <input type="text" name="UsrnameArea" size="30" ></td></tr>
        <tr>
          <td height="30">
            <p align="right">Password</p>
          </td>
          <td height="30">&nbsp;&nbsp; <input type="password" name="PasswordArea" size="30" onKeydown="Javascript: if (event.keyCode==13) RunScript();"></td></tr>
      </table><BR>
    <HR color="#0000FF">
     <Input id=runbutton1 class="button" type="button" value=" Map Drives " name="run_button"  onClick="RunScript">
        &nbsp;
     <Input id=runbutton2 class="button" type="button" value=" Disconnect Drives " name="dis_button"  onClick="DisconnectDrives">
        &nbsp;
     <Input id=runbutton3 class="button" type="button" value="Cancel" name="cancel_button"  onClick="CancelScript">
    </CENTER>
    <!--Begin rounded corners bottom-->
        </div>
        </div></div><b class="b4f"></b><b class="b3f"></b><b class="b2f"></b><b class="b1f"></b>
    <!--End rounded corners bottom-->
    </BODY>
    </HTML>

  • #2
    Re: Handling incorrect credentials in a drive mapping .hta script

    Also, I should say that I've looked at the similar examples from the following pages and the error trapping(?) doesn't work in any of them. If an incorrect username or password is entered they seem to just do nothing instead of prompting the user.

    (Post count wouldn't allow URL's, so here's the partial ones, added after the main domain here)

    forums/showthread.php?t=15578
    forums/showthread.php?t=56814
    forums/showthread.php?t=62082
    _
    Last edited by Rems; 28th September 2013, 13:11.

    Comment


    • #3
      Re: Handling incorrect credentials in a drive mapping .hta script

      Add this function (place it between the other subs in the SCRIPT LANGUAGE="VBScript" section),
      Code:
      
      Function fnCheckAccess(accountname,UserPWD)
           const ADS_NAME_TYPE_NT4 = 3
           const ADS_NAME_TYPE_1779 = 1
           Const ADS_SECURE_AUTHENTICATION = &h0001 
           Const ADS_CHASE_REFERRALS_ALWAYS = &H60 
      
           On Error Resume Next
           Set objTrans = CreateObject("NameTranslate")
           objTrans.Set ADS_NAME_TYPE_NT4, accountname
           strUserDN = objTrans.Get(ADS_NAME_TYPE_1779)
      
           err.clear
           Set objDSO = GetObject("LDAP:")
           Set objUser = objDSO.OpenDSObject _
             ("LDAP://" & strUserDN, accountname, UserPWD, _
             ADS_SECURE_AUTHENTICATION OR ADS_CHASE_REFERRALS_ALWAYS)
      
           If Err.Number <> 0 then
             ' location.reload True
             PasswordArea.Value = ""
             UsrnameArea.Value = accountname
             MsgBox "Incorrect Password for " & accountname & "." _
                    & vbCRLF & vbCRLF & "Access Denied"
             fnCheckAccess = False 
           Else
             fnCheckAccess = True
           End If
      End Function
      
      The function above is called from the existing sub: RunScript. That's done with the two red lines in the sample below,
      Code:
      Sub RunScript
         on Error Resume Next
      
         strUsr = Trim(UsrnameArea.Value)
         strPas = Trim(PasswordArea.Value)
      
         minUSRnamelength = 3
         minPASSwrdlength = 3
      
         msg = vbNewline
         br = vbNewline & vbNewline
      
         If Len(strUsr) < minUSRnamelength Then _
             msg = msg & "* You have typed an invalid username." & br
         If Len(strPas) < minPASSwrdlength Then _
             msg = msg & "* You have typed an invalid password." & br
         If Len(msg) > 2 Then MsgBox msg, 64, "Invalid Credentials" : Exit Sub
      
         If instr(1,strUsr,strDOMAIN,1) < 1 Then
             strAcc = strDOMAIN & strUsr '<--- ************ Prepends the domain to the username ************
         Else
             strAcc = strUsr
         End If
      
         If (fnCheckAccess(strAcc, strPas) = True) then
           Set objNetwork = CreateObject("WScript.Network")
           Set oShell = CreateObject("Shell.Application")
      
           Call ClearDrives ' Delete existing mappings if they exist
      
           ' <-- ************ Begin Drive mapping ************
           For n = 0 To intMaxDrives ' <-- ************ Loop through our array of drives ************
             strPath = arrDrives(n,1)
             strPath = Replace(strPath, "$USR", strUsr, 1, -1, 1)
      
             Err.Clear
             objNetwork.MapNetworkDrive arrDrives(n,0), strPath, False, strUsr, strPas
             If Err.Number = 0 Then
               oShell.NameSpace(arrDrives(n,0)).Self.Name = arrDrives(n,2)
             End If
      
           Next
           ' ************ End Drive Mapping ************
      
           ' <-- ************ Clean up the objects before exiting ************
           Set objShell = CreateObject("WScript.Shell")
           objShell.Run "%SystemRoot%\explorer.exe /e, S:\"
           Set oShell = Nothing
           Set objNetwork = Nothing
           Self.Close()
         End IF
      End Sub
      /Rems
      Last edited by Rems; 30th September 2013, 08:35.

      This posting is provided "AS IS" with no warranties, and confers no rights.

      __________________

      ** Remember to give credit where credit's due **
      and leave Reputation Points for meaningful posts

      Comment


      • #4
        Re: Handling incorrect credentials in a drive mapping .hta script

        THANKS REMS!! You are the man. Seriously, where's the PayPal Donate button? If nothing else I clicked through all the ads on the page

        This appears to be working terrifically. I did slightly modify the checkaccess function. It seems if the password was entered incorrectly it would refill the username box with Domain\username once I clicked Ok in the Access Denied window. If the password was then re-entered, it hung for a while, and then connected only the last two drives.

        But that's okay because I wanted to account for an incorrect username as well, so I just modified it to leave both the username and password boxes empty (changed username to ""). And then I modified the error message.

        That function was exactly what I needed, and what's missing in all the other .hta apps! Thank you! And thanks too for being clear about how to include it!



        My next step is to modify the array to account for only 2 drives, not 3, since our users only have 2 (modified section below). It seems to work fine but "intMaxdrives" is tripping me up. I don't know if I need to change that or not, and there are only 2 hits in all of Google for "intMaxdrives" so I can't figure out what it's referencing. I changed it from 2 to 1 and then to 5 and it didn't seem to make a difference. Can you tell me what that is?


        Code:
        <SCRIPT LANGUAGE="VBScript">
        dim strUSR
        ' *** Define Drive Mappings ***
        dim arrDrives(1,2)
        intMaxdrives = 1
        
        arrDrives(0,0) = "S:"
        arrDrives(0,1) = "\\server\User Home\$USR"
        arrDrives(0,2) = "User Home Drive"
        
        arrDrives(1,0) = "T:"
        arrDrives(1,1) = "\\server\Group Home"
        arrDrives(1,2) = "Department Drive"
        ' *** End Drive Map Definitions ***
        
        strDOMAIN = "domain\"  'Domain to prepend to the username
        Last edited by Vapor; 1st October 2013, 20:06.

        Comment


        • #5
          Re: Handling incorrect credentials in a drive mapping .hta script

          Originally posted by Vapor View Post
          I did slightly modify the checkaccess function. It seems if the password was entered incorrectly it would refill the username box with Domain\username once I clicked Ok in the Access Denied window. If the password was then re-entered, it hung for a while, and then connected only the last two drives.

          But that's okay because I wanted to account for an incorrect username as well, so I just modified it to leave both the username and password boxes empty (changed username to "").
          Yes you have various options in this function when the credentials validation failed,

          location.reload True
          Un-comment this line and all boxes on the page will be cleared. You don't further need the other two lines.

          UsrnameArea.Value = accountname
          If you'd comment-out this line the entered name stays.
          Else, if you set the value to Empty it will clear just this field. Or you can set it to domain\<entered_name>, like it did in the example. Or you can set it to strUsr (the entered name will rewritten).
          In all cases it should not cause a delay after a retry.

          PasswordArea.Value = ""
          This clears just the password field.

          Or you can add the folowing just after the line: strUserDN = objTrans.Get(ADS_NAME_TYPE_1779)
          If Err.number <> 0 Then
          msgbox "user '" & accountname & "' not found"
          location.reload True
          Else
          rem UsrnameArea.Value = accountname ' (optional)
          End If




          Originally posted by Vapor View Post
          My next step is to modify the array to account for only 2 drives, not 3, since our users only have 2 (modified section below). It seems to work fine but "intMaxdrives" is tripping me up. I don't know if I need to change that or not, and there are only 2 hits in all of Google for "intMaxdrives" so I can't figure out what it's referencing. I changed it from 2 to 1 and then to 5 and it didn't seem to make a difference. Can you tell me what that is?


          Code:
          <SCRIPT LANGUAGE="VBScript">
          dim strUSR
          ' *** Define Drive Mappings ***
          dim arrDrives(1,2)
          intMaxdrives = 1
          
          arrDrives(0,0) = "S:"
          arrDrives(0,1) = "\\server\User Home\$USR"
          arrDrives(0,2) = "User Home Drive"
          
          arrDrives(1,0) = "T:"
          arrDrives(1,1) = "\\server\Group Home"
          arrDrives(1,2) = "Department Drive"
          ' *** End Drive Map Definitions ***
          
          strDOMAIN = "domain\"  'Domain to prepend to the username
          The array arrDrives() in this script is a multidimensional Array.
          To be exact it's a 2-D array - what is like: arrDrives(array(), array(), array(), array...ect.)

          internal counting of all what is in the array starts always at 0.
          So the first array within a multidimensional Array is the 0th array, the second array will have the internal number 1 and so on.
          And, the first item in each array is the 0th item, the second item will have the internal number 1 and so on.

          arrDrives(1,2) means,
          According the first of the two digits this array contains two arrays (remember internal counting starts at 0).
          And according the second digit each array contains 3 items.

          The value of intMaxdrives should be the total of arrays within the array (counting begins with 0). This would be in your case: 1 (equal to the first digit that was set for this array)

          The value of the variable intMaxdrives is used as the number of iterations here:
          ' <-- ************ Begin Drive mapping ************
          For n = 0 To intMaxDrives
          <cut...>
          Next
          ' ************ End Drive Mapping ************

          If the value would be set too low then not all the drives will be mapped. If set too hight the for-next loop will error out.
          You can also define intMaxdrives like this: intMaxdrives = Ubound(arrDrives). This way the value (1) is automatically retrieved from what is defined for arrDrives(1,2)

          But this will work too,
          Code:
          <SCRIPT LANGUAGE="VBScript">
          dim strUSR
          ' *** Define Drive Mappings ***
          
          dim arrDrives(9,2)  'The 1st digit and the value of intMaxdrives (below)
                              ' should normally be equal, but in this example this
                              ' first number is set much higher that the real amount of
                              ' drives to map.
                              'The 2nd digit is 2 (because 3 variables are used to
                              ' make the drive mapping).
          
          
          iCntDrvs= 0
          arrDrives(iCntDrvs,0) = "S:"
          arrDrives(iCntDrvs,1) = "\\server\User Home\$USR"
          arrDrives(iCntDrvs,2) = "User Home Drive"
          
          iCntDrvs= 1
          arrDrives(iCntDrvs,0) = "T:"
          arrDrives(iCntDrvs,1) = "\\server\Group Home"
          arrDrives(iCntDrvs,2) = "Department Drive"
          
          intMaxdrives = iCntDrvs
          
          ' *** End Drive Map Definitions ***
          
          strDOMAIN = "domain\"  'Domain to prepend to the username


          /Rems
          Last edited by Rems; 3rd October 2013, 01:51.

          This posting is provided "AS IS" with no warranties, and confers no rights.

          __________________

          ** Remember to give credit where credit's due **
          and leave Reputation Points for meaningful posts

          Comment


          • #6
            Re: Handling incorrect credentials in a drive mapping .hta script

            Thanks Rems for explaining all the fnCheckAccess function details. That's very helpful and should be able to be utilized in a large number of scripts requiring authentication. I dit uncomment the location.reload True to simplify things.


            Now that the functionality is working well (thank you) I'd like to refine things a bit. There's quite a harsh flicker when the window is rendered, and it's not centered on the screen.

            The flicker seems to be a common issue but I'm finding conflicting (mis)information on how to resolve it. These posts touch on the subject, I've not been able to successfully apply them to this hta script (delete all the dashes):

            www------mombu-----com/microsoft/scripting-vb-script/t-size-hta-window-on-load-1577661.html
            social------msdn----microsoft---------com/Forums/ie/en-US/f8aa8000-4f90-46e1-8bf6-0b7bfcbbd2eb/htaapplication-resizing-without-flickering
            social------technet------microsoft-------com/Forums/scriptcenter/en-US/ac3b41b8-b563-4c8e-b50a-39952c442254/how-to-detect-screen-dpi-and-modify-hta-form-size-accordingly
            https------://------groups------google---------com/forum/#!topic/microsoft.public.scripting.vbscript/6hXNJ1vXXbA


            It seems like the solution is to set a fixed window size, but then I'm wondering why so many people use the resize function then?

            There seems to be lots of options for controlling window size and location. I just want what's going to be the most stable on as many systems as possible. Is there sample code that you prefer for handling this?


            Code:
            Sub Window_Onload
              '# Size Window
              sHorizontal = 600
              sVertical = 200
              Window.resizeTo sHorizontal, sVertical
              '# Get Monitor Details
              Set objWMIService = GetObject _
                ("winmgmts:root\cimv2")
              intHorizontal = sHorizontal *2
              intVertical = sVertical *2
              Set colItems = objWMIService.ExecQuery( _
                "Select ScreenWidth, ScreenHeight from" _
                & " Win32_DesktopMonitor", , 48)
              For Each objItem In colItems
                sWidth= objItem.ScreenWidth
                sHeight = objItem.ScreenHeight
                If sWidth > sHorizontal _
                  then intHorizontal = sWidth
                If sHeight > sVertical _
                  then intVertical = sHeight
              Next
              Set objWMIService = Nothing
            
            
              '# Center window on the screen
              intLeft = (intHorizontal - sHorizontal) /2
              intTop = (intVertical - sVertical) /2
              Window.moveTo intLeft, intTop
              '# default window content
              window.location.href="#Top"
              UsrnameArea.Focus()
            End Sub
            Last edited by Vapor; 7th October 2013, 21:54.

            Comment


            • #7
              Re: Handling incorrect credentials in a drive mapping .hta script

              Originally posted by Vapor View Post
              There's quite a harsh flicker when the window is rendered, and it's not centered on the screen.

              The flicker seems to be a common issue but I'm finding conflicting (mis)information on how to resolve it. These posts touch on the subject, I've not been able to successfully apply them to this hta script ():

              http://www.mombu.com/microsoft/scrip...d-1577661.html
              http://social.msdn.microsoft.com/For...out-flickering
              http://social.technet.microsoft.com/...ze-accordingly
              https://groups.google.com/forum/#!to...pt/6hXNJ1vXXbA

              It seems like the solution is to set a fixed window size, but then I'm wondering why so many people use the resize function then?
              Users have always been testing and searching for ways to limit the flickering on load and shared it on the internet.
              The best way to prevent window flickering on load it to place the resizeTo statement already in the Head of the page. And a moveTo statement = for moving the windows off screen.
              This is applied before the page is visible and subsequently the Window_Onload event is carried out.

              Code:
              <!-- HTA script to allow machines that are not joined to a domain to access   
              	 Windows file shares with domain credentials.  It will automatically prepend the 
                   domain to the username and then map several drives.  If a drive is already 
                   mapped, it is disconnected and then mapped for the current user.
                   
                   Version 1.0.2
                   Written by Vaughn Miller 7/20/2012 
                   
                   Currently setup to map the following drives : 
                   S:  =  \\server\User Home
                   O:  =  \\server\software
                   T:  =  \\server\group home                         
                   ---------------------------------------------------------------------------------->
              
              <HTML>
              <HEAD>
              <TITLE>Connect Network Drives</title>
              
              <SCRIPT LANGUAGE="VBScript">
               '# While not yet loaded, Size Window and point it off screen.
                   Dim sHorizontal, sVertical
                   sHorizontal = 600 : sVertical = 200
                   Me.resizeTo sHorizontal, sVertical
                   Me.MoveTo ((Screen.Width)),((Screen.Height))
              </script>
              
              <HTA:APPLICATION
                   Icon="logo.ico"
                   ApplicationName="MapDrives.HTA"
                   SingleInstance="Yes"
                   WindowsState="Normal"
                   Scroll="No"
                   Navigable="Yes"
                   MaximizeButton="No"
                   SysMenu="Yes"
                   Caption="Yes"
              ></HEAD>
              
              <SCRIPT LANGUAGE="VBScript">
              
              Sub Window_Onload
                '# default window content
                 window.location.href="#Top"
                 UsrnameArea.Focus()
              
                '# Get Monitor Details
                 With createobject("internetexplorer.application")
                   .navigate2"about:blank"
                   With .document.parentWindow.screen
                     intLeft = (.width - sHorizontal) /2
                     intTop = (.height - sVertical) /2
                   End with
                   .quit '!!!
                 End with
                '# Center window (it will be back on screen again).
                 Window.moveTo intLeft, intTop
              End Sub
              
              dim strUSR
              ' *** Define Drive Mappings ***
              dim arrDrives(2,2)
              intMaxdrives = 2
              
              arrDrives(0,0) = "S:"
              arrDrives(0,1) = "\\server\User Home\$USR"
              arrDrives(0,2) = "User Home Drive"
              
              arrDrives(1,0) = "O:"
              arrDrives(1,1) = "\\server\Software"
              arrDrives(1,2) = "Software Share"
              
              arrDrives(2,0) = "T:"
              arrDrives(2,1) = "\\server\Group Home"
              arrDrives(2,2) = "Department Drive"
              ' *** End Drive Map Definitions ***
              
              strDOMAIN = "ourdomain\"  'Domain to prepend to the username
              
              [...]
              Additionally, for this sample I have used an other way to get the screen resolution. Maybe it works better with your monitor.
              Do you have multiple monitors? or using remote desktop?


              /Rems


              -EDIT-
              It seems like the solution is to set a fixed window size, but then I'm wondering why so many people use the resize function then?
              you can resize it afterwards any time you like, i.e. on a certain event.
              Or just like in this sample,
              Code:
              <HTML>
              <HEAD>
              <TITLE>Connect Network Drives</title>
              
              <SCRIPT LANGUAGE="VBScript">
               '# While not yet loaded Size Window and move it off screen.
                Dim sHorizontal, sVertical
                sHorizontal = 600 : sVertical = 200
                Me.resizeTo 0,0
                Me.MoveTo ((Screen.Width)),((Screen.Height))
              </script>
              
              <HTA:APPLICATION
              /* http://www.phpchina.com/resource/manual/dhtml/objects/hta.html
                   Icon="logo.ico"
                   ApplicationName="MapDrives.HTA"
                   SingleInstance="Yes"
                   WindowsState="Normal"
                   Scroll="No"
                   Navigable="Yes"
                   MaximizeButton="No"
                   SysMenu="Yes"
                   Caption="Yes"
              
                   SCROLLFLAT="No"
                   BORDER="thin"
                   BORDERSTYLE="complex"
                   MINIMIZEBUTTON="No"
                   SHOWINTASKBAR="no"
              ></HEAD>
              
              <SCRIPT LANGUAGE="VBScript">
              
              Sub Window_Onload
                '# Get Monitor Details
                 With createobject("internetexplorer.application")
                   .navigate2"about:blank"
                   With .document.parentWindow.screen
                     nW = .width
                     nH = .height
                   End with
                   .quit '!!!
                 End with
              
                 l = sHorizontal
                 b = sHorizontal/sVertical
                 if sVertical >= l then
                    l = sVertical : sl = "V"
                    b = sVertical/sHorizontal
                 End If
              
                '# Show window
                 For i = 200 to l step 6
                   h = i : v = int(h/b)
                   If sl= "V" Then 
                      v = i : h = int(i/b)
                   End If
                   if v >= sVertical then v = sVertical
                   if h >= sHorizontal then h = sHorizontal
              
                   intLeft = (nW - h) /2
                   intTop = (nH - v) /2
                   Window.moveTo intLeft, intTop
                   Window.resizeTo h,v
                 Next
              
                 intLeft = (nW - sHorizontal) /2
                 intTop = (nH - sVertical) /2
                 Window.moveTo intLeft, intTop
                 Window.resizeTo sHorizontal,sVertical
              
                '# default window content
                 window.location.href="#Top"
                 UsrnameArea.Focus()
              End Sub
              
              [...]
              Last edited by Rems; 9th October 2013, 09:26.

              This posting is provided "AS IS" with no warranties, and confers no rights.

              __________________

              ** Remember to give credit where credit's due **
              and leave Reputation Points for meaningful posts

              Comment


              • #8
                Re: Handling incorrect credentials in a drive mapping .hta script

                Originally posted by Rems View Post
                Users have always been testing and searching for ways to limit the flickering on load and shared it on the internet.
                The best way to prevent window flickering on load it to place the resizeTo statement already in the Head of the page. And a moveTo statement = for moving the windows off screen.
                This is applied before the page is visible and subsequently the Window_Onload event is carried out.
                Originally posted by Rems View Post
                Additionally, for this sample I have used an other way to get the screen resolution. Maybe it works better with your monitor.
                Do you have multiple monitors? or using remote desktop?
                Thanks for the input Rems. We do have dual monitor and projector setups so moving the window doesn't always work well. After quite a bit of testing I took the head section mentioned in one of the links I sent previously and plugged it in.

                I also removed the Window_Onload section out completely since a fixed size window should be fine for this. After making these changes there is a very small flicker sometimes, but it's very minor at this point and usually non-existent. I think this will work well. I'll post the updated version in my next post when I'm allowed URL links.


                Unfortunately though I've found a bug. It seems if a drive is already mapped the script will overwrite the mapping, but it doesn't change the share name properly. For example, if S: is mapped as "Software Share" and then the script is run, S: will be re-mapped to the User Home but the title in Windows Explorer still shows "Software Share". It's weird.

                Any ideas on why that may be?

                Comment


                • #9
                  Re: Handling incorrect credentials in a drive mapping .hta script

                  Originally posted by Vapor View Post
                  Unfortunately though I've found a bug. It seems if a drive is already mapped the script will overwrite the mapping, but it doesn't change the share name properly. For example, if S: is mapped as "Software Share" and then the script is run, S: will be re-mapped to the User Home but the title in Windows Explorer still shows "Software Share". It's weird.

                  Any ideas on why that may be?
                  In most conditions a short break is needed between disconnecting and reconnecting a given drive letter.
                  Try this;

                  under the line: dim strUSR
                  add a line: DIM objNetwork, objWSH

                  next, in the RunScript routine...
                  under the line,
                  Set objNetwork = CreateObject("WScript.Network"
                  add a line,
                  Set objWSH = CreateObject("WScript.Shell")

                  further down, remove the line,
                  Set objShell = CreateObject("WScript.Shell")
                  And modify the next line to,
                  objWSH.Run "%SystemRoot%\explorer.exe /e, S:\"

                  next, in the ClearDrives routine...
                  Remove the line,
                  Set objNetwork = CreateObject("WScript.Network")

                  And (the next part provides the delay), just above End Sub add,
                  If AlreadyConnected = True then
                  objWSH.Run "ping.exe -n 3 %computername%",0 , True
                  End If



                  /Rems
                  Last edited by Rems; 19th October 2013, 15:23.

                  This posting is provided "AS IS" with no warranties, and confers no rights.

                  __________________

                  ** Remember to give credit where credit's due **
                  and leave Reputation Points for meaningful posts

                  Comment


                  • #10
                    Re: Handling incorrect credentials in a drive mapping .hta script

                    Thanks Rems. I made those changes and that delay seems to solve the drive name issue. Unfortunately though the Disconnect Drives button no longer works. Any ideas to correct this?


                    Here's the complete code so far:

                    Code:
                    <!-- HTA script to access Windows file shares with domain credentials.  It will automatically prepend the 
                         domain to the username and then map several drives.  If a drive is already 
                         mapped, it is disconnected and then mapped for the current user.
                         
                         Modified Version of 1.0.2
                         Original Script by Vaughn Miller 7/20/2012
                         Developed by Rems www.petri.com
                         
                         Currently setup to map the following drives : 
                         S:  =  \\server\User Home
                         T:  =  \\server\group home                         
                         ---------------------------------------------------------------------------------->
                    
                    <HTML>
                    <HEAD>
                    <TITLE>Connect Network Drives</title>
                    
                    <script language="vbscript" type="text/vbscript" id="windowResize">
                    Const	WINDOW_WIDTH = 600, WINDOW_HEIGHT = 200
                    window.offscreenBuffering = True
                    window.resizeTo WINDOW_WIDTH, WINDOW_HEIGHT
                    window.moveTo (window.screen.width - WINDOW_WIDTH) / 2, (window.screen.height - WINDOW_HEIGHT) / 2
                    </script>
                    
                    <HTA:APPLICATION
                         Icon="logo.ico"
                    	 ApplicationName="MapDrives.HTA"
                         SingleInstance="Yes"
                         WindowsState="Normal"
                         Scroll="No"
                         Navigable="Yes"
                         MaximizeButton="No"
                         SysMenu="Yes"
                         Caption="Yes"
                    ></HEAD>
                    
                    <SCRIPT LANGUAGE="VBScript">
                    
                    dim strUSR
                    DIM objNetwork, objWSH
                    ' *** Define Drive Mappings ***
                    dim arrDrives(1,2)
                    intMaxdrives = 1	'The value of intMaxdrives should be equal to the
                    			'total of arrays within the array (counting begins with 0)
                    
                    arrDrives(0,0) = "S:"
                    arrDrives(0,1) = "\\server\User Home\$USR"
                    arrDrives(0,2) = "User Home Directory"
                    
                    arrDrives(1,0) = "T:"
                    arrDrives(1,1) = "\\server\Group Home"
                    arrDrives(1,2) = "Department Group Drive"
                    ' *** End Drive Map Definitions ***
                    
                    strDOMAIN = "domain\"  'Domain to prepend to the username
                    
                    
                    Sub RunScript
                       on Error Resume Next
                    
                       strUsr = Trim(UsrnameArea.Value)
                       strPas = Trim(PasswordArea.Value)
                    
                       minUSRnamelength = 3
                       minPASSwrdlength = 3
                    
                       msg = vbNewline
                       br = vbNewline & vbNewline
                    
                       If Len(strUsr) < minUSRnamelength Then _
                           msg = msg & "* You have typed an invalid username." & br
                       If Len(strPas) < minPASSwrdlength Then _
                           msg = msg & "* You have typed an invalid password." & br
                       If Len(msg) > 2 Then MsgBox msg, 64, "Incorrect User Credentials" : Exit Sub
                    
                       If instr(1,strUsr,strDOMAIN,1) < 1 Then
                           strAcc = UCase(strDOMAIN & strUsr) '<--- ************ Prepends the domain to the username ************
                       Else
                           strAcc = UCase(strUsr)
                       End If
                    
                    If (fnCheckAccess(strAcc, strPas) = True) then
                       Set objNetwork = CreateObject("WScript.Network")
                       Set objWSH = CreateObject("WScript.Shell")
                       Set oShell = CreateObject("Shell.Application")
                    
                       Call ClearDrives ' Delete existing mappings if they exist
                    
                       ' <-- ************ Begin Drive mapping ************
                       For n = 0 To intMaxDrives ' <-- ************ Loop through our array of drives ************
                         strPath = arrDrives(n,1)
                         strPath = Replace(strPath, "$USR", strUsr, 1, -1, 1)
                    
                         Err.Clear
                         objNetwork.MapNetworkDrive arrDrives(n,0), strPath, False, strUsr, strPas
                         If Err.Number = 0 Then
                           oShell.NameSpace(arrDrives(n,0)).Self.Name = arrDrives(n,2)
                         End If
                    
                       Next
                       ' ************ End Drive Mapping ************
                    
                       ' <-- ************ Clean up the objects before exiting ************
                       objWSH.Run "%SystemRoot%\explorer.exe /e, S:\"
                       Set oShell = Nothing
                       Set objNetwork = Nothing
                       Self.Close()
                    End IF
                    End Sub
                    
                    Function fnCheckAccess(accountname,UserPWD)
                         const ADS_NAME_TYPE_NT4 = 3
                         const ADS_NAME_TYPE_1779 = 1
                         Const ADS_SECURE_AUTHENTICATION = &h0001 
                         Const ADS_CHASE_REFERRALS_ALWAYS = &H60 
                    
                         On Error Resume Next
                         Set objTrans = CreateObject("NameTranslate")
                         objTrans.Set ADS_NAME_TYPE_NT4, accountname
                         strUserDN = objTrans.Get(ADS_NAME_TYPE_1779)
                    
                         err.clear
                         Set objDSO = GetObject("LDAP:")
                         Set objUser = objDSO.OpenDSObject _
                           ("LDAP://" & strUserDN, accountname, UserPWD, _
                           ADS_SECURE_AUTHENTICATION OR ADS_CHASE_REFERRALS_ALWAYS)
                    
                         If Err.Number <> 0 then
                           location.reload True
                           MsgBox "Incorrect Username or Password" & "." _
                                  & vbCRLF & vbCRLF & "Access Denied"
                           fnCheckAccess = False 
                         Else
                           fnCheckAccess = True
                         End If
                    End Function
                    
                    
                    Sub ClearDrives      ' Sub Routine to remove the drives if they are already mapped	
                       On Error Resume Next
                      
                       '***** Begin section to delete drive mappings ***
                       Set AllDrives = objNetwork.EnumNetworkDrives       
                       For n = 0 To intMaxDrives     'Loop through our array of drives 
                         For i = 0 To AllDrives.Count - 1 Step 2 
                            If AllDrives.Item(i) = arrDrives(n,0) Then AlreadyConnected = True 
                         Next        
                         If AlreadyConnected = True then 
                            objNetwork.RemoveNetworkDrive arrDrives(n,0), True, True
                         End If 
                       Next                  
                       '***** End section to delete drive mappings  
                       If AlreadyConnected = True then
                       objWSH.Run "ping.exe -n 3 %computername%",0 , True
                     End If
                    End Sub
                    
                    
                    Sub DisconnectDrives  ' Calls ClearDrives subroutine and then closes the window
                    	Call ClearDrives
                        Set oShell = Nothing
                        Set objNetwork = Nothing
                    	Self.close()
                    End Sub
                    
                    
                    Sub CancelScript
                       Set oShell = Nothing
                       Set objNetwork = Nothing
                       Self.Close()
                    End Sub
                    </SCRIPT>
                    
                    <!--Begin enter button to next textbox script-->
                    <script type='text/javascript' src='http://ajax.googleapis.com/ajax/libs/jquery/1.3.2/jquery.min.js?ver=1.3.2'></script>
                    <script type="text/javascript">
                        $(document).ready(function(){
                    		$("input").not( $(":button") ).keypress(function (evt) {
                    			if (evt.keyCode == 13) {
                    				iname = $(this).val();
                    				if (iname !== 'Submit'){	
                    					var fields = $(this).parents('form:eq(0),body').find('button,input,textarea,select');
                    					var index = fields.index( this );
                    					if ( index > -1 && ( index + 1 ) < fields.length ) {
                    						fields.eq( index + 1 ).focus();
                    					}
                    					return false;
                    				}
                    			}
                    		});
                        });
                    </script>
                    <!--End enter button to next textbox script-->
                     
                    <!--Begin rounded corners CSS-->
                    <style type="text/css">
                        .b1f, .b2f, .b3f, .b4f{font-size:1px; overflow:hidden;display:block;}
                        .b1f {height:1px; background:#014165; margin:0 5px}
                        .b2f {height:1px; background:#014165; margin:0 3px}
                        .b3f {height:1px; background:#014165; margin:0 2px}
                        .b4f {height:2px; background:#014165; margin:0 1px}
                        .cf {background: #014165}
                        .cf div {margin-left: 5px;}
                    #DataOptions {
                        background-color: #014165;
                        width: 100%;
                        padding: 0.1em;
                    }
                    </style>
                    <!--End rounded corners CSS-->
                    
                    
                    <BODY STYLE="font:14 pt arial; color:white">
                    <!--Begin rounded corners top-->
                    <b class="b1f"></b><b class="b2f"></b><b class="b3f"></b><b class="b4f"></b><div class="cf"><div>
                        <div id="DataOptions" style="background-image: url(http://i.imgur.com/a4uD654.png); background-repeat:no-repeat;>
                    <!--End rounded corners top-->
                    <a name="Top"></a><CENTER>
                    <table border="0" cellpadding="0" cellspacing="0"><font size="2" color="black" face="Arial">
                        <tr>
                          <td height="30">
                            <p align="right">Key Account</p>
                          </td>
                          <td height="30">&nbsp;&nbsp; <input type="text" name="UsrnameArea" size="30" ></td></tr>
                        <tr>
                          <td height="30">
                            <p align="right">Password</p>
                          </td>
                          <td height="30">&nbsp;&nbsp; <input type="password" name="PasswordArea" size="30" onKeydown="Javascript: if (event.keyCode==13) RunScript();"></td></tr>
                      </table><BR>
                    <HR color="#0000FF">
                     <Input id=runbutton1 class="button" type="button" value=" Map Drives " name="run_button"  onClick="RunScript">
                        &nbsp;
                     <Input id=runbutton2 class="button" type="button" value=" Disconnect Drives " name="dis_button"  onClick="DisconnectDrives">
                        &nbsp;
                     <Input id=runbutton3 class="button" type="button" value="Cancel" name="cancel_button"  onClick="CancelScript">
                    </CENTER>
                    <!--Begin rounded corners bottom-->
                        </div>
                        </div></div><b class="b4f"></b><b class="b3f"></b><b class="b2f"></b><b class="b1f"></b>
                    <!--End rounded corners bottom-->
                    </BODY>
                    </HTML>
                    Last edited by Vapor; 23rd October 2013, 17:42.

                    Comment


                    • #11
                      Re: Handling incorrect credentials in a drive mapping .hta script

                      change the DisconnectDrives sub routine to:

                      Code:
                      Sub DisconnectDrives  ' Calls ClearDrives subroutine and then closes the window
                          Set objNetwork = CreateObject("WScript.Network")
                          Set objWSH = CreateObject("WScript.Shell")
                          Call ClearDrives
                          Self.close()
                      End Sub
                      btw.
                      you can safely remove all lines with
                      Set oShell = Nothing
                      or,
                      Set objNetwork = Nothing
                      from the script.

                      /Rems
                      Last edited by Rems; 23rd October 2013, 18:21.

                      This posting is provided "AS IS" with no warranties, and confers no rights.

                      __________________

                      ** Remember to give credit where credit's due **
                      and leave Reputation Points for meaningful posts

                      Comment


                      • #12
                        Re: Handling incorrect credentials in a drive mapping .hta script

                        Originally posted by Rems View Post
                        change the DisconnectDrives sub routine to:

                        Code:
                        Sub DisconnectDrives  ' Calls ClearDrives subroutine and then closes the window
                            Set objNetwork = CreateObject("WScript.Network")
                            Set objWSH = CreateObject("WScript.Shell")
                            Call ClearDrives
                            Self.close()
                        End Sub
                        btw.
                        you can safely remove all lines with
                        Set oShell = Nothing
                        or,
                        Set objNetwork = Nothing
                        from the script.

                        /Rems
                        Thanks for sharing the script.. I have been searching for a while...Will try to use it now

                        Comment


                        • #13
                          Re: Handling incorrect credentials in a drive mapping .hta script

                          I've bookmarked this page - I have a feeling it'll come in handy in the next month!

                          many thanks Rems, and OP, and others who contributed
                          Please do show your appreciation to those who assist you by leaving Rep Point https://www.petri.com/forums/core/im.../icon_beer.gif

                          Comment


                          • #14
                            Re: Handling incorrect credentials in a drive mapping .hta script

                            Rems just want to thank you again for the help. I've been testing the final version and it works great.

                            The only thing I've found that trips it up is the DPI issue where if a user is blind and using 150% DPI the buttons are not viewable (without resizing the window). That's touched on in this forum post but it's rare enough (and those people are used to resizing windows all the time anyway) that I'm not going to be concerned with it. The window resizing function I started with could address this, but it's not worth the nasty resizing flash so I'm content keeping things as-is.


                            For others' reference my final version is below with the edits and tweaks discussed. The HTML can modified pretty easily to change the colors, logo, style etc if desired.



                            Code:
                            <!-- HTA script to access Windows file shares with domain credentials.  It will automatically prepend the 
                                 domain to the username and then map several drives.  If a drive is already 
                                 mapped, it is disconnected and then mapped for the current user.
                                 
                                 Modified Version of 1.0.2
                                 Original Script by Vaughn Miller 7/20/2012
                                 Developed by Rems - www.petri.com
                                 
                                 Currently setup to map the following drives : 
                                 S:  =  \\server\User Home
                                 T:  =  \\server\group home                         
                                 ---------------------------------------------------------------------------------->
                            
                            <HTML>
                            <HEAD>
                            <TITLE>Connect Network Drives</title>
                            
                            <script language="vbscript" type="text/vbscript" id="windowResize">
                            Const	WINDOW_WIDTH = 600, WINDOW_HEIGHT = 200
                            window.offscreenBuffering = True
                            window.resizeTo WINDOW_WIDTH, WINDOW_HEIGHT
                            window.moveTo (window.screen.width - WINDOW_WIDTH) / 2, (window.screen.height - WINDOW_HEIGHT) / 2
                            </script>
                            
                            <HTA:APPLICATION
                                 Icon="logo.ico"
                            	 ApplicationName="MapDrives.HTA"
                                 SingleInstance="Yes"
                                 WindowsState="Normal"
                                 Scroll="No"
                                 Navigable="Yes"
                                 MaximizeButton="No"
                                 SysMenu="Yes"
                                 Caption="Yes"
                            ></HEAD>
                            
                            <SCRIPT LANGUAGE="VBScript">
                            
                            dim strUSR
                            DIM objNetwork, objWSH
                            ' *** Define Drive Mappings ***
                            dim arrDrives(1,2)
                            intMaxdrives = 1	'The value of intMaxdrives should be equal to the
                            			'total of arrays within the array (counting begins with 0)
                            
                            arrDrives(0,0) = "S:"
                            arrDrives(0,1) = "\\server\User Home\$USR"
                            arrDrives(0,2) = "User Home Directory"
                            
                            arrDrives(1,0) = "T:"
                            arrDrives(1,1) = "\\server\Group Home"
                            arrDrives(1,2) = "Department Group Drive"
                            ' *** End Drive Map Definitions ***
                            
                            strDOMAIN = "domain\"  'Domain to prepend to the username
                            
                            
                            Sub RunScript
                               on Error Resume Next
                            
                               strUsr = Trim(UsrnameArea.Value)
                               strPas = Trim(PasswordArea.Value)
                            
                               minUSRnamelength = 3
                               minPASSwrdlength = 3
                            
                               msg = vbNewline
                               br = vbNewline & vbNewline
                            
                               If Len(strUsr) < minUSRnamelength Then _
                                   msg = msg & "* You have typed an invalid username." & br
                               If Len(strPas) < minPASSwrdlength Then _
                                   msg = msg & "* You have typed an invalid password." & br
                               If Len(msg) > 2 Then MsgBox msg, 64, "Incorrect User Credentials" : Exit Sub
                            
                               If instr(1,strUsr,strDOMAIN,1) < 1 Then
                                   strAcc = UCase(strDOMAIN & strUsr) '<--- ************ Prepends the domain to the username ************
                               Else
                                   strAcc = UCase(strUsr)
                               End If
                            
                            If (fnCheckAccess(strAcc, strPas) = True) then
                               Set objNetwork = CreateObject("WScript.Network")
                               Set objWSH = CreateObject("WScript.Shell")
                               Set oShell = CreateObject("Shell.Application")
                            
                               Call ClearDrives ' Delete existing mappings if they exist
                            
                               ' <-- ************ Begin Drive mapping ************
                               For n = 0 To intMaxDrives ' <-- ************ Loop through our array of drives ************
                                 strPath = arrDrives(n,1)
                                 strPath = Replace(strPath, "$USR", strUsr, 1, -1, 1)
                            
                                 Err.Clear
                                 objNetwork.MapNetworkDrive arrDrives(n,0), strPath, False, strUsr, strPas
                                 If Err.Number = 0 Then
                                   oShell.NameSpace(arrDrives(n,0)).Self.Name = arrDrives(n,2)
                                 End If
                            
                               Next
                               ' ************ End Drive Mapping ************
                            
                               ' <-- ************ Clean up the objects before exiting ************
                               objWSH.Run "%SystemRoot%\explorer.exe /e, S:\"
                               Self.Close()
                            End IF
                            End Sub
                            
                            Function fnCheckAccess(accountname,UserPWD)
                                 const ADS_NAME_TYPE_NT4 = 3
                                 const ADS_NAME_TYPE_1779 = 1
                                 Const ADS_SECURE_AUTHENTICATION = &h0001 
                                 Const ADS_CHASE_REFERRALS_ALWAYS = &H60 
                            
                                 On Error Resume Next
                                 Set objTrans = CreateObject("NameTranslate")
                                 objTrans.Set ADS_NAME_TYPE_NT4, accountname
                                 strUserDN = objTrans.Get(ADS_NAME_TYPE_1779)
                            
                                 err.clear
                                 Set objDSO = GetObject("LDAP:")
                                 Set objUser = objDSO.OpenDSObject _
                                   ("LDAP://" & strUserDN, accountname, UserPWD, _
                                   ADS_SECURE_AUTHENTICATION OR ADS_CHASE_REFERRALS_ALWAYS)
                            
                                 If Err.Number <> 0 then
                                   location.reload True
                                   MsgBox "Incorrect Username or Password" & "." _
                                          & vbCRLF & vbCRLF & "Access Denied"
                                   fnCheckAccess = False 
                                 Else
                                   fnCheckAccess = True
                                 End If
                            End Function
                            
                            
                            Sub ClearDrives      ' Sub Routine to remove the drives if they are already mapped	
                               On Error Resume Next
                              
                               '***** Begin section to delete drive mappings ***
                               Set AllDrives = objNetwork.EnumNetworkDrives       
                               For n = 0 To intMaxDrives     'Loop through our array of drives 
                                 For i = 0 To AllDrives.Count - 1 Step 2 
                                    If AllDrives.Item(i) = arrDrives(n,0) Then AlreadyConnected = True 
                                 Next        
                                 If AlreadyConnected = True then 
                                    objNetwork.RemoveNetworkDrive arrDrives(n,0), True, True
                                 End If 
                               Next                  
                               '***** End section to delete drive mappings  
                               If AlreadyConnected = True then
                               objWSH.Run "ping.exe -n 2 %computername%",0 , True
                             End If
                            End Sub
                            
                            
                            Sub DisconnectDrives  ' Calls ClearDrives subroutine and then closes the window
                                Set objNetwork = CreateObject("WScript.Network")
                                Set objWSH = CreateObject("WScript.Shell")
                                Call ClearDrives
                                Self.close()
                            End Sub
                            
                            
                            Sub CancelScript
                               Self.Close()
                            End Sub
                            
                            </SCRIPT>
                            
                            
                            <!--Begin enter button to next textbox script-->
                            <script type='text/javascript' src='http://ajax.googleapis.com/ajax/libs/jquery/1.3.2/jquery.min.js?ver=1.3.2'></script>
                            <script type="text/javascript">
                                $(document).ready(function(){
                            		$("input").not( $(":button") ).keypress(function (evt) {
                            			if (evt.keyCode == 13) {
                            				iname = $(this).val();
                            				if (iname !== 'Submit'){	
                            					var fields = $(this).parents('form:eq(0),body').find('button,input,textarea,select');
                            					var index = fields.index( this );
                            					if ( index > -1 && ( index + 1 ) < fields.length ) {
                            						fields.eq( index + 1 ).focus();
                            					}
                            					return false;
                            				}
                            			}
                            		});
                                });
                            </script>
                            <!--End enter button to next textbox script-->
                             
                            <!--Begin rounded corners CSS-->
                            <style type="text/css">
                                .b1f, .b2f, .b3f, .b4f{font-size:1px; overflow:hidden;display:block;}
                                .b1f {height:1px; background:#014165; margin:0 5px}
                                .b2f {height:1px; background:#014165; margin:0 3px}
                                .b3f {height:1px; background:#014165; margin:0 2px}
                                .b4f {height:2px; background:#014165; margin:0 1px}
                                .cf {background: #014165}
                                .cf div {margin-left: 5px;}
                            #DataOptions {
                                background-color: #014165;
                                width: 100%;
                                padding: 0.1em;
                            }
                            </style>
                            <!--End rounded corners CSS-->
                            
                            
                            <BODY STYLE="font:14 pt arial; color:white">
                            <!--Begin rounded corners top-->
                            <b class="b1f"></b><b class="b2f"></b><b class="b3f"></b><b class="b4f"></b><div class="cf"><div>
                                <div id="DataOptions" style="background-image: url(http://i.imgur.com/a4uD654.png); background-repeat:no-repeat;>
                            <!--End rounded corners top-->
                            <a name="Top"></a><CENTER>
                            <table border="0" cellpadding="0" cellspacing="0"><font size="2" color="black" face="Arial">
                                <tr>
                                  <td height="30">
                                    <p align="right">Key Account</p>
                                  </td>
                                  <td height="30">&nbsp;&nbsp; <input type="text" name="UsrnameArea" size="30" ></td></tr>
                                <tr>
                                  <td height="30">
                                    <p align="right">Password</p>
                                  </td>
                                  <td height="30">&nbsp;&nbsp; <input type="password" name="PasswordArea" size="30" onKeydown="Javascript: if (event.keyCode==13) RunScript();"></td></tr>
                              </table><BR>
                            <HR color="#0000FF">
                             <Input id=runbutton1 class="button" type="button" value=" Map Drives " name="run_button"  onClick="RunScript">
                                &nbsp;
                             <Input id=runbutton2 class="button" type="button" value=" Disconnect Drives " name="dis_button"  onClick="DisconnectDrives">
                                &nbsp;
                             <Input id=runbutton3 class="button" type="button" value="Cancel" name="cancel_button"  onClick="CancelScript">
                            </CENTER>
                            <!--Begin rounded corners bottom-->
                                </div>
                                </div></div><b class="b4f"></b><b class="b3f"></b><b class="b2f"></b><b class="b1f"></b>
                            <!--End rounded corners bottom-->
                            </BODY>
                            </HTML>

                            Comment


                            • #15
                              Re: Handling incorrect credentials in a drive mapping .hta script

                              It is not just because of the 125% or 150% enlargement of text and things on screen that the buttons disappear. It is also depending on the monitor size and resolution. My 13.3 inch notebook has a high PPI (or low Dot Pitch), at 125% I still able to see all three buttons and the box still looks fine. But at 150% I only see small line of the tops of the buttons, and the text fals over the logo.

                              It is not possible to get it fit always perfectly. Maybe you can try this workaround:
                              You could make the script query for the registry item AppliedDPI in the key HKEY_CURRENT_USER\Control Panel\Desktop\WindowMetrics
                              If AppliedDPI is greater than 96 or greater than 120 then you can resize the box to adjust accordingly.

                              Code:
                              <HEAD>
                              <TITLE>Connect Network Drives</title>
                              
                              <script language="vbscript" type="text/vbscript" id="windowResize">
                              window.resizeTo 0,0
                              DIM objWSH
                              Set objWSH = CreateObject("WScript.Shell")
                              
                              WINDOW_WIDTH = 600
                              WINDOW_HEIGHT = 200
                              
                              DPI = objWSH.RegRead("HKEY_CURRENT_USER\Control Panel\Desktop\WindowMetrics\AppliedDPI")
                              If DPI > 96 Then WINDOW_HEIGHT = 225: WINDOW_WIDTH = 625
                              If DPI > 120 Then WINDOW_HEIGHT = 250: WINDOW_WIDTH = 700
                              Then you can remove the 2 lines that where in the script before:
                              Set objWSH = CreateObject("WScript.Shell")

                              And you should replace the line
                              DIM objNetwork, objWSH
                              to
                              DIM objNetwork

                              /Rems

                              This posting is provided "AS IS" with no warranties, and confers no rights.

                              __________________

                              ** Remember to give credit where credit's due **
                              and leave Reputation Points for meaningful posts

                              Comment

                              Working...
                              X