
Set objNet = CreateObject("WScript.Network")

Public Sub CheckAndMapNetDrive(Letter, Path, Persist)
  'Check if drive letter is already used

set fso = createobject("scripting.filesystemobject")
set dr = fso.drives

for each d in dr
	if d.drivetype = 3 then
		if d.driveletter = replace(Letter, ":", "") then
			objNet.RemoveNetworkDrive d

		end if
	end if
next


	dim login
	dim pwd
	dim ofile
	dim user
	dim thisfile
	dim temp

	dim oc
	dim key

	dim encUser
	dim encString

	set oc = new cryptography
	key = "pass"

	oc.key = key
	
	user = objNet.UserName
	encUser = oc.encrypt(user)
	encUser = safeName(encUser)

	thisfile = "swl_" & encUser & ".txt"

	if fso.fileexists(thisfile) then
		set ofile = fso.opentextfile(thisfile)
		temp = ofile.readline
		temp = oc.decrypt(temp)
		temp = split(temp, ",")
		
		login = temp(0)
		pwd = temp(1)
		ofile.close
	end if

	if login = "" and password = "" then
		login = InputBox("Enter your School Web Lockers DirectSave webdav account login at " & path & ":")
		pwd = InputBox("Password")
		set ofile = fso.createtextfile(thisfile)
		ofile.writeline(oc.encrypt(login & "," & pwd))
		ofile.close
	end if

'runAES(thisfile)

  objNet.MapNetworkDrive Letter, Path, Persist, login, pwd

	dim sh
	set sh = wscript.createobject("shell.application")
	sh.explore Letter
	set sh = nothing

End Sub  

function safename (inp)
dim out
dim temp
	temp = replace(inp, "/", "slash")
	temp = replace(inp, "\", "backslash")
	temp = replace(inp, ":", "colon")

	out = temp

	safename = out
end function

function unsafename (inp)
dim out
dim temp
	temp = replace(inp, "slash", "/")
	temp = replace(inp, "backslash", "\")
	temp = replace(inp, "colon", ":")
	out = temp

	unsafename = out
end function


'*****************************************************************
'	CRYPTOGRAPHY CLASS
'	
'	Author: 	Jason Beaudoin
'				ColdFire Designs
'				http://www.coldfiredesigns.com
'
'	Date: 		19 October 2011
'
'	Addaptation of 4GuysFromRolla
'	See: http://www.4guysfromrolla.com/webtech/110599-1.shtml
'*****************************************************************


Class Cryptography

'-----------------------------------------------------------------
' Standard Private Variable Declarations
'-----------------------------------------------------------------
	Private m_key
	Private m_sessionId
	Private m_encryptedString
	
'-----------------------------------------------------------------
' Initialize the class
'-----------------------------------------------------------------
	Private Sub Class_Initialize
		m_key = ""
		m_sessionId = ""
	End Sub
  
'*****************************************************************
' CLASS METHODS
'*****************************************************************

'-----------------------------------------------------------------
' Encrypt
' Requires: strCryptThis (string): the string to encrypt.
'----------------------------------------------------------------- 
	Public Function Encrypt(ByVal strCryptThis)
		Dim strChar, iKeyChar, iStringChar, i,g_Key
		Dim strToEncrypt
		Dim g_keypos, iCryptChar, iCryptCharHex, iCryptCharHexStr
		Dim strEncrypted
		
		Call KeyCheck()
		Call stringCheck(strCryptThis)
		
		strToEncrypt = m_sessionId & strCryptThis		
		
		g_keypos=0
		for i=0 to len(strToEncrypt)
			g_Key=g_Key & mid(m_key,1,g_keypos)
			g_keypos=g_keypos+1
			if g_keypos>len(m_key) Then g_keypos=0
		next
		
		for i = 1 to Len(strToEncrypt)
			iKeyChar = Asc(mid(g_Key,i,1))
			iStringChar = Asc(mid(strToEncrypt,i,1))
			iCryptChar = iKeyChar Xor iStringChar
			iCryptCharHex = Hex(iCryptChar)
			iCryptCharHexStr = cstr(iCryptCharHex)
			if len(iCryptCharHexStr)=1 then iCryptCharHexStr = "0" & iCryptCharHexStr
			strEncrypted = strEncrypted & iCryptCharHexStr
		next
		
		m_encryptedString = strEncrypted
		EnCrypt = strEncrypted
	End Function

'-----------------------------------------------------------------
' DeCrypt
' Requires: strEncrypted (string): the string to decrypt
'-----------------------------------------------------------------
	Public Function DeCrypt(strEncrypted)
		Dim strChar, iKeyChar, iStringChar, i,g_Key, varSessionID
		Dim LenGKey, g_keypos, iStringChar2, iDeCryptChar, strDecrypted
		
		Call KeyCheck()
		
		'Response.Write "String = " & strEncrypted & "<br>"
		Call stringCheck(strEncrypted)
		
		LenGKey=Len(strEncrypted)/2
		g_keypos=0
		For i=0 to LenGKey
			g_Key=g_Key & mid(m_key,1,g_keypos)
			g_keypos=g_keypos+1
			if g_keypos>len(m_key) Then g_keypos=0
		Next
		for i = 1 to Len(strEncrypted) /2
			iKeyChar = (Asc(mid(g_Key,i,1)))
			iStringChar2 = mid(strEncrypted,(i*2)-1,2)
			iStringChar = CLng("&H" & iStringChar2)
			iDeCryptChar = iKeyChar Xor iStringChar
			strDecrypted = strDecrypted & chr(iDeCryptChar)
		next
		DeCrypt = Replace(strDecrypted, m_sessionId, "")
	End Function
	
'*****************************************************************
' PRIVATE FUNCTIONS
'*****************************************************************

'-----------------------------------------------------------------
' KeyCheck
' Ensures that there is a encryption key
'-----------------------------------------------------------------
	Private Function keyCheck()
		If m_key = "" Then Response.Write "<span style='color:red;'>Error: No encryption key was provided.</span>":Response.End()
	End Function

'-----------------------------------------------------------------
' StringCheck
' Ensures that there is a string to encrypt or decrypt
'-----------------------------------------------------------------
	Private Function stringCheck(myString)
		If myString = "" Then Response.Write "<span style='color:red;'>Error: No string was provided for encryption.</span>":Response.End()
	End Function
	
	Public Function EncryptList(arr())
		Dim x		
		For x = 0 To UBound(arr)
			execute(arr(x) & " = Encrypt(arr(x))")
		Next
	End Function
	
	Public Function DecryptList(arr())
		Dim x
		For x = 0 To UBound(arr)
			execute(arr(x) & " = Decrypt(arr(x))")
		Next
	End Function
	
	
'*****************************************************************
' PUBLIC PROPERTIES
'*****************************************************************
	Property Let key(value)
		m_key = value
	End Property
	
	Property Get encryptedString()
		encryptedString = m_encryptedString
	End Property
	
	Property Let GUID(value)
		m_sessionId = value
	End Property
	
	Property Get GUID()
		GUID = m_sessionId
	End Property

End Class




CheckAndMapNetDrive "T:", "http://www.schoolweblockers.com/dav/", True





