VERSION 5.00
Object = "{EAB22AC0-30C1-11CF-A7EB-0000C05BAE0B}#1.1#0"; "ieframe.dll"
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   10215
   ClientLeft      =   120
   ClientTop       =   450
   ClientWidth     =   15045
   LinkTopic       =   "Form1"
   ScaleHeight     =   10215
   ScaleWidth      =   15045
   StartUpPosition =   3  '窗口缺省
   Begin VB.PictureBox Picture1 
      Height          =   4335
      Left            =   9240
      ScaleHeight     =   4275
      ScaleWidth      =   3915
      TabIndex        =   7
      Top             =   5760
      Width           =   3975
   End
   Begin VB.TextBox Text3 
      Height          =   375
      Left            =   360
      TabIndex        =   6
      Text            =   "Text3"
      Top             =   960
      Width           =   14415
   End
   Begin VB.ListBox List1 
      Height          =   4380
      Left            =   9240
      TabIndex        =   5
      Top             =   1320
      Width           =   5535
   End
   Begin VB.TextBox Text2 
      Height          =   8175
      Left            =   480
      MultiLine       =   -1  'True
      ScrollBars      =   3  'Both
      TabIndex        =   4
      Text            =   "Form1.frx":0000
      Top             =   1320
      Visible         =   0   'False
      Width           =   8655
   End
   Begin VB.CommandButton Command2 
      Caption         =   "Command2"
      Height          =   495
      Left            =   7440
      TabIndex        =   3
      Top             =   9600
      Width           =   1695
   End
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   615
      Left            =   10680
      TabIndex        =   2
      Top             =   240
      Width           =   1935
   End
   Begin VB.TextBox Text1 
      Height          =   615
      Left            =   360
      TabIndex        =   1
      Text            =   "http://www.gongkaike.org/search.html?wd=[[Title]]&submit="
      Top             =   240
      Width           =   10095
   End
   Begin SHDocVwCtl.WebBrowser WebBrowser1 
      Height          =   8175
      Left            =   480
      TabIndex        =   0
      Top             =   1320
      Width           =   8655
      ExtentX         =   15266
      ExtentY         =   14420
      ViewMode        =   0
      Offline         =   0
      Silent          =   0
      RegisterAsBrowser=   0
      RegisterAsDropTarget=   1
      AutoArrange     =   0   'False
      NoClientEdge    =   0   'False
      AlignLeft       =   0   'False
      NoWebView       =   0   'False
      HideFileNames   =   0   'False
      SingleClick     =   0   'False
      SingleSelection =   0   'False
      NoFolders       =   0   'False
      Transparent     =   0   'False
      ViewID          =   "{0057D0E0-3573-11CF-AE69-08002B2E1262}"
      Location        =   "http:///"
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
Dim Link As String
Dim Keyword As String
Keyword = UTF8EncodeURI("超级少女")
Link = Replace(Text1.Text, "[[Title]]", Keyword)
WebBrowser1.Visible = True
Text2.Visible = False
WebBrowser1.Silent = True
WebBrowser1.Navigate Link
End Sub

Private Sub Command2_Click()
Dim Nr, Gjz1, Gjz2 As String


WebBrowser1.Visible = False
Text2.Visible = True
Text2.Text = WebBrowser1.Document.body.outerHTML
List1.Clear
'Gjz1 = "data-original=" & """"
Gjz1 = "title="
'Gjz2 = ">"
Gjz2 = ">"
s$ = Text2.Text
P& = InStr(s, Gjz1)
l& = Len(Gjz1)
 Do While P
 p2& = InStr(P + l, s, Gjz2)
 Nr = Mid$(s, P + l, p2 - P - l)
 P = InStr(p2, s, Gjz1)
Nr = Replace(Nr, """", "")
 'x = InStr(Nr, "data-src=")
 'y = Mid(Nr, x, Len(Nr) - x)
 'y = Replace(y, "data-src=" & """", "")
 'Url = Mid(y, 1, InStr(y, """") - 1)
 'Url = Replace(Url, "//", "http://")
'
 'x = InStr(Nr, "title=")
 'y = Mid(Nr, x, Len(Nr) - x)
 'y = Replace(y, "title=" & """", "")
 'Title = Mid(y, 1, InStr(y, """") - 1)
 'Nr = Title & "|" & Url
If InStr(Nr, "data-original=") > 0 Then
List1.AddItem Nr
End If

Loop

End Sub

Private Sub List1_Click()
Text3.Text = List1.List(List1.ListIndex)
End Sub


Function UTF8EncodeURI(strUTF8 As String) As String
    Dim nFor    As Long
    Dim nAsc    As Long
    Dim strWchar    As String
    Dim strURIchar  As String
    
    UTF8EncodeURI = ""
    For nFor = 1 To Len(strUTF8)
        strWchar = Mid(strUTF8, nFor, 1)
        nAsc = AscW(strWchar)
        If nAsc < 0 Then nAsc = nAsc + 65536
        If (nAsc And &HFF80) = 0 Then
            UTF8EncodeURI = UTF8EncodeURI & strWchar
        ElseIf (nAsc And &HF000) = 0 Then
            strURIchar = "%" & Hex(((nAsc \ 2 ^ 6)) Or &HC0) & Hex(nAsc And &H3F Or &H80)
            UTF8EncodeURI = UTF8EncodeURI & strURIchar
        Else
            strURIchar = "%" & Hex((nAsc \ 2 ^ 12) Or &HE0) & _
                         "%" & Hex((nAsc \ 2 ^ 6) And &H3F Or &H80) & _
                         "%" & Hex(nAsc And &H3F Or &H80)
            UTF8EncodeURI = UTF8EncodeURI & strURIchar
        End If
    Next
End Function


