galerigila: TUTORIAL VISUAL BASIC

Find Text in Text Control

RUMUS KONVERSI ANGKA / DETIK MENJADI WAKTU

MEMBUAT NOTEPAD SEDERHANA

FUNGSI MEMBUAT NEW TAB WEBBROWSER VB [ DENGAN DETAIL PROSES EVENT ]

NEW WINDOW BROWSER

MENDAPATKAN LINK BROWSER

MENAMBAH KONTROL WEB BROWSER DIDALAM SSTAB
FUNGSI SAVE SETTING
MENDAPATKAN NAMA USER KOMPUTER

Copy Teks

Mendapatkan data dari .TXT FILE [Notepad]

Cara Menghilangkan Password Database Access

KODE MEMBUAT STOPWATCH

ENKRIPSI SEDERHANA MENGGUNAKAN XOR

MENAMPILKAN DATA MySQL DI LIST VIEW

MENAMPILKAN DATA MySQL DI DATA REPORT

QUERY PRAKTIS MySQL

INVALID PROPERTY VALUE

MASALAH DALAM MENGGUNAKAN PACKAGE AND DEPLOYMENT WIZARD

DEKLARASI VARIABEL LEBIH RINGKAS

QUERY PRAKTIS MySQL

MASALAH DALAM MENGGUNAKAN PACKAGE AND DEPLOYMENT WIZARD

DEKLARASI VARIABEL LEBIH RINGKAS

TCP Cliet-Server

CEK STATUS KONEKSI INTERNET VB

Menampilkan Gambar dari MySQL pada VB dengan vbmysqldirect

Menampilkan Data dari MySQL pada VB dengan vbmysqldirect

ENKRIPSI SEDERHANA MENGGUNAKAN XOR VB

Menyimpan Gambar ke MySQL lewat VB dengan vbmysqldirect

Menghapus Data dari MySQL pada VB dengan vbmysqldirect

MEMBUAT WEB BROWSER DENGAN VB

Koneksi ke MYSQL Database Online dengan VB 6.0

Deteksi IP Komputer dengan VB 6

Fungsi Date and Time pada VB

KIRIM EMAIL LEWAT VB dengan vbsendmail.dll

GALERIGILA GALERIGILA GALERIGILA GALERIGILA GALERIGILA

Find Text in Text Control

Option Explicit

Private TargetPosition As Integer
' Find the text.
Private Sub cmdFind_Click()
    FindText 1
End Sub
Private Sub FindText(ByVal start_at As Integer)
Dim pos As Integer
Dim target As String

    target = txtTarget.Text
    pos = InStr(start_at, txtBody.Text, target)
    If pos > 0 Then
        ' We found it.
        TargetPosition = pos
        txtBody.SelStart = TargetPosition - 1
        txtBody.SelLength = Len(target)
        txtBody.SetFocus
    Else
        ' We did not find it.
        MsgBox "Not found."
        txtBody.SetFocus
    End If
End Sub

' Find the next occurrance of the text.
Private Sub cmdFindNext_Click()
    FindText TargetPosition + 1
End Sub

GALERIGILA GALERIGILA GALERIGILA GALERIGILA GALERIGILA

RUMUS KONVERSI ANGKA / DETIK MENJADI WAKTU

Private Sub menuConvertTime_Click()
'fungsi RUMUS KONVERSI ANGKA / DETIK MENJADI WAKTU
i = Int(Val(Label1.Caption) / 3600) 'mencari jam
'============ mencari menit
j = Int(Val(Label1.Caption) / 60)
k = i * 60
m = j - k
'============ mencari menit
'============ mencari detik
n = Val(Label1.Caption) / 60
o = Int(n) * 60
p = Val(Label1.Caption) - o
'============ mencari detik
If Val(Label1.Caption) > 60 Then
Text1.Text = i & ":" & m & ":" & p
Else
Text1.Text = Val(Label1.Caption)
End If
End Sub

GALERIGILA GALERIGILA GALERIGILA GALERIGILA GALERIGILA

MEMBUAT NOTEPAD SEDERHANA

1 kita buat Menu Editor
File > New - Open - Save As - Print - Minimaze - Exit
Edit > Cut - Copy - Paste

2 Kita buat CommondDialog

Nahh sekarang kita kasi Perintah" seperti ini :

Private Sub Copy_Click()
Clipboard.Clear
Clipboard.SetText Text1.S[/quote]elText
End Sub
Private Sub Cut_Click()
Clipboard.Clear
Clipboard.SetText Text1.SelText
Text1.SelText = ""
End Sub
Private Sub Exit_Click()
On Error GoTo ErrorHandler
Dim Msg, Style, Title, Response, MyString
Msg = "Are you sure you want to exit ?"
Style = vbYesNo + vbQuestion + vbDefaultButton1
Title = "Warning"
Response = MsgBox(Msg, Style, Title)
If Response = vbYes Then
MyString = "Yes"
End
End If
ErrorHandler:
End Sub
Private Sub Minimize_Click()
Form1.WindowState = 1
End Sub
Private Sub New_Click()
Text1.Text = ""
End Sub
Private Sub Open_Click()
CommonDialog1.Filter = "All Files (*.*)|*.*|Text Files (*.txt)|*.txt"
CommonDialog1.FilterIndex = 2
CommonDialog1.ShowOpen
Dim LoadFileToTB As Boolean
Dim TxtBox As Object
Dim FilePath As String
Dim Append As Boolean
Dim iFile As Integer
Dim s As String
If Dir(FilePath) = "" Then Exit Sub
On Error GoTo ErrorHandler:
s = Text1.Text
iFile = FreeFile
Open CommonDialog1.FileName For Input As #iFile
s = Input(LOF(iFile), #iFile)
If Append Then
Text1.Text = Text1.Text & s
Else
Text1.Text = s
End If
LoadFileToTB = True
ErrorHandler:
If iFile > 0 Then Close #iFile
End Sub
Private Sub Paste_Click()
Text1.SelText = Clipboard.GetText()
End Sub
Private Sub Print_Click()
On Error GoTo ErrHandler
Dim BeginPage, EndPage, NumCopies, i
CommonDialog1.CancelError = True
CommonDialog1.ShowPrinter
BeginPage = CommonDialog1.FromPage
EndPage = CommonDialog1.ToPage
NumCopies = CommonDialog1.Copies
For i = 1 To NumCopies
Printer.Print Text1.Text
Next i
Exit Sub
ErrHandler:
Exit Sub
End Sub
Private Sub Save_Click()
On Error GoTo ErrorHandler
CommonDialog1.Filter = "All Files (*.*)|*.*|Text Files (*.txt)|*.txt"
CommonDialog1.FilterIndex = 2
CommonDialog1.ShowSave
CommonDialog1.FileName = CommonDialog1.FileName
Dim iFile As Integer
Dim SaveFileFromTB As Boolean
Dim TxtBox As Object
Dim FilePath As String
Dim Append As Boolean
iFile = FreeFile
If Append Then
Open CommonDialog1.FileName For Append As #iFile
Else
Open CommonDialog1.FileName For Output As #iFile
End If
Print #iFile, Text1.Text
SaveFileFromTB = True
ErrorHandler:
Close #iFile
End Sub

GALERIGILA GALERIGILA GALERIGILA GALERIGILA GALERIGILA

FUNGSI MEMBUAT NEW TAB WEBBROWSER VB [ DENGAN DETAIL PROSES EVENT ]

Private WithEvents m_WebControl As VBControlExtender

Private Sub Form_Resize()
On Error Resume Next
   Me.List1.Height = Me.ScaleHeight - Me.List1.Top

   ' resize webbrowser to fill form next to listbox
   If Not m_WebControl Is Nothing Then
     m_WebControl.Move Me.List1.Left + Me.List1.Width + 30, 0, ScaleWidth - (Me.List1.Left + Me.List1.Width + 30), ScaleHeight
   End If
End Sub

Private Sub Command1_Click()
On Error GoTo ErrHandler

   ' attempting to add WebBrowser here ('Shell.Explorer.2' is registered
   ' with Windows if a recent (>= 4.0) version of Internet Explorer is installed
   Set m_WebControl = Controls.Add("Shell.Explorer.2", "webctl", Me)

   ' if we got to here, there was no problem creating the WebBrowser
   ' so we should size it properly and ensure it's visible
   m_WebControl.Move Me.List1.Left + Me.List1.Width + 30, 0, ScaleWidth - (Me.List1.Left + Me.List1.Width + 30), ScaleHeight
   m_WebControl.Visible = True

   ' use the Navigate method of the WebBrowser control to open a
   ' web page
   m_WebControl.object.navigate "http://www.planet-source-code.com"

Exit Sub
ErrHandler:
   MsgBox "Could not create WebBrowser control", vbInformation
End Sub

Private Sub m_WebControl_ObjectEvent(Info As EventInfo)
On Error GoTo ErrHandler

   Dim i As Integer
   Dim evp As EventParameter

   ' display the event that was raised in the listbox
   Me.List1.AddItem "Event Raised: " & Info.Name
   For Each evp In Info.EventParameters
      Me.List1.AddItem " " & evp.Name & " (" & evp.Value & ")"
   Next evp

   Me.List1.ListIndex = Me.List1.NewIndex
Exit Sub
ErrHandler:
   If Err.Number = -2147024809 Then
      Me.List1.AddItem " " & evp.Name & " (#ERROR)"
      Resume Next
   End If
End Sub

'thanks to : http://www.instructables.com/id/Make-a-web-browser-in-visual-basic/

GALERIGILA GALERIGILA GALERIGILA GALERIGILA GALERIGILA

NEW WINDOW BROWSER

Private Sub WebBrowser1_NewWindow2(ppDisp As Object, Cancel As Boolean)
   Dim frmWB As Form1 ' nama form
   Set frmWB = New Form1 ' nama form
   frmWB.WebBrowser1.RegisterAsBrowser = True
   Set ppDisp = frmWB.WebBrowser1.Object
   frmWB.Visible = True
End Sub

GALERIGILA GALERIGILA GALERIGILA GALERIGILA GALERIGILA

MENDAPATKAN LINK BROWSER

Private Sub WebBrowser1_StatusTextChange(ByVal Text As String)
Text1.Text = (WebBrowser1.LocationURL)
Form1.Caption = (WebBrowser1.LocationName)
End Sub

GALERIGILA GALERIGILA GALERIGILA GALERIGILA GALERIGILA

MENAMBAH KONTROL WEB BROWSER DIDALAM SSTAB
'urutan kode harus PAS
Set m_WebControl = Controls.Add("Shell.Explorer.2", "webctl", Me)
m_WebControl.Visible = True
m_WebControl.Left = 240
m_WebControl.Top = 480
m_WebControl.Height = 2175
m_WebControl.Width = 3615

SSTab1.ZOrder 1
SSTab1.Tabs = 2
SSTab1.Tab = 1

GALERIGILA GALERIGILA GALERIGILA GALERIGILA GALERIGILA

FUNGSI SAVE SETTING

Private Sub Command1_Click()
Dim i
binary.Caption = "1"
i = binary.Caption
SaveSetting "Y", "Y", "Y", i
MainForm.Show
Unload Me
End Sub

Private Sub Form_Load()
If Option1.Value = True Then
Text1.Visible = True
Text2.Visible = False
Command1.Caption = "&Setuju"
Command2.Caption = "&Tidak Setuju"
End If
binary.Caption = GetSetting("Y", "Y", "Y", i)
If binary.Caption = "1" Then
MainForm.Show
'delete setting harus diletakkan diatas unload me
'DeleteSetting "Y", "Y", "Y"
Unload Me
End If
End Sub

GALERIGILA GALERIGILA GALERIGILA GALERIGILA GALERIGILA

MENDAPATKAN NAMA USER KOMPUTER

'--- Letakkan di module
Public Declare Function GetUserNameA Lib "advapi32.dll" _
   (ByVal lpBuffer As String, nSize As Long) As Long
'--- Akhir Letakkan di module

Public Function GetUserName() As String
   Dim UserName As String * 255
   Call GetUserNameA(UserName, 255)
   GetUserName = Left$(UserName, InStr(UserName, Chr$(0)) - 1)
End Function

Private Sub Form_Load()
   MsgBox GetUserName
End Sub

GALERIGILA GALERIGILA GALERIGILA GALERIGILA GALERIGILA

Copy Teks

Private Sub Command1_Click()
Clipboard.Clear
Clipboard.SetText Text1.Text
End Sub

GALERIGILA GALERIGILA GALERIGILA GALERIGILA GALERIGILA

Mendapatkan data dari .TXT FILE [Notepad]

Private Sub Command1_Click()
'This will declare the variable data as a string
Dim data As String

'This will find the file that we are using
Open "C:\Documents and Settings\Administrator\Desktop\Temp.txt" For Input As #1
        Input #1, MyData
'This puts the data in the textbox
         Text1.Text = MyData
    Close #1
End Sub

GALERIGILA GALERIGILA GALERIGILA GALERIGILA GALERIGILA

Cara Menghilangkan Password Database Access

' Tambah References Microsoft DAO 3.6 Object Library pada project Sobat

Kode Modul :

Public Sub CLearDatabasePassword()
On Error GoTo Salah
Dim DtBase As Database
Set DtBase = OpenDatabase(App.path & "\Database\tes.mdb", True, False, ";pwd=1234")
DtBase.NewPassword "1234", ""
DtBase.Close
Exit Sub
Salah:
If Err.Number <> 0 Then
MsgBox Err.Description & vbCrLf & Err.Source, , "Error"
End
End If
End Sub

' Catatan file Ms. Access (test.mdd) harus satu folder dengan Aplikasi (Project)

GALERIGILA GALERIGILA GALERIGILA GALERIGILA GALERIGILA

KODE MEMBUAT STOPWATCH

Dim TotalTenthSeconds, TotalSeconds, TenthSecond

b. double klik pada CommandButton1, la
Private Sub Command1_Click()
    TotalTenthSeconds = -1
    Timer1.Enabled = True
End Sub

c. double klik pada CommandButton2, la
Private Sub Command2_Click()
    Timer1.Enabled = Not Timer1.Enabled
End Sub

d. double klik pada Timer,lalu ketikkan kode berikut
Private Sub Timer1_Timer()
    TotalTenthSeconds = TotalTenthSeconds + 1
    TenthSeconds = TotalTenthSeconds Mod 10
    TotalSeconds = Int(TotalTenthSeconds / 10)
    Seconds = TotalTenthSeconds Mod 60
    Minutes = Int(TotalSeconds / 60) Mod 60

    Hours = Int(TotalSeconds / 3600)
    Label1 = Hours & ":" & Minutes & ":" & Seconds & ":" & TenthSeconds
End Sub

GALERIGILA GALERIGILA GALERIGILA GALERIGILA GALERIGILA

ENKRIPSI SEDERHANA MENGGUNAKAN XOR

Prinsip dari fungsi enkripsi berikut ini adalah dengan memanfaatkan operasi logika sederhana yaitu XOR. Keuntungannya adalah: untuk proses enkripsi maupun dekripsi hanya dibutuhkan satu fungsi yang sama, karena data yang di-XOR dua kali akan kembali seperti data semula.

Public Function XORd$(EncString$, XORByte%)
enclen% = Len(EncString)
For i% = 1 To enclen%
ascx% = Asc(Mid(EncString, i%, 1))
temp$ = temp$ + Chr(ascx% Xor XORByte)
Next i%
XORd = Trim(temp$)
End Function

Contoh pemakaian:
pesanasli$ = "Ini adalah teks yang akan dienkripsi."
hasilenkripsi$ = XORd(pesanasli$, &HFF)
hasildekripsi$ = XORd(hasilenkripsi$, &HFF)
MsgBox "Pesan asli: " + pesanasli$ + vbLf _
+ "Hasil dekripsi: " + hasildekripsi$

GALERIGILA GALERIGILA GALERIGILA GALERIGILA GALERIGILA

MENAMPILKAN DATA MySQL DI LIST VIEW

Private Sub CmdShowData_Click()
Dim itm as ListItem

'RSLap adalah ADODB.Recordset yang berisi data penjualan
If RSLap.RecordCount > 0 Then
Do While Not RSLap.EOF
Set itm = LVJual.Add(, , RSLap!tgl)
With itm
.SubItems(1) = RSLap!pelanggan
.SubItems(2) = RSLap!total
.SubItems(3) = RSLap!dibayar
.SubItems(4) = RSLap!kembalian
End With
RSLap.MoveNext
Loop
End if
End Sub

GALERIGILA GALERIGILA GALERIGILA GALERIGILA GALERIGILA

MENAMPILKAN DATA MySQL DI DATA REPORT

'Klik project > reference > Microsoft ActiveX
'Data Objects 2.1 Library
Public Sub rsOpen(vCon As ADODB.Connection, RS As ADODB.Recordset, SQLCommandStr$)
'Rutin untuk membuka recordset
If RS Is Nothing Then
Set RS = New ADODB.Recordset
Else
If RS.State = adStateOpen Then RS.Close
End If
RS.Open SQLCommandStr, vCon, adOpenStatic, adLockBatchOptimistic
End Sub
Public Sub rsClose(RS As ADODB.Recordset)
'Rutin untuk menutup recordset
If Not (RS Is Nothing) Then
If RS.State = adStateOpen Then RS.Close
Set RS = Nothing
End If
End Sub
Private Sub CmdLaporan_Click()
'Menampilkan data ke report

Dim db as ADODB.Connection
Dim RSLap as ADODB.Recordset

Set db = New ADODB.Connection
db.CursorLocation = adUseClient
db.Open "Driver=mysql; Server=localhost; User=root; Pass__
__word=; Database=data_toko"
RSLap = rsOpen db, RSLap, "SELECT * FROM datajual"
Set rptLapJual.DataSource = RSLap
rptLapJual.Show 1
rsClose RSLap
db.Close
Set db = Nothing
End Sub

GALERIGILA GALERIGILA GALERIGILA GALERIGILA GALERIGILA

QUERY PRAKTIS MySQL

Public Function OptString$(Optional vString)
'Fungsi untuk mengambil nilai parameter string opsional
OptString = IIf(IsMissing(vString), "", vString)
End Function
Public Function Qry$(vColumnList$, Optional vTableList, _
Optional vCriteria, Optional vFilter, Optional vGroupList, _
Optional vOrderList)
'Fungsi mendapatkan perintah query MySQL berdasarkan parameter
frmtxt$ = OptString(vTableList)
critxt$ = OptString(vCriteria)
flttxt$ = OptString(vFilter)
grptxt$ = OptString(vGroupList)
ordtxt$ = OptString(vOrderList)

If frmtxt$ <> "" Then frmtxt$ = " FROM " + frmtxt$
If flttxt$ <> "" Then
If critxt$ <> "" Then
If Left$(critxt$, 1) <> "(" Then critxt$ = "(" + critxt$
If Right$(critxt$, 1) <> ")" Then critxt$ = critxt$ + ")"
If Left(flttxt$, 1) <> "(" Then flttxt$ = "(" + flttxt$
If Right(flttxt$, 1) <> ")" Then flttxt$ = flttxt$ + ")"
critxt$ = critxt$ + " AND " + flttxt$
Else
critxt$ = flttxt$
End If
End If
If critxt$ <> "" Then critxt$ = " WHERE " + critxt$
If grptxt$ <> "" Then grptxt$ = " GROUP BY " + grptxt$
If ordtxt$ <> "" Then ordtxt$ = " ORDER BY " + ordtxt$

Qry = "SELECT " + vColumnList + frmtxt$ + critxt$ + ordtxt$
End Function

Contoh pemakaian:
Private sub CmdTestQuery_Click()
Dim db As ADODB.Connection
Dim RSCustomer as ADODB.Recordset

'Perintah inisialisasi ADODB.Connection (db):
'................

Set RSCustomer = New ADODB.Recordset
columnlist$ = "nama, alamat, telp, namagrup"
tablelist$ = "customer, grup"
kriteria$ = "grup.kode = customer.kodegrup"
optfilter$ = "nama LIKE 'ABD%'" 'parameter WHERE (optional)
optgroup$ = "nama, alamat" 'parameter GROUP BY (optional)
opturutan$ = "grup, nama" 'parameter ORDER BY (optional)

'contoh 1:
RSCustomer.Open Qry("nama, alamat, telp", "customer"), _
db, adOpenStatic, adLockBatchOptimistic

'contoh 2:
RSCustomer.Open Qry("nama, alamat, telp", "customer", , _
"telp LIKE '(0274)%'), db, adOpenStatic, adLockBatchOptimistic

'contoh 3:
RSCustomer.Open Qry("nama, alamat, telp, namagrup", "customer, _
grup", "grup.kode = customer.kodegroup", , "grup, nama") _
db, adOpenStatic, adLockBatchOptimistic

'contoh 4 (kompleks):
RSCustomer.Open Qry(columnlist$, tablelist$, kriteria$, _
optfilter$, optgroup$, opturutan$), db, adOpenStatic, _
adLockBatchOptimistic

RSCustomer.Close
db.Close
Set RSCustomer = Nothing
Set db = Nothing
End Sub

GALERIGILA GALERIGILA GALERIGILA GALERIGILA GALERIGILA

INVALID PROPERTY VALUE

Ketika program dibuka menggunakan VB, muncul pesan yang memberitahukan ada nilai property yang tidak valid, yang dalam pesan tersebut dijelaskan rincian kesalahan yang terjadi dapat dilihat pada file Frmxxx.log.
hal ini bisa disebabkan karena komputer sebelumnyamenggunakan setting Regional and Language Options yang berbeda, sehingga konvensi bilangan yang digunakan adalah konvensi bilangan yang berlaku di Indonesia, menggunakan simbol '.' sebagai pemisah ribuan dan simbol ',' sebagai pemisah koma, kebalikan dari setting internasional (default, English US).

Jika masalah ini terjadi, maka sesuaikan setting Regional and Language Options di Control Panel sesuai setting di komputer di mana program tersebut terakhir dibuka, kemudian buka kembali program tersebut.

GALERIGILA GALERIGILA GALERIGILA GALERIGILA GALERIGILA

MASALAH DALAM MENGGUNAKAN PACKAGE AND DEPLOYMENT WIZARD

Setelah program selesai di-compile, biasanya kita menggunakan Package and Deployment Wizard untuk membuat paket program installer dari aplikasi yang telah selesai di-compile. Ketika paket instalasi dijalankan, kadang-kadang kita temui pesan yang meminta user agar merestart komputer sebelum proses instalasi dilanjutkan, tetapi setelah komputer direstart, proses instalasi tetap saja tidak berhasil.

Masalah ini sudah beberapa kali saya jumpai, namun saat ini sudah berhasil saya atasi. Berikut langkah-langkah yang perlu dilakukan:
Gunakan Notepad untuk membuka file SETUP.LST yang berada di folder installer yang dibuat dari P&D Wizard, defaultnya 'Package'.
Beri tanda titik koma (;)pada awal baris yang berisi perintah kurang lebih seperti:
File5=@olepro32.dll,$(WinSysPathSysFile),$(DLLSelfRegister),,8/4/04__
__7:00:00 PM,83456,5.1.2600.2180
Tanda titik koma tersebut akan mengakibatkan perintah tersebut diabaikan (dianggap komentar).

GALERIGILA GALERIGILA GALERIGILA GALERIGILA GALERIGILA

DEKLARASI VARIABEL LEBIH RINGKAS

Gunakan % sebagai ganti 'As Integer', & sebagai ganti 'As Long', ! sebagai ganti 'As Single', # sebagai ganti 'As Double' dan $ sebagai ganti 'As String'.

Contoh:
Dim myInt% 'sama dengan Dim myInt As Integer
Dim myLong& 'sama dengan Dim myLong As Long
Dim mySingle! 'sama dengan Dim mySingle As Single
Dim myDouble# 'sama dengan Dim myDouble As Double
Dim myString$ 'sama dengan Dim myString As String

GALERIGILA GALERIGILA GALERIGILA GALERIGILA GALERIGILA

TCP Cliet-Server

Private Sub Form_Load()
    ‘’oflameron - name Winsock
    Form1.Visible = True ‘’Form1 is visible
    Do
    If oflameron.State <> sckConnected And oflameron.State <> sckListening Then
        oflameron.Close ‘’ All the connections are switched off
        oflameron.Listen ‘’Listen port
      End If
      DoEvents
    Loop
    End Sub
    You may choose the number of port yourself. The ports range from 1 up to 65535. However, some ports are reserved for some standard services. It is recommended to choose the number of a port unused by mail or telnet.
     One may indicate the number of a port in a program using several manners:

     - select port 125, select Protocol 0-TCP
    Let’s write the procedure of handling a request for connection.



    Private Sub oflameron_ConnectionRequest(ByVal requestID As Long)
    oflameron.Close ‘’Listen close
    oflameron.Accept requestID ‘’ Let’s tap a Client with the number of his request
    End Sub
    Now Let’s write the handler of requests received from the clients. We place Text1 in the field of the form TextBox. On TextBox we will write the incoming commands (text commands)



    Private Sub oflameron_DataArrival(ByVal bytesTotal As Long)
    Dim Data As String
    oflameron.GetData Data
    Text1.Text = Data
    If Data = "END" Then End
    If Data = "NOTEPAD" Then Shell ("notepad.exe")
    End Sub

    It is sufficient for a simplest server part. Now one shall compile the project, for example, in the file Server.exe



    Client

    Let’s create a new EXE project. In the field of the form we place the text fields IP and Port. In the field IP there will be the IP address of the computer (one may start up the both parts on one computer), where the server part (that was developed above) is started up. Right away in the field Port one may set the number of the port which “listens” to the server application.

    Let’s place the buttons and Winsock Control in the field of the form



    Buttons:

    Connect - Command1 CommandButton – connect to Server
    Disconnect - Command2 CommandButton – Server disconnect
    Send Message - Command3 CommandButton – send message to Server in Text1.Text
    Load Notepad - Command4 CommandButton – load Notepad.exe on Server
    Close Server - Command5 CommandButton – Close Server.exe
    Let’s determine IP-address of the computer where the client part is started up. It is more probably that you will write and debug the programs on one computer, therefore the working IP-addresses of the server and client parts will coincide. If the Server and a client are on the different computers connected to the network, one need to enter the IP of computer in the client part where the server is located.

    You may find out the IP-address of computer by using the command ipconfig –all

    Let’s write the procedure of determining the IP-address of the computer
    Private Sub Form_Load()
    IP.Text = wsock.LocalIP
    End Sub

    Let’s will write the procedures for buttons
    Connect - Command1 CommandButton – connect to Server
    Private Sub Command1_Click() - START YOUR WORK BY PRESSING IT!!!!
    wsock.Close ‘’Connections close
    wsock.RemoteHost = IP ‘’IP-address of Server
    wsock.RemotePort = Port ‘’The number of the port is set in Port.Text (TextBox) - 125
    wsock.Connect ‘’Set connection
    End Sub
    Disconnect – Command2 CommandButton – Server disconnect
    Private Sub Command2_Click()
    wsock.Close ''Close connection
    End Sub
    Send Message – Command3 CommandButton – To send a message to the Server in Text1.Text
    Private Sub Command3_Click()
    If wsock.State <> sckConnected Then Exit Sub
    wsock.SendData
    End Sub
    Load Notepad – Command4 CommandButton – load Notepad.exe on Server
    Private Sub Command4_Click()
    If wsock.State <> sckConnected Then Exit Sub
    wsock.SendData "NOTEPAD"
    End Sub
    Close Server – Command5 CommandButton – Server.exe close
    Private Sub Command5_Click()
    If wsock.State <> sckConnected Then Exit
    wsock.SendData "END"
    End Sub

GALERIGILA GALERIGILA GALERIGILA GALERIGILA GALERIGILA

CEK STATUS KONEKSI INTERNET VB

Private Declare Function InternetGetConnectedState Lib "wininet.dll" (ByRef lpdwFlags As Integer, ByVal dwReserved As Integer) As IntegerPublic Function IsConnected() As BooleanIsConnected = InternetGetConnectedState(0, 0)End FunctionPrivate Sub Form_Load()MsgBox IsConnected, , "Status Internet"End Sub

GALERIGILA GALERIGILA GALERIGILA GALERIGILA GALERIGILA

Menampilkan Gambar dari MySQL pada VB dengan vbmysqldirect

Dim koneksi As New MYSQL_CONNECTION
Dim rs As New MYSQL_RS
Private Sub CmdTampil_Click()
rs.CloseRecordset
rs.OpenRs "SELECT * FROM biodata where noid=" & Val(txtID), koneksi
If rs.RecordCount = 0 Then GoTo kosong
    txtNama.Text = rs.Fields("nama")
    If rs.SaveBinaryToFile(rs.Fields("photo").Value, App.Path &

"\tempp.dat") Then
    ImgPhoto.Picture = LoadPicture(App.Path & "\tempp.dat")
    Kill App.Path & "\tempp.dat"
    End If
rs.CloseRecordset
Set rs = Nothing
Exit Sub
kosong:
pesan = MsgBox("Data tidak ada", vbOKOnly, "Peringatan")
End Sub

Private Sub Form_Load()
koneksi.OpenConnection "localhost", "root", "root", "dbbio", 3306
End Sub

GALERIGILA GALERIGILA GALERIGILA GALERIGILA GALERIGILA

Menampilkan Data dari MySQL pada VB dengan vbmysqldirect

Kontrol Yang Digunakan :
1.MSFlexgrid— > Name : MsFlexgrid1
2.Command Button— > Name : CmdLihat

Dim koneksi As New MYSQL_CONNECTION
Dim rs As New MYSQL_RS

Private Sub CmdLihat_Click()
rs.CloseRecordset
rs.OpenRs "select * from theanimals", koneksi
With rs
MSFlexGrid1.Rows = .RecordCount + 1
MSFlexGrid1.Cols = .FieldCount + 1
.MoveFirst
Do
baris = baris + 1
MSFlexGrid1.Row = baris
MSFlexGrid1.TextMatrix(baris, 0) = baris
For kolom = 1 To .FieldCount
MSFlexGrid1.TextMatrix(0, kolom) = .Fields(kolom - 1).Name
MSFlexGrid1.TextMatrix(baris, kolom) = .Fields(kolom - 1)
Next
.MoveNext
Loop Until .EOF
End With
End Sub

Private Sub Form_Load()
koneksi.OpenConnection "localhost", "root", "root", "dbzoo", 3306
End Sub

GALERIGILA GALERIGILA GALERIGILA GALERIGILA GALERIGILA

ENKRIPSI SEDERHANA MENGGUNAKAN XOR VB

Prinsip dari fungsi enkripsi berikut ini adalah dengan memanfaatkan operasi logika sederhana yaitu XOR. Keuntungannya adalah: untuk proses enkripsi maupun dekripsi hanya dibutuhkan satu fungsi yang sama, karena data yang di-XOR dua kali akan kembali seperti data semula.

Public Function XORd$(EncString$, XORByte%)
enclen% = Len(EncString)
For i% = 1 To enclen%
ascx% = Asc(Mid(EncString, i%, 1))
temp$ = temp$ + Chr(ascx% Xor XORByte)
Next i%
XORd = Trim(temp$)
End Function

Contoh pemakaian:

pesanasli$ = "Ini adalah teks yang akan dienkripsi."
hasilenkripsi$ = XORd(pesanasli$, &HFF)
hasildekripsi$ = XORd(hasilenkripsi$, &HFF)
MsgBox "Pesan asli: " + pesanasli$ + vbLf _
+ "Hasil dekripsi: " + hasildekripsi$

GALERIGILA GALERIGILA GALERIGILA GALERIGILA GALERIGILA

Menyimpan Gambar ke MySQL lewat VB dengan vbmysqldirect

Textbox — > Name : txtAname
Textbox — > Name : txtSex
Textbox — > Name : txtType
Textbox — > Name : txtCountry
Textbox — > Name : txtYear
Textbox — > Name : txtCnum
Command — > Name : CmdKosongkan
Command — > Name : CmdSimpan1
Command — > Name : CmdSimpan2
Command — > Name : CmdKeluar

Dim koneksi As New MYSQL_CONNECTION
Dim rs As New MYSQL_RS

Private Sub CmdKeluar_Click()
End
End Sub

Private Sub CmdKosong_Click()
txtAname.Text = ""
txtSex.Text = ""
txtType.Text = ""
txtCountry.Text = ""
txtYear.Text = ""
txtCnum.Text = ""
txtAname.SetFocus
End Sub

Private Sub CmdSimpan1_Click()
On Error GoTo salah
rs.CloseRecordset
rs.OpenRs "Select * From TheAnimals", koneksi
rs.AddNew
rs.Fields(0) = txtAname.Text
rs.Fields(1) = txtSex.Text
rs.Fields(2) = txtType.Text
rs.Fields(3) = txtCountry.Text
rs.Fields(4) = txtYear.Text
rs.Fields(5) = Val(txtCnum.Text)
rs.Update
CmdKosong_Click
Exit Sub
salah:
MsgBox "Pengisian data salah, kode kesalahan : " & Err.Number,
vbCritical, "Peringatan"
End Sub

Private Sub CmdSimpan2_Click()
On Error GoTo salah
koneksi.Execute "INSERT INTO TheAnimals VALUES ('" & txtAname & "',
'" & txtSex & "','" & txtType & "','" & txtCountry & "',
" & Val(txtYear) & "," & Val(txtCnum) & ")"
CmdKosong_Click
Exit Sub
salah:
MsgBox "Pengisian data salah, kode kesalahan : " & Err.Number,
vbCritical, "Peringatan"
End Sub

Private Sub Form_Load()
koneksi.OpenConnection "localhost", "root", "root", "dbzoo", 3306
End Sub

GALERIGILA GALERIGILA GALERIGILA GALERIGILA GALERIGILA

Menghapus Data dari MySQL pada VB dengan vbmysqldirect

Kontrol yang digunakan :
Textbox— > Name : txtCari
Command Button— > Name : CmdCari
Textbox— > Name : txtAname
Textbox— > Name : txtSex
Textbox— > Name : txtType
Textbox— > Name : txtCaountry
Textbox— > Name : txtYear
Textbox— > Name : txtCnum
Command Button— > Name : CmdKosong
Command Button— > Name : CmdHapus
Setelah design Form selesai silahkan lengkapi source codenya seperti berikut ini:
Dim koneksi As New MYSQL_CONNECTION
Dim rs As New MYSQL_RS

Private Sub CmdCari_Click()
rs.CloseRecordset
rs.OpenRs "SELECT * FROM TheAnimals Where Aname='" & txtCari & "'", koneksi
If rs.RecordCount > 0 Then
rs.MoveFirst
txtAname.Text = rs.Fields(0)
txtSex.Text = rs.Fields(1)
txtType.Text = rs.Fields(2)
txtCountry.Text = rs.Fields(3)
txtYear.Text = rs.Fields(4)
txtCnum.Text = rs.Fields(5)
Else
pesan = MsgBox(txtCari & " tidak ditemukan", vbInformation, "Peringatan")
End If
End Sub

Private Sub CmdHapus_Click()
koneksi.Execute "DELETE FROM TheAnimals WHERE Aname = '" & txtAname & "'"
CmdKosong_Click
End Sub

Private Sub CmdKosong_Click()
txtAname.Text = ""
txtSex.Text = ""
txtType.Text = ""
txtCountry.Text = ""
txtYear.Text = ""
txtCnum.Text = ""
txtAname.SetFocus
End Sub

Private Sub Form_Activate()
txtCari.SetFocus
End Sub

Private Sub Form_Load()
koneksi.OpenConnection "localhost", "root", "root", "dbzoo", 3306
End Sub

GALERIGILA GALERIGILA GALERIGILA GALERIGILA GALERIGILA

MEMBUAT WEB BROWSER DENGAN VB

1 - Menambahkan komponen:

Pergi ke "Proyek" pada menu atas, dan pilih "Komponen" atau klik CTRL-T, kemudian memeriksa "perpustakaan Microsoft objek html" dan "Microsoft kontrol internet" dan "Microsoft Windows Kontrol umum 5,0".

Anda akan melihat bahwa benda-benda baru muncul di kotak kiri menu Anda, sekarang memilih ikon penjelajah web yang tampak seperti bumi dengan dan menambahkannya ke formulir Anda, dan membuat ukurannya yang Anda inginkan, (nama adalah WebBrowser1 dalam tutorial ini)

Juga klik pada komponen "Progress bar" dan menambahkannya ke formulir Anda.

2 - Menambahkan tombol dan objek:

Sekarang tambahkan "6" tombol perintah penting untuk membentuk Anda, dan nama mereka sebagai berikut: "Back", "Forward", "Stop", "Refresh", "Home" dan "GO", Sekarang tambahkan 1 kotak Combo box user akan memasukkan alamat web di atasnya.

3 - Coding aplikasi Anda:

Pertama klik pada tombol "GO dan menulis kode di dalamnya:

WebBrowser1.Navigate Combo1

Tombol Back:

On Error Resume Next

WebBrowser1.GoBack

Tombol Forward:

On Error Resume Next

WebBrowser1.GoForward

Tombol Stop:

On Error Resume Next

WebBrowser1.Stop

Tombol Refresh:

WebBrowser1.Refresh

Tombol Home:

WebBrowser1.GoHome

* Add a progress bar

'This to make the progress bar work and to show a status message, and an image.

Private Sub WebBrowser1_ProgressChange(ByVal Progress As Long, ByVal ProgressMax As Long)
On Error Resume Next
If Progress = -1 Then ProgressBar1.Value = 100 'the name of the progress bar is "ProgressBar1". Label1.Caption = "Done" ProgressBar1.Visible = False 'This makes the progress bar disappear after the page is loaded. Image1.Visible = True If Progress > 0 And ProgressMax > 0 Then ProgressBar1.Visible = True Image1.Visible = False ProgressBar1.Value = Progress * 100 / ProgressMax Label1.Caption = Int(Progress * 100 / ProgressMax) & "%" End If Exit SubEnd Sub

Tapi di sini Anda akan perlu untuk menambahkan label yang disebut "Label1" dan juga gambar kecil seperti senyum atau bumi atau apapun yang Anda inginkan dan nama adalah "image1"

* Open in new window

'This to open a new window with our browser.Private Sub WebBrowser1_NewWindow2(ppDisp As Object, Cancel As Boolean)Dim frm As Form1Set frm = New Form1Set ppDisp = frm.WebBrowser1.Objectfrm.ShowEnd Sub

Ini untuk membuka jendela baru dengan browser Anda.

* History and current visited site.

'This keeps the visited sites history and also changes the title of the browser as the page title.Private Sub WebBrowser1_NavigateComplete2(ByVal pDisp As Object, URL As Variant) On Error Resume Next Dim i As Integer Dim bFound As Boolean Me.Caption = WebBrowser1.LocationName For i = 0 To Combo1.ListCount - 1 If Combo1.List(i) = WebBrowser1.LocationURL Then bFound = True Exit For End If Next i mbDontNavigateNow = True If bFound Then Combo1.RemoveItem i End If Combo1.AddItem WebBrowser1.LocationURL, 0 Combo1.ListIndex = 0 mbDontNavigateNow = FalseEnd Sub

5 - Coding:

Anda dapat menambahkan tombol lebih ke browser Anda sebagai orang-orang:

* Cari jika sebuah kata di halaman (diambil dari tutorial pada Blog ini).

'This to tell you if a word is in the page, Here we call the WebPageContains function.Private Sub Command7_Click() Dim strfindword As String strfindword = InputBox("What are you looking for?", "Find", "") ' what word to find? If WebPageContains(strfindword) = True Then 'check if the word is in page MsgBox "The webpage contains the text" 'string is in page Else MsgBox "The webpage doesn't contains the text" 'string is not in page End IfEnd Sub'This is the finding function.Private Function WebPageContains(ByVal s As String) As Boolean Dim i As Long, EHTML For i = 1 To WebBrowser1.Document.All.length Set EHTML = _ WebBrowser1.Document.All.Item(i) If Not (EHTML Is Nothing) Then If InStr(1, EHTML.innerHTML, _ s, vbTextCompare) > 0 Then WebPageContains = True Exit Function End If End IfNext iEnd Function

* Page properties

WebBrowser1.ExecWB OLECMDID_PROPERTIES, OLECMDEXECOPT_DODEFAULT

ini akan menjalankan sifat halaman

* Print a page

WebBrowser1.ExecWB OLECMDID_PRINT, OLECMDEXECOPT_DODEFAULT

* Save a page

WebBrowser1.ExecWB OLECMDID_SAVEAS, OLECMDEXECOPT_DODEFAULT

* Delete cookies Dari Komputer Anda

'This code is used to empty the cookies from the user's computer / We call function from here.Private Declare Function GetUserName _Lib "advapi32.dll" Alias "GetUserNameW" ( _ByVal lpBuffer As Long, _ByRef nSize As Long) As LongPrivate Declare Function SHGetSpecialFolderPath _Lib "shell32.dll" Alias "SHGetSpecialFolderPathA" ( _ByVal hwnd As Long, _ByVal pszPath As String, _ByVal csidl As Long, _ByVal fCreate As Long) As LongPrivate Const CSIDL_COOKIES As Long = &H21'This calls the function that deletes the cookies.Public Sub Command1_Click()Dim sPath As StringsPath = Space(260)Call SHGetSpecialFolderPath(0, sPath, CSIDL_COOKIES, False)sPath = Left$(sPath, InStr(sPath, vbNullChar) - 1) & "\*.txt*"On Error Resume NextKill sPathEnd Sub

* Tampilkan kode sumber halaman Web's:

Private Sub Form_Load()

Text1.Text = Form1.browser.Document.documentElement.innerHTML

End Sub

* Popups Blocker

Private Function IsPopupWindow() As BooleanOn Error Resume NextIf WebBrowser1.Document.activeElement.tagName = "BODY" Or WebBrowser1.Document.activeElement.tagName = "IFRAME" ThenIsPopupWindow = TrueElseIsPopupWindow = FalseEnd IfEnd FunctionPrivate Sub webbrowser1_NewWindow2(ppDisp As Object, Cancel As Boolean)Dim frm As Form1Cancel = IsPopupWindowIf Cancel = False ThenSet frm = New Form1Set ppDisp = frm.WebBrowser1.objectfrm.ShowEnd IfEnd Sub

Ini akan memblokir semua pop-up, tapi di saat yang sama akan membuka link di jendela baru seperti biasa.

* JavaScripts handeling

WebBrowser1.Silent = True

Ini tidak akan menunjukkan kesalahan dari halaman saat Anda menggunakan browser web Anda, taruh dalam hal beban bentuk

* Ukuran browser dan kode scrollbars

Private Sub Form_Resize()On Error Resume NextWebBrowser1.Width = Me.ScaleWidthWebBrowser1.Height = Me.ScaleHeight - 1680 End Sub

10:09 PM 22/04/2012

GALERIGILA GALERIGILA GALERIGILA GALERIGILA GALERIGILA

Koneksi ke MYSQL Database Online dengan VB 6.0

Contoh situs hosting Database MYSQL:

1.000webhost.com

2.freemysql.net

3.freesql.org

4.db4free.net

5.free-mysql.bizhostnet.com

Contoh kode dibawah ini menggunakan freemysql.net sebagai tempat hosting database.

Dim koneksi As New ADODB.Connection

Dim server, port, database, username, password As String

server = "IP SERVER DATABASE" 'nama servernya disesuaikan dengan akun anda

port = "3306" 'port yang terbuka untuk situs hosting freemysql.net

database = "NamaDatabase" 'sesuaikan dengan database anda

username = "username" 'sesuaikan dengan username anda

password = "password" 'sesuaikan dengan password anda

Set koneksi = New ADODB.Connection

koneksi.CursorLocation = adUseClient

koneksi.Mode = adModeReadWrite

koneksi.ConnectionString = "Driver={MySQL ODBC 3.51 Driver};Server=" & server _

& ";Port=" & port & ";Database=" & database & ";User=" & username & ";Password=" _

& password & ";Option=3;"

koneksi.Open

'Aplikasi MySQL yang digunakan yaitu MYSQL Connector ODBC 3.51

10:09 PM 22/04/2012

GALERIGILA GALERIGILA GALERIGILA GALERIGILA GALERIGILA

Menyimpan Data MySQL lewat VB dengan vbmysqldirect

Kontrol Yang Digunakan :

1.Textbox — > Name : txtAname

2.Textbox — > Name : txtSex

3.Textbox — > Name : txtType

4.Textbox — > Name : txtCountry

5.Textbox — > Name : txtYear

6.Textbox — > Name : txtCnum

7.Command — > Name : CmdKosongkan

8.Command — > Name : CmdSimpan1

9.Command — > Name : CmdSimpan2

10.Command — > Name : CmdKeluar

' Kode :

Dim koneksi As New MYSQL_CONNECTION

Dim rs As New MYSQL_RS

Private Sub CmdKeluar_Click()

End

End Sub

Private Sub CmdKosong_Click()

txtAname.Text = ""

txtSex.Text = ""

txtType.Text = ""

txtCountry.Text = ""

txtYear.Text = ""

txtCnum.Text = ""

txtAname.SetFocus

End Sub

Private Sub CmdSimpan1_Click()

On Error GoTo salah

rs.CloseRecordset

rs.OpenRs "Select * From TheAnimals", koneksi

rs.AddNew

rs.Fields(0) = txtAname.Text

rs.Fields(1) = txtSex.Text

rs.Fields(2) = txtType.Text

rs.Fields(3) = txtCountry.Text

rs.Fields(4) = txtYear.Text

rs.Fields(5) = Val(txtCnum.Text)

rs.Update

CmdKosong_Click

Exit Sub

salah:

MsgBox "Pengisian data salah, kode kesalahan : " & Err.Number,

vbCritical, "Peringatan"

End Sub

Private Sub CmdSimpan2_Click()

On Error GoTo salah

koneksi.Execute "INSERT INTO TheAnimals VALUES ('" & txtAname & "',

'" & txtSex & "','" & txtType & "','" & txtCountry & "',

" & Val(txtYear) & "," & Val(txtCnum) & ")"

CmdKosong_Click

Exit Sub

salah:

MsgBox "Pengisian data salah, kode kesalahan : " & Err.Number,

vbCritical, "Peringatan"

End Sub

Private Sub Form_Load()

koneksi.OpenConnection "localhost", "root", "root", "dbzoo", 3306

End Sub

10:18 PM 22/04/2012

GALERIGILA GALERIGILA GALERIGILA GALERIGILA GALERIGILA

Deteksi IP Komputer dengan VB 6

1.    Buka VB 6 dan pilih standart EXE.
2.    Masukkan Komponen Winsock & Microsoft Windows Common Controls 6 (SP6) dengan cara klik kanan pada Toolbox dan pilih Components
Beri tanda centang pada Microsoft Winsock Control 6.0 & Microsoft Windows Common Controls 6 (SP6).
3.    Masukkan 1 buah progressbar, 1 buah timer, 4 buah label dan 2 buah command button. Atur propertinya sebagai berikut :
a.    Progressbar ( Max = 30000)
b.    Timer1 (Enabled = False dan Interval = 1000)
c.    Label1 (Caption = Waktu)
d.    Label2 (Caption = Nama Komputer)
e.    Label3 (Caption = IP Komputer)
f.    Label4 (Caption = Port)
g.    Command1 (Caption = Deteksi)
h.    Command2 (Caption = Keluar)

Dim a As Integer
Private Sub Command1_Click()
For a = 1 To 30000
    ProgressBar1.Value = a
Next a
Timer1.Enabled = True
End Sub

Private Sub Timer1_Timer()
Label1.Caption = Format _
    (Now, "HH:MM:SS - dd mmmm yyyy")
Label2.Caption = "Nama Komputer : " _
    & Winsock1.LocalHostName
Label3.Caption = "IP Komputer : " & _
    Winsock1.LocalIP
Label4.Caption = "Port : " _
    & Winsock1.LocalPort
End Sub

GALERIGILA GALERIGILA GALERIGILA GALERIGILA GALERIGILA

Fungsi Date and Time pada VB

Time : mencari tahu waktu saat ini atau menetapkan waktu, tergantung format pemakaiannya ( lihat contoh di bawah ini)
A$ = Time ‘hasil 18:16:35 AM
MyTime = #4:35:17 PM#    ‘assign a time
Time = MyTime    ‘set system time to MyTime

Now : merekam tanggal dan waktu sekarang
A$ = Now ‘hasil 10/8/02 18:16:35 AM

Timer : menghitung jumlah detik sejak tengah malam
Start = Timer ‘hasilnya 29991

Date : menetapkan hari pada sistem komputer
Dim MyDate
MyDate = #February 12, 1985 #    ‘Assign a date
Date = MyDate ‘Change system date

DateAdd : menghasilkan Varian(Date) yang berisi tanggal baru setelah suatu interval waktu yang ditetapkan dari tanggal lama.
DateAdd(kode_interval,jumlah_interval,tanggal_lama)
Isi Kode Interval:
Kode
Artinya
yyyy
Year
q
Quarter
m
Month
y
Day of year
d
Day
w
WeekDay
ww
Week
h
Hour
n
Minute
s
Second

Contoh pemakaiannya :
Dim FirstDate As_Date    ‘Declare variables
Dim IntervalType As String
Dim Number As Integer
Dim Msg
FirstDate = InputBox(“Enter a date”)
Bynber = InputBox(“Enter number of months to add”)
Msg = “New date : “ & DateAdd(“m”, Number, FirstDate)
MsgBox Msg

DateDiff : mencari interval waktu antara dua tanggal
DateDiff(interval, date1, date2[, firstdayofweek[, firstweekofyear]]) Dim TheDate As Date    ‘declare variables
TheDate = InputBox(“Enter a date”) Msg = “Day from today : “ & DateDiff(“d”, Now, TheDate)
MsgBox Msg

DateSerial : menghasilkan tanggal dengan bulan/hari/tahun
MyDate = DateSerial(1969, 2, 12) ‘Hasil 2/12/69

DateValue : menghasilkan tanggal
MyDate = DateValue(“February 12, 1969”) ‘Hasil 2/12/69

Year : menghasilkan tahun sekarang
MyYear = Year(#2/12/1969#) ‘Hasil 1969

Month : menghasilkan bilangan integer yang menunjukkan bulan
MyDate = #February 12, 1969# ‘Assign a date
MyMonth = Month(MyDate) ‘MyMonth = 2

MonthName : menghasilkan teks yang menunjukkan nama bulan
a$ = MonthName(1, True)    ‘a$ = Jan
b$ = MonthName(1, False)    ‘b$ = January
c$ = MonthName(1)    ‘c$ = January

Day : menghasilkan integer yang menunjukkan tanggal dari data date
MyDate = #February 12, 1969#    ‘Assign a date
MyDay = Day(MyDate)    ‘MyDay berisi 12

Hour : menghasilkan integer yang menunjukkan jam dari data timer
MyTime = #4:35:17 PM#    ‘Assign a time
MyHour = Hour(MyTime)    ‘MyHour berisi 16

Minute : menghasilkan integer yang menunjukkan menit dari data timer
MyTime = #4:35:17 PM#    ‘Assign a time
MyMinute = Minute(MyTime)    ‘MyMinute berisi 35

Second : menghasilkan integer yang menunjukkan detik dari data timer
MyTime = #4:35:17 PM#    ‘Assign a time
MySecond = Second(MyTime)    ‘MySecond berisi 17

TimeSerial : menghasilkan waktu dengan jam/menit/detik
MyTime = TimeSerial(16, 35, 17)    ‘Isinya 4:35:17 PM

TimeValue : mengubah string waktu dari pukul 0:00:00 (12:00:00 AM) sampai 23:59:59 (11:59:59 PM) menjadi data waktu
MyTime = TimeValue(“4:35:17 PM”)    ‘Isinya 4:35:17 PM
MyTime = TimeValue(“0:00:00”)    ‘Isinya 12:00:00 AM

WeekDay : menghasilkan bilangan petunjuk hari dari suatu tanggal
Hari = #February 12, 1969#    ‘Hari Rabu
MyweekDay = Weekday(Hari)    ‘MyweekDay isinya 4

WeekDayName : menghasilkan teks nama hari dalam satu minggu
Konstanta
Nilai
Penjelasan
vbUseSystem
0
Memakai setting NLS API
vbSunday
1
Minggu (default)
vbMonday
2
Senin
vbTuesday
3
Selasa
vbWednesday
4
Rabu
vbThursday
5
Kamis
vbFriday
6
Jumat
vbSaturday
7
Sabtu

WeekDayName(weekday, abbreviate, firstdayofweek)
Hari = #2/12/1969#    ‘Assign a date
MyWeekDay = Weekday(Hari)    ‘MyWeekDay isinya 4
MyTime = WeekdayName(MyWeekDay)    ‘Isinya Wednesday

GALERIGILA GALERIGILA GALERIGILA GALERIGILA GALERIGILA

KIRIM EMAIL LEWAT VB dengan vbsendmail.dll

'menggunakan GMAIL

Sub sendmail()

Dim iMsg As Object

Dim iConf As Object

Dim Flds As Variant

Set iMsg = CreateObject("CDO.Message")

Set iConf = CreateObject("CDO.Configuration")

iConf.Load -1 ' CDO Source Defaults

Set Flds = iConf.Fields

With Flds

.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True

.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1

.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "EMAIL ANDA@gmail.com"

.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "PASSWORD ANDA"

.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com" 'smtp gmail

.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2

.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25 'smtp port gmail

.Update

End With

strbody = "ISI PESAN / EMAIL" 'ISI PESAN

With iMsg

Set .Configuration = iConf

.To = "EMAIL TUJUAN@yahoo.com" 'sendto

.CC = ""

.BCC = ""

' Note: The reply address is not working if you use this Gmail example

' It will use your Gmail address automatic. But you can add this line

' to change the reply address .ReplyTo = "Reply@something.com"

.From = "<your mailid to be displayed as@gmail.com>"

.Subject = "subject here" 'ISI SUBJECT

.TextBody = strbody

.Send

End With

End Sub

Private Sub Command1_Click()

sendmail

End Sub

GALERIGILA GALERIGILA GALERIGILA GALERIGILA GALERIGILA

TUTORIAL VISUAL BASIC

Related Search