VB6 Code - Mendapatkan Source Html Dari URLTertentu

Di bawah ini merupakan fungsi VB6 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 VB6 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 - VB6 Code - Mendapatkan Source Html Dari URLTertentu

VB Code - Menghapus Seluruh Komentar Visual Basic 6.0

Di bawah ini merupakan fungsi VB6 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 - VB Code - Menghapus Seluruh Komentar Visual Basic 6.0

VB Code - Fungsi Personal Editor Html Unordering List [ ul ]

Ini merupakan fungsi VB6 yang digunakan untuk membuat personal editor. Tag yang akan kita modifikasi adalah tag UL (Unordering List).

Option Explicit

Function UL(strText As String) As String
    Dim sText As String
    Dim aText() As String
    Dim i As Integer
    sText = strText
    aText = Split(sText, vbCrLf)
    For i = LBound(aText) To UBound(aText)
        Select Case i
        Case LBound(aText)
            sText = "<ul>" & "<li>" & aText(i) & "</li>" & vbCrLf
        Case UBound(aText)
            sText = sText & "<li>" & aText(i) & "</li>" & "</ul>"
        Case Else
            sText = sText & "<li>" & aText(i) & "</li>" & vbCrLf
        End Select
    Next
    UL = sText
End Function

Cara penggunaan Fungsi Personal Editor HTML Unordering List <UL>

Private Sub Command1_Click()
    Text1.SelText = UL(Text1.SelText)
End Sub

READ MORE - VB Code - Fungsi Personal Editor Html Unordering List [ ul ]

VB6 Code - Fungsi Encode Dan Decode Tag HTML

Mengenai Fungsi VB6 untuk meng-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 = "&,<,>," & Chr(34) & ",±"
    DecTag = "&amp;,&lt;,&gt;,&quot;,&plusmn;"
    EncodeTag = Split(EncTag, ",")
    DecodeTag = Split(LCase(DecTag), ",")
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 - VB6 Code - Fungsi Encode Dan Decode Tag HTML