strong46202
پنج شنبه 11 اسفند 1390, 13:19 عصر
HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Office\12.0\ Access Connectivity Engine\Engines\ACE\MaxBufferSize
یکی از دوستان گفته بود با تغییر سایز بافر میشه سرعت اجرای اکسس رو افزایش داد. حالا من میخوام این کد رو در form_load بزارم تا با این روش تا اندازه ای سرعت کم لود شدن فرم ها رو جبران کنم....کسی از دوستان میدونه که چطور با کد vba میشه میزان بافر رو در ریجستری افزایش بدم ؟
ARData
پنج شنبه 11 اسفند 1390, 17:14 عصر
اين کد ايجاد لود شدن يک برنامه در هنگام باز شدن ويندوز هست با توجه به عمکرد اين کد شما مي توانيد با معادل سازي نمونه خودتان به اجراش بذاريد :
Dim StrArshadLen As Variant
StrArshadLen = Len("C:\Windows\System32\regedit.exe")
Dim r As Long
r = RegCreateKey(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Run", keyhand)
r = RegSetValueEx(keyhand, "Regedt", 0, REG_SZ, ByVal ("C:\Windows\System32\regedit.exe"), StrArshadLen)
r = RegCloseKey(keyhand)
ARData
یک شنبه 14 اسفند 1390, 09:01 صبح
البته استفاده از کل توابع Api مربوط به رجيستري به صرت زير مي باشد :
Private Const REG_SZ As Long = 1
Private Const REG_DWORD As Long = 4
Private Const HKEY_CLASSES_ROOT = &H80000000
Private Const HKEY_CURRENT_USER = &H80000001
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const HKEY_USERS = &H80000003
Private Const ERROR_SUCCESS = 0
Private Const ERROR_NONE = 0
Private Const KEY_QUERY_VALUE = &H1
Private Const KEY_ALL_ACCESS = &H3F
'فراخواني کدهاي API جهت نوشتن رجيستري
'بستن کليد رجيستري
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 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 RegQueryValueExString Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long
'پرس جوي يک مقدار از نوع Long در رجيستري
Private Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Long, lpcbData As Long) As Long
'پرس و جوي مقدار خالي در رجيستري
Private Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As Long, lpcbData As Long) As Long
'شمارش کليد هاي تابع
Private Declare Function RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, ByVal cbName 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
'حذف کليد (Key)
Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
Private Sub SaveValue(hKey As Long, strPath As String, strvalue As String, strData As String)
Dim ret
'ايجاد کليد جديد
RegCreateKey hKey, strPath, ret
'ذخيره مقدار در کليد
RegSetValueEx ret, strvalue, 0, REG_SZ, ByVal strData, Len(strData)
'بستن کليد (Key)
RegCloseKey ret
End Sub
Private Sub QueryValue(sKeyName As String, sValueName As String)
Dim lRetVal As Long
Dim hKey As Long
Dim vValue As Variant
lRetVal = RegOpenKeyEx(HKEY_LOCAL_MACHINE, sKeyName, 0, KEY_QUERY_VALUE, hKey)
lRetVal = QueryValueEx(hKey, sValueName, vValue)
frmRegistry.Caption = vValue
RegCloseKey (hKey)
End Sub
Function QueryValueEx(ByVal lhKey As Long, ByVal szValueName As String, vValue As Variant) As Long
Dim Data As Long
Dim retval As Long
Dim lType As Long
Dim lValue As Long
Dim sValue As String
On Error GoTo QueryValueExError
retval = RegQueryValueExNULL(lhKey, szValueName, 0&, lType, 0&, Data)
If retval <> ERROR_NONE Then Error 5
Select Case lType
Case REG_SZ:
sValue = String(Data, 0)
retval = RegQueryValueExString(lhKey, szValueName, 0&, lType, sValue, Data)
If retval = ERROR_NONE Then
vValue = Left$(sValue, Data - 1)
Else
vValue = Empty
End If
Case REG_DWORD:
retval = RegQueryValueExLong(lhKey, szValueName, 0&, lType, lValue, Data)
If retval = ERROR_NONE Then vValue = lValue
Case Else
retval = -1
End Select
QueryValueExError:
QueryValueEx = retval
Exit Function
End Function
Private Sub cmdCreateKey_Click()
SaveValue HKEY_LOCAL_MACHINE, "Software\" & CurrentProject.Name, "Test", "Testing123"
End Sub
Private Sub cmdDelete_Click()
DeleteSetting CurrentProject.Name, "Form Location"
cmdGet.Enabled = False
MsgBox "The section - Form Location - has been deleted from the " & CurrentProject.Name & " Registry Key"
End Sub
Private Sub cmdDeleteKey_Click()
RegDeleteKey HKEY_LOCAL_MACHINE, "Software\" & CurrentProject.Name
MsgBox "The key - " & CurrentProject.Name & " - has been deleted from HKEY_LOCAL_MACHINE\Software Key"
End Sub
Private Sub cmdEnumKeys_Click()
Dim strvalue As String
Dim lDataLen As Long
Dim lresult As Long
Dim lValueLen As Long
Dim lCurIdx As Long
Dim lRetVal As Long
Dim hKeyResult As Long
lRetVal = RegOpenKeyEx(HKEY_LOCAL_MACHINE, "Software\Microsoft", 0, KEY_ALL_ACCESS, hKeyResult)
If lRetVal = ERROR_SUCCESS Then
lCurIdx = 0
lDataLen = 32
lValueLen = 32
Do
strvalue = String(lValueLen, 0)
lresult = RegEnumKey(hKeyResult, lCurIdx, strvalue, lDataLen)
If lresult = ERROR_SUCCESS Then
txtEnumKeys.Text = txtEnumKeys & vbCrLf & Left(strvalue, lValueLen)
End If
lCurIdx = lCurIdx + 1
Loop While lresult = ERROR_SUCCESS
RegCloseKey hKeyResult
Else
MsgBox "Cannot Open Key"
End If
End Sub
Private Sub cmdGet_Click()
Dim strTop As String
Dim strLeft As String
strLeft = GetSetting(CurrentProject.Name, "Form Location", "Left")
strTop = GetSetting(CurrentProject.Name, "Form Location", "Top")
frmRegistry.Left = CInt(strLeft)
frmRegistry.Top = CInt(strTop)
End Sub
Private Sub cmdGetAll_Click()
Dim arrAllSettings As Variant
arrAllSettings = GetAllSettings(CurrentProject.Name, "Form Location")
txtGetAllSettings.Text = arrAllSettings(0, 0) & " = " & arrAllSettings(0, 1) & vbCrLf
txtGetAllSettings.Text = txtGetAllSettings.Text & arrAllSettings(1, 0) & " = " & arrAllSettings(1, 1)
End Sub
Private Sub cmdQueryValue_Click()
QueryValue "Software\" & CurrentProject.Name, "Test"
End Sub
vBulletin® v4.2.5, Copyright ©2000-1403, Jelsoft Enterprises Ltd.