2. Masukan Code di bawah ini ke dalam Form :
'Tambahkan 5 buak textbox dan sebuah command button
Option Explicit
'Untuk mencatat ke ini file
Private Sub Command1_Click()
WriteIniValue App.Path & "\Test.ini", "konfigurasi", "Server", Text1.Text
WriteIniValue App.Path & "\Test.ini", "konfigurasi", "Database", Text2.Text
WriteIniValue App.Path & "\Test.ini", "konfigurasi", "User", Text3.Text
WriteIniValue App.Path & "\Test.ini", "konfigurasi", "Password", Text4.Text
WriteIniValue App.Path & "\Test.ini", "keterangan", "data", Text5.Text
Unload Me
End Sub
'Untuk membaca ke ini file
Private Sub Form_Load()
Text1.Text = ReadIniValue(App.Path & "\Test.ini", "konfigurasi", "Server")
Text2.Text = ReadIniValue(App.Path & "\Test.ini", "konfigurasi", "Database")
Text3.Text = ReadIniValue(App.Path & "\Test.ini", "konfigurasi", "User")
Text4.Text = ReadIniValue(App.Path & "\Test.ini", "konfigurasi", "Password")
Text5.Text = ReadIniValue(App.Path & "\Test.ini", "keterangan", "data")
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If UnloadMode = 0 Then Cancel = 1
End Sub
3. Lalu masukan Code di bawah ini, ke dalam Modul, nama (terserah) :
Option Explicit
'Untuk membaca isi ini file
Public Function ReadIniValue(INIpath As String, KEY As String, Variable As String)
Dim NF As Integer
Dim Temp As String
Dim LcaseTemp As String
Dim ReadyToRead As Boolean
AssignVariables:
NF = FreeFile
ReadIniValue = ""
KEY = "[" & LCase$(KEY) & "]"
Variable = LCase$(Variable)
EnsureFileExists:
Open INIpath For Binary As NF
Close NF
SetAttr INIpath, vbArchive
LoadFile:
Open INIpath For Input As NF
While Not EOF(NF)
Line Input #NF, Temp
LcaseTemp = LCase$(Temp)
If InStr(LcaseTemp, "[") <> 0 Then ReadyToRead = False
If LcaseTemp = KEY Then ReadyToRead = True
If InStr(LcaseTemp, "[") = 0 And ReadyToRead = True Then
If InStr(LcaseTemp, Variable & "=") = 1 Then
ReadIniValue = Mid$(Temp, 1 + Len(Variable & "="))
Close NF: Exit Function
End If
End If
Wend
Close NF
End Function
'Untuk menulis ke ini file
Public Function WriteIniValue(INIpath As String, PutKey As String, PutVariable As String, PutValue As String)
Dim Temp As String
Dim LcaseTemp As String
Dim ReadKey As String
Dim ReadVariable As String
Dim LOKEY As Integer
Dim HIKEY As Integer
Dim KEYLEN As Integer
Dim VAR As Integer
Dim VARENDOFLINE As Integer
Dim NF As Integer
Dim X As Integer
AssignVariables:
NF = FreeFile
ReadKey = vbCrLf & "[" & LCase$(PutKey) & "]" & Chr$(13)
KEYLEN = Len(ReadKey)
ReadVariable = Chr$(10) & LCase$(PutVariable) & "="
EnsureFileExists:
Open INIpath For Binary As NF
Close NF
SetAttr INIpath, vbArchive
LoadFile:
Open INIpath For Input As NF
Temp = Input$(LOF(NF), NF)
Temp = vbCrLf & Temp & "[]"
Close NF
LcaseTemp = LCase$(Temp)
LogicMenu:
LOKEY = InStr(LcaseTemp, ReadKey)
If LOKEY = 0 Then GoTo AddKey:
HIKEY = InStr(LOKEY + KEYLEN, LcaseTemp, "[")
VAR = InStr(LOKEY, LcaseTemp, ReadVariable)
If VAR > HIKEY Or VAR < LOKEY Then GoTo AddVariable:
GoTo RenewVariable:
AddKey:
Temp = Left$(Temp, Len(Temp) - 2)
Temp = Temp & vbCrLf & vbCrLf & "[" & PutKey & "]" & vbCrLf & PutVariable & "=" & PutValue
GoTo TrimFinalString:
AddVariable:
Temp = Left$(Temp, Len(Temp) - 2)
Temp = Left$(Temp, LOKEY + KEYLEN) & PutVariable & "=" & PutValue & vbCrLf & Mid$(Temp, LOKEY + KEYLEN + 1)
GoTo TrimFinalString:
RenewVariable:
Temp = Left$(Temp, Len(Temp) - 2)
VARENDOFLINE = InStr(VAR, Temp, Chr$(13))
Temp = Left$(Temp, VAR) & PutVariable & "=" & PutValue & Mid$(Temp, VARENDOFLINE)
GoTo TrimFinalString:
TrimFinalString:
Temp = Mid$(Temp, 2)
Do Until InStr(Temp, vbCrLf & vbCrLf & vbCrLf) = 0
Temp = Replace(Temp, vbCrLf & vbCrLf & vbCrLf, vbCrLf & vbCrLf)
Loop
Do Until Right$(Temp, 1) > Chr$(13)
Temp = Left$(Temp, Len(Temp) - 1)
Loop
Do Until Left$(Temp, 1) > Chr$(13)
Temp = Mid$(Temp, 2)
Loop
OutputAmendedINIFile:
Open INIpath For Output As NF
Print #NF, Temp
Close NF
End Function
4. Lalu RUN aplikasi.
Sumber : http://cimahi-one.com
2 komentar:
ms, minta sc.nya kirim ke nurhofik31@mail.com
Nur Hofik, Source code.nya kan tinggal di copy paste aja bro...
Posting Komentar
Setelah melihat - lihat, Alangkah baiknya memberikan komentar mengenai Blog ini.
Kritik dan Saran teman-teman semua, Saya anggap sebagai masukan buat saya... terima kasih telah berkunjung