VERSION 5.00 Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX" Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "RICHTX32.OCX" Begin VB.Form Form2 Caption = "Sucker-store" ClientHeight = 6405 ClientLeft = -105 ClientTop = 1620 ClientWidth = 11880 LinkTopic = "Form2" ScaleHeight = 6405 ScaleWidth = 11880 Begin VB.Timer Timer4 Enabled = 0 'False Interval = 10000 Left = 2040 Top = 3480 End Begin VB.Timer Timer3 Enabled = 0 'False Interval = 3000 Left = 1560 Top = 3480 End Begin VB.Timer Timer2 Enabled = 0 'False Interval = 3000 Left = 1080 Top = 3480 End Begin VB.Timer Timer1 Enabled = 0 'False Interval = 3000 Left = 600 Top = 3480 End Begin VB.CommandButton Command2 Caption = "Test" Height = 375 Left = 2880 TabIndex = 6 Top = 3360 Width = 1215 End Begin RichTextLib.RichTextBox RichTextBox1 Height = 2295 Left = 120 TabIndex = 5 Top = 3960 Width = 6735 _ExtentX = 11880 _ExtentY = 4048 _Version = 393217 TextRTF = $"sk2.frx":0000 End Begin MSWinsockLib.Winsock Winsock1 Left = 0 Top = 480 _ExtentX = 741 _ExtentY = 741 _Version = 393216 End Begin VB.ListBox List1 Height = 2400 Left = 120 TabIndex = 4 Top = 840 Width = 11655 End Begin VB.CommandButton Command1 Caption = "Command1" Height = 375 Left = 120 TabIndex = 0 Top = 120 Width = 1215 End Begin MSWinsockLib.Winsock Winsock2 Left = 480 Top = 480 _ExtentX = 741 _ExtentY = 741 _Version = 393216 End Begin MSWinsockLib.Winsock Winsock3 Left = 960 Top = 480 _ExtentX = 741 _ExtentY = 741 _Version = 393216 End Begin VB.Label Label4 Caption = "Label4" Height = 375 Left = 6960 TabIndex = 7 Top = 240 Width = 1575 End Begin VB.Label Label3 Caption = "Label3" Height = 375 Left = 5160 TabIndex = 3 Top = 240 Width = 1575 End Begin VB.Label Label2 Caption = "Label2" Height = 375 Left = 3600 TabIndex = 2 Top = 240 Width = 1335 End Begin VB.Label Label1 Caption = "Label1" Height = 375 Left = 1800 TabIndex = 1 Top = 240 Width = 1455 End End Attribute VB_Name = "Form2" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False '****** '****** '****** '-------- '程式結果 'USER.TXT => 欲抓的 [Store_Categories_Name] 原始表 'USER.HTML => [Store_Categories] 的產品網頁 'ITEM.TXT => 切 [Store_Categories] 產品網頁 user.html 取連結 'ITEM.HTML => Item 的 PHOTO1 產品網頁 'Store_Categories-PHOTO.TXT => 已切出的 [Store_Categories_Items] 列表 '-------- '****** '****** '****** Dim Total As Long Dim cnt As Long Dim Store_Categories, Store_Categories_page As String 'Store_Categories_Name及頁數 Dim Item_url As String 'ITEM編號 Dim Item_cut_Ends_found_flag, Item_cut_Price_found_flag, Item_cut_Price_found_flag_ok As String '搜尋旗標 Dim Item_url_temp, Item_photo_url_temp, Item_title_temp, Item_ends_temp, Item_price_temp As String 'ITEM內容 Dim Store_Categories_Array(50) As String '定義陣列給Store_Categories Dim Store_Categories_Array_count, head_xml_s_w_count As Integer '定義計數器給Store_Categories Dim Store_Categories_Array_count_temp As Integer '定義計數器給Store_Categories 'Dim Item_count_timer As Integer '定義ITEM執行的次數 'vbCRLF vbNewLine 'store Private Sub Form_Load() '清空ITEM的列表檔案 Open App.Path & "\item.txt" For Output As #7 Close #7 '清空PHOTO1的列表檔案 'Open App.Path & "\" & Store_Categories & "-photo.txt" For Output As #6 'Close #6 '設定VB執行檢查檔 Open App.Path & "\lock.txt" For Output As #8 Print #8, "lock" Close #8 '手動設要抓的Store_Categories Store_Categories = "dvoneb5" Item_url = "" '測試抓Store的後續頁面 head_xml_s_w_count = 1 ' Store_Categories = "Self-Depot_PC-Parts" '"_W0QQcolZ4QQdirZ1QQpZ1QQsclZallQQsotimedisplayZ2QQtZkm" 將 pZ1QQ 改為 pZ2QQ 即為第二頁 Store_Categories_page = "_W0QQcolZ4QQdirZ1QQsclZallQQsotimedisplayZ2QQtZkm" ' Command1_Click '自動設要抓的Store_Categories 'http://www.selfdepot.com/sf/ins1.php?a=ebid Socker_Store_Categories End Sub '========>>>>>> '抓欲sucker的 [Store_Categories_Name] Private Sub Socker_Store_Categories() '清空 [Store_Categories_Name] 的列表檔案-放欲sucker的 [Store_Categories_Name] Open App.Path & "\user.txt" For Output As #2 'ALEX主機 Winsock3.RemoteHost = "www.selfdepot.com" Print 1 Winsock3.RemotePort = 80 Print 2 Winsock3.Protocol = sckTCPProtocol Print 3 Winsock3.Connect 'DoEvents Timer3.Enabled = True End Sub '定時器 Private Sub Timer3_Timer() '抓欲sucker的 [Store_Categories_Name] If (Label3.Caption = "Winsock3 Close") And (Winsock3.State = 0) Then 'Sucker [Store_Categories_Name] 完成 '呼叫切 [Store_Categories_Name] List1.AddItem "Go Store_Categories_cut" Store_Categories_cut Timer3.Enabled = False Label3.Caption = "" Else 'Sucker [Store_Categories_Name] 還未結束 List1.AddItem "Not end" + Str(Winsock3.State) If Winsock3.State = 8 Then Winsock3.Close End If End If End Sub 'SUCKER ========>>>>>> Private Sub Winsock3_Close() Label3.Caption = "Winsock3 Close" '抓完 [Store_Categories_Name] 的網頁關閉USER.TXT Close #2 End Sub 'PPPPPP Private Sub Winsock3_Connect() Dim req As String List1.AddItem "hahaha ! Connect !" '要chown www.www test.html,ODOA問題 req = "POST /sf/ins1.php?a=store HTTP/1.0" + vbCrLf _ + "User-Agent: Mozilla/4.0 (compatible; MSIE 5.0; Windows 95; CNETHomeBuild03171999)" + vbCrLf _ + "Host: www.selfdepot.com" & vbCrLf & vbCrLf ' req = "POST /cfdocs/resumeupdateview.dbm HTTP/1.0" + vbCrLf _ ' + "Referer: http://www.104.com.tw/job/resumeupdate.htm" + vbCrLf _ ' + "User-Agent: Mozilla/4.0 (compatible; MSIE 5.0; Windows 95; CNETHomeBuild03171999)" + vbCrLf _ ' + "Content-type: application/x-www-form-urlencoded" + vbCrLf _ ' + "Content-length: 30" + vbCrLf + vbCrLf _ ' + "id=" & Cs3 & "&" & "password=" & Cs4 '+ "id=A220539930&password=520520" ' List1.AddItem req Winsock3.SendData (req) End Sub 'PPPPPP Private Sub Winsock3_DataArrival(ByVal bytesTotal As Long) Winsock3.GetData arrstr1, vbString, 10240 Total = Total + bytesTotal Label1.Caption = Total 'bytesTotal 'List1.AddItem arrstr1 Print #2, arrstr1 End Sub 'PPPPPP Private Sub Winsock3_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean) 'List1.AddItem "Error = " & Number & Description Kill (App.Path & "\lock.txt") End End Sub 'SUCKER <<<<<<======== ''將抓到的USER.TXT切出 [Store_Categories_Name] Private Sub Store_Categories_cut() Open App.Path & "\user.txt" For Input As #2 List1.Clear '設定欲修改的指標啟始位置 Line_c = 1 Start_flag = 0 Store_Categories_Array_count = 1 Do While Not EOF(2) Line Input #2, TextLine List1.AddItem Line_c List1.AddItem TextLine List1.Selected(List1.ListCount - 1) = True '開始抓單筆資料 If Start_flag = 1 Then '找到 [Store_Categories_Name] Store_Categories_Array(Store_Categories_Array_count) = TextLine List1.AddItem Store_Categories_Array(Store_Categories_Array_count) Store_Categories_Array_count = Store_Categories_Array_count + 1 End If '進入資料區 If InStr(TextLine, "sucker_store") <> 0 Then List1.AddItem "START" Start_flag = 1 Store_Categories_Array_count = 1 End If Line_c = Line_c + 1 Loop List1.Selected(List1.ListCount - 1) = True Close #2 Store_Categories_Array_count_temp = 1 'Store是空的,結束程式 If Store_Categories_Array_count = 1 Then Kill (App.Path & "\lock.txt") End End If 'For Store_Categories_Array_count_temp = 1 To Store_Categories_Array_count ' If Store_Categories_Array(Store_Categories_Array_count_temp) <> "" Then Store_Categories = Store_Categories_Array(Store_Categories_Array_count_temp) '清空PHOTO1的列表檔案 Open App.Path & "\" & Store_Categories & "-photo.txt" For Output As #6 Close #6 Command1_Click Timer4.Enabled = True ' End If 'Next Store_Categories_Array_count_temp End Sub '<<<<<<======== '將 [Store_Categories_Name] 內的名單全部作完 Private Sub Timer4_Timer() If (Winsock1.State = 0) And (Winsock2.State = 0) And (Label4.Caption = "Winsock2 Close") Then List1.AddItem "Go 叫Command1_Click" List1.Selected(List1.ListCount - 1) = True Timer4.Enabled = False 'Label3.Caption = "Winsock2 Go" '[Store_Categories_Name] 內的名單 尚未作完 If (Store_Categories_Array_count_temp < Store_Categories_Array_count - 1) Then 'List1.AddItem Store_Categories_Array_count_temp 'List1.AddItem Store_Categories_Array_count 'List1.Selected(List1.ListCount - 1) = True 'Store_Categories = Store_Categories_Array(Store_Categories_Array_count_temp) Store_Categories_Array_count_temp = Store_Categories_Array_count_temp + 1 Store_Categories = Store_Categories_Array(Store_Categories_Array_count_temp) '清空PHOTO1的列表檔案 Open App.Path & "\item.txt" For Output As #7 Close #7 Open App.Path & "\" & Store_Categories & "-photo.txt" For Output As #6 Close #6 Command1_Click '呼叫抓PHOTO1的網頁 Else '[Store_Categories_Name] 內的名單 已經作完 '設定VB執行檢查檔 'Open App.Path & "\lock.txt" For Output As #8 'Close #8 Kill (App.Path & "\lock.txt") End End If List1.AddItem "Go 叫Command1_Click run" Else List1.AddItem "Not2 end" + Str(Winsock2.State) If Winsock1.State = 8 And Winsock2.State = 8 Then Winsock1.Close Winsock2.Close End If End If End Sub '========>>>>>> '抓 [Store_Categories] 的產品網頁 => user.html Private Sub Command1_Click() Open App.Path & "\user.html" For Output As #1 Total = 0 cnt = 0 'Winsock1.RemoteHost = "61.220.188.84" '第一頁list Winsock1.RemoteHost = "stores.ebay.com" '第二頁item 'Winsock1.RemoteHost = "cgi.ebay.com" 'store第一頁list 'Winsock1.RemoteHost = "stores.ebay.com" Print 1 Winsock1.RemotePort = 80 Print 2 Winsock1.Protocol = sckTCPProtocol Print 3 Winsock1.Connect 'DoEvents Timer1.Enabled = True End Sub '定時器 Private Sub Timer1_Timer() If (Label3.Caption = "Winsock Close") And (Winsock1.State = 0) Then 'If (Winsock1.State = 0) Then 'Timer1.Enabled = True List1.AddItem "Go Cut" User_cut '呼叫抓銷貨的的item連結 Timer1.Enabled = False Else 'List1.AddItem "Not end" + Str(Winsock1.State) If Winsock1.State = 8 Then Winsock1.Close End If End If End Sub ''SUCKER ========>>>>>> Private Sub Winsock1_Close() Label3.Caption = "Winsock Close" Close #1 '抓完ITEM的網頁關閉user.html 'Timer1.Enabled = True 'User_cut '呼叫抓銷貨的的item連結 End Sub 'PPPPPP Private Sub Winsock1_Connect() Dim req As String List1.AddItem "hahaha ! Connect !" 'List1.AddItem Store_Categories + "_W0QQcolZ4QQdirZ1QQpZ" + Store_Categories_page + "QQsclZallQQsotimedisplayZ2QQtZkm" 'req = "POST /index.html HTTP/1.0" + vbCrLf + vbCrLf '第一頁list 'req = "POST /_W0QQgotopageZ1QQsassZ" + Store_Categories + "QQsorecordsperpageZ50QQsosortorderZ1QQsosortpropertyZ1 HTTP/1.0" + vbCrLf 'test-ok 'req = "POST /_W0QQsassZ" + Store_Categories + "QQsocustoverrideZ1QQsorecordsperpageZ25QQsosortpropertyZ1 HTTP/1.0" + vbCrLf 'req = "POST /Self-Depot_PC-Parts_W0QQcolZ4QQdirZ1QQpZ2QQsclZallQQsotimedisplayZ2QQtZkm HTTP/1.0" + vbCrLf req = "POST /" + Store_Categories + "_W0QQcolZ4QQdirZ1QQftidZ2QQtZkm HTTP/1.0" + vbCrLf _ + "User-Agent: Mozilla/4.0 (compatible; MSIE 5.0; Windows 95; CNETHomeBuild03171999)" + vbCrLf _ + "Host: stores.ebay.com" & vbCrLf & vbCrLf '第二頁item 'req = "POST /ws/eBayISAPI.dll?ViewItem&category=20684&item=4340145380&rd=1 HTTP/1.0" + vbCrLf _ ' + "User-Agent: Mozilla/4.0 (compatible; MSIE 5.0; Windows 95; CNETHomeBuild03171999)" + vbCrLf _ ' + "Host: cgi.ebay.com" & vbCrLf & vbCrLf _ 'store第一頁list 'req = "POST /The-Aqua-Safe-Pure-Water-Shop_ACCESSORY-ITEMS_W0QQcolZ2QQdirZ1QQsclZallQQsotimedisplayZ2QQtZkm HTTP/1.0" + vbCrLf _ ' + "User-Agent: Mozilla/4.0 (compatible; MSIE 5.0; Windows 95; CNETHomeBuild03171999)" + vbCrLf _ ' + "Host: stores.ebay.com" & vbCrLf & vbCrLf _ '+ "Accept: image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, application/vnd.ms-excel, application/vnd.ms-powerpoint, application/msword, */*" + vbCrLf _ '+ "Referer: " & Referer & vbCrLf _ '+ "Accept-Language: en-us" & vbCrLf _ '+ "Content-Type: application/x-www-form-urlencoded" & vbCrLf _ '+ "User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; Q312461; .NET CLR 1.0.3705)" & vbCrLf _ '+ "Host: 61.220.188.84" & vbCrLf _ '+ "Content-Length: 30" & vbCrLf _ '+ "Cookie: " & Cookie & vbCrLf _ '+ & vbCrLf & Data & vbCrLf ' List1.AddItem req Winsock1.SendData (req) End Sub 'PPPPPP Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long) Winsock1.GetData arrstr1, vbString, 10240 Total = Total + bytesTotal Label1.Caption = Total 'bytesTotal 'List1.AddItem arrstr1 Print #1, arrstr1 End Sub 'PPPPPP Private Sub Winsock1_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean) 'List1.AddItem "Error = " & Number & Description Kill (App.Path & "\lock.txt") End End Sub 'SUCKER <<<<<<======== '切 [Store_Categories] 產品網頁 user.html 將連結放入 Item.txt與陣列 Private Sub User_cut() Sell_Line_c = 1 Sell_Start_flag = 0 Temp_userid_start = 0 head_xml_s_w_count = 1 Dim head_xml As String Dim head_xml_s As String Dim Buff() As Byte Dim LongString As String 'Dim head_Xml_Value(2500) As String '定義陣列給xml前段欄位 List1.AddItem "GO User_cut" List1.Selected(List1.ListCount - 1) = True Open App.Path & "\user.html" For Binary As #3 ReDim Buff(LOF(3) - 1) Get #3, , Buff LongString = StrConv(Buff, vbUnicode) Item_head_len = LOF(3) Close #3 'List1.AddItem Item_head_len head_word_c = 1 '分解TAG For head_xml_i = 1 To Item_head_len head_xml_s = Mid$(LongString, head_xml_i, 1) 'List1.AddItem head_xml_s If head_xml_s = "<" Then '把空DATA排除 If head_xml_s_w <> "" Then 'head_Xml_Value(head_word_c) = head_xml_s_w head_word_c = head_word_c + 1 '列出DATA 'List1.AddItem head_xml_s_w 'Print #4, head_xml_s_w End If head_xml_s_w = head_xml_s Else If head_xml_s = ">" Then head_xml_s_w = head_xml_s_w + head_xml_s 'head_Xml_Value(head_word_c) = head_xml_s_w head_word_c = head_word_c + 1 '列出TAG If InStr(head_xml_s_w, " 0 Then 'LongString = Replace(LongString, vbNewLine, "") Item_url_noCRLF = Replace(head_xml_s_w, vbNewLine, "") Item_url = Replace(Mid(Item_url_noCRLF, 10, Len(Item_url_noCRLF) - 11), "amp;", "") '第二頁的連結,已去重覆 If (Item_url <> Item_url_temp) And (InStr(head_xml_s_w, "target=""_top") = 0) Then 'List1.AddItem Item_url Open App.Path & "\item.txt" For Append As #7 'List1.AddItem item_url Print #7, Item_url Item_Value(head_xml_s_w_count) = Item_url Close #7 'List1.AddItem head_xml_s_w_count head_xml_s_w_count = head_xml_s_w_count + 1 End If 'List1.AddItem head_xml_s_w_count 'head_xml_s_w_count = head_xml_s_w_count + 1 Item_url_temp = Item_url End If 'Print #4, head_xml_s_w Item_url = "" head_xml_s_w = "" Else head_xml_s_w = head_xml_s_w + head_xml_s 'List1.AddItem head_xml_s_w End If End If 'List1.AddItem head_xml_i 'List1.AddItem head_xml_s_w 'List1.Selected(List1.ListCount - 1) = True 'End If Next head_xml_i List1.AddItem "Cut End" Item_count_timer = 1 'Open App.Path & "\item.txt" For Input As #8 '呼叫產品連結列表檔 Open App.Path & "\" & Store_Categories & "-photo.txt" For Append As #6 Print #6, "store=" & Store_Categories Close #6 '測試_測試_測試_測試_測試_測試 Go_suck_item '抓所有 Item 的產品網頁及切出 PHOTO1 連結 '測試_測試_測試_測試_測試_測試 'Timer2.Enabled = True 'Form3.Show 'Form2.Hide 'DoEvents End Sub '<<<<<<======== '========>>>>>> '抓所有 Item 的產品網頁及切出 PHOTO1 連結 Private Sub Go_suck_item() 'Item_count = 1 'Open App.Path & "\item.txt" For Input As #8 '呼叫產品連結列表檔 'Do While Not EOF(8) 'List1.AddItem Item_count 'Line Input #8, Textline Item_url = Mid(Item_Value(Item_count_timer), InStr(Item_Value(Item_count_timer), ".com") + 4) 'Item_url = Mid(Textline, InStr(Textline, ".com") + 4) Open App.Path & "\item.html" For Output As #4 Total = 0 cnt = 0 'Winsock2.Close '第二頁item Winsock2.RemoteHost = "cgi.ebay.com" Print 1 Winsock2.RemotePort = 80 Print 2 Winsock2.Protocol = sckTCPProtocol Print 3 'DoEvents Winsock2.Connect Timer2.Enabled = True ' Close #4 '抓完PHOTO1的網頁關閉item.html 'Item_count = Item_count + 1 'Loop 'Close #8 End Sub '定時器 將所有 Item 的產品網頁抓完 Private Sub Timer2_Timer() If (Label3.Caption = "Winsock2 Close") And (Winsock2.State = 0) Then 'Timer1.Enabled = True List1.AddItem "Go Go_suck_item" List1.Selected(List1.ListCount - 1) = True 'Go_suck_item '呼叫抓PHOTO1的網頁 Timer2.Enabled = False Label3.Caption = "Winsock2 Go" If (Item_count_timer <> head_xml_s_w_count - 1) Then 'Winsock2.Close 'List1.AddItem Item_count_timer 'List1.AddItem head_xml_s_w_count - 1 'List1.Selected(List1.ListCount - 1) = True Item_count_timer = Item_count_timer + 1 Go_suck_item '呼叫抓PHOTO1的網頁 'Item_url = Mid(Item_Value(Item_count_timer), InStr(Item_Value(Item_count_timer), ".com") + 4) 'Close #4 'Open App.Path & "\item.html" For Output As #4 Else List1.AddItem "Good end" List1.Selected(List1.ListCount - 1) = True ret = 0 'Text1.Text = ret ret = Shell("ebupload001.exe " + Store_Categories + "-photo.txt", vbNormalFocus) 'Text1.Text = ret '回到最前頭,作下一位USER Timer4.Enabled = True Label4.Caption = "Winsock2 Close" 'End End If Else 'List1.AddItem "Not2 end" + Str(Winsock2.State) If Winsock2.State = 8 Then Winsock2.Close Item_cut '呼叫抓PHOTO1的連結 End If End If End Sub 'SUCKER ========>>>>>> Private Sub Winsock2_Connect() 'Dim req As String List1.AddItem "hahaha ! Connect2222 !" List1.AddItem "Item_url" + Item_url '第二頁item req2 = "POST " + Item_url + " HTTP/1.0" + vbCrLf _ + "User-Agent: Mozilla/4.0 (compatible; MSIE 5.0; Windows 95; CNETHomeBuild03171999)" + vbCrLf _ + "Host: cgi.ebay.com" & vbCrLf & vbCrLf Winsock2.SendData (req2) 'DoEvents End Sub Private Sub Winsock2_DataArrival(ByVal bytesTotal As Long) Winsock2.GetData arrstr2, vbString, 10240 Total = Total + bytesTotal Label1.Caption = Total 'bytesTotal 'List1.AddItem arrstr2 Print #4, arrstr2 'Winsock2.Close 'DoEvents End Sub Private Sub Winsock2_Close() 'DoEvents Label3.Caption = "Winsock2 Close" 'Label4.Caption = "Winsock2 Close" Close #4 '抓完PHOTO1的網頁關閉item.html 'Item_cut '呼叫抓PHOTO1的連結 'List1.AddItem "One End" 'List1.Selected(List1.ListCount - 1) = True 'Close #8 'Timer2.Enabled = True End Sub Private Sub Winsock2_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean) 'List1.AddItem "Error = " & Number & Description Kill (App.Path & "\lock.txt") End End Sub 'SUCKER <<<<<<======== '切 ITEM 內的產品 PHOTO1 連結 放入 Store_Categories-PHOTO.TXT Private Sub Item_cut() Item_s_w_count = 1 Item_cut_Ends_found_flag = "" Item_cut_Price_found_flag = "" Item_cut_Price_found_flag_ok = "" Item_photo_url_temp = "" Item_title_temp = "" Item_price_temp = "" Item_ends_temp = "" Dim Item As String Dim Item_s As String Dim Buff2() As Byte Dim LongString2 As String List1.AddItem "GO Item_cut" List1.Selected(List1.ListCount - 1) = True Open App.Path & "\item.html" For Binary As #5 ReDim Buff2(LOF(5) - 1) Get #5, , Buff2 LongString2 = StrConv(Buff2, vbUnicode) Item_head_len = LOF(5) Close #5 List1.AddItem Item_head_len Item_word_c = 1 '分解TAG For Item_i = 1 To Item_head_len Item_s = Mid$(LongString2, Item_i, 1) 'List1.AddItem Item_s If Item_s = "<" Then '把空DATA排除 If Item_s_w <> "Error" Then 'If Item_s_w = "" Then ' Kill (App.Path & "\lock.txt") ' End 'End If '找到Ends和Title If Item_cut_Ends_found_flag = "found" Then Item_url_noCRLF = Replace(Item_s_w, vbNewLine, "") If InStr(1, Item_url_noCRLF, "PDT)") > 1 Then '產品的Ends Item_url = Mid(Item_url_noCRLF, InStr(1, Item_url_noCRLF, "(Ends", 1) + 6, InStr(1, Item_url_noCRLF, "PDT)", 1) + 3 - InStr(1, Item_url_noCRLF, "(Ends", 1) - 6) '產品的TITLE Item_url_title = Mid(Item_url_noCRLF, InStr(1, Item_url_noCRLF, "PDT)", 1) + 7) Else '產品的Ends Item_url = Mid(Item_url_noCRLF, InStr(1, Item_url_noCRLF, "(Ends", 1) + 6, InStr(1, Item_url_noCRLF, "PST)", 1) + 3 - InStr(1, Item_url_noCRLF, "(Ends", 1) - 6) '產品的TITLE Item_url_title = Mid(Item_url_noCRLF, InStr(1, Item_url_noCRLF, "PST)", 1) + 7) End If ' Open App.Path & "\photo.txt" For Append As #6 'List1.AddItem Item_url_title 'List1.AddItem Item_url Item_title_temp = Item_url_title Item_ends_temp = Item_url ' Close #6 Item_cut_Ends_found_flag = "" 'List1.AddItem Item_cut_Ends_found_flag Else If (Item_cut_Price_found_flag = "found") And (Item_cut_Price_found_flag_ok <> "yes") Then Item_url_noCRLF = Replace(Item_s_w, vbNewLine, "") If InStr(1, Item_url_noCRLF, "US $", 1) = 1 Then '產品的Price Item_url = Item_url_noCRLF ' Open App.Path & "\photo.txt" For Append As #6 'List1.AddItem Item_url Item_price_temp = Item_url Item_cut_Price_found_flag_ok = "yes" ' Close #6 Item_cut_Price_found_flag = "" 'List1.AddItem Item_cut_Price_found_flag End If End If End If If (InStr(1, Item_s_w, "price:", 1) = 1) Or (InStr(1, Item_s_w, "price:", 1) = 2) Then Item_cut_Price_found_flag = "found" 'List1.AddItem Item_cut_Price_found_flag End If 'Item_Value(head_word_c) = Item_s_w head_word_c = head_word_c + 1 '列出DATA 'List1.AddItem Item_s_w 'Print #4, Item_s_w End If Item_s_w = Item_s Else If Item_s = ">" Then Item_s_w = Item_s_w + Item_s 'Item_Value(head_word_c) = Item_s_w Item_word_c = Item_word_c + 1 '列出TAG If InStr(Item_s_w, "name=""eBayBig""") <> 0 Then Item_url_noCRLF = Replace(Item_s_w, vbNewLine, "") Item_url = Mid(Item_url_noCRLF, 11, InStr(1, Item_url_noCRLF, "JPG", 1) - 8) '第二頁的PHOTO1連結 ' If item_url <> item_url_temp Then ' Open App.Path & "\photo.txt" For Append As #6 ' List1.AddItem Item_url Item_photo_url_temp = Item_url ' Close #6 ' End If 'List1.AddItem Item_s_w_count 'Item_s_w_count = Item_s_w_count + 1 ' item_url_temp = item_url Else If InStr(Item_s_w, "title") = 2 Then Item_cut_Ends_found_flag = "found" 'List1.AddItem Item_cut_Ends_found_flag End If End If Item_url = "" Item_s_w = "" Else Item_s_w = Item_s_w + Item_s 'List1.AddItem Item_s_w End If End If 'List1.AddItem Item_i 'List1.AddItem Item_s_w List1.Selected(List1.ListCount - 1) = True 'End If Next Item_i Open App.Path & "\" & Store_Categories & "-photo.txt" For Append As #6 Print #6, "1=" + Item_Value(Item_count_timer) Print #6, "2=" + Item_photo_url_temp Print #6, "3=" + Item_title_temp Print #6, "4=" + Item_price_temp Print #6, "5=" + Item_ends_temp Close #6 List1.AddItem "Cut Photo1 End" List1.Selected(List1.ListCount - 1) = True End Sub Private Sub Form_Unload(Cancel As Integer) 'Winsock1.Close 'Winsock2.Close End Sub '測試_測試_測試_測試_測試_測試 Private Sub Command2_Click() '測試用按鍵 'User_cut '呼叫抓第一頁內的第二頁item連結 'Go_suck_item '抓第二頁的網頁 Item_cut '抓第二頁內的PHOTO1連結 'Kill (App.Path & "\lock.txt") '------ 'Dim Buff() As Byte 'Dim LongString As String 'Open App.Path & "\000.txt" For Binary As #9 ' ReDim Buff(LOF(9) - 1) ' Get #9, , Buff ' LongString = StrConv(Buff, vbUnicode) ' List1.AddItem "111" + LongString ' 'LongString = Replace(LongString, vbNewLine, "") ' Item_url_noCRLF = Replace(LongString, vbNewLine, "") ' Item_url = Replace(Mid(Item_url_noCRLF, 10, Len(Item_url_noCRLF) - 11), "amp;", "") ' List1.AddItem "222" + Item_url 'Close #9 '------ End Sub