Προς το περιεχόμενο

Έυρεση version από DLL με VB6.


NiTroGen

Προτεινόμενες αναρτήσεις

Δημοσ.

Θέλω να ελέγξω τη version ενός DLL μέσα από Visual Basic 6. Βρήκα τις εξής API ρουτίνες:

>Public Declare Function GetFileVersionInfo Lib "version.dll"  Alias "GetFileVersionInfoA" (ByVal lptstrFilename As String, ByVal dwHandle As Long, ByVal dwLen As Long, lpData As Any) As Long
Public Declare Function GetFileVersionInfoSize Lib "version.dll" Alias "GetFileVersionInfoSizeA" (ByVal lptstrFilename As String, lpdwHandle As Long) As Long
Public Declare Function GetVersion Lib "kernel32" Alias "GetVersion" () As Long
Public Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long

Είναι καμία από αυτές αυτή που ψάχνω; Αν ναι, πώς την καλώ; Αν όχι, ξέρετε την σωστή;

Δημοσ.

Xrisimopoieis tis eksis sunartiseis me tin seira pou sou parathetw:

 

1) GetFileVersionInfoSize: sou dinei to megethos se bytes tou version info block tou dll (ean uparxei, alliws 0)

 

2) GetFileVersionInfo: xrisimopoieis to parapanw megethos kai sou dinei pointer sto versioninfo.

 

3) VerQueryValue: sou dinei to version, xrisimopoiwdas "\" san subblock.

 

4) me tis HIWORD kai LOWORD pairneis ta noumera apo ta members tis VS_FIXEDFILEINFO domis pou sou edwse i proigoumeni sunartisi.

 

Ama deis to help gia kathe sunartisi tha katalabeis pws akrivws xrisimopoioudai.

  • 4 εβδομάδες αργότερα...
Δημοσ.

Τελικά το κατάφερα και σας παραθέτω τον κώδικα.

>' Procedure and Type Declarations
Public Declare Function GetFileVersionInfo Lib "Version.dll" Alias "GetFileVersionInfoA" (ByVal lptstrFilename As String, ByVal dwhandle As Long, ByVal dwlen As Long, lpData As Any) As Long
Public Declare Function GetFileVersionInfoSize Lib "Version.dll" Alias "GetFileVersionInfoSizeA" (ByVal lptstrFilename As String, lpdwHandle As Long) As Long
Public Declare Function VerQueryValue Lib "Version.dll" Alias "VerQueryValueA" (pBlock As Any, ByVal lpSubBlock As String, lplpBuffer As Any, puLen As Long) As Long
Public Declare Sub MoveMemory Lib "KERNEL32" Alias "RtlMoveMemory" (dest As Any, ByVal Source As Long, ByVal Length As Long)
Public Declare Function lstrcpy Lib "KERNEL32" Alias "lstrcpyA" (ByVal lpString1 As String, ByVal lpString2 As Long) As Long
Public Type FileInfo
    CompanyName As String
    FileDescription As String
    FileVersion As String
    InternalName As String
    LegalCopyright As String
    OriginalFileName As String
    ProductName As String
    ProductVersion As String
End Type

' Main Function
Public Function GetFileInfo(FullFileName As String) As FileInfo
    Dim rc As Long
    Dim tmpInfo As FileInfo
    
    On Local Error GoTo ErrLine
    Dim lBufferLen As Long, lDummy As Long
    lBufferLen = GetFileVersionInfoSize(FullFileName, lDummy)
    If lBufferLen < 1 Then Exit Function

    Dim sBuffer()  As Byte
    ReDim sBuffer(lBufferLen)
    rc = GetFileVersionInfo(FullFileName, 0&, lBufferLen, sBuffer(0))
    If rc = 0 Then Exit Function

    Dim lVerPointer As Long
    rc = VerQueryValue(sBuffer(0), "\VarFileInfo\Translation", lVerPointer, lBufferLen)

    If rc = 0 Then Exit Function
         
    Dim bytebuffer(255) As Byte
    MoveMemory bytebuffer(0), lVerPointer, lBufferLen
    Dim Lang_Charset_String As String
    Dim HexNumber As Long

    HexNumber = bytebuffer(2) + bytebuffer(3) * &H100 + bytebuffer(0) * &H10000 + bytebuffer(1) * &H1000000
    Lang_Charset_String = Hex(HexNumber)

    Do While Len(Lang_Charset_String) < 8
        Lang_Charset_String = "0" & Lang_Charset_String
    Loop

    Dim strVersionInfo(7) As String
    Dim Buffer(7) As String
    strVersionInfo(0) = "CompanyName"
    strVersionInfo(1) = "FileDescription"
    strVersionInfo(2) = "FileVersion"
    strVersionInfo(3) = "InternalName"
    strVersionInfo(4) = "LegalCopyright"
    strVersionInfo(5) = "OriginalFileName"
    strVersionInfo(6) = "ProductName"
    strVersionInfo(7) = "ProductVersion"

    Dim i As Integer
    Dim strTemp, strTemp2 As String
    For i = 0 To 7
        Buffer(i) = String(255, 0)
        strTemp = "\StringFileInfo\" & Lang_Charset_String & "\" & strVersionInfo(i)
        rc = VerQueryValue(sBuffer(0), strTemp, lVerPointer, lBufferLen)
        If rc = 0 Then Exit Function

        lstrcpy Buffer(i), lVerPointer
        Buffer(i) = Mid$(Buffer(i), 1, InStr(Buffer(i), Chr(0)) - 1)
    Next i
    tmpInfo.CompanyName = Buffer(0)
    tmpInfo.FileDescription = Buffer(1)
    tmpInfo.FileVersion = Buffer(2)
    tmpInfo.InternalName = Buffer(3)
    tmpInfo.LegalCopyright = Buffer(4)
    tmpInfo.OriginalFileName = Buffer(5)
    tmpInfo.ProductName = Buffer(6)
    tmpInfo.ProductVersion = Buffer(7)
    GetFileInfo = tmpInfo
    Exit Function
ErrLine:
    Call MsgBox("GetFileInfo Function. " + vbCrLf + "Error " + Str$(Err.Number) + ": " + Err.Description + " occured.", vbCritical + vbOKOnly, "Error")
    Err.Clear
    Resume Next
    Exit Function
End Function

Η συνάρτηση είναι η GetFileInfo(FileName) που επιστρέφει τις πληροφορίες από το αρχείο FileName σαν τύπο FileInfo με τα εξής πεδία: CompanyName, FileDescription, FileVersion, InternalName, LegalCopyright, OriginalFileName, ProductName, ProductVersion. Το όνομα του πεδίου λέει ακριβώς τι πληροφορίες περιέχονται. Όλα είναι strings.

 

Παράδειγμα χρήσης:

>Dim GDIInfo As FileInfo
GDIInfo = GetFileInfo("c:\winnt\system32\gdi32.dll")

Όλο τον κώδικα μπορείτε να τον κάνετε copy-paste σε ένα module και να τον χρησιμοποιήσετε απευθείας στα προγράμματά σας. Έχει και παγίδα για errors. <img src="http://www.insomnia.gr/ubbthreads/images/graemlins/wink.gif" alt="" />

Δημοσ.

ti 8es na ftiaxeis pali re ? <img src="http://www.insomnia.gr/ubbthreads/images/graemlins/laugh.gif" alt="" /> <img src="http://www.insomnia.gr/ubbthreads/images/graemlins/laugh.gif" alt="" /> <img src="http://www.insomnia.gr/ubbthreads/images/graemlins/laugh.gif" alt="" />

Δημοσ.
trustfm

said:

ti 8es na ftiaxeis pali re ? <img src="http://www.insomnia.gr/ubbthreads/images/graemlins/laugh.gif" alt="" /> <img src="http://www.insomnia.gr/ubbthreads/images/graemlins/laugh.gif" alt="" /> <img src="http://www.insomnia.gr/ubbthreads/images/graemlins/laugh.gif" alt="" />

<img src="http://www.insomnia.gr/ubbthreads/images/graemlins/grin.gif" alt="" /> <img src="http://www.insomnia.gr/ubbthreads/images/graemlins/grin.gif" alt="" /> <img src="http://www.insomnia.gr/ubbthreads/images/graemlins/grin.gif" alt="" /> <img src="http://www.insomnia.gr/ubbthreads/images/graemlins/grin.gif" alt="" />

Αρχειοθετημένο

Αυτό το θέμα έχει αρχειοθετηθεί και είναι κλειστό για περαιτέρω απαντήσεις.

  • Δημιουργία νέου...