返回列表 上一主題 發帖

[分享] 使用 XMLHTTP + ADODB.Stream 查詢保戶股權分散表

[分享] 使用 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〕的差異!
get:第一次執行,譬如向客戶要求傳真,須等文件傳送,所以花些時間;
    第二次以後的執行,因文件已存在,就直接取用,時間快很多;
    但那是〔舊資料〕,可能與最新的正本有差異。
post則每次都要求傳送,以取得最新的資料。
 
另外可以在網址後面加入亂數,例如:
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
 
==================================
附件下載:
20151108-01(保戶股權分散表查詢).rar (10.48 KB)
EXCEL參考資料:
http://blog.xuite.net/smile1000mile/blog

1

評分人數

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

本帖最後由 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通常會這樣寫:
  1. 'GET
  2. .Open "GET" , sURL & "?" & sEncodeArg
  3. .send
複製代碼
  1. 'POST
  2. .Open "POST" , sURL
  3. .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
  4. .setRequestHeader "Content-Length", Len(sEncodeArg)
  5. .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
1

評分人數

    • 准提部林: 真是菁華出類, 倍增添益, 謝謝!金錢 + 5
表達不清、題意不明確、沒附檔案格式、沒有討論問題的態度~~~~~~以上愛莫能助。

TOP

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

回復 3# stillfish00
拼拼湊湊推導出來的編碼邏輯,若有發現錯誤請指點下,謝謝。
  1. Function UrlEncode_BIG5(s As String) As String
  2.     Dim c As Integer
  3.     Dim hiByte As Byte, loByte As Byte
  4.     Dim ar
  5.    
  6.     For i = 1 To Len(s)
  7.         c = Asc(Mid(s, i, 1))
  8.         hiByte = (c And &HFF00&) / &H100
  9.         loByte = c And &HFF&
  10.         If hiByte = 0 Then ar = Array(loByte) Else ar = Array(hiByte, loByte)
  11.         
  12.         For Each x In ar
  13.             If (x >= &H30 And x <= &H39) Or _
  14.                 (x >= &H41 And x <= &H5A) Or _
  15.                 (x >= &H61 And x <= &H7A) Then
  16.                 UrlEncode_BIG5 = UrlEncode_BIG5 & Chr(x)
  17.             Else
  18.                 UrlEncode_BIG5 = UrlEncode_BIG5 & "%" & Hex(x)
  19.             End If
  20.         Next
  21.     Next
  22. End Function
複製代碼
UrlEncode_BIG5("台泥") => "%A5x%AAd"
1

評分人數

    • 准提部林: 看來雖簡單, 不容易呀! 收下了, 謝謝!金錢 + 5
表達不清、題意不明確、沒附檔案格式、沒有討論問題的態度~~~~~~以上愛莫能助。

TOP

回復 4# stillfish00


=UrlEncode_BIG5("台泥") → "%A5x%AAd"  直接儲存格公式即得,好用!
EXCEL參考資料:
http://blog.xuite.net/smile1000mile/blog

TOP

回復 5# 准提部林
參考stillfish00大大的規則寫的,提供不一樣的寫法
沒有比對很多字,有寫錯的地方指導一下
  1. Function Urlbig5(Ub5 As String) As String  'uni轉big5
  2. Dim a() As Byte: a = StrConv(Ub5, 128)
  3. For I = 0 To UBound(a)
  4.     If Chr(a(I)) Like "[A-Za-z0-9]" Then  
  5.         Urlbig5 = Urlbig5 & Chr(a(I))
  6.     Else
  7.         Urlbig5 = Urlbig5 & "%" & Hex(a(I))
  8.     End If
  9. Next I
  10. End Function

  11. Function UrlUto8x(Uu As String) As String  'uni轉utf-8
  12. With CreateObject("ADODB.Stream")
  13.     .Type = 2
  14.     .Charset = "utf-8"
  15.     .Open
  16.     .writetext Uu '內容
  17.     .Position = 0
  18.     .Type = 1
  19.     Dim ax() As Byte: ax = .read
  20.     .Close
  21. End With

  22. For I = 3 To UBound(ax) '保留BOM 3改1
  23.     UrlUto8x = UrlUto8x & "%" & Hex(ax(I))
  24. Next I
  25. End Function
複製代碼
1

評分人數

    • 准提部林: 與stillfish00大大不同的寫法來對照, 更容易 ...金錢 + 5

TOP

回復 6# no3-taco

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

貴解及stillfish00大大的程式都是正規, 謝謝提供有用的知識~
EXCEL參考資料:
http://blog.xuite.net/smile1000mile/blog

TOP

        靜思自在 : 不要隨心所欲,要隨心教育自己。
返回列表 上一主題