MapShare v2.0 - HTA Code

Forums

My Profile

Inbox

Address Book

My Subscription

My Forums

MapShare v2.0 - HTA Code

Logged in as: Guest

arrSession:exec spGetSession 2,16,35762

	Active Users: There are 0 members and 0 guests.
	Users viewing this topic: none

Printable Version

All Forums >> [Scripting] >> Post a VBScript >> MapShare v2.0 - HTA Code
Do you like VisualBasicScript.com? Link to us and help spread the word about our forum. Thanks!

Page: [1]

Message

<< Older Topic Newer Topic >>

MapShare v2.0 - HTA Code - 6/25/2006 11:50:19 PM

NssB

Posts: 30
Score: 0
Joined: 6/25/2006
Status: offline

Hi all,

I'm fairly new to the scripting world and have been dabbling a bit in VBS and HTA apps...
I began reading a book on VBS for Absolute Beginners 3 months ago and immediately became hooked.
I wrote the following tool as a requirement for work and may indeed be useful to the general public.

The tool is a share mapping manager which completely bypasses the need for Windows Share management (almost)

Usage:
---------
Blue Button opens the Share
Red Button shows Read/Write and Read-Only/List Folder share access in a MsgBox (This is the only non-generic part, but is what I need for my job role. Easily modified)

Path <---- Must be UNC path to share/shared folder (NO trailing slash) e.g \\servername\share\folder
Username <---- Self-Explanatory
Password <---- Self-Explanatory
NB: Leaving Username and Password blank will NOT use default logon values as credentials. These must be provided.

I hope I have commented enough. Please be kind :)

<html>
<head>
<title>MapShare - v2.0</title>
<HTA:APPLICATION 
   ID="MapShare"
   INNERBORDER="no"
   BORDER="dialog"
   MAXIMIZEBUTTON="no"
   MINIMIZEBUTTON="no"
   CONTEXTMENU="no"
   APPLICATIONNAME="MapShare"
   SCROLL="no"
   SINGLEINSTANCE="yes"
   WINDOWSTATE="normal"
>
</head>

<SCRIPT Language="VBScript">
  'Sub used to enumerate access rights of currently mapped drive (called from Red Button on HTA)
  Sub AccessRights
if DriveLetters.Value = "" OR DriveLetters.Value = "- No Drives Mapped -" Then
MsgBox "You have NO drives mapped to access!",64,"Woops..."
Exit Sub
End If
target = mid(DriveLetters.Value,1,2) & "\"
set aceflags = CreateObject("Scripting.Dictionary")
aceflags(1) = "OBJECT_INHERIT_ACE"
aceflags(2) = "CONTAINER_INHERIT_ACE"
aceflags(4) = "NO_PROPOGATE_INHERIT_ACE"
aceflags(8) = "INHERIT_ONLY_ACE"
aceflags(16) = "INHERITED_ACE"
set acetypes = CreateObject("Scripting.Dictionary")
acetypes(0) = "Access Allowed"
acetypes(1) = "Access Denied"
acetypes(2) = "Audit"

set rights = CreateObject("Scripting.Dictionary")
rights(&h00000001) = "FILE_LIST_DIRECTORY"
rights(&h00000002) = "FILE_ADD_FILE"
rights(&h00000004) = "FILE_ADD_SUBDIRECTORY"
rights(&h00000008) = "FILE_READ_EA"
rights(&h00000010) = "FILE_WRITE_EA"
rights(&h00000020) = "FILE_TRAVERSE"
rights(&h00000040) = "FILE_DELETE_CHILD"
rights(&h00000080) = "FILE_READ_ATTRIBUTES"
rights(&h00000100) = "FILE_WRITE_ATTRIBUTES"
rights(&h00010000) = "DELETE"
rights(&h00020000) = "READ_CONTROL"
rights(&h00040000) = "WRITE_DAC"
rights(&h00080000) = "WRITE_OWNER"
rights(&h00100000) = "SYNCHRONIZE"
Set wmi = GetObject("winmgmts:")
Set sec = wmi.Get("Win32_LogicalFileSecuritySetting='" & target & "'")
retval = sec.GetSecurityDescriptor(sd)
acetypes = Array("Access Allowed","Access Denied","Audit")
If sd.ControlFlags and 4 Then
   For Each ace in sd.DACL
i=0
access = iif(ace.AceFlags and 16,"(inherited)","(actual)")
for each mask in rights.Keys
 
       if mask and ace.AccessMask then 
        Select Case rights(mask)
         Case "FILE_LIST_DIRECTORY"
          i=i+1
         Case "FILE_ADD_FILE"
          i=i+2
         Case "FILE_ADD_SUBDIRECTORY"
          i=i+4
         Case "FILE_READ_EA"
          i=i+8
         Case "FILE_WRITE_EA"
          i=i+16
         Case "FILE_TRAVERSE"
          i=i+32
         Case "FILE_READ_ATTRIBUTES"
          i=i+64
         Case "FILE_WRITE_ATTRIBUTES"
          i=i+128
         Case "DELETE"
          i=i+256
         Case "READ_CONTROL"
          i=i+512
         Case "SYNCHRONIZE"
          i=i+1024
        End Select      
       end if
next
If i=2047 AND access = "(actual)" AND NOT IsNull(ace.Trustee.Name) Then
        modifyBox = modifyBox & vbCrLf & ace.Trustee.Name
   ElseIf i=1641 AND access = "(actual)" AND NOT IsNull(ace.Trustee.Name) Then
       readonlyBox = readonlyBox & vbCrLf & ace.Trustee.Name
   End If
   next
MsgBox "Read/Write Groups:" & vbCrLf & "------------------------" & modifyBox & vbCrLf & _
vbCrLf & vbCrLf & "Read-Only/List Folder Groups:" & _
       vbCrLf & "------------------------------------" & readonlyBox,64,"Access Rights..."
Else
   MsgBox "No DACL present in security descriptor"
      End If
  End Sub
  Function iif ( condition , truevalue , falsevalue )
  if condition then
      iif = truevalue
  else
iif = falsevalue
  end if
  End Function
  
  'This sub is used to map a specified path(strPath) to the first available drive letter.
  Sub Net
'Instantiate Shell object and initialise variables
On Error Resume Next
Set objShell = CreateObject("WScript.Shell") 
strDriveLetter = "J:"
strAlpha = "KLMNOPQRSTUVWXYZ" 
intAlpha = 0 
intCount = 0
intMapped = 0
err.number= vbEmpty
err.description = vbEmpty

'Check all required fields are set
If (strPath.Value ="" OR strUser.Value ="" OR strPass.Value ="") Then
   MsgBox "You MUST fill in ALL 3 required fields",64,"Woops..."
   Exit Sub
End If
'Instatiate network object and enumerate connected drives
Set objNetwork = CreateObject("WScript.Network")
Set CheckDrive = objNetwork.EnumNetworkDrives()
DriveExists = False 
'Control loop checking for letter values against initial(strDriveLetter) and then
'with string(strAlpha) - Assigning letter should it find one not in use
Do While intMapped <> 1
  DriveExists = False 
  For intDrive = 0 To CheckDrive.Count - 1 Step 2 
      If CheckDrive.Item(intDrive) = strDriveLetter Then DriveExists = True
  Next
intAlpha = intAlpha + 1

'Map drive if DriveExists should be false on this iteration
If DriveExists = False Then 
   objNetwork.MapNetworkDrive strDriveLetter, _
   strPath.Value,true,strUser.Value,strPass.Value
   intMapped = 1
End If     
 
'Check for errors on drive mapping
If (IntMapped = 1 AND Err <> 0) Then
   MsgBox "Error occurred: " & Err.Description & vbCrLf & _
     "Please check the details and try again.",16,"Hang about..."
   Exit Sub
End IF

'Set next drive letter to check in the strAlpha string
strDriveLetter = Mid(strAlpha, intAlpha,1) & ":"
Loop
      window.location.reload()
  End Sub

'HTA Load routine
  Sub Window_onLoad
Dim arrLetters()

'Resize window to dimension specified
      window.resizeTo 380,250

'Instatiate network object and enumerate connected drives
Set objNet = CreateObject("Wscript.Network")
Set Drives = objNet.EnumNetworkDrives
'Calls DisplayNone Sub should there be no drives connected
If Drives.Count = 0 Then
   DisplayNone
Else

'Populates array(arrLetters) with select(combo) options
for l = 0 to Drives.Count -1 step 2 
          strLine = Drives.item(l) & "   " & Drives.Item(l+1)
   Redim Preserve arrLetters(l)
   arrLetters(l) = strLine
      next

'Bubble sorts combo options in descending order. This step is the only way I could think
'of reordering the combo to show last mapped drive first.
for i = UBound(arrLetters) - 1 To 0 Step -1
       for j = 0 to i
      if arrLetters(j) < arrLetters(j+1) then
              temp = arrLetters(j+1)
              arrLetters(j+1) = arrLetters(j)
              arrLetters(j) = temp
              end if
       next
next
'Calls AddOption Sub to populate combo
for each objOption in arrLetters
   AddOption objOption
next
End If
  End Sub
   
  'Sub used to populate combo in HTML body.
  Sub AddOption (strLine)
if strLine <> "" Then
   Set objOption = Document.createElement("OPTION")
          objOption.Text = strLine
          objOption.Value = strLine
          DriveLetters.Add(objOption)
End If
  End Sub
  'Sub used to populate combo with default message should No Drives be mapped. Disables combo also.
  Sub DisplayNone
Set objOption = Document.createElement("OPTION")
      objOption.Text = "- No Drives Mapped -"
      objOption.Value = "- No Drives Mapped -"
      DriveLetters.Add(objOption)
DriveLetters.disabled = true
  End Sub
  'This sub simply disconnects a selected drive
  Sub DisNet
'Check to see if a mapped drive is selected
if DriveLetters.Value = "" OR DriveLetters.Value = "- No Drives Mapped -" Then
   MsgBox "You have NO drives mapped to disconnect!",64,"Woops..."
   Exit Sub
End If
'Instantiate network object and remove selected network drive
Set objNet = CreateObject("Wscript.Network")
objNet.RemoveNetworkDrive mid(DriveLetters.Value,1,2), true, true
window.location.reload()
  End Sub
  'Small sub used to open selected drive in Explorer
  Sub openDrive
'Check to see if a mapped drive is selected
if DriveLetters.Value = "" OR DriveLetters.Value = "- No Drives Mapped -" Then
MsgBox "You have NO drives mapped to open!",64,"Woops..."
   Exit Sub
Else
   'Instantiate shell object and open drive in Explorer
   set objShell = CreateObject("Wscript.Shell")
          objShell.Run ("Explorer " & mid(DriveLetters.Value,1,2) & "\" )
End If
  End Sub
    
  'Pretty self explanatory - Small Yes/No box open on right click of window :)
  Sub copyRight
Set objShell = CreateObject("Wscript.Shell")
intMessage = Msgbox ("MapShare Utility" & vbCrLf & _
 "BP Service Desk - Greenock CSC(IBM)" & vbCrLf & vbCrLf & _
 "Would you like to email the author?",vbYesNo,"� Martin Lydon 2006")
If intMessage = vbYes Then
      objShell.Run("[email=martinlydon@uk.ibm.com]mailto:martinlydon@uk.ibm.com[/email]")
End If
  End Sub
</SCRIPT>
<body STYLE="font:14 pt arial; color:white;
filter:progid:DXImageTransform.Microsoft.Gradient
(GradientType=0, StartColorStr='#000000', EndColorStr='#0000FF')" onContextMenu="copyRight">
<h4>Enter details of share:</h4>
<p>
<table border="0">
  <tr><td>Drive:</td><td><select size="1" name="DriveLetters" style="width:200px"></select>
  <input type="button" name="getGroups" value="" onClick="AccessRights" style="width:25px; background:red; border-style:window-inset" title="Show access groups...">
  <input type="button" name="opendrive" value="" onClick="OpenDrive" style="width:25px; background:blue; border-style:window-inset" title="Open Selected Drive..."></td></tr>
  <tr><td>Path:*</td><td><input type="text" name="strPath" value="" id="path" onFocus="strPath.select" style="width:200px"></td></tr>
  <tr><td>Username:*</td><td> <input type="text" name="strUser" value="" onFocus="strUser.select" style="width:200px"></td></tr>
  <tr><td>Password:*</td><td><input type="password" name="strPass" value="" onFocus="strPass.select" style="width:200px"></td></tr>
  <tr><td><td><input type="submit" name="map" value="Map Drive" onClick="Net" style="width:99px">    
  <input type="button" name="Disconnect" value="Disconnect" onClick="DisNet" style="width:99px"></td></td></tr>
</table>
<div style="font-size:12; margin-top: 5px; ">
*Required Fields
</div>
</body>
</html>

< Message edited by NssB -- 6/26/2006 1:20:55 AM >

_____________________________

Its all about the code!