ثبت تعداد دفعات اجرای برنامه

[Rasool-GH]

سلام
من برای شمارش و ثبت تعداد دفعات اجرای برنامه و زمان اجرای اون یک جدول ایجاد کردم و هر بار که برنامه اجرا میشه مقدار قبلی خونده میشه و یک واحد به اون اضافه میشه و در جدول ذخیره میشه . بعد از اتمام کار برنامه قبل از بستن برنامه زمان استفاده از برنامه هم با زمان قبلی جمع میشه و در همون فیلد ذخیره میشه .
سوالم اینه که روش بهتری برای این کار میتونید معرفی کنید
به طور مثال ذخیره این مقادیر در رجیستری به چه صورت باید انجام بشه ؟
برای شمارش تعداد کلیک چه کدی استفاده میکنید که سراسری باشه و وابسته به فرم نباشه . یعنی لازم نباشه در یک رویداد خاص از هر فرم نوشته بشه ؟

[Rasool-GH]

چرا هیچکی منو دوس نداره . :افسرده:
یه کمکی . راهنمایی . چیزی

[amirzazadeh]

از اين لينك كمك بگيريد:

(http://vba-corner.livejournal.com/3054.html)http://4linecode.mihanblog.com/post/24

http://vba-corner.livejournal.com/3054.html

[Rasool-GH]

خیلی لطف کردید جناب میرزا زاده . ایا روش های دیگه ای هم برای این کار پیشنهاد میکنید ؟


توابع GetSetting و SaveSetting

SevaSettingمقداری (کلیدی) را در رجیستری ذخیره میکند و تابع GetSetting آن مقدار را فراخوانی می کند. دستوات SeveSetting ، GetSetting، از توابع خود ویژوال بیسیک هستند و نیازی به فراخوانی اونا نیست. طرز کار این دستورات خیلی ساده است، این دستورات فقط برای ثبت و بازیابی تنظیمات استفاده میشن و هیچ کار دیگه ای انجام نمیدن (مثلا در تکس باکس مقداری را نوشتی و برنامه رو بستی و با اجرای دوباره برنامه اون مقدار تکست باشه یا مثلا میخوای اگر کاربر نام رمز را از n دفعه بیشتر اشتباه وارد کرد دیگر نتونه از برنامتون استفاده کنه و ...(،در واقع محدوده عملیات این دستورات در رجیستری محدود به این آدرس است:

HKEY_CURRENT_USER\Software\VB and VBA Program Settings

SevaSetting: این دستور بسیار ساده ست. ببینید در واقع این دستور اولین کاری که میکنه، یک پوشه که بیانگر نام برنامه ست (AppName) در آدرسی که گفتم میسازه. بعدش میره سراغ پوشه بعدی (Section) یعنی عملیاتی که قراره انجام بدیم مثلاً اگر قراره تست اینکه چند بار رمز اشتباه وارد شده. که من اسم پوشه را گذاشتم freemind و بعد از اون هم کلید یا همون مقداری که باید ذخیره بشه مثل passcheck. به دستور زیر توجّه کنید:

Dim i As String



Private Sub Form_Load()
i = GetSetting("af", "freemind", "PassCheck", "0")
If i >= 5 Then
MsgBox "shoma digar nemitavanid az in barname estefade konid", , "end"
End
End If
End Sub



Private Sub Command1_Click()
i = GetSetting("af", "freemind", "PassCheck", "0")
If i >= 5 Then
MsgBox "shoma digar nemitavanid az in barname estefade konid", , "end"
Text1.Enabled = False
End If
If Text1.Text <> "programming" Then
SaveSetting "af", "freemind", "PassCheck", Val(i) + 1
MsgBox "shma faghat mitavanid " & 5 - (i + 1) & " dafe digar az in barname estefade konid ", , "fazell nasiri"
Else
SaveSetting "af", "freemind", "PassCheck", "0"
MsgBox "miss you", , "fazell nasiri"
End If
End Sub

در همون لحظه اول اجرا با دستور GetSetting مقدار را فراخوانی کردیم و چون برای اولین باره که برنامه اجرا میشه پس مقدار 0 برمیگردونه. و در این رویداد تست میشه آیا مقدار برگشتی بزرگتر مساویه 5 است یا خیر که اگه بود یه اختار میده که دیگه نمیتونید از این برنامه استفاده کنید و برنامه را می بنده.در رویداد کلید هم تست میکنه که آیا اگر رمز را درست وارد کردید مقدار کلید 0 را در رجیستری ذخیره کنه که رمز programming هست . ولی اگه اشتباه بوده به مقدار متغیر یکی اضافه میکنه و اونو در رجیستری ذخیره مینماید.

منبع : http://4linecode.mihanblog.com/post/24

[Rasool-GH]

اصل مطالب رو به اینجا منتقل کردم که بعدها از دسترس خارج نشه


Read and Write Windows Registry with VBA
VBA offers the functions GetSetting, SaveSetting, GetAllSettings and DeleteSetting for reading and writing the Windows Registry. (For detailed info see the Microsoft VBA help for these functions or look at the MSDN (http://msdn2.microsoft.com/en-us/library/aa155437%28office.10%29.aspx))

But unfortunately you can't access the entire registry, only the path HKEY_CURRENT_USER\Software\VB and VBA Program Settings\. So you can create, save and read user settings for your own Visual Basic application, but you can't access settings for any other application (e.g. the Default download directory for the Internet Explorer, which, btw, is HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Download Directory)

Fortunately, when programming with VBA, you're not limited to what functionality VBA offers. By making use of Windows Scripting features, you can access the entire Window Registry quite easily.

Reading from the Registry:



'reads the value for the registry key i_RegKey
'if the key cannot be found, the return value is ""
Function RegKeyRead(i_RegKey As String) As String
Dim myWS As Object

On Error Resume Next
'access Windows scripting
Set myWS = CreateObject("WScript.Shell")
'read key from registry
RegKeyRead = myWS.RegRead(i_RegKey)
End Function



Checking if a Registry key exists:



'returns True if the registry key i_RegKey was found
'and False if not
Function RegKeyExists(i_RegKey As String) As Boolean
Dim myWS As Object

On Error GoTo ErrorHandler
'access Windows scripting
Set myWS = CreateObject("WScript.Shell")
'try to read the registry key
myWS.RegRead i_RegKey
'key was found
RegKeyExists = True
Exit Function

ErrorHandler:
'key was not found
RegKeyExists = False
End Function



Saving a Registry key:



'sets the registry key i_RegKey to the
'value i_Value with type i_Type
'if i_Type is omitted, the value will be saved as string
'if i_RegKey wasn't found, a new registry key will be created
Sub RegKeySave(i_RegKey As String, _
i_Value As String, _
Optional i_Type As String = "REG_SZ")
Dim myWS As Object

'access Windows scripting
Set myWS = CreateObject("WScript.Shell")
'write registry key
myWS.RegWrite i_RegKey, i_Value, i_Type

End Sub



Deleting a key from the Registry:



'deletes i_RegKey from the registry
'returns True if the deletion was successful,
'and False if not (the key couldn't be found)
Function RegKeyDelete(i_RegKey As String) As Boolean
Dim myWS As Object

On Error GoTo ErrorHandler
'access Windows scripting
Set myWS = CreateObject("WScript.Shell")
'delete registry key
myWS.RegDelete i_RegKey
'deletion was successful
RegKeyDelete = True
Exit Function

ErrorHandler:
'deletion wasn't successful
RegKeyDelete = False
End Function



These functions need the Registry key with its complete path, so i_RegKey must always begin with one of the following values:

HKCU or HKEY_CURRENT_USER
HKLM or HKEY_LOCAL_MACHINE
HKCR or HKEY_CLASSES_ROOT
HKEY_USERS
HKEY_CURRENT_CONFIG

and end with the name of the key...

RegKeySave also has an input parameter for the type of the Registry key value. Supported are the following types:

REG_SZ - A string. If the type is not specified, this will be used as Default.
REG_DWORD - A 32-bit number.
REG_EXPAND_SZ - A string that contains unexpanded references to environment variables.
REG_BINARY - Binary data in any form. You really shouldn't touch such entries.

You can find more info about Registry value types (http://msdn2.microsoft.com/en-us/library/ms724884.aspx) in the MSDN.


Finally, here's a little program for testing the above functions:



Sub TestRegistry()
Dim myRegKey As String
Dim myValue As String
Dim myAnswer As Integer

'get registry key to work with
myRegKey = InputBox("Which registry key do you want to read?", _
"Get Registry Key")
If myRegKey = "" Then Exit Sub
'check if key exists
If RegKeyExists(myRegKey) = True Then
'key exists, read it
myValue = RegKeyRead(myRegKey)
'display result and ask if it should be changed
myAnswer = MsgBox("The registry value for the key """ & _
myRegKey & """" & vbCr & "is """ & myValue & _
"""" & vbCr & vbCr & _
"Do you want to change it?", vbYesNo)
Else
'key doesn't exist, ask if it should be created
myAnswer = MsgBox("The registry key """ & myRegKey & _
""" could not be found." & vbCr & vbCr & _
"Do you want to create it?", vbYesNo)
End If
If myAnswer = vbYes Then
'ask for new registry key value
myValue = InputBox("Please enter new value:", _
myRegKey, myValue)
If myValue <> "" Then
'save/create registry key with new value
RegKeySave myRegKey, myValue
MsgBox "Registry key saved."
End If
End If

'ask if key should be deleted from registry
myAnswer = MsgBox("Do you want to delete the registry key """ & _
myRegKey & """?", vbYesNo)
If myAnswer = vbYes Then
'delete registry key
If RegKeyDelete(myRegKey) = True Then
'deletion was successful
MsgBox "Registry key """ & myRegKey & """ deleted."
Else
'deletion wasn't successful
MsgBox "Registry key """ & myRegKey & _
""" could not be deleted."
End If
End If
End Sub



Of course, the usual warnings apply:
Don't mess around with the Registry if you don't know what you're doing, or it could have severe consequences! If you change entries you're not too sure about, backup the registry first! Don't delete entries, better rename them, so you can easily get them back if your change didn't what you wanted! Only delete them when you're absolutely sure you (and neither Windows nor any application) don't need them anymore! You change the Registry at your own risk!

منبع : http://vba-corner.livejournal.com/3054.html