home

Versionsüberprüfung WinWord & Co

Manches Mal ärgerte ich mich bei der Installation von Programmen darüber, daß ich nach der Version meiner Textverarbeitung gefragt wurde. Ein Produkt, das eine Vielzahl unterschiedlicher Textverarbeitungen und das auch noch in unterschiedlichen Versionen unterstützen musste, sollte dies besser können.

Zunächst wählt der Benutzer aus, welches Programm er unterstüzt haben möchte. Anschließend wird dieses Textverarbeitungsprogramm auf seinem System gesucht:

Declare Function FindExecutable Lib "shell.dll" (ByVal lpFile _
	As String, ByVal lpDirectory As String, _
	ByVal lpResult As String) As Long

Private Function GetExecutableFound(AppStr As String) As String
Dim h1, h2, h3 As String * 255
Dim x&
    h1 = AppStr & Chr$(0)
    h2 = Chr$(0)
    h3 = String(255, 0)
    x& = FindExecutable(h1, h2, h3)
    If h3 = String(255, 0) Then
        GetExecutableFound = ""
    Else
        GetExecutableFound = h3
    End If
End Function

Wichtig beim Aufruf der Funktion GetExecutableFound ist, daß eine tatsächlich bestehende Datei angegeben wird, da die API Funktion FindExecutable bei Übergabe einer nicht existierenden Datei ebenfalls keine zugehörige Applikation zurückliefert:

        ...
        ret$ = GetExecutableFound(SourcePath$ + "instfile." + _
		WPExtension(Selected%))
        ...

Dann wird mit der Funktion GetFileVersion die Version der Applikation abgefragt. Aber Achtung: einige der uralten Textverarbeitungssysteme (z.B. WinWord 2.0a, Amipro 2) beinhalten keine Versionskennzeichnung. Vorher unbedingt testen!!

Function GetFileVersion(FileToCheck As String) As String
    On Error Resume Next
    VersionInfoSize& = GetFileVersionInfoSize(FileToCheck, lpdwHandle&)
    If VersionInfoSize& = 0 Then
        GetFileVersion = ""
        Exit Function
    End If
    lpvdata$ = String(VersionInfoSize&, Chr$(0))
    VersionInfo% = GetFileVersionInfo(FileToCheck, lpdwHandle&, _
	VersionInfoSize&, lpvdata$)
    ptrFixed% = VerQueryValue(lpvdata$, "\FILEVERSION", _
	lplpBuffer&, lpcb%)
    If ptrFixed% = 0 Then
        ' Take a shot with the hardcoded TransString
        TransString$ = "040904E4"
        ptrString% = VerQueryValue(lpvdata$, "\StringFileInfo\" & _
		TransString$ & "\CompanyName", lplpBuffer&, lpcb%)
        If ptrString% <> 0 Then GoTo GetValues
        ptrFixed% = VerQueryValue(lpvdata$, "\", lplpBuffer&, lpcb%)
        If ptrFixed% = 0 Then
            GetFileVersion = ""
            Exit Function
        Else
            TransString$ = ""
            fixedstr$ = String(lpcb% + 1, Chr(0))
            stringcopy& = lstrcpyn(fixedstr$, lplpBuffer&, lpcb% + 1)
            For i = lpcb% To 1 Step -1
                Char$ = Hex(Asc(Mid(fixedstr$, i, 1)))
                If Len(Char$) = 1 Then
                    Char$ = "0" + Char$
                End If
                TransString$ = TransString$ + Char$
                If Len(TransString$ & nextchar$) Mod 8 = 0 Then
                    TransString$ = "&H" & TransString$
                    TransValue& = Val(TransString$)
                    TransString$ = ""
                End If
            Next i
        End If
    End If
    TransTable$ = String(lpcb% + 1, Chr(0))
    TransString$ = String(0, Chr(0))
    stringcopy& = lstrcpyn(TransTable$, lplpBuffer&, lpcb% + 1)
    For i = 1 To lpcb%
        Char$ = Hex(Asc(Mid(TransTable$, i, 1)))
        If Len(Char$) = 1 Then
            Char$ = "0" + Char$
        End If
        If Len(TransString$ & nextchar$) Mod 4 = 0 Then
            nextchar$ = Char$
        Else
            TransString$ = TransString$ + Char$ + nextchar$
            nextchar$ = ""
            Char$ = ""
        End If
    Next i
GetValues:
    ptrString% = VerQueryValue(lpvdata$, "\StringFileInfo\" & _
	TransString$ & "\FileVersion", lplpBuffer&, lpcb%)
    If ptrString% = 1 Then
        TransTable$ = String(lpcb%, Chr(0))
        stringcopy& = lstrcpyn(TransTable$, lplpBuffer&, lpcb% + 1)
        GetFileVersion = TransTable$
    Else
        GetFileVersion = ""
    End If
End Function

top