PDA

View Full Version : چرا این کد جواب نمی ده؟



khomar
جمعه 22 دی 1385, 00:42 صبح
این کد برنامه های add remove program رو نشون می ده اما نمی دونم چرا جواب نمی ده جاهایی که به نظر خودم باعث می شه جواب نگیرم رو قرمز رنگ کردم تا نظر بقیه دوستان چی باشه مرسی


Const READ_CONTROL = &H20000
Const KEY_QUERY_VALUE = &H1
Const KEY_SET_VALUE = &H2
Const KEY_CREATE_SUB_KEY = &H4
Const KEY_ENUMERATE_SUB_KEYS = &H8
Const KEY_NOTIFY = &H10
Const KEY_CREATE_LINK = &H20
Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + _
KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + _
KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL


Const HKEY_LOCAL_MACHINE = &H80000002
Const ERROR_SUCCESS = 0
Const REG_SZ = 1
Const REG_DWORD = 4
Const gREGKEYSYSINFOLOC = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstal l"
'Const gREGVALSYSINFOLOC = "displayname"
Const gREGKEYSYSINFO = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstal l"
Const gREGVALSYSINFO = "displayname"

Const ERROR_BADDB = 1009&
Const ERROR_BADKEY = 1010&
Const ERROR_CANTOPEN = 1011&
Const ERROR_CANTREAD = 1012&
Const ERROR_CANTWRITE = 1013&
Const ERROR_OUTOFMEMORY = 14&
Const ERROR_INVALID_PARAMETER = 87&
Const ERROR_ACCESS_DENIED = 5&
Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, ByRef phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByVal lpData As String, ByRef lpcbData As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long

Public Function GetKeyValue(KeyRoot As Long, KeyName As String, SubKeyRef As String, ByRef KeyVal As String) As Boolean
Dim i As Long
Dim rk As Long
Dim hKey As Long
Dim hDepth As Long
Dim KeyValType As Long
Dim tmpVal As String
Dim KeyValSize As Long
rk = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey)
If (rk <> ERROR_SUCCESS) Then GoTo GetKeyError
tmpVal = String$(1024, 0)
KeyValSize = 1024
tmpVal = String$(1024, 0)
KeyValSize = 1024
rk = RegQueryValueEx(hKey, SubKeyRef, 0, _
KeyValType, tmpVal, KeyValSize)
If (rk <> ERROR_SUCCESS) Then GoTo GetKeyError

If (Asc(Mid(tmpVal, KeyValSize, 1)) = 0) Then
tmpVal = Left(tmpVal, KeyValSize - 1)
Else
tmpVal = Left(tmpVal, KeyValSize)
End If



Select Case KeyValType
Case REG_SZ
KeyVal = tmpVal
Case REG_DWORD
For i = Len(tmpVal) To 1 Step -1
KeyVal = KeyVal + Hex(Asc(Mid(tmpVal, i, 1)))
Next
KeyVal = Format$("&h" + KeyVal)
End Select

GetKeyValue = True
rk = RegCloseKey(hKey)
Exit Function
GetKeyError:
KeyVal = ""
GetKeyValue = False

'gAPIDisplayError
rk = RegCloseKey(hKey)
End Function
'Imports Microsoft.Win32
Sub gAPIDisplayError(Code&)
Select Case Code&
Case ERROR_BADDB
MsgBox "Corrupt Registry Database!"
Case ERROR_BADKEY
MsgBox "Key name is bad"
Case ERROR_CANTOPEN
MsgBox "Cannot Open Key"
Case ERROR_CANTREAD
MsgBox "Cannot Read Key"
Case ERROR_CANTWRITE
MsgBox "Cannot Write Key"
Case ERROR_ACCESS_DENIED
MsgBox "Access to Registry Denied"
Case ERROR_OUTOFMEMORY
MsgBox "Out of memory"
Case ERROR_INVALID_PARAMETER
MsgBox "Invalid Parameter"
Case Else
MsgBox "Undefined key error code!"
End Select
End Sub
Public Sub StartSysInfo()
On Error GoTo SysInfoErr

Dim rk As Long
Dim SysInfoPath As String

' Try To Get System Info Program Path\Name From Registry...
If GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFO, gREGVALSYSINFO, SysInfoPath) Then
Else
GoTo SysInfoErr
End If
SysInfoErr:
MsgBox "System Information Is Unavailable At This Time", vbOKOnly
End Sub
Private Sub Command1_Click()
'Dim names() As String
StartSysInfo


'names = rk.RegQueryValueEx()
' For i = 0 To i Step 1
' StartSysInfo
' If i < names.Length Then
' List1.List = RegQueryValueEx()
'List1.List = StartSysInfo
' Next i
End Sub

Ner'zhul Arthas
جمعه 22 دی 1385, 02:02 صبح
Const gREGKEYSYSINFOLOC = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninsta ll"

Const gREGKEYSYSINFO = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninsta ll"


مشکل از این نیست که Uninstall جدا نوشته شده؟
Uninsta ll نوشته شده؟

khomar
جمعه 22 دی 1385, 12:11 عصر
نه به خاطر جدا نوشتن unistall نیست چون تو برنامه سر هم نوشته نشده

googoole
جمعه 22 دی 1385, 12:41 عصر
برنامه ای که نوشتی مشکلی نداره و درست عمل میکنه ولی ازش چی میخوای این تیکه برنامه می تونه یکی از پارامترهای مورد درخواست شما رو در ریجستری جستجو کنه و وجود و عدم وجود اونو اطلاع بده و همچنین مقدار یک کلید درخواستی رو نمایش بده و کاملا صحیح عمل می کنه حالا مشکل شما چیه و چه پیغامی رو دریافت می کنید .
فقط یک مشکل کوچیک داره اونم اینه که به هر حال پیغام ارور رو نشون می ده اونم به دلیل اینه که بعد از end if برنامه نویس یادش رفته یک Exit sub بنویسه

khomar
جمعه 22 دی 1385, 17:19 عصر
توضیحاتی که شما گفتید کاملا درسته اما من می خواستم بیاد تمام برنامه ها که در قسمت unistall رجستری هست رو نشون بده در واقع این برنامه یه جورایی شبیه سوال dalan هست که قبلا سوال کرده بودند و کسی جواب ایشون رو نداده بود اما من برنامه رو نوشتم و با مشکل مواجه شدم برنامه تمام برنامه های نصب شده یا همون برنامه هایی که در قسمت unistall هست رو نشون نمی ده البته هنوز برنامه در قسمت command ناقصه
من می خوام دوستان منو کمک کنم تا بتونم بقیه برنامه رو هم بنویسم و برنامه بتونه برنامه های نصب شده رو نشون بده
از توضیحاتتون ممنون

Payman62
شنبه 23 دی 1385, 12:31 عصر
سلام.
چطوری خمار. چرا از خودم نمیپرسی. تو که مسیر uninstall تو رجیستری رو تو یاهو ازم پرسیدی اینم میپرسیدی دیگه.
همون موقع هم بهت گفتم تو باید تو اون مسیر کل کلید ها رو چک کنی. یه حلقه باید بذاری که تا موقعی که کلید پیدا میکنه بچرخه.
کد سرچ به این روش تو یه کلید خاص رو هم تو اون لینکی که تو یاهو بهت دادم نوشتم. اگه دقت میکردی متوجه میشدی.

khomar
شنبه 23 دی 1385, 14:50 عصر
سلام.
چطوری خمار. چرا از خودم نمیپرسی. تو که مسیر uninstall تو رجیستری رو تو یاهو ازم پرسیدی اینم میپرسیدی دیگه.
همون موقع هم بهت گفتم تو باید تو اون مسیر کل کلید ها رو چک کنی. یه حلقه باید بذاری که تا موقعی که کلید پیدا میکنه بچرخه.
کد سرچ به این روش تو یه کلید خاص رو هم تو اون لینکی که تو یاهو بهت دادم نوشتم. اگه دقت میکردی متوجه میشدی.

مرسی خوب همیشه که نباید مزاحم شما شد:لبخند:
ممنون با چیزاهایی که گفتی یه کارایی رو کدم انجام می دم اگه باز ایراد داشتم می ام می پرسم:لبخند: :خجالت:

khomar
یک شنبه 24 دی 1385, 00:54 صبح
من یه کوچولو کدم رو تغییر دادم (اونم توی error ها ) اما باعث می شده که این error رو بهم بده
undefiesnd key error code
این حلقه ای که می گی باید قبل از RegQueryValueEx باشه
من تو اون linke چیزی در مورد حلقه و این جور چیزا ندیدم فقط در مورد RegEnumValueA بحث شده بود