QTP codes & cookies

Function DeleteIECookies()
    Set oWebUtil = CreateObject("Mercury.GUI_WebUtil")
End Function
Function DeleteFFCookies()
    Dim FSO, cookiePath
    Set FSO = CreateObject("Scripting.FileSystemObject"
    cookiePath = GetFFCookiesPath()  
    If FSO.FileExists(cookiePath) Then FSO.DeleteFile cookiePath 
End Function
Function GetFFCookiesPath()
      Dim FSO, oShell
      Set FSO = CreateObject("Scripting.FileSystemObject")
      Set oShell = CreateObject("WScript.Shell"
      If InStr(Environment("OS"),"Vista") Then
            Dim sUserProf
            sUserProf = oShell.ExpandEnvironmentStrings("%USERPROFILE%") & "\AppData\Roaming\Mozilla\Firefox\Profiles"
            GetFFCookiesPath = ""  
            If FSO.FolderExists(sUserProf)  Then
              Set oFolder =  FSO.GetFolder(sUserProf)
              If oFolder.SubFolders.Count> 0 Then  
                  'oFolder.item(0) throws an error, so we use a workaround to find the first folder 
                  For each oFolder in oFolder.SubFolders
                        Exit For
                  'Set oFolder = oFolder.item(0)
                  Dim sPath
                  sPath = oFolder.Path  
                  If FSO.FileExists(sPath & "\Cookies.txt") Then
                    GetFFCookiesPath = sPath & "\Cookies.txt"
                  End If
              End If
            End If
            Err.raise vbObjectError + 1, "GetFFCookiesPath", "This function has not yet been implemented for your OS - " & Environment("OS")
      End if
End Function

Post a Comment


Close Menu