28 Desember 2012



Aplikasi trial adalah aplikasi yang mempunyai batasan waktu penggunaan berdasarkan lama hari atau berapa kali aplikasi dijalankan.
Pembuatanya biasanya digunakan pada aplikasi shareware (berbayar) yang bertujuan agar user dapat menikmati aplikasi (demo) sebelum membeli aplikasi.
Berikut ini adalah contoh pembuatan aplikasi trial yang menggunakan lama hari penggunaan, lengkap dengan prosedur input kode registrasinya.

PADA VB 6.0
Buat Project baru dengan sebuah Form. Di bagian '(Declarations)' dari Form ketikkan :
Const LocationReg = "System\Windows\User" 'lokasi penyimpanan d registry (ubah sesuai selera)
Const PasswordReg = "kode" 'kode kunci registrasi

Function GetInfoReg() As String 'fungsi utk mendapatkan info registrasi
On Error GoTo Ero
Dim Reg As Object
Set Reg = CreateObject("WScript.Shell")
GetInfoReg = Reg.RegRead("HKEY_CLASSES_ROOT\" & LocationReg & "\")
Exit Function
Ero:
Reg.RegWrite "HKEY_CLASSES_ROOT\" & LocationReg & "\", Format(Now, "short date") 'memasukkan tgl sekarang
GetInfoReg = Format(Now, "short date")
End Function


Function SuccessReg() As Boolean 'fungsi utk prosedur pemasukan kode registrasi
Dim s As String
Lagi:
s = InputBox("Masukkan kode registrasi", "Registrasi")
If s = PasswordReg Then
Dim Reg As Object
Set Reg = CreateObject("WScript.Shell")
Reg.RegWrite "HKEY_CLASSES_ROOT\" & LocationReg & "\", "Registered" 'mendaftarkan k registry
MsgBox "Terima kasih telah melakukan registrasi", vbInformation, "Registrasi Sukses"
SuccessReg = True
      
ElseIf s = "" Then
SuccessReg = False
  
Else
If MsgBox("Maaf kode registrasi salah, coba lagi ?", vbYesNo + vbExclamation, "Registrasi") = vbYes Then GoTo Lagi
SuccessReg = False
End If
End Function


Lalu di bagian 'Form_Load' ketikkan :
Dim s As String, l As Long
  
s = GetInfoReg
If s <> "Registered" Then 'jika belum terdaftar"
l = 30 - (CDate(Format(Now, "short date")) - CDate(s)) 'max penggunaan trial 30 hari
      
If l > 0 And l <= 30 Then 'jika masih ada sisa hari
If MsgBox("Aplikasi ini hanya dapat digunakan sampai " & l & " hari lagi." & vbCrLf & _
"Jika ingin menggunakan tanpa batasan waktu, masukkan kode registrasi" & vbCrLf & vbCrLf & _
"Masukkan kode registrasi sekarang ?", vbYesNo + vbInformation, "Registrasi") = vbYes Then SuccessReg
          
Else 'jika kadaluarsa
If MsgBox("Aplikasi ini sudah tidak dapat digunakan lagi." & vbCrLf & _
"Jika ingin menggunakannya kembali, masukkan kode registrasi" & vbCrLf & vbCrLf & _
"Masukkan kode registrasi sekarang ?", vbYesNo + vbExclamation, "Registrasi") = vbYes Then
              
If SuccessReg = False Then End 'mengakhiri aplikasi
Else
End 'mengakhiri aplikasi
End If
          
End If
End If




PADA VB.NET
Buat Project baru dengan sebuah Form. Di bagian '(Declarations)' dari Form ketikkan :
Const LocationReg = "System\Windows\User" 'lokasi penyimpanan d registry (ubah sesuai selera)
Const PasswordReg = "kode" 'kode kunci registrasi
Function GetInfoReg() As String 'fungsi utk mendapatkan info registrasi
Dim Reg = CreateObject("WScript.Shell")
Try
GetInfoReg = Reg.RegRead("HKEY_CLASSES_ROOT\" & LocationReg & "\")
Catch
Reg.RegWrite("HKEY_CLASSES_ROOT\" & LocationReg & "\", Now.Date) 'memasukkan tgl sekarang
GetInfoReg = Now.Date
End Try
End Function
Function SuccessReg() As Boolean 'fungsi utk prosedur pemasukan kode registrasi
Dim s As String
Lagi:
s = InputBox("Masukkan kode registrasi", "Registrasi")
If s = PasswordReg Then
Dim Reg = CreateObject("WScript.Shell")
Reg.RegWrite("HKEY_CLASSES_ROOT\" & LocationReg & "\", "Registered") 'mendaftarkan k registry
MsgBox("Terima kasih telah melakukan registrasi", vbInformation, "Registrasi Sukses")
SuccessReg = True

ElseIf s = "" Then
SuccessReg = False

Else
If MsgBox("Maaf kode registrasi salah, coba lagi ?", vbYesNo + vbExclamation, "Registrasi") = vbYes Then GoTo Lagi
SuccessReg = False
End If
End Function

Lalu di bagian 'Form1_Load' ketikkan :
Dim s As String, l As Long

s = GetInfoReg()
If s <> "Registered" Then 'jika belum terdaftar"
l = 30 - CType(Now.Date - CDate(s), TimeSpan).TotalDays 'max penggunaan trial 30 hari

If l > 0 And l <= 30 Then 'jika masih ada sisa hari
If MsgBox("Aplikasi ini hanya dapat digunakan sampai " & l & " hari lagi." & vbCrLf & _
"Jika ingin menggunakan tanpa batasan waktu, masukkan kode registrasi" & vbCrLf & vbCrLf & _
"Masukkan kode registrasi sekarang ?", vbYesNo + vbInformation, "Registrasi") = vbYes Then SuccessReg()

Else 'jika kadaluarsa
If MsgBox("Aplikasi ini sudah tidak dapat digunakan lagi." & vbCrLf & _
"Jika ingin menggunakannya kembali, masukkan kode registrasi" & vbCrLf & vbCrLf & _
"Masukkan kode registrasi sekarang ?", vbYesNo + vbExclamation, "Registrasi") = vbYes Then

If SuccessReg() = False Then End 'mengakhiri aplikasi
Else
End 'mengakhiri aplikasi
End If

End If
End If

19 Desember 2012


Source code berikut untuk mengoneksikan VB 6 dengan database Access. Agar aplikasi bisa di running dimana saja, dengan menggunakan fungsi App.Path, dan database Access disimpan dalam satu folder yang sama dengan project VB nya.
Source code simpan di Module :

Public Sub koneksi()
On Error GoTo konekErr

If Con.State = 1 Then Con.Close

'sesuaikan database .mdbnyadengan database anda
Con.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + App.Path + "\db_tes.mdb;Persist Security Info=False"
Exit Sub

konekErr:
MsgBox "Error Connected the database !Error from : " &Err.Description, vbCritical, "Peringatan"
End Sub


Private Sub Form_Load()

Adodc1.ConnectionString = Con.ConnectionString
Adodc1.RecordSource = "select * from contoh"
Adodc1.Refresh
Set DataGrid1.DataSource = Adodc1
End Sub



Cara Membuat Text Berjalan Di Layar Desktop

Posted by Administrator on 19.46 with 2 comments

Kode berikut ini akan membuat atau memunculkan teks di area layar secara terus-menerus.
Buat sebuah Project baru dengan sebuah Form didalamnya. Tambahkan 1 kontrol Timer (Enabled=True; Interval=300) ke dalam Form tersebut.


PADA VB 6.0
Di bagian '(Declarations)' dari Form ketikkan :
Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long Private Declare Function GetDesktopWindow Lib "user32" () As LongPrivate Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long Const s = " Contoh Project Baru "
Di bagian 'Form_Load' ketikkan :
App.TaskVisible = False Me.Hide
Lalu di bagian 'Timer1_Timer' ketikkan :
Dim l As Long l = GetWindowDC(GetDesktopWindow)
Randomize TextOut l, Rnd * (Screen.Width / Screen.TwipsPerPixelX), Rnd * (Screen.Height / Screen.TwipsPerPixelY), s, Len(s)




PADA VB.NET
Di bagian '(Declarations)' dari Form ketikkan :
Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Integer) As Integer Private Declare Function GetDesktopWindow Lib "user32" () As Integer Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Integer, ByVal x As Integer, ByVal y As Integer, ByVal lpString As String, ByVal nCount As Integer) As Integer Const s = "Contoh Project Baru"
Di bagian 'Form1_Shown' ketikkan :
Me.Hide()
Lalu di bagian 'Timer1_Tick' ketikkan :
Dim i As Integer = GetWindowDC(GetDesktopWindow)

Randomize()
TextOut(i, Rnd() * Screen.PrimaryScreen.Bounds.Width, Rnd() * Screen.PrimaryScreen.Bounds.Height, s, Len(s))




CATATAN : Isi teks yang muncul dapat dirubah dengan mengganti kode yang berwarna Hijau
Semoga dapat membantu :)

Membuka dan Menyimpan File Text

Posted by Administrator on 19.42 with 13 comments

Kegiatan / proses membuka dan menyimpan file teks biasanya digunakan untuk aplikasi sejenis Notepad, tapi selain itu juga dilakukan untuk menyimpan data aplikasi ke dalam file teks (*.txt). Sebelum melanjutkannya, siapkan sebuah Form dan kontrol TextBox (Multiline=True) didalamnya. Lalu siapkan sebuah file *.txt yang berisi, dan ingat-ingat lokasinya (dalam contoh dibawah ini, lokasi file-nya di C:\contoh.txt).
Berikut ini macam-macam metodenya :

Pada VB 6.0
  • Membuka Teks dari File
Dim i As Integer
i = FreeFile
Open "D:\contoh.txt" For Input As #i
Text1.Text = Input(LOF(i), i)
Close #i

  • Membuka Teks dari File (dengan cara dibaca per baris)
Dim i As Integer
i = FreeFile
  
Dim s As String, s1 As String
Open "D:\contoh.txt" For Input As #i
Do Until EOF(i)
Input #i, s 'tiap baris d tampung d variabel "s"
s1 = s1 & s & IIf(EOF(i), "", vbCrLf)
Loop
Close #i
  
Text1.Text = s1

  • Menyimpan Teks ke File
Dim i As Integer
i = FreeFile
Open "D:\contoh.txt" For Output As #i
Print #i, Text1.Text
Close #i

  • Menambahkan Teks ke File
Dim i As Integer
i = FreeFile
Open "D:\contoh.txt" For Append As #i
Print #i, Text1.Text
Close #i




Pada VB.NET
  • Membuka Teks dari File
Dim i As Integer = FreeFile()
FileOpen(i, "D:\contoh.txt", OpenMode.Input)
TextBox1.Text = InputString(i, LOF(i))
FileClose(i)

  • Membuka Teks dari File (dengan cara dibaca per baris)
Dim i As Integer = FreeFile()

Dim s, s1 As String
FileOpen(i, "D:\contoh.txt", OpenMode.Input)
Do Until EOF(i)
Input(i, s) 'tiap baris d tampung d variabel "s"
s1 &= s & IIf(EOF(i), "", vbCrLf)
Loop
FileClose(i)

TextBox1.Text = s1

  • Menyimpan Teks ke File
Dim i As Integer = FreeFile()
FileOpen(i, "D:\contoh.txt", OpenMode.Output)
PrintLine(i, TextBox1.Text)
FileClose(i)

  • Menambahkan Teks ke File
Dim i As Integer = FreeFile()
FileOpen(i, "D:\contoh.txt", OpenMode.Append)
PrintLine(i, TextBox1.Text)
FileClose(i)

Mengetahui UserName dan ComputerName

Posted by Administrator on 19.35 with No comments

UserName dan ComputerName biasanya digunakan untuk melengkapi Form registrasi suatu aplikasi / software berbayar. Untuk mengetahui / mendapatkan UserName maupun ComputerName, hanya dibutuhkan 1 baris kode, berikut ini kodenya :

UserName :
s = Environ("UserName")
ComputerName :
s = Environ("ComputerName")
Selain itu, Anda juga bisa menggantikan teks yang berwarna merah untuk mendapatkan informasi yang lain. Seperti : UserDomain, OS, LogOnServer, ClientName, dll. 

Cara Mengganti Semua Judul Aplikasi

Posted by Administrator on 19.33 with No comments
Kode berikut ini akan mengganti semua judul Form aplikasi yang sedang berjalan.
Buat sebuah Project baru dengan sebuah Form didalamnya. Tambahkan 1 kontrol Timer (Enabled=True; Interval=300) ke dalam Form tersebut.



Pada VB 6.0
Di bagian '(Declarations)' dari Form ketikkan :
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long Private Declare Function GetDesktopWindow Lib "user32" () As Long Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long Dim l As Long
Di bagian 'Form_Load' ketikkan :
App.TaskVisible = False Me.Hide
Lalu di bagian 'Timer1_Timer' ketikkan :
l = GetWindow(GetDesktopWindow(), 5)
Do While l <> 0
SetWindowText l, "
Error
"
l = GetWindow(l, 2)
Loop
Pada VB.NET
Di bagian '(Declarations)' dari Form ketikkan :
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Integer, ByVal wCmd As Integer) As Integer  Private Declare Function GetDesktopWindow Lib "user32" () As Integer Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Integer, ByVal lpString As String) As Integer Dim i As Integer
Di bagian 'Form1_Shown' ketikkan :
Me.Hide()
Lalu di bagian 'Timer1_Tick' ketikkan : 
i = GetWindow(GetDesktopWindow(), 5) Do While i <> 0 SetWindowText(i, "Error")
i = GetWindow(i, 2)

Loop 
Semoga Bermanfaat :)

Menghilankan PopUp Menu Klik Kanan Pada TextBox

Posted by Administrator on 19.19 with No comments
Bagi teman-teman yang ingin menghilangkan menu klik kanan pada sebuah textbox.Berikut ini kode yang digunakan untuk menghilangkan PopUp Menu (menu yang muncul bila di klik kanan) pada kontrol TextBox. Buat Form baru dengan sebuah kontrol TextBox.


Pada VB 6.0
Di bagian '(Declarations)' dari Form ketikkan
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Di bagian 'Text1_MouseDown'.
If Button = vbRightButton ThenSendMessage Me.hwnd, &H204, 0, 0 End If
Pada VB.NET
Di bagian '(Declarations)' dari Form ketikkan
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
Di bagian 'TextBox1_MouseDown'.
If e.Button = Windows.Forms.MouseButtons.Right Then SendMessage(Me.Handle.ToInt32, &H204, 0, 0)End If 
Semoga Bermanfaat :)

Cara Menjalankan ScreenSaver

Posted by Administrator on 19.11 with No comments
Jika teman-teman ingin mencoba menjalankan screensaver tanpa harus menunggu waktunya screensaver itu muncul, berikut cara-caranya :

Pada VB 6.0

Di bagian '(Declaratios)' dari Form ketikkan :
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long
Untuk menggunakannya ketikkan perintah kode :
SendMessage Me.hwnd, 274, 61760, 0

Pada VB.NET

Di bagian '(Declaratios)' dari Form ketikkan :
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
Untuk menggunakannya ketikkan perintah kode :
SendMessage(Me.Handle.ToInt32, 274, 61760, 0)
Semoga Bermanfaat bagi teman-teman :)

Cara Menonaktifkan Task Manager

Posted by Administrator on 18.57 with No comments
Bagi teman-teman yang ingin menonaktifkan task manager di windows, berikut adalah cara-caranya :



Buat sebuah Module baru dan ketikkan :

Public Sub DisableTaskManager(ByVal State As Boolean)
On Error Resume Next
Dim o As Object
Set o = CreateObject("wscript.shell")
o.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\System\DisableTaskmgr", CInt(State), "REG_DWORD"
End Sub
Untuk menonaktifkan Task Manager, tinggal menuliskan kode berikut :
DisableTaskManager True

Untuk mengaktifkan kembali Task Manager ketikkan :
DisableTaskManager False 

Semoga bermanfaat :)

16 Desember 2012

Shutdown Restart dan LogOff

Posted by Administrator on 21.25 with No comments

Berikut ini kode yang digunakan untuk Shutdown, Restart, dan LogOff komputer.

  VB 6.0   &   VB .NET
Shutdown
Shell "shutdown -s -f -t 0"
Restart
Shell "shutdown -r -f -t 0"
LogOff
Shell "shutdown -l -f -t 0"


VB Script
Untuk Shutdown ketikkan :
Set SH = CreateObject("WScript.Shell")
SH.Run shutdown -s -f -t 0
Untuk Restart gantikan tulisan yang bewarna merah dengan "shutdown -r -f -t 0", dan untuk LogOff gantikan dengan "shutdown -l -f -t 0".