Sabtu, 16 Juni 2012

Setting konfigurasi dengan (*.ini) file

1. Siapkan 5 TexsBox dan 1 CommandButton.

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:

zenlypay mengatakan...

ms, minta sc.nya kirim ke nurhofik31@mail.com

CAP INFO TECH mengatakan...

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