麻辣家族討論版版 - Powered by Discuz! Board

標題: [分享] 使用 XMLHTTP + ADODB.Stream 查詢保戶股權分散表 [打印本頁]

作者: 准提部林 時間: 2015-11-9 21:05 標題: 使用 XMLHTTP + ADODB.Stream 查詢保戶股權分散表

本帖最後由准提部林於 2015-11-9 21:18 編輯

使用 XMLHTTP + ADODB.Stream 查詢保戶股權分散表
　
＜題由＞　
取得網頁原始碼的資料
http://forum.twbts.com/thread-15528-1-1.html
　
雖然作了回覆，特再花個時間做個MEMO，
除了為自己做個備忘錄，也希望讓網友多個參考處。
　
＜註一＞　
無法使用.responseText取得原始碼文字，肇因可能為網頁編碼的關係，
取出的文字為〔亂碼〕，故造成程式的錯誤中斷；
因此借用 ADODB.Stream 為中介，以〔二進位〕方式取出原始碼，
可用〔XMLHTTP　ADODB.Stream〕為關鍵字 GOOGLE 一下，
有相當多的資料可參考，個人也是一知半解（知其然）而已，
為免做錯誤的解釋，請自行去探索，
也期待有心的專家來補充益眾。　
　
＜註二＞　
本範例主要網址為：http://www.tdcc.com.tw/smWeb/QryStock.jsp，
XMLHTTP 並未對網頁〔控件〕做查詢參數的輸入操作，
因此，程式碼必須含有〔查詢參數〕，例如：〔日期〕〔股票代碼〕，
經多次嚐試，不得其門而入，拼半天也只是：
SCA_DATE=日期&StockNo=股票代碼～～但行不通！！！
後想到超板有答過此相關題，找了一下，在這裡：
http://forum.twbts.com/thread-15067-1-7.html
　
網址完整後綴如下：
SCA_DATE=日期&SqlMethod=StockNo&StockNo=股票代碼&StockName=&sub=%ACd%B8%DF
　
這串文字怎來的？期待超板的開示～～　
　
＜註三＞　
XMLHTTP〔post．get〕的差異！
ｇｅｔ：第一次執行，譬如向客戶要求傳真，須等文件傳送，所以花些時間；
　　　　第二次以後的執行，因文件已存在，就直接取用，時間快很多；
　　　　但那是〔舊資料〕，可能與最新的正本有差異。
ｐｏｓｔ則每次都要求傳送，以取得最新的資料。
　
另外可以在網址後面加入亂數，例如：
URL = "http://www.tdcc.com.tw/smWeb/QryStock.jsp" & "?" & Rnd
使每次連結的網址視為不同，也可達到取得最新內容的目的，但並非所有網址可如此。
　
＜註四＞　
一般若輸入錯誤的網址，應會傳回錯誤，或傳回未就緒訊息，
但有時網頁雖未進入指定的目的頁，但會自動跳至其主頁或首頁，
此時 XMLHTTP 仍然可以正常傳回文字，只是並非所要的內容，
所以還是要注意。
　
＜後記＞　
對網頁存取仍是門外人，僅如上淺薄注文，間或有誤有漏，請自行參酌；
以下的程式碼及範例也僅供參考套用，恕不為網友個別提供客製修改；
希望路過專家不吝指導，為此帖漏誤之處做更精確的大補帖，謝謝！　

＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
Sub 取出日期清單()
Dim XML, URL$, TT
[A:A].ClearContents
URL = "http://www.tdcc.com.tw/smWeb/QryStock.jsp" & "?" & Rnd
Set XML = CreateObject("Microsoft.XMLHTTP")
XML.Open "post", URL, False
XML.send
If XML.Status = 200 Then
　With CreateObject("ADODB.Stream")
　　　　.Open
　　　　.Type = 1
　　　　.Write XML.ResponseBody
　　　　.Position = 0
　　　　.Type = 2
　　　　.Charset = "BIG5"
　　　　TT = .ReadText
　　　　.Close
　End With
　TT = Replace(TT, "</option><option >", "_")
　TT = Split(TT, "</option>")(0)
　TT = Split(TT, "<option >")(1)
　TT = Split(TT, "_")
　[A1].Resize(UBound(TT) + 1) = Application.Transpose(TT)
End If
Set XML = Nothing
End Sub

＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
Sub 保戶股權分散表查詢()
Dim XML, URL$, TT, vDate, vNo, vFile$, X, PP$
vDate = [F1]: vNo = [F2]: vFile = vNo & "_" & vDate & ".csv"
URL = "http://www.tdcc.com.tw/smWeb/QryStock.jsp?SCA_DATE=" & vDate & _
　　　"&SqlMethod=StockNo&StockNo=" & vNo & "&StockName=&sub=%ACd%B8%DF"
Set XML = CreateObject("Microsoft.XMLHTTP")
XML.Open "post", URL, False
XML.send
If XML.Status = 200 Then
　With CreateObject("ADODB.Stream")
　　　　.Open
　　　　.Type = 1
　　　　.Write XML.ResponseBody

　　　　.Position = 0
　　　　.Type = 2
　　　　.Charset = "BIG5"
　　　　TT = .ReadText
　　　　.Close

　　　　PP = "<table cellspacing=0 cellpadding=0 width=""100%"" border=0>"
　　　　X = Split(TT, PP)
　　　　If UBound(X) < 3 Then Exit Sub
　　　　TT = Replace(X(3) & PP & X(4), "集保戶股權分散表", "")
　
　　　　.Open
　　　　.Writetext TT
　　　　.SaveToFile ThisWorkbook.Path & "\" & vFile, 2
　　　　.Close
　　　　Beep
　End With
End If
Set XML = Nothing
End Sub
　
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
附件下載：
[attach]22383[/attach]

作者: GBKEE 時間: 2015-11-10 07:23

回復 1# 准提部林
請問java 的網頁可以抓的下來嗎？
請問如何用 vba 點擊網頁查詢

作者: stillfish00 時間: 2015-11-12 10:58

本帖最後由 stillfish00 於 2015-11-12 11:00 編輯

回復 1# 准提部林
自己也對網頁擷取自行摸索一段時間，以下是個人見解提供參考:
首先，我們要與(網頁)伺服器溝通，是透過對瀏覽器的操作(例如重新整理或網頁上的送出按鈕)
來發出"請求"(request)封包，經由網路傳給伺服器，
伺服器再經由網路返回"響應"(response)給瀏覽器。

這個"請求"封包中包含了 url , method , status , header , body 等等
GET和POST就是請求的方法(method)中最常見的兩種，
最大不同的地方在於：
GET是直接把要傳遞的參數附加在url字串後方
POST是把要傳遞的參數放在body。

假設
sURL = "http://www.tdcc.com.tw/smWeb/QryStock.jsp"
sArg = "SCA_DATE=20151106&SqlMethod=StockNo&StockNo=1101&StockName=&sub=查詢"
sEncodeArg = UrlEncode(sArg)
'UrlEncode : 自訂Function，
'編碼完 sEncodeArg = "SCA_DATE=20151106&SqlMethod=StockNo&StockNo=1101&StockName=&sub=%ACd%B8%DF"

GET附加的文字要經過Url Encode
POST放到body的內容可選擇不同編碼方式，但要在header中說明
所以XML通常會這樣寫:

'GET
.Open "GET" , sURL & "?" & sEncodeArg
.send

複製代碼

'POST
.Open "POST" , sURL
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.setRequestHeader "Content-Length", Len(sEncodeArg)
.send (sEncodeArg)

複製代碼

1. 版主提到的取到舊資料，應是緩存(cache的關係)
可考慮上述GET的send前加上
      .setRequestHeader "Pragma", "no-cache"
或
      .setRequestHeader "Cache-Control", "no-cache"
告訴網路中的節點(如proxy), 不要用你自己的cache資料返回給我
URL加亂數也是類似道理，因為URL變了不容易有相同URL的cache資料
(但亂數到同一個值還是有機會取到舊的)

2. URL Encode  Function，網路上找到的一般應該多是 for "utf-8"的，
無法把 "sub=查詢" 轉成 "sub=%ACd%B8%DF"  (所以當初有人問chrome為何無法decode)
http://www.mytju.com/classCode/tools/urlencode_big5.asp
這網站有線上的，可以知道for "big5" url encode 的結果
但不知道編碼邏輯，不好做成自定的 function

作者: stillfish00 時間: 2015-11-13 18:11

本帖最後由 stillfish00 於 2015-11-13 18:25 編輯

回復 3# stillfish00
拼拼湊湊推導出來的編碼邏輯，若有發現錯誤請指點下，謝謝。

Function UrlEncode_BIG5(s As String) As String
Dim c As Integer
Dim hiByte As Byte, loByte As Byte
Dim ar
For i = 1 To Len(s)
c = Asc(Mid(s, i, 1))
hiByte = (c And &HFF00&) / &H100
loByte = c And &HFF&
If hiByte = 0 Then ar = Array(loByte) Else ar = Array(hiByte, loByte)
For Each x In ar
If (x >= &H30 And x <= &H39) Or _
(x >= &H41 And x <= &H5A) Or _
(x >= &H61 And x <= &H7A) Then
UrlEncode_BIG5 = UrlEncode_BIG5 & Chr(x)
Else
UrlEncode_BIG5 = UrlEncode_BIG5 & "%" & Hex(x)
End If
Next
Next
End Function

複製代碼

UrlEncode_BIG5("台泥") => "%A5x%AAd"

作者: 准提部林 時間: 2015-11-13 18:31

回復 4# stillfish00

=UrlEncode_BIG5("台泥") → "%A5x%AAd" 　直接儲存格公式即得，好用！

作者: no3-taco 時間: 2015-11-14 06:35

回復 5# 准提部林
參考stillfish00大大的規則寫的，提供不一樣的寫法
沒有比對很多字，有寫錯的地方指導一下

Function Urlbig5(Ub5 As String) As String 'uni轉big5
Dim a() As Byte: a = StrConv(Ub5, 128)
For I = 0 To UBound(a)
If Chr(a(I)) Like "[A-Za-z0-9]" Then
Urlbig5 = Urlbig5 & Chr(a(I))
Else
Urlbig5 = Urlbig5 & "%" & Hex(a(I))
End If
Next I
End Function
Function UrlUto8x(Uu As String) As String 'uni轉utf-8
With CreateObject("ADODB.Stream")
.Type = 2
.Charset = "utf-8"
.Open
.writetext Uu '內容
.Position = 0
.Type = 1
Dim ax() As Byte: ax = .read
.Close
End With
For I = 3 To UBound(ax) '保留BOM 3改1
UrlUto8x = UrlUto8x & "%" & Hex(ax(I))
Next I
End Function

複製代碼

作者: 准提部林 時間: 2015-11-14 11:00

回復 6# no3-taco

對字碼編碼的知識並不充分, 頂多要用時上網找現成的, 能套則套,
一般公司資料應用上, 用的機會並不多!

貴解及stillfish00大大的程式都是正規, 謝謝提供有用的知識~

歡迎光臨麻辣家族討論版版 (http://forum.twbts.com/)