VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.2#0"; "MSCOMCTL.OCX"
Object = "{EAB22AC0-30C1-11CF-A7EB-0000C05BAE0B}#1.1#0"; "ieframe.dll"
Begin VB.Form Form6 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "查找封面"
   ClientHeight    =   6135
   ClientLeft      =   45
   ClientTop       =   375
   ClientWidth     =   9750
   BeginProperty Font 
      Name            =   "微软雅黑"
      Size            =   10.5
      Charset         =   134
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   Icon            =   "Form6.frx":0000
   LinkTopic       =   "Form6"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   6135
   ScaleWidth      =   9750
   StartUpPosition =   2  '屏幕中心
   Begin VB.TextBox Text4 
      Height          =   1935
      Left            =   2640
      MultiLine       =   -1  'True
      ScrollBars      =   3  'Both
      TabIndex        =   12
      Text            =   "Form6.frx":628A
      Top             =   3840
      Visible         =   0   'False
      Width           =   2775
   End
   Begin VB.CommandButton Command4 
      Caption         =   "请点击搜索键"
      Height          =   495
      Left            =   120
      TabIndex        =   11
      Top             =   5520
      Width           =   2055
   End
   Begin VB.Frame Frame1 
      Caption         =   "查找封面"
      Height          =   5295
      Left            =   120
      TabIndex        =   2
      Top             =   120
      Width           =   9495
      Begin SHDocVwCtl.WebBrowser WebBrowser1 
         Height          =   4215
         Left            =   120
         TabIndex        =   10
         Top             =   960
         Width           =   5295
         ExtentX         =   9340
         ExtentY         =   7435
         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
      Begin VB.PictureBox Picture1 
         Height          =   4815
         Left            =   5520
         ScaleHeight     =   4755
         ScaleWidth      =   3795
         TabIndex        =   5
         Top             =   360
         Width           =   3855
         Begin VB.TextBox Text1 
            Height          =   495
            Left            =   600
            TabIndex        =   7
            Text            =   "http://www.gongkaike.org/search.html?wd=[[Title]]&submit="
            Top             =   1080
            Visible         =   0   'False
            Width           =   2535
         End
         Begin VB.TextBox Text2 
            Height          =   1695
            Left            =   600
            MultiLine       =   -1  'True
            ScrollBars      =   3  'Both
            TabIndex        =   6
            Top             =   1800
            Visible         =   0   'False
            Width           =   2655
         End
      End
      Begin VB.TextBox Text3 
         Height          =   420
         Left            =   1320
         TabIndex        =   4
         Top             =   360
         Width           =   2535
      End
      Begin VB.CommandButton Command1 
         Caption         =   "搜索"
         Height          =   495
         Left            =   3960
         TabIndex        =   3
         Top             =   320
         Width           =   1455
      End
      Begin MSComctlLib.ListView ListView1 
         Height          =   4215
         Left            =   120
         TabIndex        =   8
         Top             =   960
         Width           =   5295
         _ExtentX        =   9340
         _ExtentY        =   7435
         LabelWrap       =   -1  'True
         HideSelection   =   -1  'True
         _Version        =   393217
         Icons           =   "ImageList1"
         SmallIcons      =   "ImageList1"
         ColHdrIcons     =   "ImageList1"
         ForeColor       =   -2147483640
         BackColor       =   -2147483643
         BorderStyle     =   1
         Appearance      =   1
         NumItems        =   0
      End
      Begin MSComctlLib.ImageList ImageList1 
         Left            =   960
         Top             =   1200
         _ExtentX        =   1005
         _ExtentY        =   1005
         BackColor       =   -2147483643
         ImageWidth      =   30
         ImageHeight     =   28
         MaskColor       =   12632256
         _Version        =   393216
         BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
            NumListImages   =   1
            BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "Form6.frx":63E5
               Key             =   ""
            EndProperty
         EndProperty
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "关键字："
         Height          =   300
         Left            =   240
         TabIndex        =   9
         Top             =   400
         Width           =   840
      End
   End
   Begin VB.CommandButton Command3 
      Caption         =   "取消"
      Height          =   495
      Left            =   7680
      TabIndex        =   1
      Top             =   5520
      Width           =   1935
   End
   Begin VB.CommandButton Command2 
      Caption         =   "确定"
      Height          =   495
      Left            =   5750
      TabIndex        =   0
      Top             =   5520
      Width           =   1935
   End
   Begin VB.Menu MM 
      Caption         =   "菜单"
      Visible         =   0   'False
      Begin VB.Menu M1 
         Caption         =   "复制图片链接"
      End
   End
End
Attribute VB_Name = "Form6"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long

Private Sub Command1_Click()
Dim Link As String
Dim Keyword As String

Open App.Path & "\Temp\Search.html" For Output As #1
Print #1, Replace(Text4.text, "请点击搜索键开始", "等待页面加载")
Close #1
WebBrowser1.Navigate2 App.Path & "\Temp\Search.html"
Keyword = UTF8EncodeURI(Text3.text)
Link = Replace(Text1.text, "[[Title]]", Keyword)
WebBrowser1.Visible = True
ListView1.Visible = False
Command4.Visible = True
WebBrowser1.Silent = True
WebBrowser1.Navigate Link

Command1.Caption = "正在加载.."
Command4.Caption = "分析页面内容 >"
End Sub

Private Sub Command2_Click()
If ListView1.ListItems.Count > 0 Then
    If ListView1.SelectedItem.Index > 0 Then
        FileCopy App.Path & "\Temp\" & ListView1.SelectedItem.text & ".jpg", App.Path & "\Web\Image\" & Form1.ListView1.SelectedItem.text & ".jpg"
        Form1.Picture1.Picture = Picture1.Picture
        Unload Me
    Else
        MsgBox "没有选择内容!", vbCritical + vbOKOnly, "提示"
    End If
Else
    MsgBox "列表内容为空,请修改关键字后重新搜索!", vbCritical + vbOKOnly, "提示"
End If
End Sub

Private Sub Command3_Click()
Unload Me
End Sub


Private Sub Command4_Click()
Dim Nr, Title, Url As String
Dim Fg() As String
Dim Gjz1, Gjz2 As String

WebBrowser1.Visible = False
ListView1.Visible = True
Command4.Visible = False
Command1.Caption = "重新搜索"
Text2.text = WebBrowser1.Document.body.outerHTML
ListView1.ListItems.Clear
Gjz1 = "title="
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, """", "")
If InStr(Nr, "data-original=") > 0 Then
Title = Mid(Nr, 1, InStr(Nr, "href") - 1)
Url = Mid(Nr, InStr(Nr, "data-original="), Len(Nr))
Url = Replace(Url, "data-original=", "")
Set Items = ListView1.ListItems.Add(, , Title, 1, 1)
        Items.SubItems(1) = Url
End If
Loop
If ListView1.ListItems.Count = 0 Then
MsgBox "没有搜索到相关内容!", vbCritical + vbOKOnly, "提示"
End If
End Sub

Private Sub Form_Load()
Me.KeyPreview = True
With ListView1
    .ColumnHeaders.Clear
    .View = lvwReport
    .LabelEdit = 1
    .HideColumnHeaders = False
    .FullRowSelect = True
    .GridLines = True
    .ListItems.Clear
    .ColumnHeaders.Add 1, , "名称", ListView1.Width - 335
    .ColumnHeaders.Add 2, , "", 0
End With
If Dir(App.Path & "\Temp", vbDirectory) = "" Then
    MkDir App.Path & "\Temp"
End If
Text3.text = Form1.ListView1.SelectedItem.text
Open App.Path & "\Temp\Search.html" For Output As #1
Print #1, Text4.text
Close #1
WebBrowser1.Navigate2 App.Path & "\Temp\Search.html"
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
If KeyAscii = 27 Then
Unload Me
End If
End Sub

Private Sub ListView1_Click()
On Error GoTo ErrHander
If ListView1.ListItems.Count > 0 Then
    If ListView1.SelectedItem.Index > 0 Then
        If Dir(App.Path & "\Temp\" & ListView1.SelectedItem.text & ".jpg") = "" Then
        r = URLDownloadToFile(0, ListView1.SelectedItem.SubItems(1), App.Path & "\Temp\" & ListView1.SelectedItem.text & ".jpg", 0, 0)
        End If
        Picture1.Picture = LoadPicture(App.Path & "\Temp\" & ListView1.SelectedItem.text & ".jpg")
    End If
End If
Exit Sub
ErrHander:
MsgBox "加载错误,请检查图片资源链接:" & ListView1.SelectedItem.SubItems(1), vbCritical + vbOKOnly, "提示"
ShellExecute Me.hwnd, "open", ListView1.SelectedItem.SubItems(1), "", "", 0
Exit Sub
End Sub

Private Sub ListView1_DblClick()
On Error GoTo ErrHander
If ListView1.ListItems.Count > 0 Then
    If ListView1.SelectedItem.Index > 0 Then
        r = URLDownloadToFile(0, ListView1.SelectedItem.SubItems(1), App.Path & "\Temp\" & ListView1.SelectedItem.text, 0, 0)
        Picture1.Picture = LoadPicture(App.Path & "\Temp\" & ListView1.SelectedItem.text)
    End If
End If
Exit Sub
ErrHander:
MsgBox "加载错误,请检查图片资源链接:" & ListView1.SelectedItem.SubItems(1), vbCritical + vbOKOnly, "提示"
ShellExecute Me.hwnd, "open", ListView1.SelectedItem.SubItems(1), "", "", 0
Exit Sub
End Sub

Private Sub ListView1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 2 Then
    If ListView1.ListItems.Count > 0 Then
        If ListView1.SelectedItem.Index > 0 Then
            PopupMenu MM
        End If
    End If
End If
End Sub

Private Sub M1_Click()
If ListView1.ListItems.Count > 0 Then
    If ListView1.SelectedItem.Index > 0 Then
        VB.Clipboard.Clear
        VB.Clipboard.SetText ListView1.SelectedItem.SubItems(1)
        MsgBox "复制链接成功!" & vbCrLf & ListView1.SelectedItem.text & vbCrLf & ListView1.SelectedItem.SubItems(1), vbInformation + vbOKOnly, "提示"
    End If
End If

End Sub

Private Sub Text3_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
    If Text3.text <> "" Then
        Command1_Click
    End If
End If

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

