Modul Koneksi Vb 6.0 dengan Database Sql Server 2000

Klo beberapa waktu lalu saya sudah mempostingkan cara untuk koneksi vb 6.0 dengan database microsoft access, sekarang saya berikan cara koneksi bila menggunakan database ms. sql server. Database yang saya gunakan adalah sql server 2000 jadi klo ada perbedaan cara koneksinya bila menggunakan database sql yang terbaru mohon dikonfirmasikan karena saya belum mencoba database yang baru.

Berikut adalah code-nya yang bisa diletakkan pada modul :


Public con As New ADODB.Connection
Public rst As New ADODB.Recordset 'berfungsi sebagai variabel penyimpan sementara record
Public strcon As String ' variabel untuk code koneksi
Public strsql As String ' variabel untuk menampung code atau query sql

Public Sub Connections()
strcon = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=test"
If con.State = adStateOpen Then
con.Close
Set con = New ADODB.Connection
con.Open strcon
Else
con.Open strcon
End If
End Sub

Sama seperti koneksi pada ms. access, inti dari koneksi ini adalah pada variabel strcon
"strcon = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=test""

Pada bagian akhir code tersebut yaitu "Initial Catalog=test", test merupakan nama database yang telah dibuat pada sql server pada code ini saya memberikan contoh nama databasenya "test". Sehingga perlu disesuaikan dengan nama database yang digunakan.

Sebelum mencoba untuk mengkoneksikan, pastikan terlebih dahulu bahwa Servis Manager sql server sudah berada dalam kondisi Running, bila belum maka harus diaktifkan terlebih dahulu.

Untuk pemanggilan atau penggunaanya bisa dibaca pada posting saya sebelumnya.

Semoga berguna ya..................... Read more ...

Pembuatan Modul Pada VB 6.0 dan Pengaplikasiannya

Untuk membuat sebuah modul, sama aja seperti kita mau menambahkan sebuah form ke aplikasi kita, tapi yang kita tambahkan bukan form tapi modul.

Kalo saya biasanya menggunakan modul buat prosedur2 yang akan saya pake di hampir semua form yang saya gunakan jadi dari pada saya buat prosedur yang sama maka saja buat di modul. Tapi gak harus di modul juga bisa, misalnya di sebuah form tapi dibagian depannya kita ganti biasanya "Private Sub Nama prosedur" kita ganti menjadi "Public sub Nama Prosedur". Public disini berarti prosedur yang kita buat bisa dipake disemua form yang ada di aplikasi kita.

Trus cara pemanggilannya juga gampang banget kok. Klo prosedurnya diletakkan di modul maka pemanggilannya "Call Nama prosedur", fungsi "call" berfungsi untuk memanggil prosedur yang sudah kita buat. Tapi kalo prosedurnya kita letakkan di form maka pemanggilannya agak berbeda, tapi tetap menggunakan fungsi "Call", menjadi "Call (nama form letak prosedur).(nama prosedur). Semua prosedur atau metode dan fungsi juga sama dalam pemanggilannya dengan menggunakan call dan pembuatannya didahului dengan kata "Public", klo sub prosedur ya menjadi Public Sub nama prosedur, kalo fungsi ya menjadi "public Function".
Semoga bermanfaat. Read more ...

Simple Stopwatch Application from VB 6.0

Untuk membuat sebuah aplikasi yang menggunakan control timer satu hal yang perlu diperhatiin atau diketahui yaitu interval yang digunakan. Pada visual basic untuk satu detik nilai interval timernya adalah 1000.

Code program ini bisa kalian coba buat dengan metode perulangan atau looping. Namun pada code ini saya menggunakan "if bersarang". dan saya mencoba membuat sebuah logika yang sederhana yang semoga saja bisa dimengerti.
Berikut tampilan design dan name dari tiap control nya aplikasinya:


Dan berikut adalah coding yang digunakan :

Dim jam, menit, detik, milisec

Private Sub cmdExit_Click()

Timer1.Enabled = False
Timer2.Enabled = False
End

End Sub

Private Sub cmdreset_Click()

'membuat tampilan menjadi 00:00:00:00

lblSecon.Caption = "00"
lblMinute.Caption = "00"
lblHour.Caption = "00"

'pengaturan nilai variabel

jam = "0"
menit = "0"
detik = "0"

End Sub

Private Sub cmdStart_Click()

Timer1.Enabled = True
Timer2.Enabled = True
cmdreset.Enabled = False
cmdStart.Enabled = False
cmdStop.Enabled = True

jam = lblHour.Caption
menit = lblMinute.Caption
detik = lblSecon.Caption

End Sub

Private Sub cmdStop_Click()

Timer1.Enabled = False
Timer2.Enabled = False
cmdreset.Enabled = True
cmdStart.Enabled = True
cmdStop.Enabled = False

End Sub

Private Sub Form_Load()

'pemberian nilai properti interval timer
' interval untuk satu detik sama dengan kuranglebih 1000

Timer1.Interval = 1000
Timer2.Interval = 500

End Sub

Private Sub Timer1_Timer()

detik = detik + 1
If Val(detik) > 59 Then 'fungsi "val" untuk menggubah karakter menjadi angka atau number

detik = "00"
menit = Val(menit) + 1

If Val(menit) > 59 Then

menit = "00"
jam = Val(jam) + 1

If Val(jam) > 23 Then
jam = "00"

End If
End If
End If

d = Len(detik) 'fungsi "len" berguna untuk mengetahui banyak/panjang karakter
If d = 1 Then
lblSecon.Caption = "0" & detik 'membuat tampilan menjadi "0X"
'tanda "&" berfungsi untuk penggabungan karakter
Else
lblSecon.Caption = detik
End If

m = Len(menit)
If m = 1 Then
lblMinute.Caption = "0" & menit
Else
lblMinute.Caption = menit
End If

j = Len(jam)
If j = 1 Then
lblHour.Caption = "0" & jam
Else
lblHour.Caption = jam
End If

End Sub

Private Sub Timer2_Timer()

'Untuk membuat karakter titik dua ( : ) berkedip

Label1.Visible = Not Label1.Visible
Label2.Visible = Not Label2.Visible

End Sub

Untk pengembangannya bisa dicoba menambahkan fasilitas milisecon nya.

Read more ...

Mengubah atribut file dengan Ms. VB 6.0

Kalo gak salah satu tahun 2006 yang lalu aku dapet komputer yang kena sebuah virus, aku gak tau apa namanya tapi aku dan teman-teman menyebutnya virus 463 karena besar file yang dihasilkan sebesar 463 Kb. Virus ini menghiden semua folder yang ada dan mengantinya dengan file bentukan yang baru namun berekstensi aplikasi atau (.exe). Si virus berhasil aku lumpuhkan dan file bentukannya sudah aku bersihkan, namun karena semua folder di hidden sama si virus mau gak mau aku harus mengembaliinnya seperti semula lagi. Aku coba klik kanan foldernya lalu propertis dengan harapan bisa aku hilangin centang pada hidden-nya, tapi ternyata si virus bukan cuma meng-hidden-nya tapi meng-superhidden atau hidden system. cara satu-satunya dengan cara menghilangkan attribut filenya melalui command promt dengan mengetikkan " attrib -S -H nama_file ", ko cuma satu file seh gak masalah, tapi klo semua folder tentu butuh waktu yang sangat lama dan capek banget.

Akhirnya aku mencoba membuat sebuah aplikasi untuk mengubah attribut filenya menggunakan microsoft visual basic 6.0 , dan berhasil. neh aku bagiin sebuah aplikasi sederhana untuk membuka file yang ke superhidden.

Tampilan aplikasinya sbb:

Berikut adalah coding buat modulnya :



Public Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Public Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Public Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long
Public Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Public Declare Function SetFileAttributes Lib "kernel32" Alias "SetFileAttributesA" (ByVal lpFileName As String, ByVal dwFileAttributes As Long) As Long
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Public Const MAX_PATH = 260
Public Const MAXWORD = &HFFFF
Public Const INVALID_HANDLE_VALUE = -1
Public Const FILE_ATTRIBUTE_ARCHIVE = &H20
Public Const FILE_ATTRIBUTE_DIRECTORY = &H10
Public Const FILE_ATTRIBUTE_HIDDEN = &H2
Public Const FILE_ATTRIBUTE_NORMAL = &H80
Public Const FILE_ATTRIBUTE_READONLY = &H1
Public Const FILE_ATTRIBUTE_SYSTEM = &H4
Public Const FILE_ATTRIBUTE_TEMPORARY = &H100

Public Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type

Public Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type

Public Function StripNulls(OriginalStr As String) As String
If (InStr(OriginalStr, Chr(0)) > 0) Then
OriginalStr = Left(OriginalStr, InStr(OriginalStr, Chr(0)) - 1)
End If

StripNulls = OriginalStr
End Function

Dan ini coding pada formnya :

Option Explicit

Function FindFilesAPI(path As String, SearchStr As String, FileCount As Integer, DirCount As Integer)

Dim FileName As String
Dim DirName As String
Dim SearchPath As String, FindStr As String
Dim dirNames() As String
Dim nDir As Integer
Dim i As Integer
Dim hSearch As Long
Dim WFD As WIN32_FIND_DATA
Dim Cont As Integer
Dim x As Long
Dim xx As Long

If Right(path, 1) <> "\" Then path = path & "\"
nDir = 0
ReDim dirNames(nDir)
Cont = True
hSearch = FindFirstFile(path & "*", WFD)

If hSearch <> INVALID_HANDLE_VALUE Then
Do While Cont

DirName = StripNulls(WFD.cFileName)

If (DirName <> ".") And (DirName <> "..") Then
If GetFileAttributes(path & DirName) Or FILE_ATTRIBUTE_DIRECTORY Then

dirNames(nDir) = DirName
DirCount = DirCount + 1

nDir = nDir + 1
ReDim Preserve dirNames(nDir)

End If
End If
If (DirName <> ".") And (DirName <> "..") And (DirName <> "RECYCLER") And (DirName <> "System Volume Information") And (DirName <> "Thumbs.db") And (DirName <> "Desktop.ini") And (DirName <> "desktop.ini") Then
x = SetFileAttributes(path & DirName, FILE_ATTRIBUTE_NORMAL)
xx = CloseHandle(x)

List1.AddItem path & DirName
End If
Cont = FindNextFile(hSearch, WFD)

Loop
Cont = FindClose(hSearch)

End If


If nDir > 0 Then
For i = 0 To nDir - 1
FindFilesAPI = FindFilesAPI(path & dirNames(i) & "\", SearchStr, FileCount, DirCount)
Next i
End If

End Function

Private Sub Command1_Click()
Dim SearchPath As String, FindStr As String
Dim FileSize As Long
Dim NumFiles As Integer, NumDirs As Integer
Dim msg

If Trim(UCase(Text1.Text)) = "C:\" Then
msg = MsgBox("Any Directories System will be show " & Chr(13) & " Are you sure to continue ?", vbQuestion + vbYesNo, ":: Confirmation ::")
If msg = vbYes Then
GoTo scan_acc
End If
Else
GoTo scan_acc
End If
Exit Sub

scan_acc:
Screen.MousePointer = vbHourglass
Command2.Enabled = False
Command1.Caption = "Please....wait"
List1.Clear
Label4.Caption = ""
SearchPath = Text1.Text
FindStr = Label1.Caption
FileSize = FindFilesAPI(SearchPath, FindStr, NumFiles, NumDirs)
Label4.Caption = NumDirs & " Directories found in ' " & SearchPath & "'"
Screen.MousePointer = vbDefault
Command2.Enabled = True
Command1.Caption = "&Scan"
End Sub

Private Sub Command2_Click()
End
End Sub

Private Sub Dir1_Change()
Text1.Text = Dir1.path
End Sub

Private Sub Drive1_Change()
On Error GoTo err
Dir1.path = Drive1.Drive
Exit Sub

err:
MsgBox "Device not ready", vbExclamation, ":: Device ::"
Drive1.Drive = "D:\"
Exit Sub
End Sub

Private Sub Form_Load()
Drive1.Drive = "D:\"
End Sub

Semoga aplikasi ini bisa membantu dan bisa memberikan ide baru buat kamu yang pengen belajar bareng aku.




Read more ...