Quantcast
Channel: VBForums - Visual Basic 6 and Earlier
Viewing all articles
Browse latest Browse all 21842

Drive Mapping Issues

$
0
0
Hey Guys,
I have been looking quite extensively into simplifying mapped drives so our users can set them up without too much hassle. I have taken some example scripts, and editted etc to suit my needs, however I am stumped. I don't know if anyone has any idea, but after running this script, it maps the drive perfectly, with the correct credentials and prefix for the server. However after re-logging the mapping is lost and has to be set up again. When manually mapping the drives through Windows there is the option to "reconnect and logon" which works fine, however I am not sure how I can introduce this into my script, please see the current script below. Any help would be greatly appreciated,
Thanks in advance!

Code:

<HTML>
<HEAD>
<TITLE>Map drive Z: to Basware</title>
<HTA:APPLICATION
    ApplicationName="BaswareDrive.HTA"
    SingleInstance="Yes"
    WindowsState="Normal"
    Scroll="No"
    Navigable="Yes"
    MaximizeButton="No"
    SysMenu="Yes"
    Caption="Yes"
></HEAD>

<SCRIPT LANGUAGE="VBScript">

Sub Window_Onload
  '# Size Window
  sHorizontal = 440
  sVertical = 175
  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"
End Sub

Sub RemoveDrive
On Error Resume Next
Dim objNetwork
  Set objNetwork = CreateObject("WScript.Network")
  objNetwork.RemoveNetworkDrive "Z:", "True", "True"
     
End Sub

Sub KeyPress
        If window.event.Keycode = 13 Then
            Call RunScript
        End If
End Sub

Sub RunScript
on Error Resume Next

' *** variables
mDrive = "Z:"
strRemoteShare = "\\192.168.0.1\SHARE"
strDriveAlias = "SHARE"

strUPNsuffix = "192.168.0.1\"

minUSRnamelength = 2
minPASSwrdlength = 3


' *** Map drive using the entered credentials

strUsr = UsrnameArea.Value
strPas = PasswordArea.Value

Set objNetwork = CreateObject("WScript.Network")
Set oShell = CreateObject("Shell.Application")

 If Len(strUsr) >= minUSRnamelength then
    strUsr = strUPNsuffix & Ucase(strUsr)  '<--- adds the UPNsuffix to the account

      if Len(strPas) >= minPASSwrdlength then
        Err.Clear
        objNetwork.MapNetworkDrive mDrive, strRemoteShare, True, strUsr, strPas
          If Err.Number = 0 Then
            oShell.NameSpace(mDrive).Self.Name = strDriveAlias
          End If
      ELSE
          Msgbox chr(34) & strPas & """  is an incorrect password !"
          Exit Sub
      End If
 ELSE
    Msgbox chr(34) & strUsr & """  is an incorrect Username !"
    Exit Sub
 End If

Set oShell = Nothing
Set objNetwork = Nothing
  Self.Close()
End Sub


Sub CancelScript
  Set oShell = Nothing
  Set objNetwork = Nothing
  Self.Close()
End Sub

</SCRIPT>

<body onload="RemoveDrive" onkeypress="KeyPress">

<BODY STYLE="font:14 pt arial; color:white; filter:progid:DXImageTransform.Microsoft.Gradient(GradientType=1, StartColorStr='#000000', EndColorStr='#0000FF')">
<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">Username:</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"></td></tr>
  </table><BR>

<HR color="#0000FF">
 <Input id=runbutton class="button" type="button" value="      Create Drive      " name="run_button"  onClick="RunScript">
    &nbsp;&nbsp;&nbsp;
 <Input id=runbutton class="button" type="button" value="Cancel" name="cancel_button"  onClick="CancelScript">
 
</CENTER>
</BODY>

</HTML>


Viewing all articles
Browse latest Browse all 21842

Trending Articles



<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>