نیاز به سورس برای ذخیره در فایل ini یا رجیستری

[unforgiven]

سلام به همگی
من احتیاج به فایل ini برای ذخیره چند تنظیم دارم
مثلا وارد کردن اطلاعات فقط یکبار در اولین اجرای برنامه و چند چیز دیگه
هر چی در مورد این ini
خوندم نتئنستم مشابه سازی کنم
لطفا اگه کسی میتونه سورس ساخت و نوشتن و خوندن این فایل رو بزاره
پیشاپیش ممنونم

[PalizeSoftware]

اینجوری با ini‌ کار کن:


Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long

Private Sub Command1_Click()
Dim strRet As String
Dim lRet As Long

WritePrivateProfileString "MyProgram", "LastDate", "1384/06/15", "me.ini"

strRet = Space(128)
lRet = GetPrivateProfileString("MyProgram", "LastDate", "", strRet, 128, "me.ini")
strRet = Left(strRet, lRet)
Me.Caption = strRet
End Sub

[حامد مصافی]

سلام
از کلاس زیر برای کار با فایل های ini استفاده کنید


Option Explicit

' Projet name :Ini Class
' Programer : Hamed Masafi
' Hamed.Masafi@GMail.com

'--- Start API Declares --------------------------------------------------
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function PathFileExistsA Lib "shlwapi.dll" (ByVal pszPath As String) As Long

'--- Start Variables -----------------------------------------------------
Dim m_IniFileName As String


'--- Start Methods -------------------------------------------------------
Public Function GetData(Section As String, _
Key As String, _
Optional Default As Variant = vbNullString) As Variant

Dim Msg, Success, X As String
Dim Result As String * 128
Result = Space(128)

If m_IniFileName = vbNullString Then
Err.Raise 1, "cINI", "The ini file name not set"
End If

Success = GetPrivateProfileString(Section, Key, "", Result, Len(Result), m_IniFileName)
If Left$(Result, 1) <> Chr$(0) Then
X = Left$(Result, InStr(Result, Chr$(0)) - 1)
Else
X = Default
End If
GetData = X

End Function

Public Sub SetData(Section As String, _
Key As String, _
Value As String)

Dim Msg, Success As String
Dim booR As Boolean
Dim Result As String * 128

If m_IniFileName = vbNullString Then
Err.Raise 1, "cINI", "The ini file name not set"
End If

Result = WritePrivateProfileString(Section, Key, Value, m_IniFileName)
'Success = GetPrivateProfileString(Section, Keyword, "", Result, Len(Result), FileName)
' If Result <> 0 Then
' booR = True
' Else
' booR = False
' End If
' SetToIni = booR

End Sub

Private Sub CreateFile(sFileName As String)
On Error GoTo File_Access_Error
If PathFileExistsA(sFileName) = 0 Then
Open sFileName For Output As #1
Close #1
End If

Exit Sub
File_Access_Error:
Err.Raise 2, "cINI", "Can not open file"
End Sub

'--- Stsrt Properties Block ----------------------------------------------
Public Property Get IniFileName() As String
IniFileName = m_IniFileName
End Property

Public Property Let IniFileName(ByVal vNewValue As String)
m_IniFileName = vNewValue
CreateFile vNewValue
End Property


اینم یه ماژول برای رجیستری


Rem Hamed Masafi
Rem Ineed: No Module!


Option Explicit
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" ( _
ByVal hKey As Long, _
ByVal lpSubKey As String, _
ByVal Reserved As Long, _
ByVal lpClass As String, _
ByVal dwOptions As Long, _
ByVal samDesired As Long, _
ByRef lpSecurityAttributes As SECURITY_ATTRIBUTES, _
ByRef phkResult As Long, _
ByRef lpdwDisposition 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, _
ByRef 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, _
ByRef lpType As Long, _
ByVal lpData As String, _
ByRef 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, _
ByVal lpData As String, _
ByVal cbData As Long) As Long
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" ( _
ByVal hKey As Long, _
ByVal lpValueName As String) As Long

' Reg Data Types...
Const REG_SZ = 1 ' Unicode nul terminated string
Const REG_EXPAND_SZ = 2 ' Unicode nul terminated string
Const REG_DWORD = 4 ' 32-bit number

' Reg Create Type Values...
Const REG_OPTION_NON_VOLATILE = 0 ' Key is preserved when system is rebooted

' Reg Key Security Options...
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_WRITE = KEY_SET_VALUE + KEY_CREATE_SUB_KEY + READ_CONTROL

Const KEY_READ = KEY_QUERY_VALUE + _
KEY_ENUMERATE_SUB_KEYS + _
KEY_NOTIFY + _
READ_CONTROL
Const KEY_EXECUTE = KEY_READ
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

'This lines disabled by me' Reg Key ROOT Types...
'Const HKEY_CLASSES_ROOT = &H80000000
'Const HKEY_CURRENT_USER = &H80000001
'Const HKEY_LOCAL_MACHINE = &H80000002
'Const HKEY_USERS = &H80000003
'Const HKEY_PERFORMANCE_DATA = &H80000004

' Return Value...
Const ERROR_NONE = 0
Const ERROR_BADKEY = 2
Const ERROR_ACCESS_DENIED = 8
Const ERROR_SUCCESS = 0

'---------------------------------------------------------------
'- This lines added with me
'---------------------------------------------------------------

Public Enum eKeyRoot
HKEY_CLASSES_ROOT = &H80000000
HKEY_CURRENT_USER = &H80000001
HKEY_LOCAL_MACHINE = &H80000002
HKEY_USERS = &H80000003
HKEY_PERFORMANCE_DATA = &H80000004
End Enum

'---------------------------------------------------------------
'- Registry Security Attributes TYPE...
'---------------------------------------------------------------
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Boolean
End Type

Public Function RegWriteA(KeyRoot As eKeyRoot, KeyName As String, SubKeyName As String, SubKeyValue As String) As Boolean
Dim rc As Long ' Return Code
Dim hKey As Long ' Handle To A Registry Key
Dim hDepth As Long '
Dim lpAttr As SECURITY_ATTRIBUTES ' Registry Security Type

lpAttr.nLength = 50 ' Set Security Attributes To Defaults...
lpAttr.lpSecurityDescriptor = 0 ' ...
lpAttr.bInheritHandle = True ' ...

'------------------------------------------------------------
'- Create/Open Registry Key...
'------------------------------------------------------------
rc = RegCreateKeyEx(KeyRoot, _
KeyName, _
0, _
REG_SZ, _
REG_OPTION_NON_VOLATILE, _
KEY_ALL_ACCESS, _
lpAttr, _
hKey, _
hDepth) ' Create/Open //KeyRoot//KeyName

If (rc <> ERROR_SUCCESS) Then GoTo CreateKeyError ' Handle Errors...

'------------------------------------------------------------
'- Create/Modify Key Value...
'------------------------------------------------------------
If (SubKeyValue = vbNullString) Then SubKeyValue = " " ' A Space Is Needed For RegSetValueEx() To Work...

rc = RegSetValueEx(hKey, _
SubKeyName, _
0, _
REG_SZ, _
SubKeyValue, _
LenB(StrConv(SubKeyValue, vbFromUnicode)))

If (rc <> ERROR_SUCCESS) Then GoTo CreateKeyError ' Handle Error
'------------------------------------------------------------
'- Close Registry Key...
'------------------------------------------------------------
rc = RegCloseKey(hKey) ' Close Key

RegWriteA = True ' Return Success
Exit Function ' Exit
CreateKeyError:
RegWriteA = False ' Set Error Return Code
rc = RegCloseKey(hKey) ' Attempt To Close Key
End Function

Public Function RegReadA(KeyRoot As eKeyRoot, _
KeyName As String, _
SubKeyRef As String, _
Optional ElseValue As String = vbNullString) As String
Dim I As Long ' Loop Counter
Dim rc As Long ' Return Code
Dim hKey As Long ' Handle To An Open Registry Key
Dim hDepth As Long '
Dim sKeyVal As String
Dim lKeyValType As Long ' Data Type Of A Registry Key
Dim tmpVal As String ' Tempory Storage For A Registry Key Value
Dim KeyValSize As Long ' Size Of Registry Key Variable

' Open RegKey Under KeyRoot {HKEY_LOCAL_MACHINE...}
'------------------------------------------------------------
rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey)

If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError ' Handle Error...

tmpVal = String$(1024, 0) ' Allocate Variable Space
KeyValSize = 1024 ' Mark Variable Size

'------------------------------------------------------------
' Retrieve Registry Key Value...
'------------------------------------------------------------
rc = RegQueryValueEx(hKey, SubKeyRef, 0, _
lKeyValType, tmpVal, KeyValSize) ' Get/Create Key Value

If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError ' Handle Errors

tmpVal = Left$(tmpVal, InStr(tmpVal, Chr(0)) - 1)

'------------------------------------------------------------
' Determine Key Value Type For Conversion...
'------------------------------------------------------------
Select Case lKeyValType ' Search Data Types...
Case REG_SZ, REG_EXPAND_SZ ' String Registry Key Data Type
sKeyVal = tmpVal ' Copy String Value
Case REG_DWORD ' Double Word Registry Key Data Type
For I = Len(tmpVal) To 1 Step -1 ' Convert Each Bit
sKeyVal = sKeyVal + Hex(Asc(Mid(tmpVal, I, 1))) ' Build Value Char. By Char.
Next
sKeyVal = Format$("&h" + sKeyVal) ' Convert Double Word To String
End Select

RegReadA = sKeyVal
rc = RegCloseKey(hKey) ' Close Registry Key
Exit Function

GetKeyError:
RegReadA = ElseValue
rc = RegCloseKey(hKey) ' Close Registry Key
End Function

Public Function RegDeleteA(KeyRoot As eKeyRoot, _
KeyName As String, _
SubKeyRef As String) As Boolean
Dim rc As Long
Dim hKey As Long
Dim df As Long

rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey)
If (rc <> ERROR_SUCCESS) Then GoTo DeleteKeyError ' Handle Error...
df = RegDeleteValue(hKey, SubKeyRef)
RegDeleteA = df = 0

Exit Function
DeleteKeyError:
RegDeleteA = df = 0
End Function

[unforgiven]

سلام دوستان
از همتون ممنونم
حتما استفاده می کنم و نتیجه رو می گم
خیلی ممنون

[pmn.asd]

سلام
دوست عزیز ماژول خیلی مفیدی بود. خیلی به دردم خورد. حوصله نوشتنش رو نداشتم. دستت درد نکه.