|
[ Crazy shadow @ 11.09.2008. 12:50 ] @
| Potreban mi je mali programcic tj pomoc da napravim program,koji bi proveravao da li racunar ima instaliran net.framework 2.0 i ako ga nema da pokrene instalaciju koja bi se nalazila na disku.
Hvala unapred. |
[ stefanpn @ 11.09.2008. 13:04 ] @
Možeš da proveriš da li postoji ključ "InstallRoot" u "HKEY_LOCAL_MACHINE\Software\Microsoft\.NETFramework" u registriju. Ukoliko postoji, postoji i .NET framework.
Ne postoji ugrađen mehanizam za operacije nad Registry bazom unutar samog VB6 već moraš koristiti API pozive:
Code:
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long
[ Crazy shadow @ 12.09.2008. 10:04 ] @
Nije mi sve ovo bas naj jasnije.Da li ima vec napisan takav program tj verovatno ga ima..Ili neki tutorial da pogledam malo o tome.
[ Aleksandar Ružičić @ 12.09.2008. 11:32 ] @
pretrazi ovaj (vb6) forum, trazi "registry access"
[ Eurora3D Team @ 13.09.2008. 01:17 ] @
Evo ti funkcija
Code:
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const READ_CONTROL = &H20000
Private Const STANDARD_RIGHTS_READ = (READ_CONTROL)
Private Const KEY_QUERY_VALUE = &H1
Private Const KEY_ENUMERATE_SUB_KEYS = &H8
Private Const KEY_NOTIFY = &H10
Private Const SYNCHRONIZE = &H100000
Private Const REG_SZ = 1
Private Const KEY_READ = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Private Function NotNet() As Boolean
Dim hKey As Long
If 0 <> RegOpenKeyEx(HKEY_LOCAL_MACHINE, "Software\Microsoft\.NETFramework", 0, KEY_READ, hKey) Then NotNet = False: Exit Function
Dim lngSize As Long: lngSize = 260
Dim Buffer As String: Buffer = String(lngSize, vbNullChar)
If 0 <> RegQueryValueEx(hKey, "InstallRoot", 0, REG_SZ, ByVal Buffer, lngSize) Then NotNet = False: RegCloseKey hKey: Exit Function
RegCloseKey hKey
NotNet = True
Debug.Print Left(Buffer, lngSize)
End Function
Private Sub Form_Load()
If NotNet Then MsgBox "Ima instaliran NET framework" Else MsgBox "Nema instaliran NET framework"
End Sub
Po ovoj Stefanovoj teoriji ... :)
[Ovu poruku je menjao Eurora3D Team dana 13.09.2008. u 02:28 GMT+1]
[ stefanpn @ 15.09.2008. 08:51 ] @
Citat: Code: Private Function NotNet() As Boolean - NotNet :)
Mislio sam da si napravio f-ju koja treba da vrati True ako nema instaliran .Net, pa sam procitao kod. :)
F-ja radi, bar kod mene... Ali ne vraca koja je verzija instalirana vec samo da je neka instalirana.
[ Eurora3D Team @ 15.09.2008. 13:05 ] @
Nisam video ovo 2.0 :)
NotNet je zbog dotNet + malo sarkazma ... mogao sam i srecnije da je nazovem , npr. IsNetInstalled
[Ovu poruku je menjao Eurora3D Team dana 16.09.2008. u 17:17 GMT+1]
[ Eurora3D Team @ 15.09.2008. 14:10 ] @
Ovo bi trebalo da nadje 2.0 net framework ... dodao sam 10-ak linija
Mislim da je ipak bolje da se trazilo u
Code:
HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\NET Framework Setup\NDP
zato sto je tu izlistano vise verzija (bar kod mene)
Code:
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const READ_CONTROL = &H20000
Private Const STANDARD_RIGHTS_READ = (READ_CONTROL)
Private Const KEY_QUERY_VALUE = &H1
Private Const KEY_ENUMERATE_SUB_KEYS = &H8
Private Const KEY_NOTIFY = &H10
Private Const SYNCHRONIZE = &H100000
Private Const REG_SZ = 1
Private Const KEY_READ = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Const ERROR_NO_MORE_ITEMS = 259&
Private Declare Function RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, lpcbName As Long, ByVal lpReserved As Long, ByVal lpClass As String, lpcbClass As Long, lpftLastWriteTime As FILETIME) As Long
Private Function IsNet2Installed() As Boolean
Dim hKey As Long
If 0 <> RegOpenKeyEx(HKEY_LOCAL_MACHINE, "Software\Microsoft\.NETFramework", 0, KEY_READ, hKey) Then IsNet2Installed = False: Exit Function
Dim lngSize As Long: lngSize = 260
Dim Buffer As String: Buffer = String(lngSize, vbNullChar)
If 0 <> RegQueryValueEx(hKey, "InstallRoot", 0, REG_SZ, ByVal Buffer, lngSize) Then IsNet2Installed = False: RegCloseKey hKey: Exit Function
Debug.Print Left(Buffer, lngSize)
Dim n As Long, ft As FILETIME: n = 0
lngSize = 260
Dim Buffer2 As String: Buffer2 = String(lngSize, vbNullChar)
If 0 <> RegEnumKeyEx(hKey, n, ByVal Buffer, lngSize, 0, ByVal Buffer2, 260, ft) Then IsNet2Installed = False: RegCloseKey hKey: Exit Function
Debug.Print Left(Buffer, lngSize)
Dim ret As Long
While ret <> ERROR_NO_MORE_ITEMS
lngSize = 260
ret = RegEnumKeyEx(hKey, n, ByVal Buffer, lngSize, 0, ByVal Buffer2, 260, ft)
n = n + 1
Debug.Print Left(Buffer, lngSize)
If Left(Buffer, 4) = "v2.0" Then IsNet2Installed = True: RegCloseKey hKey: Exit Function
Wend
RegCloseKey hKey
IsNet2Installed = False
End Function
Private Sub Form_Load()
If IsNet2Installed Then MsgBox "Ima instaliran NET framework 2.0" Else MsgBox "Nema instaliran NET framework 2.0"
End Sub
[Ovu poruku je menjao Eurora3D Team dana 16.09.2008. u 17:42 GMT+1]
[ Crazy shadow @ 18.09.2008. 11:51 ] @
Hvala na odgovorima.Odradio sam da mi proverava framework.Ali sad kad testiram na XP sp1 trazi mi da pri instalaciji frameworka da imam instaliran Windows Installer 3.0.E sad me zanima kako to da proverim dali preko baze registri ili ima neki drugi nacin?
[ stefanpn @ 18.09.2008. 14:23 ] @
Ukoliko postoji datoteka msi.dll u system32 folderu onda postoji Microsoft Installer, a instalirana verzija je verzija datoteke.
Code:
Const VS_FFI_SIGNATURE = &HFEEF04BD
Const VS_FFI_STRUCVERSION = &H10000
Const VS_FFI_FILEFLAGSMASK = &H3F&
Const VS_FF_DEBUG = &H1
Const VS_FF_PRERELEASE = &H2
Const VS_FF_PATCHED = &H4
Const VS_FF_PRIVATEBUILD = &H8
Const VS_FF_INFOINFERRED = &H10
Const VS_FF_SPECIALBUILD = &H20
Const VOS_UNKNOWN = &H0
Const VOS_DOS = &H10000
Const VOS_OS216 = &H20000
Const VOS_OS232 = &H30000
Const VOS_NT = &H40000
Const VOS__BASE = &H0
Const VOS__WINDOWS16 = &H1
Const VOS__PM16 = &H2
Const VOS__PM32 = &H3
Const VOS__WINDOWS32 = &H4
Const VOS_DOS_WINDOWS16 = &H10001
Const VOS_DOS_WINDOWS32 = &H10004
Const VOS_OS216_PM16 = &H20002
Const VOS_OS232_PM32 = &H30003
Const VOS_NT_WINDOWS32 = &H40004
Const VFT_UNKNOWN = &H0
Const VFT_APP = &H1
Const VFT_DLL = &H2
Const VFT_DRV = &H3
Const VFT_FONT = &H4
Const VFT_VXD = &H5
Const VFT_STATIC_LIB = &H7
Const VFT2_UNKNOWN = &H0
Const VFT2_DRV_PRINTER = &H1
Const VFT2_DRV_KEYBOARD = &H2
Const VFT2_DRV_LANGUAGE = &H3
Const VFT2_DRV_DISPLAY = &H4
Const VFT2_DRV_MOUSE = &H5
Const VFT2_DRV_NETWORK = &H6
Const VFT2_DRV_SYSTEM = &H7
Const VFT2_DRV_INSTALLABLE = &H8
Const VFT2_DRV_SOUND = &H9
Const VFT2_DRV_COMM = &HA
Private Type VS_FIXEDFILEINFO
dwSignature As Long
dwStrucVersionl As Integer
dwStrucVersionh As Integer
dwFileVersionMSl As Integer
dwFileVersionMSh As Integer
dwFileVersionLSl As Integer
dwFileVersionLSh As Integer
dwProductVersionMSl As Integer
dwProductVersionMSh As Integer
dwProductVersionLSl As Integer
dwProductVersionLSh As Integer
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 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 GetFileVersionInfoSize Lib "Version.dll" Alias "GetFileVersionInfoSizeA" (ByVal lptstrFilename As String, lpdwHandle As Long) 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 MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As Any, ByVal Source As Long, ByVal length As Long)
Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Dim Filename As String, Directory As String, FullFileName As String
Dim StrucVer As String, FileVer As String, ProdVer As String
Dim FileFlags As String, FileOS As String, FileType As String, FileSubType As String
Private Sub DisplayVerInfo()
Dim rc As Long, lDummy As Long, sBuffer() As Byte
Dim lBufferLen As Long, lVerPointer As Long, udtVerBuffer As VS_FIXEDFILEINFO
Dim lVerbufferLen As Long
lBufferLen = GetFileVersionInfoSize(FullFileName, lDummy)
If lBufferLen < 1 Then
MsgBox "No Version Info available!"
Exit Sub
End If
ReDim sBuffer(lBufferLen)
rc = GetFileVersionInfo(FullFileName, 0&, lBufferLen, sBuffer(0))
rc = VerQueryValue(sBuffer(0), "\", lVerPointer, lVerbufferLen)
MoveMemory udtVerBuffer, lVerPointer, Len(udtVerBuffer)
StrucVer = Format$(udtVerBuffer.dwStrucVersionh) & "." & Format$(udtVerBuffer.dwStrucVersionl)
FileVer = Format$(udtVerBuffer.dwFileVersionMSh) & "." & Format$(udtVerBuffer.dwFileVersionMSl) & "." & Format$(udtVerBuffer.dwFileVersionLSh) & "." & Format$(udtVerBuffer.dwFileVersionLSl)
ProdVer = Format$(udtVerBuffer.dwProductVersionMSh) & "." & Format$(udtVerBuffer.dwProductVersionMSl) & "." & Format$(udtVerBuffer.dwProductVersionLSh) & "." & Format$(udtVerBuffer.dwProductVersionLSl)
FileFlags = ""
If udtVerBuffer.dwFileFlags And VS_FF_DEBUG Then FileFlags = "Debug "
If udtVerBuffer.dwFileFlags And VS_FF_PRERELEASE Then FileFlags = FileFlags & "PreRel "
If udtVerBuffer.dwFileFlags And VS_FF_PATCHED Then FileFlags = FileFlags & "Patched "
If udtVerBuffer.dwFileFlags And VS_FF_PRIVATEBUILD Then FileFlags = FileFlags & "Private "
If udtVerBuffer.dwFileFlags And VS_FF_INFOINFERRE Then FileFlags = FileFlags & "Info "
If udtVerBuffer.dwFileFlags And VS_FF_SPECIALBUILD Then FileFlags = FileFlags & "Special "
If udtVerBuffer.dwFileFlags And VFT2_UNKNOWN Then FileFlags = FileFlags + "Unknown "
Select Case udtVerBuffer.dwFileOS
Case VOS_DOS_WINDOWS16
FileOS = "DOS-Win16"
Case VOS_DOS_WINDOWS32
FileOS = "DOS-Win32"
Case VOS_OS216_PM16
FileOS = "OS/2-16 PM-16"
Case VOS_OS232_PM32
FileOS = "OS/2-16 PM-32"
Case VOS_NT_WINDOWS32
FileOS = "NT-Win32"
Case other
FileOS = "Unknown"
End Select
Select Case udtVerBuffer.dwFileType
Case VFT_APP
FileType = "App"
Case VFT_DLL
FileType = "DLL"
Case VFT_DRV
FileType = "Driver"
Select Case udtVerBuffer.dwFileSubtype
Case VFT2_DRV_PRINTER
FileSubType = "Printer drv"
Case VFT2_DRV_KEYBOARD
FileSubType = "Keyboard drv"
Case VFT2_DRV_LANGUAGE
FileSubType = "Language drv"
Case VFT2_DRV_DISPLAY
FileSubType = "Display drv"
Case VFT2_DRV_MOUSE
FileSubType = "Mouse drv"
Case VFT2_DRV_NETWORK
FileSubType = "Network drv"
Case VFT2_DRV_SYSTEM
FileSubType = "System drv"
Case VFT2_DRV_INSTALLABLE
FileSubType = "Installable"
Case VFT2_DRV_SOUND
FileSubType = "Sound drv"
Case VFT2_DRV_COMM
FileSubType = "Comm drv"
Case VFT2_UNKNOWN
FileSubType = "Unknown"
End Select
Case VFT_FONT
FileType = "Font"
Select Case udtVerBuffer.dwFileSubtype
Case VFT_FONT_RASTER
FileSubType = "Raster Font"
Case VFT_FONT_VECTOR
FileSubType = "Vector Font"
Case VFT_FONT_TRUETYPE
FileSubType = "TrueType Font"
End Select
Case VFT_VXD
FileType = "VxD"
Case VFT_STATIC_LIB
FileType = "Lib"
Case Else
FileType = "Unknown"
End Select
End Sub
Private Sub Form_Load()
Me.AutoRedraw = True
Filename = "msi.dll"
Directory = getSystemDir
FullFileName = Directory & "\" & Filename
DisplayVerInfo
Me.Print "Full filename: " + FullFileName
Me.Print "File version: " + FileVer
Me.Print "Product version: " + ProdVer
Me.Print "File flags: " + FileFlags
Me.Print "File OS: " + FileOS
Me.Print "File type: " + FileType + IIf(FileSubType = "", "", " (" + FileSubType + ")")
End Sub
Public Function getSystemDir() As String
Dim sSave As String, Ret As Long
sSave = Space(255)
Ret = GetSystemDirectory(sSave, 255)
sSave = Left$(sSave, Ret)
getSystemDir = sSave
End Function
[ Eurora3D Team @ 18.09.2008. 16:54 ] @
Koliko konstanti :)
Evo sad net progameri imaju celo resenje kako da provere dali postoje instalirane komponente ... jos samo da nadju VB6 :)
[ stefanpn @ 18.09.2008. 16:59 ] @
Mislim da bi im pametnije bilo da nadju neki dobar "Package & Deployment Wizard". :)
[ Shadowed @ 18.09.2008. 17:00 ] @
Imamo mi setup project, nista vi ne brinite ;)
[ dava @ 18.09.2008. 19:06 ] @
A zasto se onda muvate po VB6 forumu :)
[ Eurora3D Team @ 18.09.2008. 23:20 ] @
Citat: dava: A zasto se onda muvate po VB6 forumu :)
Pa da vide kako moze da se proveri jel NET instaliran ... on neradi po defaultu :)
[ Shadowed @ 19.09.2008. 06:27 ] @
Citat: dava: A zasto se onda muvate po VB6 forumu :)
Iz zaje bancije ;]
[ Aleksandar Ružičić @ 19.09.2008. 15:10 ] @
bez preteranog offtopica molim, da vas ne bi bacio pod kljuc :)
Copyright (C) 2001-2025 by www.elitesecurity.org. All rights reserved.
|