Skip to content

Commit 3b5d6b2

Browse files
OlimilO1402OlimilO1402
committed
some code-cleanups
1 parent fcb6c19 commit 3b5d6b2

4 files changed

Lines changed: 59 additions & 65 deletions

File tree

‎Classes/FileVersionInfo.cls‎

Lines changed: 47 additions & 54 deletions
Original file line numberDiff line numberDiff line change
@@ -20,32 +20,32 @@ Option Explicit
2020
' Datei auf einem Datenträger bereit.
2121
#If VBA7 Then
2222
'we assume in VBA7 ansi is obsolete
23-
Private Declare PtrSafe Function pGetFileVersionInfoSize Lib "version" Alias "GetFileVersionInfoSizeW" (ByVal lptstrFilename As LongPtr, ByRef lpdwHandle As LongPtr) As Long
24-
Private Declare PtrSafe Function pGetFileVersionInfo Lib "version" Alias "GetFileVersionInfoW" (ByVal lptstrFilename As LongPtr, ByVal dwHandle As LongPtr, ByVal dwLen As Long, lpData As Any) As Long
25-
Private Declare PtrSafe Function pVerQueryValue Lib "version" Alias "VerQueryValueW" (pBlock As Any, ByVal lpSubBlock As LongPtr, lplpBuffer As Any, puLen As Long) As Long
26-
Private Declare PtrSafe Function pVerLanguageName Lib "kernel32" Alias "VerLanguageNameW" (ByVal wLang As Long, ByVal szLang As LongPtr, ByVal nSize As Long) As Long
27-
Private Declare PtrSafe Function plstrlen Lib "kernel32" Alias "lstrlenW" (ByVal lpString As LongPtr) As Long
28-
Private Declare PtrSafe Function plstrcpy Lib "kernel32" Alias "lstrcpyW" (ByVal dst As LongPtr, ByVal src As LongPtr) As Long
23+
Private Declare PtrSafe Function GetFileVersionInfoSize Lib "version" Alias "GetFileVersionInfoSizeW" (ByVal lptstrFilename As LongPtr, ByRef lpdwHandle As LongPtr) As Long
24+
Private Declare PtrSafe Function GetFileVersionInfo Lib "version" Alias "GetFileVersionInfoW" (ByVal lptstrFilename As LongPtr, ByVal dwHandle As LongPtr, ByVal dwLen As Long, lpData As Any) As Long
25+
Private Declare PtrSafe Function VerQueryValue Lib "version" Alias "VerQueryValueW" (pBlock As Any, ByVal lpSubBlock As LongPtr, lplpBuffer As Any, puLen As Long) As Long
26+
Private Declare PtrSafe Function VerLanguageName Lib "kernel32" Alias "VerLanguageNameW" (ByVal wLang As Long, ByVal szLang As LongPtr, ByVal nSize As Long) As Long
27+
Private Declare PtrSafe Function lstrlen Lib "kernel32" Alias "lstrlenW" (ByVal lpString As LongPtr) As Long
28+
Private Declare PtrSafe Function lstrcpy Lib "kernel32" Alias "lstrcpyW" (ByVal dst As LongPtr, ByVal src As LongPtr) As Long
2929
Private Declare PtrSafe Sub RtlMoveMemory Lib "kernel32" (ByRef pDst As Any, ByRef pSrc As Any, ByVal bytLen As Long)
3030
#Else
3131
Private Enum LongPtr
3232
[_]
3333
End Enum
3434
#Const defUnicode = 1
3535
#If defUnicode Then
36-
Private Declare Function pGetFileVersionInfoSize Lib "version" Alias "GetFileVersionInfoSizeW" (ByVal lptstrFilename As LongPtr, ByRef lpdwHandle As LongPtr) As Long
37-
Private Declare Function pGetFileVersionInfo Lib "version" Alias "GetFileVersionInfoW" (ByVal lptstrFilename As LongPtr, ByVal dwHandle As LongPtr, ByVal dwLen As Long, lpData As Any) As Long
38-
Private Declare Function pVerQueryValue Lib "version" Alias "VerQueryValueW" (pBlock As Any, ByVal lpSubBlock As LongPtr, lplpBuffer As Any, puLen As Long) As Long
39-
Private Declare Function pVerLanguageName Lib "kernel32" Alias "VerLanguageNameW" (ByVal wLang As Long, ByVal szLang As LongPtr, ByVal nSize As Long) As Long
40-
Private Declare Function plstrlen Lib "kernel32" Alias "lstrlenW" (ByVal lpString As LongPtr) As Long
41-
Private Declare Function plstrcpy Lib "kernel32" Alias "lstrcpyW" (ByVal dst As LongPtr, ByVal src As LongPtr) As Long
36+
Private Declare Function GetFileVersionInfoSize Lib "version" Alias "GetFileVersionInfoSizeW" (ByVal lptstrFilename As LongPtr, ByRef lpdwHandle As LongPtr) As Long
37+
Private Declare Function GetFileVersionInfo Lib "version" Alias "GetFileVersionInfoW" (ByVal lptstrFilename As LongPtr, ByVal dwHandle As LongPtr, ByVal dwLen As Long, lpData As Any) As Long
38+
Private Declare Function VerQueryValue Lib "version" Alias "VerQueryValueW" (pBlock As Any, ByVal lpSubBlock As LongPtr, lplpBuffer As Any, puLen As Long) As Long
39+
Private Declare Function VerLanguageName Lib "kernel32" Alias "VerLanguageNameW" (ByVal wLang As Long, ByVal szLang As LongPtr, ByVal nSize As Long) As Long
40+
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenW" (ByVal lpString As LongPtr) As Long
41+
Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyW" (ByVal dst As LongPtr, ByVal src As LongPtr) As Long
4242
#Else
43-
Private Declare Function pGetFileVersionInfoSize Lib "version" Alias "GetFileVersionInfoSizeA" (ByVal lptstrFilename As LongPtr, ByRef lpdwHandle As LongPtr) As Long
44-
Private Declare Function pGetFileVersionInfo Lib "version" Alias "GetFileVersionInfoA" (ByVal lptstrFilename As LongPtr, ByVal dwHandle As Long, ByVal dwLen As Long, lpData As Any) As Long
45-
Private Declare Function pVerQueryValue Lib "version" Alias "VerQueryValueA" (pBlock As Any, ByVal lpSubBlock As LongPtr, lplpBuffer As Any, puLen As Long) As Long
46-
Private Declare Function pVerLanguageName Lib "kernel32" Alias "VerLanguageNameA" (ByVal wLang As Long, ByVal szLang As LongPtr, ByVal nSize As Long) As Long
47-
Private Declare Function plstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As LongPtr) As Long
48-
Private Declare Function plstrcpy Lib "kernel32" Alias "lstrcpyA" (ByVal dst As LongPtr, ByVal src As LongPtr) As Long
43+
Private Declare Function GetFileVersionInfoSize Lib "version" Alias "GetFileVersionInfoSizeA" (ByVal lptstrFilename As LongPtr, ByRef lpdwHandle As LongPtr) As Long
44+
Private Declare Function GetFileVersionInfo Lib "version" Alias "GetFileVersionInfoA" (ByVal lptstrFilename As LongPtr, ByVal dwHandle As Long, ByVal dwLen As Long, lpData As Any) As Long
45+
Private Declare Function VerQueryValue Lib "version" Alias "VerQueryValueA" (pBlock As Any, ByVal lpSubBlock As LongPtr, lplpBuffer As Any, puLen As Long) As Long
46+
Private Declare Function VerLanguageName Lib "kernel32" Alias "VerLanguageNameA" (ByVal wLang As Long, ByVal szLang As LongPtr, ByVal nSize As Long) As Long
47+
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As LongPtr) As Long
48+
Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (ByVal dst As LongPtr, ByVal src As LongPtr) As Long
4949
#End If
5050
Private Declare Sub RtlMoveMemory Lib "kernel32" (ByRef pDst As Any, ByRef pSrc As Any, ByVal bytLen As Long)
5151

@@ -145,34 +145,27 @@ Private mSpecialBuild As String
145145

146146
Friend Sub New_(aPathFileName As String)
147147
mFileName = aPathFileName
148-
'End Sub
149-
150-
'Public Shared Function GetVersionInfo(ByVal fileName As String) As System.Diagnostics.FileVersionInfo
151-
'Public Function GetVersionInfo(ByVal FileName As String) As FileVersionInfo
152148
If (LenB(Dir$(mFileName)) = 0) Then
153149
MsgBox "FileNotFoundException: " & mFileName
154150
Exit Sub
155151
End If
156-
Dim num2 As Long: num2 = pGetFileVersionInfoSize(StrPtr(mFileName), 0)
157-
'Dim info1 As FileVersionInfo: Set info1 = New_FileVersionInfo(FileName)
158-
If (num2 = 0) Then
152+
Dim siz As Long: siz = GetFileVersionInfoSize(StrPtr(mFileName), 0)
153+
If (siz = 0) Then
159154
'Set GetVersionInfo = info1:
160-
Exit Sub
161155
End If
162-
Dim buffer1() As Byte: ReDim buffer1(0 To num2 - 1)
163-
Dim numRef1 As LongPtr: numRef1 = VarPtr(buffer1(0))
164-
Dim ptr1 As LongPtr: ptr1 = numRef1 ': Set ptr1 = New_IntPtr(numRef1)
165-
If CBool(pGetFileVersionInfo(StrPtr(mFileName), 0, num2, ByVal ptr1)) Then
156+
ReDim Buffer(0 To siz - 1)
157+
Dim pBuffer As LongPtr: pBuffer = VarPtr(Buffer(0))
158+
If CBool(GetFileVersionInfo(StrPtr(mFileName), 0, siz, ByVal pBuffer)) Then
166159
'Debug.Print buffer1
167-
Dim num3 As Long: num3 = GetVarEntry(ptr1)
160+
Dim ve As Long: ve = GetVarEntry(pBuffer) 'num3
168161
'If Not info1.GetVersionInfoForCodePage(ptr1, ConvertTo8DigitHex(num3)) Then
169-
If Not GetVersionInfoForCodePage(ptr1, ConvertTo8DigitHex(num3)) Then
162+
If Not GetVersionInfoForCodePage(pBuffer, ConvertTo8DigitHex(ve)) Then
170163
'Wenn die Sprache nicht geklappt hat, dann noch mit den drei anderen probieren
171-
Dim num4, numArray1: numArray1 = Array(&H40904B0, &H40904E4, &H4090000)
172-
For Each num4 In numArray1
173-
If (num4 <> num3) Then
164+
Dim v, vArr: vArr = Array(&H40904B0, &H40904E4, &H4090000) 'num4
165+
For Each v In vArr
166+
If (v <> ve) Then
174167
'If info1.GetVersionInfoForCodePage(ptr1, ConvertTo8DigitHex(num4)) Then
175-
If GetVersionInfoForCodePage(ptr1, ConvertTo8DigitHex(num4)) Then
168+
If GetVersionInfoForCodePage(pBuffer, ConvertTo8DigitHex(v)) Then
176169
Exit For
177170
End If
178171
End If
@@ -189,14 +182,14 @@ End Function
189182

190183
'Private Shared Function ConvertTo8DigitHex(ByVal value As Integer) As String
191184
Friend Function ConvertTo8DigitHex(ByVal value As Long) As String
192-
Dim StrVal As String: StrVal = Hex$(value)
193-
ConvertTo8DigitHex = String$(8 - Len(StrVal), "0") & StrVal
185+
Dim s As String: s = Hex$(value)
186+
ConvertTo8DigitHex = String$(8 - Len(s), "0") & s
194187
End Function
195188

196189
'Private Shared Function GetVarEntry(ByVal memPtr As IntPtr) As Integer
197190
Friend Function GetVarEntry(ByVal memPtr As LongPtr) As Long
198191
Dim num1 As Long, ptr1 As LongPtr
199-
If pVerQueryValue(ByVal memPtr, StrPtr("\VarFileInfo\Translation"), ByVal VarPtr(ptr1), num1) Then
192+
If VerQueryValue(ByVal memPtr, StrPtr("\VarFileInfo\Translation"), ByVal VarPtr(ptr1), num1) Then
200193
GetVarEntry = ShL(ReadInt16(ptr1), 16) + CLng(ReadInt16(ptr1, 2))
201194
Exit Function
202195
End If
@@ -207,15 +200,15 @@ End Function
207200
Friend Function GetFileVersionLanguage(ByVal memPtr As LongPtr) As String
208201
Dim num1 As Long: num1 = ShR(GetVarEntry(memPtr), 16)
209202
'Dim buffer As String * 256
210-
ReDim buffer(0 To 511) As Byte
211-
Dim L As Long: L = pVerLanguageName(num1, VarPtr(buffer(0)), 256) 'hmm hier * 2???????????????????????
212-
GetFileVersionLanguage = Left$(buffer, L)
203+
ReDim Buffer(0 To 511) As Byte
204+
Dim l As Long: l = VerLanguageName(num1, VarPtr(Buffer(0)), 256) 'hmm hier * 2???????????????????????
205+
GetFileVersionLanguage = Left$(Buffer, l)
213206
End Function
214207

215208
'Private Shared Function GetFileVersionString(ByVal memPtr As IntPtr, ByVal name As String) As String
216209
Friend Function GetFileVersionString(ByVal memPtr As LongPtr, ByVal name As String) As String
217210
Dim num1 As Long, ptr1 As LongPtr
218-
If pVerQueryValue(ByVal memPtr, StrPtr(name), ptr1, num1) Then
211+
If VerQueryValue(ByVal memPtr, StrPtr(name), ptr1, num1) Then
219212
If (ptr1 <> 0) Then
220213
GetFileVersionString = PtrToString(ptr1)
221214
End If
@@ -254,7 +247,7 @@ End Function
254247
'Private Shared Function GetFixedFileInfo(ByVal memPtr As IntPtr) As VS_FIXEDFILEINFO
255248
Friend Function GetFixedFileInfo(ByVal memPtr As LongPtr) As VS_FIXEDFILEINFO
256249
Dim num1 As Long, ptr As LongPtr
257-
pVerQueryValue ByVal memPtr, StrPtr("\"), ptr, num1
250+
VerQueryValue ByVal memPtr, StrPtr("\"), ptr, num1
258251
PtrToStructure ptr, VarPtr(GetFixedFileInfo), LenB(GetFixedFileInfo)
259252
End Function
260253

@@ -282,17 +275,17 @@ End Function
282275

283276
'##############################' Marshal '##############################'
284277
Private Function ReadInt16(ByVal ptr As LongPtr, Optional ByVal ofs As Long) As Integer
285-
' pDst , pSrc
286-
Call RtlMoveMemory(ByVal VarPtr(ReadInt16), ByVal (ptr + ofs), 2)
278+
' pDst , pSrc
279+
RtlMoveMemory ByVal VarPtr(ReadInt16), ByVal (ptr + ofs), 2
287280
End Function
288-
Private Function PtrToString(ByVal ptr As LongPtr, Optional ByVal sLen As Long) As String
289-
If (ptr = 0) Then
290-
MsgBox "Marshal.PtrToString: Ptr=Nullpointer"
291-
Exit Function
281+
Private Function PtrToString(ByVal pStr As LongPtr, Optional ByVal sLen As Long) As String
282+
If (pStr = 0) Then
283+
MsgBox "Marshal.PtrToString: pStr=Nullpointer"
284+
Exit Function
292285
End If
293-
Dim num1 As Long: num1 = plstrlen(ptr)
294-
PtrToString = Space$(num1)
295-
Call plstrcpy(StrPtr(PtrToString), ptr)
286+
Dim l As Long: l = lstrlen(pStr)
287+
PtrToString = Space$(l)
288+
lstrcpy StrPtr(PtrToString), pStr
296289
#If defUnicode Then
297290
'ist es dann schon der richtige String?
298291
'MsgBox PtrToString
@@ -305,7 +298,7 @@ End Function
305298
Private Sub PtrToStructure(ByVal ptr As LongPtr, ByVal pStruct As LongPtr, ByVal LenBStruct As Long)
306299
'hier wird nicht der Pointer übertragen, sondern vielmehr der gesamte Speicherbereich
307300
'in das Objekt structure hineinkopiert
308-
Call RtlMoveMemory(ByVal pStruct, ByVal ptr, LenBStruct)
301+
RtlMoveMemory ByVal pStruct, ByVal ptr, LenBStruct
309302
End Sub
310303

311304

‎Forms/Form1.frm‎

Lines changed: 11 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -60,7 +60,7 @@ Attribute VB_Creatable = False
6060
Attribute VB_PredeclaredId = True
6161
Attribute VB_Exposed = False
6262
Option Explicit
63-
Private FileVersionInfo As New FileVersionInfo
63+
Private FVInfo As FileVersionInfo
6464

6565
Private Sub BtnInfo_Click()
6666
MsgBox App.CompanyName & " " & App.ProductName & " v" & App.Major & "." & App.Minor & "." & App.Revision & vbCrLf & _
@@ -73,26 +73,27 @@ End Sub
7373

7474
Private Sub BtnFileVersion_Click()
7575
Try: On Error GoTo Catch
76-
Dim VI As FileVersionInfo: Set VI = MNew.FileVersionInfo(TxtFileName.Text)
77-
TxtFileVersionInfo.Text = VI.ToStr
76+
Set FVInfo = MNew.FileVersionInfo(TxtFileName.Text)
77+
If FVInfo Is Nothing Then Exit Sub
78+
TxtFileVersionInfo.Text = FVInfo.ToStr
7879
Exit Sub
7980
Catch:
8081
MsgBox ("Probably file not found")
8182
End Sub
8283

8384
Private Sub Form_Resize()
84-
Dim L As Single, T As Single, W As Single, H As Single
85+
Dim l As Single, T As Single, W As Single, H As Single
8586
Dim Brdr As Single ': Brdr = 8 * 15
86-
L = TxtFileName.Left
87+
l = TxtFileName.Left
8788
T = TxtFileName.Top
88-
W = Form1.ScaleWidth - Brdr - L
89+
W = Form1.ScaleWidth - Brdr - l
8990
H = TxtFileName.Height
90-
If ((W > 0) And (H > 0)) Then Call TxtFileName.Move(L, T, W, H)
91-
L = TxtFileVersionInfo.Left
91+
If ((W > 0) And (H > 0)) Then Call TxtFileName.Move(l, T, W, H)
92+
l = TxtFileVersionInfo.Left
9293
T = TxtFileVersionInfo.Top
93-
W = Form1.ScaleWidth - Brdr - L
94+
W = Form1.ScaleWidth - Brdr - l
9495
H = Form1.ScaleHeight - Brdr - T
95-
If ((W > 0) And (H > 0)) Then Call TxtFileVersionInfo.Move(L, T, W, H)
96+
If ((W > 0) And (H > 0)) Then Call TxtFileVersionInfo.Move(l, T, W, H)
9697
End Sub
9798

9899
Private Sub TxtFileName_KeyUp(KeyCode As Integer, Shift As Integer)

‎Mappe1.xlsm‎

-97 Bytes
Binary file not shown.

‎PFileVersionInfo.vbp‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -15,7 +15,7 @@ HelpContextID="0"
1515
CompatibleMode="0"
1616
MajorVer=1
1717
MinorVer=2
18-
RevisionVer=5
18+
RevisionVer=10
1919
AutoIncrementVer=1
2020
ServerSupportFiles=0
2121
VersionComments="Drag'n'drop files onto the form"

0 commit comments

Comments
 (0)