[VB] Something else from my bored ass.

[l)ragon]

If you don't like API then don't evin look at this post.

Code Select Expand

Public Type SYSTEMTIME
   wYear As Integer
   wMonth As Integer
   wDayOfWeek As Integer
   wDay As Integer
   wHour As Integer
   wMinute As Integer
   wSecond As Integer
   wMilliseconds As Integer
End Type

Public Type FILETIME
   dwLowDateTime  As Long
   dwHighDateTime As Long
End Type

Public Type VS_FIXEDFILEINFO
   dwSignature        As Long
   dwStrucVersion     As Long
   dwFileVersionMS    As Long
   dwFileVersionLS    As Long
   dwProductVersionMS As Long
   dwProductVersionLS As Long
   dwFileFlagsMask    As Long
   dwFileFlags        As Long
   dwFileOS           As Long
   dwFileType         As Long
   dwFileSubtype      As Long
   dwFileDateMS       As Long
   dwFileDateLS       As Long
End Type

Private Declare Function GetFileVersionInfoSize Lib "Version.dll" Alias "GetFileVersionInfoSizeA" (ByVal lptstrFilename As String, lpdwHandle As Long) As Long
Private Declare Function VirtualAlloc Lib "kernel32" (lpAddress As Any, ByVal dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
Private 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
Private Declare Function VerQueryValue Lib "Version.dll" Alias "VerQueryValueA" (pBlock As Any, ByVal lpSubBlock As String, lplpBuffer As Any, puLen As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef destination As Any, ByRef Source As Any, ByVal numbytes As Long)
Private Declare Function VirtualFree Lib "kernel32" (ByVal lpAddress As Long, ByVal dwSize As Long, ByVal dwFreeType As Long) As Long
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function GetFileTime Lib "kernel32" (ByVal hFile As Long, lpCreationTime As FILETIME, lpLastAccessTime As SYSTEMTIME, lpLastWriteTime As FILETIME) As Long
Private Declare Function FileTimeToSystemTime Lib "kernel32" (lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long
Private Declare Function GetFileSize Lib "kernel32" (ByVal hFile As Long, lpFileSizeHigh As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long


Code Select Expand

Private Function GetExeVersion(fPath As String, fName As String) As Long
Dim hFile As Long, dwSize As Long, dwBytesRead As Long, gfvi As Long, lVerPointer As Long
Dim ffi As VS_FIXEDFILEINFO
Dim sBuffer()  As Byte
Dim Fver As String

   dwSize = GetFileVersionInfoSize(fPath & fName, dwBytesRead)
   
   ReDim sBuffer(dwSize)
   
   lpbBuffer = VirtualAlloc(&H0, dwSize, &H1000, &H4)
   
   gfvi = GetFileVersionInfo(fPath & fName, &H0&, dwSize, sBuffer(0))
   If gfvi = 0 Then GoTo EndFun
   
   gfvi = VerQueryValue(sBuffer(0), "\", lVerPointer, dwSize)
   If gfvi = 0 Then GoTo EndFun
   
   CopyMemory ffi, ByVal lVerPointer, Len(ffi)
       
   Fver = Chr((LOWORD(ffi.dwProductVersionLS) And &HFF)) & _
          Chr((HIWORD(ffi.dwProductVersionLS) And &HFF)) & _
          Chr((LOWORD(ffi.dwProductVersionLS) And &HFF)) & _
          Chr((HIWORD(ffi.dwProductVersionMS) And &HFF))
   
   GetExeVersion = MakeL(Fver)
   
   VirtualFree lpbBuffer, 0, &H8000 'MEM_RELEASE
Exit Function
EndFun:
   GetExeVersion = &H0
End Function


Code Select Expand

Private Function GetExeInfo(fPath As String, fName As String) As String
Dim st As SYSTEMTIME
Dim hFile As Long
   
   hFile = CreateFile(fPath & fName, &H80000000, &H1, &H0, 3, &H80, &H0)
   
   Dim CreationTime As FILETIME
   Dim LastAccessTime As SYSTEMTIME
   Dim LastWriteTime As FILETIME
   
   If GetFileTime(hFile, CreationTime, LastAccessTime, LastWriteTime) Then
      If Not FileTimeToSystemTime(LastWriteTime, st) Then
        'Debug.Print "Year of file  :" & st.wYear
        'Debug.Print "Month of File :" & st.wMonth
        'Debug.Print "Day of File   :" & st.wDay
      Else
        'Debug.Print "FileTimeToSystemTime Failed"
      End If
    Else
      'Debug.Print "GetFileTime Failed"
    End If
         
   Dim stHour As String
       stHour = st.wHour
   If Len(stHour) = 1 Then
       stHour = "0" & stHour
   End If
   
   dwTotalSize = GetFileSize(hFile, &H0)
   CloseHandle hFile
   
   GetExeInfo = fName & " " & st.wMonth & "/" & st.wDay & "/" & Right(st.wYear, 2) & " " & stHour & ":" & st.wMinute & ":" & st.wSecond & " " & dwTotalSize
End Function


Code Select Expand

Public Function HIWORD(dw As Long) As Integer
   If dw And &H80000000 Then
       HIWORD = (dw \ 65535) - 1
   Else
       HIWORD = dw \ 65535
   End If
End Function
Public Function LOWORD(dw As Long) As Integer
   If dw And &H8000& Then
       LOWORD = &H8000 Or (dw And &H7FFF&)
   Else
       LOWORD = dw And &HFFFF&
   End If
End Function
Public Function MakeL(x As String) As Long
   If Len(x) < 4 Then
       Exit Function
   End If
   CopyMemory MakeL, ByVal x, 4
End FunctionI have yet to see somone post this in VB, yes my lazy ass got bored, do what you like with it, if you find away to make this "better" by all means post away.

Note: I probably should have posted this on the Bot Devo board. Anyways if somone wishes to modify the checkrevision dll for the "I wana eventualy all out VB" users this would be a good time to do so.

[Grok]

Nice but perhaps the routines could use some parameter checking and error checking.

[l)ragon]

Nice but perhaps the routines could use some parameter checking and error checking.

Probably but I'm a lazy ass and would rather watch dvd's 8p which I don't get to do to often anymore, I'll either get to it at some later date or somone else can do so since it is here now.

[SPY-3]

and you never did edit it porves you really are lazy :p

[Blaze]

Stop bringing up old posts...