VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.2#0"; "MSCOMCTL.OCX"
Begin VB.Form Form5 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "查找封面"
   ClientHeight    =   6180
   ClientLeft      =   45
   ClientTop       =   375
   ClientWidth     =   9765
   BeginProperty Font 
      Name            =   "微软雅黑"
      Size            =   10.5
      Charset         =   134
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   Icon            =   "Form5.frx":0000
   LinkTopic       =   "Form5"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   6180
   ScaleWidth      =   9765
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton Command2 
      Caption         =   "确定"
      Height          =   495
      Left            =   5750
      TabIndex        =   4
      Top             =   5520
      Width           =   1935
   End
   Begin VB.CommandButton Command3 
      Caption         =   "取消"
      Height          =   495
      Left            =   7680
      TabIndex        =   5
      Top             =   5520
      Width           =   1935
   End
   Begin VB.Frame Frame1 
      Caption         =   "查找封面"
      Height          =   5295
      Left            =   120
      TabIndex        =   1
      Top             =   120
      Width           =   9495
      Begin VB.CommandButton Command1 
         Caption         =   "重新搜索"
         Height          =   495
         Left            =   3960
         TabIndex        =   2
         Top             =   320
         Width           =   1455
      End
      Begin VB.TextBox Text3 
         Height          =   420
         Left            =   1320
         TabIndex        =   0
         Top             =   360
         Width           =   2535
      End
      Begin VB.PictureBox Picture1 
         Height          =   4815
         Left            =   5520
         ScaleHeight     =   4755
         ScaleWidth      =   3795
         TabIndex        =   6
         Top             =   360
         Width           =   3855
         Begin VB.TextBox Text2 
            Height          =   1695
            Left            =   600
            MultiLine       =   -1  'True
            ScrollBars      =   3  'Both
            TabIndex        =   8
            Top             =   1800
            Visible         =   0   'False
            Width           =   2655
         End
         Begin VB.TextBox Text1 
            Height          =   495
            Left            =   600
            TabIndex        =   7
            Text            =   "https://so-kan.2345.com/search_[[Title]]/"
            Top             =   1080
            Visible         =   0   'False
            Width           =   2535
         End
      End
      Begin MSComctlLib.ListView ListView1 
         Height          =   4215
         Left            =   120
         TabIndex        =   3
         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         =   "Form5.frx":628A
               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
End
Attribute VB_Name = "Form5"
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()
On Error GoTo ErrHander
Dim Link As String
Dim Nr, Title, Url As String
Dim Fg() As String
Link = Replace(Text1.text, "[[Title]]", Text3.text)
Text2.text = GetHTML2(Link)

ListView1.ListItems.Clear
s$ = Text2.text
P& = InStr(s, "<img")
l& = Len("<img")
 Do While P
 p2& = InStr(P + l, s, ">")
 Nr = Mid$(s, P + l, p2 - P - l)
 P = InStr(p2, s, "<img")
' Nr = Replace(Nr, """", "")
If InStr(Nr, "src=") > 0 Then
If InStr(Nr, "data-src=") > 0 Then
If InStr(Nr, "width=") > 0 Then
 'ListView1.ListItems.Add , , Nr, 1, 1
 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
    Set Items = ListView1.ListItems.Add(, , Title, 1, 1)
        Items.SubItems(1) = Url
End If
End If
End If
Loop
ErrHander:
If ListView1.ListItems.Count = 0 Then
MsgBox "没有搜索到相关内容!", vbCritical + vbOKOnly, "提示"
End If

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 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

Command1_Click

End Sub

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

Public Function GetHTML2(Url As String)
Dim text As String
Set xmlHTTP1 = CreateObject("Microsoft.XMLHTTP")
xmlHTTP1.Open "get", Url, True
xmlHTTP1.send
While xmlHTTP1.ReadyState <> 4
DoEvents
Wend
GetHTML2 = xmlHTTP1.responseText
Set xmlHTTP1 = Nothing
End Function

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 Text3_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
    If Text3.text <> "" Then
        Command1_Click
    End If
End If

End Sub
