✔ MailTo - Firefox Standard in der Registry finden

So hier mal meine Funktion, bis auf einige Standardfunktionen kann die 1 zu 1 übernommen werden.
Ist net besonders schön, aber scheint zumindest zu klappen:

Visual Basic: 
'''<summary>
'''Setzt im Standardprofil, wenn gefunden, ansonsten 1. Profil, das mailto auf Consolidate.
'''</summary>
'''<remarks>mm 07.08.2012 - 1896734</remarks>
Private Sub setMozillaStandardMailClient()
  On Error GoTo setMozillaStandardMailClient_Error
  Dim thisFSO As FileSystemObject
  Dim thisFolder As folder
  Dim thisMainFolder As folder
  Dim thisFile As String
  Dim thisCnt As Long
  Dim thisFolderFound As Boolean
  
  thisFile = GetSpecialFolder(spf_AppData)
  thisFile = thisFile & "\Mozilla\FireFox\Profiles" 'MLHIDE
  
  Set thisFSO = New FileSystemObject
  Set thisMainFolder = thisFSO.GetFolder(thisFile)
  
  
  For Each thisFolder In thisMainFolder.SubFolders
    If InStr(1, thisFolder.Name, "default", vbTextCompare) Then 'MLHIDE
      thisFolderFound = True
      Exit For
    End If
  Next
  
  If thisFolderFound = False And thisMainFolder.SubFolders.Count Then
    'Muss so gemacht werden, da SubFolder buggy ist und nicht per Item angesprochen werden kann
    For Each thisFolder In thisMainFolder.SubFolders
      Exit For
    Next thisFolder
  End If
  
  If Not thisFolder Is Nothing Then
    If FilesExists(thisFolder.Path & "\mimeTypes.rdf") Then 'MLHIDE
      Dim thisStr As String
      thisStr = ReadFileToString(thisFolder.Path & "\mimeTypes.rdf") 'MLHIDE
      If InStr(1, thisStr, "<RDF:Description RDF:about=" & Chr$(34) & "urn:scheme:externalApplication:mailto" & Chr$(34), vbTextCompare) Then 'MLHIDE
        Dim thisStartPos As Long
        Dim thisEndPos As Long
        Dim thisStrToChange As String
        Dim thisNewStr As String
        Dim thisConsPath As String
        
        If InVbIde Then
          thisConsPath = "Path" 'MLHIDE
        Else
          thisConsPath = GetSetting("OC", "startup", "ProgramDir", Path) 'MLHIDE
        End If
        
        thisStartPos = InStr(1, thisStr, "<RDF:Description RDF:about=" & Chr$(34) & "urn:scheme:externalApplication:mailto" & Chr$(34), vbTextCompare) 'MLHIDE
        thisEndPos = InStr(thisStartPos, thisStr, "/>", vbTextCompare) + 2 'MLHIDE
        thisStrToChange = mID$(thisStr, thisStartPos, thisEndPos - thisStartPos)
        
        thisNewStr = "<RDF:Description RDF:about=" & Chr$(34) & "urn:scheme:externalApplication:mailto" & Chr$(34) & vbCrLf  'MLHIDE
        thisNewStr = thisNewStr & "                   " 'MLHIDE
        thisNewStr = thisNewStr & "NC:prettyName=" & Chr$(34) & "exe" & Chr$(34) & vbCrLf 'MLHIDE
        thisNewStr = thisNewStr & "                   " 'MLHIDE
        thisNewStr = thisNewStr & "NC:path=" & Chr$(34) & thisConsPath & Chr$(34) 'MLHIDE
        thisNewStr = thisNewStr & " />" 'MLHIDE
      
        thisStr = Replace$(thisStr, thisStrToChange, thisNewStr, , , vbTextCompare)
        
        If WriteStringToFile(thisStr, thisFolder.Path & "\mimeTypes.rdf", True) = False Then
          MsgBox "Die Mozilla Definitions-Datei konnte nicht beschrieben werden." & _
          "Bitte ändern Sie die das Standard Mail-Programm manuell.", vbExclamation + vbOKOnly, "Hinweis" 'MLHIDE
        End If
      End If
    End If
  End If

setMozillaStandardMailClient_Ende:
  On Error Resume Next
  Set thisFSO = Nothing
  Set thisMainFolder = Nothing
  Set thisFolder = Nothing
  Exit Sub

setMozillaStandardMailClient_Error:
  Debug.Print Err.Description & "(" & Err.Number & ")" & " setMozillaStandardMailClient in INITModul " 'MLHIDE
  Debug.Assert (Err = False)
  On Error Resume Next
  WriteDBGView Err.Description & "(" & Err.Number & ")" & " setMozillaStandardMailClient in INITModul ", App.EXEName 'MLHIDE
  GoTo setMozillaStandardMailClient_Ende
  Resume
End Sub

Was ich nicht geschafft habe ist, dass dann das Problem mit (Standard) genommen wird.
 
Man kann ja in Programm auswählen und Programm (standard). Ich nehme an, wenn dieses dann nicht gefunden wird, wird nachgefragt oder ähnliches.
 
So hier mal meine ziemlich hässliche Lösung:


Visual Basic: 
'''<summary>
'''Setzt im Standardprofil, wenn gefunden, ansonsten 1. Profil, das mailto auf Consolidate.
'''</summary>
'''<remarks>mm 07.08.2012 - 1896734</remarks>
Private Sub setMozillaStandardMailClient()
  On Error GoTo setMozillaStandardMailClient_Error
  Dim thisFSO As FileSystemObject
  Dim thisFolder As folder
  Dim thisMainFolder As folder
  Dim thisFile As String
  Dim thisCnt As Long
  Dim thisFolderFound As Boolean
  
  thisFile = GetSpecialFolder(spf_AppData)
  thisFile = thisFile & "\Mozilla\FireFox\Profiles" 'MLHIDE
  
  Set thisFSO = New FileSystemObject
  Set thisMainFolder = thisFSO.GetFolder(thisFile)
  
  
  For Each thisFolder In thisMainFolder.SubFolders
    If InStr(1, thisFolder.Name, "default", vbTextCompare) Then 'MLHIDE
      thisFolderFound = True
      Exit For
    End If
  Next
  
  If thisFolderFound = False And thisMainFolder.SubFolders.Count Then
    'Muss so gemacht werden, da SubFolder buggy ist und nicht per Item angesprochen werden kann
    For Each thisFolder In thisMainFolder.SubFolders
      Exit For
    Next thisFolder
  End If
  
  If Not thisFolder Is Nothing Then
    If FilesExists(thisFolder.Path & "\mimeTypes.rdf") Then 'MLHIDE
      Dim thisStr As String
      thisStr = ReadFileToString(thisFolder.Path & "\mimeTypes.rdf") 'MLHIDE
      If InStr(1, thisStr, "<RDF:Description RDF:about=" & Chr$(34) & "urn:scheme:externalApplication:mailto" & Chr$(34), vbTextCompare) Then 'MLHIDE
        Dim thisStartPos As Long
        Dim thisEndPos As Long
        Dim thisStrToChange As String
        Dim thisNewStr As String
        Dim thisConsPath As String
        
        If InVbIde Then
          thisConsPath = filePath 'MLHIDE
        Else
          thisConsPath = GetSetting("OfficeCom", "startup", "ProgramDir", filePath) 'MLHIDE
        End If
        
        thisStartPos = InStr(1, thisStr, "<RDF:Description RDF:about=" & Chr$(34) & "urn:scheme:externalApplication:mailto" & Chr$(34), vbTextCompare) 'MLHIDE
        thisEndPos = InStr(thisStartPos, thisStr, "/>", vbTextCompare) + 2 'MLHIDE
        thisStrToChange = Mid$(thisStr, thisStartPos, thisEndPos - thisStartPos)
        
        thisNewStr = "<RDF:Description RDF:about=" & Chr$(34) & "urn:scheme:externalApplication:mailto" & Chr$(34) & vbCrLf  'MLHIDE
        thisNewStr = thisNewStr & "                   " 'MLHIDE
        thisNewStr = thisNewStr & "NC:prettyName=" & Chr$(34) & EXEName & Chr$(34) & vbCrLf 'MLHIDE
        thisNewStr = thisNewStr & "                   " 'MLHIDE
        thisNewStr = thisNewStr & "NC:path=" & Chr$(34) & thisConsPath & Chr$(34) 'MLHIDE
        thisNewStr = thisNewStr & " />" 'MLHIDE
      
        thisStr = Replace$(thisStr, thisStrToChange, thisNewStr, , , vbTextCompare)
        
        If WriteStringToFile(thisStr, thisFolder.Path & "\mimeTypes.rdf", True) = False Then
          MsgBox "Die Mozilla Definitions-Datei konnte nicht beschrieben werden." & _
          "Bitte ändern Sie die das Standard Mail-Programm manuell.", vbExclamation + vbOKOnly, "Hinweis" 'MLHIDE
        End If
      End If
    End If
  End If

setMozillaStandardMailClient_Ende:
  On Error Resume Next
  Set thisFSO = Nothing
  Set thisMainFolder = Nothing
  Set thisFolder = Nothing
  Exit Sub

setMozillaStandardMailClient_Error:
  Debug.Print Err.Description & "(" & Err.Number & ")" & " setMozillaStandardMailClient in INITModul " 'MLHIDE
  Debug.Assert (Err = False)
  On Error Resume Next
  WriteDBGView Err.Description & "(" & Err.Number & ")" & " setMozillaStandardMailClient in INITModul ", App.EXEName 'MLHIDE
  GoTo setMozillaStandardMailClient_Ende
  Resume
End Sub
 
Ich hab nur das FSO gesehen, und stimme dir zu: Das ist potthässlich! :D

Naja, aber solange es funktioniert....

Wobei ich mir sicher bin, dass man den ganzen FSO-Müll durch API's ersetzen könnte, aber schliesslich werde ich ja nicht dafür bezahlt *gg*
 
nicht intuitive Syntax (um nicht zu sagen: gruselig), zusätzlicher Overhead (da du das ganz Objekt referenzierst, ob du den anderen Mist brauchst oder nicht), Late Binding (Referenzierung erst zur Laufzeit), und wie du selbst festgestellt hast noch zusätzlich buggy.

In deinem Fall hätte ich Environ verwendet, und die Foldersuche entweder per API oder Dir-Funktion gemacht.

Aber wie bei so vielem im Leben: Geschmackssache *gg*
 
Um antworten zu können musst du eingeloggt sein.

Neue Beiträge

Zurück