October 2009
M T W T F S S
    Nov »
 1234
567891011
12131415161718
19202122232425
262728293031  

Archives

Categories

  • [+]ASP.NET (7) 
  • [+]C# (87) 
  • [+]C++ (13) 
  • [+]Delphi (20) 
  • [+]JavaScript (24) 
  • [+]Regular Expressions (7) 
  • [+]SQL (13) 
  • [—]VB (100) 
  • [+]VB.NET (4) 

Online

Users: 5 Guests
  • Loading...


    Loading...

    Login






    Register | Lost password?

    Register





    A password will be mailed to you.
    Log in | Lost password?

    Retrieve password





    A confirmation mail will be sent to your e-mail address.
    Log in | Register
  • Gets the file description information

    '-----------------------------------------------------------
    ' FUNCTION: GetFileDescription
    '
    ' Gets the file description information.
    '
    ' IN: [strFilename] - name of file to get description of.
    '
    ' Returns: Description (vbNullString if not found)
    '-----------------------------------------------------------
    '
    Function GetFileDescription(ByVal sFile As String) As String
        Dim lVerSize As Long, lTemp As Long, lRet As Long
        Dim bInfo() As Byte
        Dim lpBuffer As Long
        Dim sDesc As String
        Dim sKEY As String
        Const sEXE As String = "\FileDescription"
    
        GetFileDescription = vbNullString
    
        '
        'Get the size of the file version info, allocate a buffer for it, and get the
        'version info.  Next, we query the Fixed file info portion, where the internal
        'file version used by the Windows VerInstallFile API is kept.  We then copy
        'the info into a string.
        '
        lVerSize = GetFileVersionInfoSize(sFile, lTemp)
        ReDim bInfo(lVerSize)
        If lVerSize > 0 Then
            lRet = GetFileVersionInfo(sFile, lTemp, lVerSize, VarPtr(bInfo(0)))
            If lRet <> 0 Then
                sKEY = GetNLSKey(bInfo)
                lRet = VerQueryValue(VarPtr(bInfo(0)), sKEY & sEXE, lpBuffer, lVerSize)
                If lRet <> 0 Then
                    sDesc = Space$(lVerSize)
                    lstrcpyn sDesc, lpBuffer, lVerSize
                    GetFileDescription = sDesc
                End If
            End If
        End If
    End Function
    Private Function GetNLSKey(byteVerData() As Byte) As String
        Const strTRANSLATION$ = "\VarFileInfo\Translation"
        Const strSTRINGFILEINFO$ = "\StringFileInfo\"
        Const strDEFAULTNLSKEY$ = "040904E4"
        Const LOCALE_IDEFAULTLANGUAGE& = &H9&
        Const LOCALE_IDEFAULTCODEPAGE& = &HB&
    
        Static strLANGCP As String
    
        Dim lpBufPtr As Long
        Dim strNLSKey As String
        Dim fGotNLSKey As Integer
        Dim intOffset As Integer
        Dim lVerSize As Long
        Dim ltmp As Long
        Dim lBufLen As Long
        Dim lLCID As Long
        Dim strTmp As String
    
        On Error GoTo GNLSKCleanup
    
        If VerQueryValue(VarPtr(byteVerData(0)), strTRANSLATION, lpBufPtr, lVerSize) <> 0 Then ' (Pass byteVerData array via reference to first element)
            If Len(strLANGCP) = 0 Then
                lLCID = GetUserDefaultLCID()
                If lLCID > 0 Then
                    strTmp = Space$(8)
    
                    GetLocaleInfoA lLCID, LOCALE_IDEFAULTCODEPAGE, strTmp, 8
                    strLANGCP = StripTerminator(strTmp)
                    While Len(strLANGCP) < 4
                        strLANGCP = gsZERO & strLANGCP
                    Wend
    
                    GetLocaleInfoA lLCID, LOCALE_IDEFAULTLANGUAGE, strTmp, 8
                    strLANGCP = StripTerminator(strTmp) & strLANGCP
                    While Len(strLANGCP) < 8
                        strLANGCP = gsZERO & strLANGCP
                    Wend
                End If
            End If
    
            If VerQueryValue(VarPtr(byteVerData(0)), strLANGCP, ltmp, lBufLen) <> 0 Then
                strNLSKey = strLANGCP
            Else
                For intOffset = 0 To lVerSize - 1 Step 4
                    CopyMemory ltmp, ByVal lpBufPtr + intOffset, 4
                    strTmp = Hex$(ltmp)
                    While Len(strTmp) < 8
                        strTmp = gsZERO & strTmp
                    Wend
    
                    strNLSKey = strSTRINGFILEINFO & Right$(strTmp, 4) & Left$(strTmp, 4)
    
                    If VerQueryValue(VarPtr(byteVerData(0)), strNLSKey, ltmp, lBufLen) <> 0 Then
                        fGotNLSKey = True
                        Exit For
                    End If
                Next
    
                If Not fGotNLSKey Then
                    strNLSKey = strSTRINGFILEINFO & strDEFAULTNLSKEY
                    If VerQueryValue(VarPtr(byteVerData(0)), strNLSKey, ltmp, lBufLen) <> 0 Then
                        fGotNLSKey = True
                    End If
                End If
            End If
        End If
    
    GNLSKCleanup:
        If fGotNLSKey Then
            GetNLSKey = strNLSKey
        End If
    End Function
    
    Share: These icons link to social bookmarking sites where readers can share and discover new web pages.
    • Digg
    • del.icio.us
    • Bloglines
    • Facebook
    • Google Bookmarks
    • LinkedIn
    • Technorati
    • TwitThis
    • Webnews

    Leave a Reply

     

     

     

    You can use these HTML tags

    <a href="" title=""> <abbr title=""> <acronym title=""> <b> <blockquote cite=""> <cite> <code> <del datetime=""> <em> <i> <q cite=""> <strike> <strong> <font color="" face="" size=""> <span style="">

    Spam Protection by WP-SpamFree Plugin