Script Koneksi MySQL Dengan Visual Basic 6

Script Koneksi MySQL Dengan Visual Basic 6

January 30, 2010 irmanf Leave a comment Go to comments

Source code berikut untuk mengoneksikan MySQL dengan VB 6. Menggunakan MySQL ODBC 3.51 Driver sebagai penghubung antara VB dan MySQL nya.

Simpan source code berikut di Module :

Public Conn As New ADODB.Connection

Public Sub koneksi()

Dim ConnString As String

Dim db_name As String

Dim db_server As String

Dim db_port As String

Dim db_user As String

Dim db_pass As String

On Error GoTo buat_koneksi_Error

db_name = "honorer"  'nama database anda

db_server = "localhost"  'server database anda

db_port = "3306"

db_user = "root"  'username db anda

db_pass = ""  'isi jika db anda menggunakan password

'ganti DRIVER berikut menjadi {MySQL ODBC 5.1 Driver} jika ODBC yang anda gunakan versi 5.1

ConnString = "DRIVER={MySQL ODBC 3.51 Driver};SERVER=" & db_server & ";DATABASE=" & db_name & ";UID=" & db_user & ";PWD=" & db_pass & ";PORT=" & db_port & ";OPTION=3"

If Conn.State = 1 Then Conn.Close

With Conn

    .ConnectionString = ConnString

    .Open

End With

On Error GoTo 0

Exit Sub

buat_koneksi_Error:

    MsgBox "Ada kesalahan dengan server, periksa apakah server sudah berjalan !", vbInformation, "Cek Server"

End Sub

Untuk pemanggilannya, gunakan pada setiap event Form_Load

Private Sub Form_Load()

    koneksi

End Sub

Jika membutuhkan ADODB Connection, gunakan variabel ‘Conn’ seperti contoh berikut :

rsAdo.Open "select * from tabel", Conn

Save dan Load File Gambar dengan SQL Server dan VB.Net 2008

Save dan Load File Gambar dengan SQL Server dan VB.Net 2008

Diposkan oleh T. Erick Sitorus | 08:02 | Aplikasi | 0 komentar »

Postingan kali ini tentang gambar, yaitu cara save image ataupun load image di VB.Net 2008. Gambar dalam hal ini akan ditampilkan melalui PictureBox.

Pertama-tama, di SQL Server siapkan sebuah table bernama tbl_img (nama database = testing).

Data di tabel hanya contoh, boleh diabaikan. Tabel tbl_img ini untuk menyimpan nama file dengan Path gambar yang kita akan gunakan.

Langsung saja buat sebuah project baru di VB.Net dan rancang form seperti berikut ini :

Catatan : Disamping objek yang terlihat diatas, saya juga menggunakan OpenFileDialog.

Anda bisa download sample programnya (beserta Sql Code utk database) di akhir postingan.

Logika programnya sederhana, awalnya memilih gambar melalui tombol Load Picture lalu save datanya ke database dengan tombol Save Picture.

Berikut adalah contoh Load File Image :

 OpenFileDialog1.Filter = "JPG Files (*.jpg)|*.jpg|JPEG Files (*.jpeg)|*.jpeg|GIF Files (*.gif)|*.gif|PNG Files (*.png)|*.png|BMP Files (*.bmp)|*.bmp|TIFF Files (*.tiff)|*.tiff" 

 If OpenFileDialog1.ShowDialog = Windows.Forms.DialogResult.OK Then 

    PictureBox1.Image = New Bitmap(OpenFileDialog1.FileName) 

    PictureBox1.SizeMode = PictureBoxSizeMode.CenterImage 

 End If 

dan berikut untuk Save (Nama file & Path) ke Database :

 Dim cmd As SqlCommand = New SqlCommand("INSERT INTO tbl_img (gambar, alamat) VALUES ('" & TextBoxFileName.Text & "', '" & PathFile & "')", koneksi) 

 cmd.CommandType = CommandType.Text 

 Dim DReader As SqlDataReader = cmd.ExecuteReader(CommandBehavior.CloseConnection) 

Untuk mempermudah anda bisa Download Program disini

Jangan lupa untuk mengganti nama server SQL Servernya dengan nama server SQL Server di komputer / laptop anda.

Mengganti Nama Server SQL Server Pada Koneksi Database Crystal Report

Mengganti Nama Server SQL Server Pada Koneksi Database Crystal Report

Diposkan oleh T. Erick Sitorus | 06:19 | Aplikasi | 0 komentar »

Beberapa waktu lalu saya membuat aplikasi yang menggunakan laporan Crystal Report, dimana datanya diambil dari SQL Server komputer saya. Laporan tersebut menggunakan kombinasi 5 tabel database sekaligus dan menggunakan banyak field dan grouping data didalamnya.

Masalah muncul saat saya ingin memindahkan aplikasi tersebut ke Laptop orang lain, dimana nama Server SQL-Server di komputer saya dan di laptop itu berbeda. Databasenya sendiri sudah saya copy ke laptop tersebut.

Otomatis saya harus mengubah setting nama Servernya. Untuk koneksi di Form, mungkin saya tinggal mengganti nama servernya di file khusus untuk modul koneksi. Bagaimana dengan koneksi database di laporan yang menggunakan Crystal Report..? Kondisinya seperti gambar berikut..!

Gambar diatas adalah kotak dialog Database Expert dan saya harus merubah Nama Server tersebut dengan nama server di laptop tadi agar aplikasi saya bisa berjalan di Laptop itu.

Berikut ini adalah cara yang saya lakukan.
1. Melalui Field Explorer, klik kanan di Database Fields pilih Set Datasource Location.
2. Akan muncul kotak dialog Set Datasource Location.
3. Klik tanda + pada tree di bagian properties (dibawah nama server).
4. Klik 2 kali pada Data Source dan isikan nama server yang baru, lihat gambar.

Sekarang nama server sudah berhasil diubah.

Membuat rumus penilaian dinamis

Membuat rumus penilaian dinamis

September 2, 2010 Admin Leave a comment Go to comments

Setahun yang lalu, sewaktu saya masih aktif mengembangkan aplikasi sekolah di beberapa kabupaten di Riau, masalah yang sering saya hadapi adalah tidak adanya standarisasi rumus dalam menentukan nilai akhir siswa (rapor akhir), tetapi untung saja variabel nilainya masih sama (rata2 tugas, rata2 ulangan, uts dan uas).
Pada awalnya saya hanya menyediakan input prosentasi untuk masing-masing nilai tersebut, dan tentu saja cara ini tidak memberikan solusi yang terbaik mengingat masing-masing guru terkadang mempunyai rumus penilaian yang berbeda.
Jadi alternatif solusi lain yang saya tawarkan adalah dengan memberikan keleluasaan untuk menginputkan sendiri rumus dan untuk melakukan ini kita harus mendefinisikan konstanta untuk mewakili nilai-nilai diatas sebagai berikut :

Contoh untuk mendapatkan nilai akhir dengan rumus :
Nilai Akhir = ((Rata2 tugas + Rata2 ulangan + UTS) / 3 x 0.6) + (UAS x 0.4)
Maka rumus yang harus diinputkan adalah sebagai berikut :

Gimana sampe disini konsepnya sudah jelas bukan, klo iya kita bahas kodenya satu per satu dan untuk menyederhanakan program, nilai dari rata2x tugas, rata2x ulangan, uts dan uas langsung diinputkan via textbox.
Pertama kita desain dulu tampilannya seperti berikut :

kemudian tambahkan fungsi berikut untuk memvalidasi inputan nilai hanya boleh angka.

view source

print?

01	Private Function validAngka(KeyAscii As Integer) As Integer

02	Dim strValid As String

03

04	On Error GoTo errHandle

05

06	strValid = "0123456789."

07

08	If InStr(strValid, Chr(KeyAscii)) = 0 And Not (KeyAscii = vbKeyBack) Then

09	validAngka = 0

10

Else

11	validAngka = KeyAscii

12

End If

13

14	Exit Function

15	errHandle:

16	validAngka = 0

17	End Function

kemudian tinggal panggil dimasing-masing event keypress inputan nilai

view source

print?

01	Private Sub txtRata2Tugas_KeyPress(KeyAscii As Integer)

02	KeyAscii = validAngka(KeyAscii)

03

End Sub

04

05	Private Sub txtRata2Ulangan_KeyPress(KeyAscii As Integer)

06	KeyAscii = validAngka(KeyAscii)

07

End Sub

08

09	Private Sub txtUAS_KeyPress(KeyAscii As Integer)

10	KeyAscii = validAngka(KeyAscii)

11

End Sub

12

13	Private Sub txtUTS_KeyPress(KeyAscii As Integer)

14	KeyAscii = validAngka(KeyAscii)

15

End Sub

selain memvalidasi inputan nilai kita juga harus memvalidasi inputan rumus penilaian, berikut fungsinya.

view source

print?

01	Private Function validKarakterRumus(KeyAscii As Integer) As Integer

02	Dim strValid As String

03

04	On Error GoTo errHandle

05

06	strValid = "0123456789aArRtTuUsS()<>+*/-. "

07

08	If InStr(strValid, Chr(KeyAscii)) = 0 And Not (KeyAscii = vbKeyBack) Then

09	validKarakterRumus = 0

10

Else

11	validKarakterRumus = KeyAscii

12

End If

13

14	Exit Function

15	errHandle:

16	validKarakterRumus = 0

17	End Function

sama seperti sebelumnya tinggal panggil di event keypress inputan rumus

view source

print?

1	Private Sub txtRumus_KeyPress(KeyAscii As Integer)

2	KeyAscii = Asc(UCase(Chr(KeyAscii))) 'otomatis huruf besar

3	KeyAscii = validKarakterRumus(KeyAscii)

4

End Sub

terakhir untuk tombol Proses akan melakukan pengecekan terhadap rumus yang diinputkan jika oke akan langsung menampilkan hasil nya :

view source

print?

001	Private Function isValidConst(ByVal value As String) As Boolean

002	Dim i           As Integer

003	Dim strNotValid As String

004

005	On Error GoTo errHandle

006

007	strNotValid = "aArRtTuUsS" 'karakter konstanta RT, RU, UTS dan UAS

008

009	isValidConst = True

010	For i = 1 To Len(value)

011	If InStr(1, strNotValid, Mid(value, i, 1)) > 0 Then

012	isValidConst = False

013

Exit For

014

End If

015

Next

016

017	Exit Function

018	errHandle:

019	isValidConst = True

020	End Function

021

022	Private Function isValidRumusPenilaian(ByVal rumus As String) As Boolean

023	Dim script              As Object

024	Dim result              As Long

025

026	Dim strParsing1         As String

027	Dim strParsing2         As String

028	Dim strFinalParsing     As String

029

030	On Error GoTo errHandle

031

032	strParsing1 = Replace(rumus, " ", "") ' menghapus spasi

033

034	strParsing2 = Replace(strParsing1, "<RT>", 0)

035	strParsing2 = Replace(strParsing2, "<RU>", 0)

036	strParsing2 = Replace(strParsing2, "<UTS>", 0)

037	strParsing2 = Replace(strParsing2, "<UAS>", 0)

038

039	strFinalParsing = Replace(strParsing2, "<", "")

040

041	strFinalParsing = Replace(strFinalParsing, ">", "")

042	If Not (Len(strFinalParsing) > 0) Then strFinalParsing = "0"

043

044	'cek klo ada rumus yg tidak sesuai dg konstanta yg sudah didefinisikan, ex : <RT> ditulis <TR>

045	If Not isValidConst(strFinalParsing) Then

046	isValidRumusPenilaian = False

047

048

Else

049	Set script = CreateObject("ScriptControl")

050	script.Language = "VBScript"

051	result = script.Eval(strFinalParsing)

052	Set script = Nothing

053

054	isValidRumusPenilaian = True

055

End If

056

057	Exit Function

058

059	errHandle:

060	isValidRumusPenilaian = False

061	End Function

062

063	Private Function execFormula(ByVal rumus As String) As Single

064	Dim script  As Object

065

066	On Error GoTo errHandle

067

068	Set script = CreateObject("ScriptControl")

069	script.Language = "VBScript"

070	execFormula = script.Eval(rumus)

071	Set script = Nothing

072

073	Exit Function

074	errHandle:

075	execFormula = 0

076	End Function

077

078	Private Function getNilaiAkhirByRumus(ByVal rumus As String, ByVal nilaiRT As Single, ByVal nilaiRU As Single, _

079	ByVal nilaiUTS As Single, ByVal nilaiUAS As Single) As Single

080

081	Dim strParsing1         As String

082	Dim strParsing2         As String

083	Dim strFinalParsing     As String

084

085	On Error GoTo errHandle

086

087	strParsing1 = Replace(rumus, " ", "") ' menghapus spasi

088	strParsing2 = Replace(strParsing1, "<RT>", nilaiRT) ' mengganti const <RT> ke nilai nilaiRT

089	strParsing2 = Replace(strParsing2, "<RU>", nilaiRU)  ' mengganti const <RU> ke nilai nilaiRU

090	strParsing2 = Replace(strParsing2, "<UTS>", nilaiUTS)  ' mengganti const <UTS> ke nilaiUTS

091	strParsing2 = Replace(strParsing2, "<UAS>", nilaiUAS)  ' mengganti const <UAS> ke nilaiUAS

092

093	strFinalParsing = Replace(strParsing2, "<", "")

094	strFinalParsing = Replace(strFinalParsing, ">", "")

095

096	If Not (Len(strFinalParsing) > 0) Then strFinalParsing = "0"

097

098	getNilaiAkhirByRumus = FormatNumber(execFormula(strFinalParsing), 0)

099

100	Exit Function

101

102	errHandle:

103	getNilaiAkhirByRumus = 0

104	End Function

105

106	Private Sub cmdProses_Click()

107	If isValidRumusPenilaian(txtRumus.Text) Then

108	txtNilaiAkhir.Text = getNilaiAkhirByRumus(txtRumus.Text, Val(txtRata2Tugas.Text), Val(txtRata2Ulangan.Text), Val(txtUTS.Text), Val(txtUAS.Text))

109

110

Else

111	MsgBox "Rumus yang Anda inputkan tidak valid", vbExclamation, "Peringatan"

112	txtRumus.SetFocus

113

End If

114

End Sub

Selamat MENCOBA