Selasa, 03 Juni 2008

Sedikit share nih buat yang baru nyoba pemrograman vb 6..
Di dalam pemrograman biasanya diperlukan untuk menyimpan data-data runtime ke dalam sebuah file, biasanya berformat *.txt atau extensi lain sesuai keinginan. Output dari sebuah hitungan program yang kita buat juga bisa memakai cara ini.

Berikut saya ambil contoh dari program saya WaterDest, code ini akan menyimpan data-data output dari program WaterDest ke dalam sebuah file utama berextensi *.wtd dan file pendukung berextensi *.slf, dimana file ini nantinya dapat dibuka dengan program WaterDest untuk keperluan mengedit atau melihat kembali hasil hitungan.

-Untuk menyimpan/create file utama (*.wtd) digunakan script berikut:

Private Sub mnuFileNew_Click()
'file baru
If updateFile = False Or fileSave = False Then
jawab = MsgBox("Simpan perubahan pada File sebelumnya?" & vbCrLf & _
"Jika Anda jawab No maka data yang telah dibuat/diganti akan hilang!", vbYesNoCancel, "WaterDest - Load File")
If jawab = 2 Then
Exit Sub
ElseIf jawab = 6 Then
SaveFile
End If
End If


dlgCommonDialog.FileName = ""
dlgCommonDialog.CancelError = True
dlgCommonDialog.InitDir = FileDef$
dlgCommonDialog.DialogTitle = "New File"
'dlgCommonDialog.FileName = "File Baru" & lNewFileCount
dlgCommonDialog.Filter = "WaterDest File|*.wtd"
On Error GoTo last
MsgBox "Buat Folder baru, kemudian isikan Nama File dan Save" & vbCrLf & _
"Simpan folder baru ini diluar folder file yang telah ada", vbOKOnly + vbInformation, "New File"
dlgCommonDialog.ShowSave
LoadNewFile
last:
End Sub


-Untuk menyimpan data yang telah di'input' atau di'edit' ke file *.slf digunakan script sbb:

Sub SaveFile()
On Error Resume Next
Set adocon = New Connection
adocon.CursorLocation = adUseClient
adocon.Open "DSN=ConnRPT2"
Set rsado = New Recordset

ChDir dlgCommonDialog.InitDir
Open FileDef$ For Output As #1
Write #1, NamProy, Prc, LokProy, pipapas, accpas, PasUAV, PasUP, PasUSB, totReserv, totSR, CostPengPip, CostPekPip, CostReserv, CostSR, pipapaspan
rsado.Open "SELECT Jenis_Pipa,Diameter,Volume,Satuan,Harga_Satuan,GalianTanah,UruganPasir,UruganKembali,Pengetesan,Pemasangan FROM PasPipa", adocon, adOpenDynamic, adLockOptimistic
Open "pipe1.slf" For Output As #2
If rsado.RecordCount <> 0 Then
Do While Not rsado.EOF
JB = rsado("Jenis_Pipa").Value
dia = rsado("Diameter").Value
Vol = rsado("Volume").Value
Sat = rsado("Satuan").Value
HSat = rsado("Harga_Satuan").Value
GT = rsado("GalianTanah").Value
UPS = rsado("UruganPasir").Value
UK = rsado("UruganKembali").Value
Tes = rsado("Pengetesan").Value
Pas = rsado("Pemasangan").Value
Write #2, JB, dia, Vol, Sat, HSat, GT, UPS, UK, Tes, Pas
rsado.MoveNext
Loop
End If
Close #2
rsado.Close

rsado.Open "SELECT Jenis_Pipa,Diameter,Volume,Satuan,Harga_Satuan,GalianTanah,UruganPasir,UruganKembali,Pengetesan,Pemasangan FROM PasPipa1", adocon, adOpenDynamic, adLockOptimistic
Open "pipe2.slf" For Output As #3
If rsado.RecordCount <> 0 Then
Do While Not rsado.EOF
JB = rsado("Jenis_Pipa").Value
dia = rsado("Diameter").Value
Vol = rsado("Volume").Value
Sat = rsado("Satuan").Value
HSat = rsado("Harga_Satuan").Value
GT = rsado("GalianTanah").Value
UPS = rsado("UruganPasir").Value
UK = rsado("UruganKembali").Value
Tes = rsado("Pengetesan").Value
Pas = rsado("Pemasangan").Value
Write #3, JB, dia, Vol, Sat, HSat, GT, UPS, UK, Tes, Pas
rsado.MoveNext
Loop
End If
rsado.Close

rsado.Open "SELECT Jenis_Aksesori,Volume,Satuan,Harga_Satuan FROM PasAcc", adocon, adOpenDynamic, adLockOptimistic
Open "acc1.slf" For Output As #4
If rsado.RecordCount <> 0 Then
Do While Not rsado.EOF
JB = rsado("Jenis_Aksesori").Value
Vol = rsado("Volume").Value
Sat = rsado("Satuan").Value
HSat = rsado("Harga_Satuan").Value
Write #4, JB, Vol, Sat, HSat
rsado.MoveNext
Loop
End If
rsado.Close

rsado.Open "Select jenis_aksesori,volume,satuan,harga_satuan from PasAcc1", adocon, adOpenDynamic, adLockOptimistic
Open "acc2.slf" For Output As #5
If rsado.RecordCount <> 0 Then
Do While Not rsado.EOF
JB = rsado("Jenis_Aksesori").Value
Vol = rsado("Volume").Value
Sat = rsado("Satuan").Value
HSat = rsado("Harga_Satuan").Value
Write #5, JB, Vol, Sat, HSat
rsado.MoveNext
Loop
End If
rsado.Close
adocon.Close

adocon.Open "DSN=ConnRPT1"
rsado.Open "Copytmprpt4", adocon, adOpenDynamic, adLockOptimistic
Open "acc3.slf" For Output As #6
If rsado.RecordCount <> 0 Then
Do While Not rsado.EOF
JB = rsado("Jenis_Barang").Value
Vol = rsado("Volume").Value
Sat = rsado("satuan").Value
HSat = rsado("Harga_Satuan").Value
Write #6, JB, Vol, Sat, HSat
rsado.MoveNext
Loop
End If
rsado.Close

rsado.Open "Copytmprpt5", adocon, adOpenDynamic, adLockOptimistic
Open "acc4.slf" For Output As #7
If rsado.RecordCount <> 0 Then
Do While Not rsado.EOF
JB = rsado("Jenis_Barang").Value
Vol = rsado("Volume").Value
Sat = rsado("satuan").Value
HSat = rsado("Harga_Satuan").Value
Write #7, JB, Vol, Sat, HSat
rsado.MoveNext
Loop
End If
rsado.Close

rsado.Open "Copytmprpt10", adocon, adOpenDynamic, adLockOptimistic
Open "acc5.slf" For Output As #8
If rsado.RecordCount <> 0 Then
Do While Not rsado.EOF
JB = rsado("Jenis_Barang").Value
Vol = rsado("Volume").Value
Sat = rsado("satuan").Value
HSat = rsado("Harga_Satuan").Value
Write #8, JB, Vol, Sat, HSat
rsado.MoveNext
Loop
JB = "%"
Vol = "%"
Sat = "%"
HSat = "%"
Write #2, JB, Vol, Sat, HSat
End If
rsado.Close
adocon.Close

adocon.Open "DSN=ConnRPT3"
rsado.Open "PekJembItem", adocon, adOpenDynamic, adLockOptimistic
Open "jmb1.slf" For Output As #9
If rsado.RecordCount <> 0 Then
Do While Not rsado.EOF
JB = rsado("Jenis_Jembatan").Value
Sat = rsado("satuan").Value
HSat = rsado("Harga_Satuan").Value
Write #9, JB, Sat, HSat
rsado.MoveNext
Loop
End If

rsado.Close
rsado.Open "PekJembItem1", adocon, adOpenDynamic, adLockOptimistic
Open "jmb2.slf" For Output As #10
If rsado.RecordCount <> 0 Then
Do While Not rsado.EOF
JB = rsado("Jenis_Jembatan").Value
Sat = rsado("satuan").Value
HSat = rsado("Harga_Satuan").Value
Write #10, JB, Sat, HSat
rsado.MoveNext
Loop
End If
rsado.Close
adocon.Close
Close #1, #2, #3, #4, #5, #6, #7, #8, #9, #10
End Sub

1 komentar:

agusworks mengatakan...

Silakan mengcopy code diatas dengan mencantumkan alamat blog ini..thx

WaterDest Snapshot

WaterDest Snapshot
Main menu of WaterDest v 1.1.0