Mengirim Email Lewat VB6.0 Menggunakan Vbsendmail.dll

Di bawah ini merupakan contoh kode untuk mengirim email lewat VB6.0 menggunakan bantuan ActiveX (vbSendMail.dll). VB SendMail merupakan ActiveX yang digunakan untuk mengirim email, terdokumentasi dengan baik dan lengkap. Anda dapat memperoleh komponen tersebut di freevbsource.com silakan Anda kunjungi situsnya.

Option Explicit

Private WithEvents poSendMail As vbSendMail.clsSendMail
Private bSendFailed As Boolean

Private Sub Command1_Click()
  Dim lCount As Long
  Dim lCtr As Long
  Dim t!

  Command1.Enabled = False
  bSendFailed = False
  lstStatus.Clear
  lblTime.Caption = ""
  Screen.MousePointer = vbHourglass

  With poSendMail
      .SMTPHost = "smtp.telkom.net"
      .From = txtSender.Text
      .FromDisplayName = txtName.Text
      .Message = txtMsg.Text
      .AsHTML = True
      t! = Timer
      .Recipient = txtRecipient.Text
       RecipientDisplayName = txtRecName.Text
      .Subject = txtSubject.Text
      lblTime = "Sending message " & Str(lCtr)
      .Send
  End With

  If Not bSendFailed Then lblTime.Caption = Str(lCount) & " Messages sent in " & Format$(Timer - t!, "#,##0.0") & " seconds."
  Screen.MousePointer = vbDefault
  Command1.Enabled = True
End Sub

Private Sub Form_Load()
  Set poSendMail = New clsSendMail
End Sub

Private Sub poSendMail_Progress(lPercentCompete As Long)
  lblProgress = lPercentCompete & "% complete"
End Sub

Private Sub poSendMail_SendFailed(Explanation As String)
  MsgBox ("Your attempt to send mail failed for the following reason(s): " & vbCrLf & Explanation)
  bSendFailed = True
  lblProgress = ""
  lblTime = ""
End Sub

Private Sub poSendMail_SendSuccesful()
  lblProgress = "Send Successful!"
End Sub

Private Sub poSendMail_Status(Status As String)
   lstStatus.AddItem Status
  lstStatus.ListIndex = lstStatus.ListCount - 1
  lstStatus.ListIndex = -1
End Sub

Download: Source Code

READ MORE - Mengirim Email Lewat VB6.0 Menggunakan Vbsendmail.dll

VB6 Code - Fungsi Format RTF Untuk Pembuatan Kamus

Pernah menggunakan Kamus 2.04 (Kamus Bahasa Inggris)? Di sana terdapat objek RichTextBox yang memuat terjemahan bahasa Inggris yang diformat secara warna-warni. Kamus tersebut dibuat dengan bahasa pemrograman Delphi. Nah, Bagaimana imlementasi format RichTextBox tersebut dalam bahasa pemrograman VB6.0.
Di bawah ini merupakan contoh format RTF untuk keperluan pembuatan kamus Bahasa Inggris. Fungsi di bawah ini dapat bekerja dengan sangat cepat, mengapa? karena ia tidak memformat tulisan pada objeknya secara langsung akan tetapi, memformat string yang terdapat dalam memori kemudian mem-feed-nya kembali ke dalam objek RichTextBox.

Bukankah:

Private Sub Command1_Click()
Dim i As Integer
For i = 1 To 1000
  Text1.Text = Text1.Text & "contoh tulisan" & vbCrLf
Next
End Sub

Berbeda dengan kode di bawah ini:

Private Sub Command1_Click()
Dim i As Integer
Dim sText As String
sText = Text1.Text
For i = 1 To 1000
  sText = sText & "contoh tulisan" & vbCrLf
Next
Text1.Text = sText
End Sub

Sepintas dua kode di atas akan memberikan hasil yang sama akan tetapi berbeda jauh dalam segi kecepatan.

Di bawah ini merupakan fungsi format RTF untuk pembuatan kamus bahasa inggris:

Option Explicit

Public Function FormatSentence(sSentence As String) As String
Dim sFormat As String
Dim sKosakata As String
Dim sText As String
Dim i As Integer
sFormat = "{\rtf1\fbidis\ansi\ansicpg1256\deff0\deflang1025{\fonttbl{\f0\fswiss\fcharset0 Arial;}}" & vbCrLf & _
"{\colortbl ;\red128\green0\blue0;\red0\green0\blue255;\red0\green128\blue128;\red0\green0\blue128;\red255\green0\blue0;\red128\green0\blue128;}" & vbCrLf & _
"{\*\generator Msftedit 5.41.15.1512;}\viewkind4\uc1\pard\ltrpar\lang1033\f0\fs17"
sKosakata = sSentence
sText = " " & Text1.Text
sText = Replace(sText, vbCrLf, " \Par" & vbCrLf)
sText = Replace(sText, " kb. ", " \cf2\b kb. \cf0\b0 ")
sText = Replace(sText, " -kki. ", " \cf5\b kki. \cf0\b0 ")
sText = Replace(sText, " kk. ", " \cf1\b kk. \cf0\b0 ")
sText = Replace(sText, " ks. ", " \cf3\b ks. \cf0\b0  ")
sText = Replace(sText, " -ks. ", " \cf3\b -ks. \cf0\b0 ")
sText = Replace(sText, " -kkt. ", " \cf5\b -kkt. \cf0\b0 ")
sText = Replace(sText, "(", "\cf5(\cf0 ")
sText = Replace(sText, ")", "\cf5)\cf0 ")
For i = 1 To 100
  If InStr(1, sText, i) Then
      sText = Replace(sText, " " & i & " ", " \b " & i & " \cf0\b0 ")
  End If
Next
sText = Replace(sText, " -kkt. ", " \cf5\b -kkt. \cf0\b0 ")
sText = Replace(sText, " ks. ", " \cf3\b ks. \cf0\b0 ")
sText = sFormat & "\b " & sKosakata & "\b0 " & sText & "\par" & vbCrLf & "}"
FormatSentence = sText
End Function

Private Sub Form_Load()
RTF.BackColor = RGB(241, 243, 241)
End Sub

Contoh penggunaan fungsi di atas:

Private Sub Command1_Click()
RTF.TextRTF = FormatSentence(Text2.Text)
End Sub

Maka hasilnya seperti gambar di bawah ini:

Catatan:
Fungsi di atas hanyalah sekadar contoh, Anda dapat memodifikasinya untuk disesuaikan dengan kebutuhan.

Download: Source code fungsi format RTF untuk Kamus Bahasa Inggris

READ MORE - VB6 Code - Fungsi Format RTF Untuk Pembuatan Kamus

Advance Form Center - Bagian Dua

Advance form center - Ini merupakan fungsi untuk menyimpan form di tengah layar, adapun ditambah kata advance, karena ia memiliki beberapa keunggulan, yaitu:menjalankan form dan menempatkannya di tengah layar, ini hanya dilakukan sekali pada saat ia ditampilkan pertama kali, setelah itu form akan mengikuti nilai yang ada pada registry.

'simpan kode di bawah pada module 
Option Explicit 
 
Private Declare Function GetSystemMetrics Lib "user32" ByVal nIndex As Long) As Long 
Private Const SM_CXFULLSCREEN = 16 
Private Const SM_CYFULLSCREEN = 17 
 
Private Const strKey As String = "HKEY_CURRENT_USER\Software\" 
 
Public Function   SavePositionsInRegistry(frm As Form) 
     
    If frm.WindowState = vbMaximized Or frm.WindowState = vbMinimized Then Exit Function 
     
    Dim KeyReg As String, k As String 
     
    KeyReg = strKey & App.Title & "\" & frm.Name & "\" 
    RegWrite KeyReg & "FormLeft", frm.Left 
    RegWrite KeyReg & "FormTop", frm.Top 
    RegWrite KeyReg & "FormWidth", frm.Width 
    RegWrite KeyReg & "FormHeight", frm.Height 
     
End Function 
 
Public Function   GetPositionsFromRegistry(frm As Form) 
     
    If frm.WindowState = vbMaximized Or frm.WindowState = vbMinimized Then Exit Function 
     
    Dim KeyReg As String 
    Dim ileft, itop, iwidth, iheight 
    Dim lCenterLeft As Long, lCenterTop As Long 
     
    GetFormCenter frm, lCenterLeft, lCenterTop 
    KeyReg = strKey & App.Title & "\" & frm.Name & "\" 
     
    ileft = IIf(IsEmpty(RegRead(KeyReg & "FormLeft")), lCenterLeft, RegRead(KeyReg & "FormLeft")) 
    itop = IIf(IsEmpty(RegRead(KeyReg & "FormTop")), lCenterTop, RegRead(KeyReg & "FormTop")) 
    iwidth = IIf(IsEmpty(RegRead(KeyReg & "FormWidth")), frm.Width, RegRead(KeyReg & "FormWidth")) 
    iheight = IIf(IsEmpty(RegRead(KeyReg & "FormHeight")), frm.Height, RegRead(KeyReg & "FormHeight")) 
     
    frm.Move ileft, itop, iwidth, iheight 
     
End Function 
 
Private Function GetFormCenter(frm As Form, lLeft As Long, lTop As Long) 
   With frm 
      lLeft =   Screen.TwipsPerPixelX * GetSystemMetrics(SM_CXFULLSCREEN) / 2)) - .Width / 2) 
      lTop = Screen.TwipsPerPixelY * GetSystemMetrics(SM_CYFULLSCREEN) / 2)) - .Height / 2) 
   End With 
End Function 

READ MORE - Advance Form Center - Bagian Dua

Kamus Bahasa Arab v3.0 | Sebelum Memulai

Software Kamus Bahasa Arab v3.0 hanya dapat berjalan pada windows yang mendukung penulisan arab, diantaranya:

1. Windows 98 Arabic Enable
2. Windows Me Arabic Enable
3. Windows XP (yang telah disetting arabic)

Sebelum proses instalasi Software Kamus Bahasa Arab v3.0, pastikan bahwa windows Anda mendukung penulisan arab penuh. Mengenai tatacara setting arabic pada windows XP klik link disamping Cara Setting Arabic Pada Windows XP

Untuk mengunduh aplikasi Kamus Bahasa Arab v3.0 silakan klik tautan disamping: unduh Kamus Bahasa Arab v3.0

READ MORE - Kamus Bahasa Arab v3.0 | Sebelum Memulai