none
Adaptar script PST - Informar o caminho do compartilhamento ao invés da letra mapeada RRS feed

  • Pergunta

  • Encontrei esse ótimo script que exibe todas os PSTs mapeados no Outlook e o tamanho deles, porém, no arquivo de saída ele exibe a letra que esta mapeada ao invés do caminho completo do compartilhamento, por exemplo, o pst esta no compartilhamento \\empresa\financeiro\teste.pst, mas o usuário possui mapeado o diretório e portanto, aparece como letra:\teste.pst. Podem me ajudar a mudar essa característica para sempre exibir o caminho completo ao invés da letra já que eu não saberei qual letra estava atribuída a determinado compartilhamento caso o perfil do usuário seja excluído.

    Segue script vbs

     Option Explicit
    Const HKEY_CURRENT_USER = &H80000001
    Const r_PSTGuidLocation = "01023d00"
    Const r_MasterConfig = "01023d0e"
    Const r_PSTCheckFile = "00033009"
    Const r_PSTFile = "001f6700"
    Const r_keyMaster = "9207f3e0a3b11019908b08002b2a56c2"
    Const r_ProfilesRoot = "Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles"
    Const r_DefaultProfileString = "DefaultProfile"
    Dim oReg        :Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
    Dim arrSubKeys, subkey, strValue, i, pstFile, arrPSTs, DefaultProfileName  
    
    oReg.GetStringValue HKEY_CURRENT_USER,r_ProfilesRoot,r_DefaultProfileString,DefaultProfileName 
    
    GetPSTsForProfile(DefaultProfileName)
    
    '_____________________________________________________________________________________________________________________________
    Function GetPSTsForProfile(p_profileName) 
    Dim strHexNumber, strPSTGuid, strFoundPST  
    
    oReg.GetBinaryValue HKEY_CURRENT_USER,r_ProfilesRoot & "\" & p_profileName & "\" & r_keyMaster,r_MasterConfig,strValue 
    
    If IsUsableArray (strValue) Then
     For Each i In strValue
     If Len(Hex(i)) = 1 Then
     strHexNumber = CInt("0") & Hex(i)
     Else
     strHexNumber = Hex(i)
     End If
     
     strPSTGuid = strPSTGuid + strHexNumber
    
     If Len(strPSTGuid) = 32 Then
     If IsAPST(r_ProfilesRoot & "\" & p_profileName & "\" & strPSTGuid) Then
     Wscript.Echo PSTFileName(r_ProfilesRoot & "\" & p_profileName & "\" & _ 
     PSTlocation(r_ProfilesRoot & "\" & p_profileName & "\" & strPSTGuid))
     wscript.echo GetSize(PSTFileName(r_ProfilesRoot & "\" & p_profileName & "\" & _ 
     PSTlocation(r_ProfilesRoot & "\" & p_profileName & "\" & strPSTGuid))) 
     End If
     
     strPSTGuid = "" 
     
     End If            
     Next 
    End If
    
    End Function
    '_____________________________________________________________________________________________________________________________
    
    Function GetSize(zFile)
    Dim objFSO      :Set objFSO = CreateObject("Scripting.FileSystemObject")
    dim objFile     :Set objFile = objFSO.GetFile(zFile)
    
    GetSize = ConvertSize(objFile.Size)
    
    End Function
    '_____________________________________________________________________________________________________________________________
    
    Function ConvertSize(Size)
    
    Do While InStr(Size,",") 
    'Remove commas from size     
     CommaLocate = InStr(Size,",")     
     Size = Mid(Size,1,CommaLocate - 1) & _         
     Mid(Size,CommaLocate + 1,Len(Size) - CommaLocate) 
    Loop
    
    Dim Suffix:Suffix = " Bytes" 
    If Size >= 1024 Then suffix = " KB" 
    If Size >= 1048576 Then suffix = " MB" 
    If Size >= 1073741824 Then suffix = " GB" 
    If Size >= 1099511627776 Then suffix = " TB"
    
    Select Case Suffix
     Case " KB" Size = Round(Size / 1024, 1)
     Case " MB" Size = Round(Size / 1048576, 1)
     Case " GB" Size = Round(Size / 1073741824, 1)
     Case " TB" Size = Round(Size / 1099511627776, 1) 
    End Select
    
    ConvertSize = Size & Suffix 
    
    End Function 
    '_____________________________________________________________________________________________________________________________ 
    
    Function IsAPST(p_PSTGuid)
    Dim x, P_PSTGuildValue 
    Dim P_PSTCheck:P_PSTCheck=0
    IsAPST=False 
    
    oReg.GetBinaryValue HKEY_CURRENT_USER,p_PSTGuid,r_PSTCheckFile,P_PSTGuildValue
    
    If IsUsableArray (P_PSTGuildValue) Then
     For Each x in P_PSTGuildValue 
     P_PSTCheck = P_PSTCheck + Hex(x)
     Next
    End If
    
    If P_PSTCheck=20 Then 
     IsAPST=True
    End If
    
    End Function  
    '_____________________________________________________________________________________________________________________________ 
    
    Function PSTlocation(p_PSTGuid) 
    Dim y, P_PSTGuildValue
    
    oReg.GetBinaryValue HKEY_CURRENT_USER,p_PSTGuid,r_PSTGuidLocation,P_PSTGuildValue 
    
    If IsUsableArray (P_PSTGuildValue) Then 
     For Each y In P_PSTGuildValue
     If Len(Hex(y)) = 1 Then
     PSTlocation = PSTlocation & CInt("0") & Hex(y)
     Else
     PSTlocation = PSTlocation & Hex(y) 
     End If     
     Next
    End If
    
    End Function  
    '_____________________________________________________________________________________________________________________________
    
    Function PSTFileName(p_PSTGuid) 
    Dim z, P_PSTName 
    Dim strString : strString = "" 
    
    oReg.GetBinaryValue HKEY_CURRENT_USER,p_PSTGuid,r_PSTFile,P_PSTName
    
    If IsUsableArray (P_PSTName) Then
     For Each z in P_PSTName
     If z > 0 Then strString = strString & Chr(z)
     Next
    End If
    
    PSTFileName = strString
    
    End Function  
    '_________________________________________________________________________________________________________ 
    Function ExpandEvnVariable(ExpandThis)
    Dim objWSHShell    :Set objWSHShell = CreateObject("WScript.Shell")
    
    ExpandEvnVariable = objWSHShell.ExpandEnvironmentStrings("%" & ExpandThis & "%")
    
    End Function         
    '_________________________________________________________________________________________________________ 
    
    Function IsUsableArray(rvnt)
    '-- Use this function to test for a Null, Empty or an undimensioned array.
    '-- Useful b/c some interfaces can hold properties for which if they have a
    '-- value will be an Array but may also be Null or an undimensioned Array.
    '-- It assumes that a Null or Empty could potentially be an array but not yet dimensioned. 
    '-- It returns -1 if it is passed a string, long, etc...
    '-- It returns 0 for an empty array or the number of elements in the first dimension.
    
    IsUsableArray = 0 
    
    If (VarType(rvnt) And 8192) = 8192 Then 
     IsUsableArray = UBound(rvnt) - LBound(rvnt) + 1 
     ElseIf Not (IsEmpty(rvnt) Or IsNull(rvnt)) Then 
     IsUsableArray = -1 
    End If
    
    End Function 

    quinta-feira, 18 de setembro de 2014 10:47

Respostas

  • K.ryn,

    Veja esta função que você passa a letra e ela retorna o compartilhamento.

    Extraia a letra que o seu script retorna e substitua pelo retorno dessa função

    On Error Resume Next
    
    'Exemplo 
    wscript.echo Get_share("Z:")
    
    function Get_Share(strLetra)
    	strComputer = "."
    	Set objWMIService = GetObject("winmgmts:" _
    		& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
    
    	Set colItems = objWMIService.ExecQuery("Select * from Win32_MappedLogicalDisk")
    
    	For Each objItem in colItems
    		if objItem.DeviceID = strLetra then
    		
    			Get_Share = objItem.ProviderName
    			exit function
    		end if
    	Next
    end function


    Fábio de Paula Junior

    • Marcado como Resposta K.ryn quarta-feira, 24 de setembro de 2014 09:59
    quinta-feira, 18 de setembro de 2014 13:48
    Moderador

Todas as Respostas

  • K.ryn,

    Veja esta função que você passa a letra e ela retorna o compartilhamento.

    Extraia a letra que o seu script retorna e substitua pelo retorno dessa função

    On Error Resume Next
    
    'Exemplo 
    wscript.echo Get_share("Z:")
    
    function Get_Share(strLetra)
    	strComputer = "."
    	Set objWMIService = GetObject("winmgmts:" _
    		& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
    
    	Set colItems = objWMIService.ExecQuery("Select * from Win32_MappedLogicalDisk")
    
    	For Each objItem in colItems
    		if objItem.DeviceID = strLetra then
    		
    			Get_Share = objItem.ProviderName
    			exit function
    		end if
    	Next
    end function


    Fábio de Paula Junior

    • Marcado como Resposta K.ryn quarta-feira, 24 de setembro de 2014 09:59
    quinta-feira, 18 de setembro de 2014 13:48
    Moderador
  • Fábio,

    Não tenho tanta facilidade assim para fazer a modificação sugerida (extrair a letra???)... vou tentar e posto aqui o resultado.

    sexta-feira, 19 de setembro de 2014 17:44
  • Veja um exemplo simples

    caminho = "X:\aaa\bbb\ccc"
    
    so_letra = left(caminho,2)
    
    msgbox so_letra


    Fábio de Paula Junior

    sexta-feira, 19 de setembro de 2014 20:02
    Moderador
  • Fábio, 

    Obrigado pela ajuda. Acho que eu não fui claro referente ao problema e necessidade. Temos centenas de compartilhamentos e a letra Z: que um usuário utiliza pode representar outros compartilhamentos para outros usuários, portanto, não tenho um mapeamento onde Z: sempre é \\servername\sharename\ ... fica a critério do usuário escolher qual letra e mapeamentos utilizar.

    Se eu entendi certo o exemplo, eu teria que ter prévio conhecimento sobre qual o caminho UNC corresponde a letra mapeada, mas o que realmente preciso é saber qual é o caminho UNC que o usuário utilizou para mapear compartilhamento.

    Interpretei certo?

    segunda-feira, 22 de setembro de 2014 17:27
  • K.ryn,

    Aquela função que eu passei faz exatamente isso que você quer, você pergunta qual é o share de determinada unidade e ele vai te responder.

    Faça o teste. crie um .vbs com aquele código que postei e execute em locais onde o Z: se refere a locais diferentes.


    Fábio de Paula Junior

    segunda-feira, 22 de setembro de 2014 19:45
    Moderador
  • Bom vc reclamou que o seu script traz o caminho com a unidade, exemplo:Unidade:\teste.pst

    1) Qual é a unidade? Já mostrei isso, usando instr, digamos que seja Z:

    2) Tendo Z: use o primeiro script pra descobrir a qual mapeamento ele se refere

    3) agora vc tem duas informações:

    Z:\Teste.pst e \\server\share (seja lá qual for o valor de Z:)

    Agora basta usar o replace pra trocar o Z: pelo valor encontra para Z, no final você vai ter algo como \\server\share\test.pst.


    Fábio de Paula Junior

    segunda-feira, 22 de setembro de 2014 19:52
    Moderador
  • Fábio,

    Agradeço a ajuda mas eu não consegui fazer a adaptação necessária. Encontrei outro script, fiz uma modificação mas esta ocorrendo erro. Foi criar outro post para solicitar ajuda.

    Grato.
    quarta-feira, 24 de setembro de 2014 09:59