Fungsi Untuk Mendapatkan Source HTML dari URL Tertentu

Di bawah ini merupakan fungsi untuk mendapatkan source code HTML dari URL tertentu.

Option Explicit 
 
Function GetSource(ByVal URL As String) As String 
 
    MousePointer = vbHourglass 
 
    Dim Data() As Byte 
    Dim sText As String 
    Dim i As Long 
 
    Data() = Inet1.OpenURL(URL) 
 
    sText = Data() 
    GetSource = sText 
 
    MousePointer = vbDefault 
   
End Function 

Cara penggunaan fungsi di atas:

Private Sub Command1_Click() 
    Dim sUrl As String 
    sUrl = Text1.Text 
    Text2.Text = GetSource(sUrl) 
End Sub 

Untuk tujuan tertentu, maka dengan sedikit modifikasi tentu saja Anda dapat menyimpannya ke dalam hardisk Anda.

READ MORE - Fungsi Untuk Mendapatkan Source HTML dari URL Tertentu

Fungsi Untuk Menghapus Seluruh Komentar Visual Basic 6.0

Di bawah ini merupakan fungsi untuk menghapus seluruh komentar yang terdapat dalam source code Visual Basic 6.0. Kami membuatnya menjadi dua fungsi, fungsi pertama untuk menghapus seluruh komentar sedangkan fungsi yang kedua untuk menghapus seluruh line kosong. Berikut kodenya di bawah ini:
Di bawah ini merupakan fungsi untuk menghapus seluruh komentar yang terdapat dalam Visual Basic 6.0:

Option Explicit 
 
Function DeleteAllComment(sText As String) As String 
     
    Dim str As String 
    Dim vArray As Variant 
    Dim g As String 
    Dim i As Integer 
    Dim x As Integer 
    Dim w As Integer 
    Dim u As String 
    Dim y As Integer 
     
    str =   sText 
    vArray = Split(str, vbCrLf) 
 
    For i = LBound(vArray) To UBound(vArray) 
     
            If Trim(Right(vArray(i), 1)) = "_" Then 
                 
                Do While Trim(Right(vArray(i + w), 1)) = "_" 
                     
                    If w > 0 Then 
                       vArray(i) = vArray(i) & Left(vArray(i + w), Len(vArray(i + w)) - 1) & " " 
                         vArray(i + w) = "'" 
                    Else 
                       vArray(i) = Left(vArray(i), Len(vArray(i)) - 1) 
                    End If 
                     
                    w = w + 1 
                     
                Loop 
                 
                vArray(i) = vArray(i) & Left(vArray(i + w), Len(vArray(i + w))) & " " 
                vArray(i + w) = "'" 
                 
              End If 
          
            w = 0 
          
            y = InStr(1, vArray(i), Chr(34) & "'" & Chr(34)) 
            x = InStr(1, vArray(i), "'") 
             
            If x > 0 Then 
                
               If (y = 0) Then 
                
                   If Right(vArray(i), 1) = "_" Then 
                       Do While Right(vArray(i + w), 1) = "_" 
                           If w > 0 Then vArray(i +   w) = "'" 
                           w = w + 1 
                       Loop 
                       vArray(i + w) = "'" 
                   End If 
                    
                   If Trim(Mid(vArray(i), 1, x)) <> "'" Then 
                        
                       If Right(Mid(vArray(i), 1, x), 1) = "'" Then 
                           g = g & Left(Mid(vArray(i), 1, x), Len(Mid(vArray(i), 1, x)) - 1) & vbCrLf 
                       Else 
                           g = g &   Mid(vArray(i), 1, x) & vbCrLf 
                       End If 
                        
                   End If 
                    
                Else 
                   g = g & vArray(i) & vbCrLf 
                End If 
             Else 
                g = g & vArray(i) & vbCrLf 
            End If 
 
    Next 
     
    DeleteAllComment = g 
     
End Function 

Di bawah ini merupakan fungsi untuk menghapus seluruh jajaran kosong (blank line)

Function DeleteBlankLine(sText As String) As String 
 
    Dim str As String   
    Dim vArray As Variant 
    Dim i As Integer 
    Dim g As String 
 
    str = sText 
    vArray = Split(sText, vbCrLf) 
 
    For i = LBound(vArray) To UBound(vArray) 
 
        If Trim(vArray(i)) <> "" Then 
            g = g & vArray(i) & vbCrLf 
        End If 
 
    Next 
 
    DeleteBlankLine = g 
 
End Function 

Cara penggunaan:

Option Explicit 
 
Private Sub Command1_Click() 
    Dim str As String 
    str = DeleteAllComment(Text1.Text) 
    Text2.Text = DeleteBlankLine(str) 
End Sub 

READ MORE - Fungsi Untuk Menghapus Seluruh Komentar Visual Basic 6.0

Fungsi Encode dan Decode Tag HTML

Kode HTML yang dituliskan dalam sebuah tulisan/postingan tentu saja tidak dapat ditulis secara langsung tetapi harus dikonversi terlebih dahulu agar format tulisannya sesuai dengan apa yang diharapkan. Perlu kita ketahui bahwa mesin penerjemah (compiler) akan menganggap tulisannya merupakan kode HTML dan menerjemahkannya, padahal yang kita maksud adalah tulisan, tulisan yang mengandung kode HTML . Dibawah ini merupakan fungsi encode dan decode tag HTML yang bisa Anda gunakan ketika membuat tulisan/postingan yang melibatkan banyak kode/tag HTML.

Option Explicit 
 
Dim EncodeTag() As String 
Dim DecodeTag() As String 
 
Enum eType 
    Decode 
    Encode 
End Enum 
 
Public Function   EncDecTag(strText As String, EncDec As eType) As String 
    Dim i As Integer 
    InitTagArray 
    For i = LBound(EncodeTag) To UBound(EncodeTag) 
        If EncDec = Encode Then 
            strText = Replace(strText, EncodeTag(i), DecodeTag(i), , , vbTextCompare) 
        Else 
            strText = Replace(strText, DecodeTag(i), EncodeTag(i), , , vbTextCompare) 
        End If 
    Next 
    EncDecTag = strText 
End Function 
 
Private Function InitTagArray() 
    Dim EncTag As String 
    Dim DecTag As String 
    EncTag = &quot;&amp;,<,>,&quot; &amp; Chr(34) &amp; &quot;,&plusmn;&quot; 
    DecTag = &quot;&amp;amp;,&amp;lt;,&amp;gt;,&amp;quot;,&amp;plusmn;&quot; 
    EncodeTag = Split(EncTag, &quot;,&quot;) 
    DecodeTag = Split(LCase(DecTag), &quot;,&quot;) 
End Function 

Cara Penggunaan Fungsi Encode dan Decode Tag HTML

Private   Sub Command1_Click() 
    Text1.SelText = EncDecTag(Text1.SelText, Decode) 
End Sub 
 
Private Sub Command2_Click() 
    Text1.SelText = EncDecTag(Text1.SelText, Encode) 
End Sub 

READ MORE - Fungsi Encode dan Decode Tag HTML

Cara Termudah Untuk Mengisi Seluruh Fonts Ke dalam ListBox

Di bawah ini merupakan fungsi untuk mengisi seluruh fonts yang ada dalam komputer Anda ke dalam objek ListBox

Public Function LoadAllFonts(lst As Control) 
    Dim i As Integer 
    For i = 1 To 1000 
        If Screen.Fonts(i) = "" Then Exit For 
        lst.AddItem Screen.Fonts(i) 
    Next i 
End Function 

Contoh penggunaan fungsi untuk mengisi seluruh fonts ke dalam ListBox

Private Sub Form_Load() 
    LoadAllFonts List1 
End Sub 

READ MORE - Cara Termudah Untuk Mengisi Seluruh Fonts Ke dalam ListBox