ethanliang 發表於 13-3-25 13:53 static/image/common/back.gif
sunny兄，您好：真是有默契，我正在試 "DLLDemoProject.exe"可以Run，很OK。我想要的報價型態是『成交明 ...
如果 OK 的話, 就可以去把 Excel VBA 裡的程式拿出來用了,就不要去管 *.pas 那些檔案了, 那應該是 Delphi 的程式,
不過我沒有外期帳號, 沒法去測試 Excel 是否 Work ,
只是我剛才看了一下 Excel 裡的程式,
模組內多了一個, 裡面呼叫了幾個 Windows 視窗用的 API,
還有呼叫群益報價要用的, 跟國內報價有點不一樣,
不知您試不出來的情況是什麼?
是沒有 Tick 還是, 沒有找到對的代碼, 還是都沒反應呢?
sunny 發表於 13-3-25 14:20 static/image/common/back.gif
如果 OK 的話, 就可以去把 Excel VBA 裡的程式拿出來用了,就不要去管 *.pas 那些檔案了, 那應該是 Delphi ...
sunny兄，您好：1. 在Excel範例檔裡，各商品都只顯示一個即時的成交報價，我希望能以 VB6 改寫程式，而且能顯示各商品的『成交明細』，含 ( 成交價、單筆量、成交時間 )，我不知道該如何修改 ? 2. 部分參考商品代碼如下， 摩台，商品代碼：16s,TWN,13,3,0,N 歐元，商品代碼：10,EC_,13,6,0,N謝謝。
sunny 發表於 13-3-25 14:20 static/image/common/back.gif
如果 OK 的話, 就可以去把 Excel VBA 裡的程式拿出來用了,就不要去管 *.pas 那些檔案了, 那應該是 Delphi ...
sunny兄，您好：我後來發現，群益DLLDemoProject.exe這個檔案，輸入身分證字號時，第一個英文字母要大寫，若是小寫，則會顯示認證失敗，供您參考，謝謝。
ethanliang 發表於 13-3-27 07:40 static/image/common/back.gif
sunny兄，您好：我後來發現，群益DLLDemoProject.exe這個檔案，輸入身分證字號時，第一個英文字母要大寫 ...
是嗎, 我再試試, 您有發消息我剛才才看到說, 系統的消息好像沒有提示, 不像回文就有提醒, 如果我的帳號沒辦法登入, 我下午再試試您的 ~
我試過了英文字母大寫還是不行, 我跟營業員反映, 現在好像認證通過了, 我來研究一下您說的明細資料.
這個外期報價 API 需要直接存取記憶體的資料, 確實有些難搞, 而且明細資料的部分, 說明文件也沒有列出用哪個參數, 所以這要花些時間測試才能知道, 這幾天有空再測試看看囉, 有找出來再上傳了 ~
sunny 發表於 13-3-27 18:03 static/image/common/back.gif
這個外期報價 API 需要直接存取記憶體的資料, 確實有些難搞, 而且明細資料的部分, 說明文件也沒有列出用哪 ...
sunny兄，您好：1. 了解，謝謝。2. 我也覺得群益外期報價超級難搞， 說明文件有寫，像沒寫， 變數命名也看不出章法， 程式中文註解還出現許多亂碼， 各個 function要輸入哪些參數 ? 傳回何值? 也看不出來為何外期報價要加入國內報價程式碼 ? 哈，簡單的說，就是搞不懂!
我周末用了些時間測試去記憶體找資料,
不過很失望, 因為都找不到有用的資料,
最多只有找到名稱跟時間在跳動,
明細實在不知道它放在哪裡,
沒辦法像 DEMO 程式可以秀出時間之後的所有資料,
所以最終還是放棄囉, 真的幫不上忙了,
看看有沒有其他大大高手能夠幫忙的,
先這樣囉 ~
sunny 發表於 13-3-27 18:03 static/image/common/back.gif
這個外期報價 API 需要直接存取記憶體的資料, 確實有些難搞, 而且明細資料的部分, 說明文件也沒有列出用哪 ...
sunny兄，您好：我把群益海期報價範例VBA修改，可以看到報價，供您參考。 1. 在C:\Program Files (x86)\Microsoft Office\OFFICE11 檔名：QuoteList.txt 更新為 16s,TWN,13,4,0,N ‘*摩台 10,AD_,13,6,0,N ‘* 澳幣 2. 將國內期貨報價api部分，全部移除。3. 將範例內暫時用不到的程式碼移除，以簡化程式，可以看到報價。
VBA 程式碼如下：
‘** Module1 程式碼 **
Option Explicit
'**自己新增的商品代碼宣告
Public Const TX As String ="TWN 201304"
Public Const AD As String = "AD_ 201306"
'**原範例程式宣告Public Declare Function FindWindow Lib"user32" Alias "FindWindowA" (ByVal lpClassName As String,ByVal lpWindowName As String) As Long
Public Declare FunctionSetWindowLong Lib "user32" Alias "SetWindowLongA" (ByValhWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long '向系??送消息
Public Declare FunctionCallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVallpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam AsLong, ByVal lParam As Long) As Long '?置Windows???的API函?定?
Public Declare Sub CopyMemory Lib"kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSourceAs Any, ByVal cbCopy As Long)
Public Declare Function ApiSendCmdLib "LSocket.dll" (ByVal Ttype As Integer, ByVal Ticktype As Integer)As Long
Public Declare Function Certify Lib"LSocket.dll" (ByVal Source As String, _
ByVal UserID As String, ByVal UserPW AsString, ByVal ApHandle As Long) As Long
Public Const GWL_WNDPROC = -4&Public Const WM_COPYDATA = &H4APublic lpPrevWndProc As Long'存放原窗口函?句柄Public Get_hWnd As LongPublic FFInit As LongPublic FFOdr As LongPublic strID As StringPublic strPass As StringPublic Const strSource As String ="COMSTOCK"Public strYear As String'當年度Public strNextYear As Integer'下個年度Public strMouth As Integer '當月Public strNextMouth As String '下一個月份
Type COPYDATASTRUCT dwData As Long 'command ID cbData As Long 'len of lpdata lpData As Long 'string dataEnd Type
Public Type TFFStock ExchangeId As String * 5 CommodityId As String * 10 Time As String * 8Option As String SettleMentYear As Long SettleMentMonth As Long StrickPrice As Long SalePrice As DoubleUnitVol As Long ToTalVol As Long Bid1_Price As Double Ask1_Price As Double Bid1_Vol As Long Ask1_Vol As Long End Type
Public Type THead ExchangeId As String * 5 CommodityId As String * 10 Option As StringSettleMentYear As LongSettleMentMonth As LongStrickPrice As Long OpenPrice As Double HighPrice As Double LowPrice As Double RefPrice As Double bDenominator As Double End Type
Public Sub FFstart(ByVal sID AsString, ByVal sPW As String) Dim sCap As String
sCap = ThisWorkbook.Windows(1).Caption
Get_hWnd = FindWindow(vbNullString, sCap)
If Get_hWnd = 0 Then sCap = Application.Name + " -" + ThisWorkbook.Windows(1).Caption
Get_hWnd = FindWindow(vbNullString,sCap)
If Get_hWnd = 0 Then Get_hWnd = Application.hWnd End If End If
FFInit = Certify(strSource, sID, sPW, Get_hWnd)'身份認證
If FFInit = 1 Then FFOdr = 0 Sheet2.Cells(2, 6) = "認證成功" Else MsgBox "海外認證失敗" End If
'* 列出商品代碼 Sheet2.Cells(11, 1) = TX Sheet2.Cells(12, 1) = AD
End Sub
Public Function WindowProc(ByValhWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long)As Long
On Error Resume Next Select Case uMsg ' 變動值 3,5,6,74,153,... ' Case WM_COPYDATA' 固定74
Case 74
Dim CD As COPYDATASTRUCT Dim data As String, B(0 To 255)As Byte Dim sData(8) As String Dim sID As String Dim iCount, i As Integer iCount = 0
Call CopyMemory(CD, ByVallParam, Len(CD))
If CD.dwData = 2 Then
Call CopyMemory(B(0), ByValCD.lpData, CD.cbData)
data = StrConv(B,vbUnicode)
For i = 1 To Len(data)
If Mid(data, i, 1) ="," Then iCount = iCount + 1 Else sData(iCount) =sData(iCount) + Mid(data, i, 1) End If Next i sID = Trim(Trim(sData(1)) +Str(sData(2) + 2000) + Format(sData(3), "00"))
If TX = sID Then '*** Sheet2.Cells(11, 2) =sData(5) End If'***
If AD = sID Then Sheet2.Cells(12, 2) =sData(5) End If
End If
End Select WindowProc = CallWindowProc(lpPrevWndProc, hWnd, uMsg, wParam, lParam)End Function
‘***********原範例 Sheet 2 修改更新後程式碼*********
Public Sub FFInitialize()
strID =Me.Cells.Range("B2").Value2 strPass =Replace(Me.Cells.Range("C2").Value2, Chr(160), "") '國外報價 Call FFstart(strID,strPass)End Sub
Public Sub FFOrder() If (FFInit = 1) And (FFOdr =0) Then FFOdr = ApiSendCmd(2, 2) lpPrevWndProc =SetWindowLong(Get_hWnd, GWL_WNDPROC, AddressOf WindowProc) Sheet2.Cells(2, 7) ="訂閱成功" End If
End Sub
因為我直接在 VB 6 裡測試, 所以我就沒有去跑 Excel 的 VBA 了, 不過我是試 S&P 500 ,
不知道有沒不同就是了, 有時間再測了 ~ 謝謝囉 ~
本帖最後由 ethanliang 於 13-4-1 14:31 編輯
sunny 發表於 13-4-1 10:30 static/image/common/back.gif
因為我直接在 VB 6 裡測試, 所以我就沒有去跑 Excel 的 VBA 了, 不過我是試 S&P 500 ,
不知道有沒不同就是 ...
sunny兄，您好：1. 請問您，在VB6內，是否可以成功執行VBA範例的報價 ?2. 我都卡在 『接收報價』按鈕裡，遇到以下紅色程式碼，VB6就當機， 請問您有類似的情況產生嗎? If (FFInit = 1) And (FFOdr =0) Then FFOdr = ApiSendCmd(2,2) lpPrevWndProc = SetWindowLong(Get_hWnd,GWL_WNDPROC, AddressOf WindowProc) Text4.Text = "訂閱報價成功End If 3. 在海期報價api 的Sub FFstart 裡，對於sCap與Get_hWnd，我缺少這方面的概念，瞎子摸象，誤打誤撞，請sunny兄幫我看一下，謝謝。 4. 以下為我修改後的VB6完整程式碼： ‘**Module 1** Option Explicit Public Const TX As String = "TWN201304"Public Const AD As String = "AD_201306" Public Declare Function FindWindow Lib"user32" Alias "FindWindowA" (ByVal lpClassName As String,ByVal lpWindowName As String) As LongPublic Declare Function SetWindowLong Lib"user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByValnIndex As Long, ByVal dwNewLong As Long) As Long '向系??送消息Public Declare Function CallWindowProc Lib"user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc AsLong, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParamAs Long) As Long '?置Windows???的API函?定?Public Declare Sub CopyMemory Lib "kernel32"Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopyAs Long)Public Declare Function ApiSendCmd Lib"LSocket.dll" (ByVal Ttype As Integer, ByVal Ticktype As Integer) AsLongPublic Declare Function Certify Lib"LSocket.dll" (ByVal Source As String, _ ByVal UserID As String, ByVal UserPW As String, ByVal ApHandle As Long)As Long Public Const GWL_WNDPROC = -4&Public Const WM_COPYDATA = &H4APublic lpPrevWndProc As Long'存放原窗口函?句柄Public Get_hWnd As LongPublic FFInit As LongPublic FFOdr As LongPublic strID As StringPublic strPass As StringPublic Const strSource As String ="COMSTOCK" Public strYear As String'當年度Public strNextYear As Integer'下個年度Public strMouth As Integer '當月Public strNextMouth As String '下一個月份 Type COPYDATASTRUCT dwData As Long 'command ID cbData As Long 'len of lpdata lpData As Long 'string dataEnd Type Public Type TFFStock ExchangeId As String * 5 CommodityId As String * 10 Time As String * 8 Option As String SettleMentYear As Long SettleMentMonth As Long StrickPrice As Long SalePrice As Double UnitVol As Long ToTalVol As Long Bid1_Price As Double Ask1_Price As Double Bid1_Vol As Long Ask1_Vol As LongEndType Public Type THead ExchangeId As String * 5 CommodityId As String * 10 Option As String SettleMentYear As Long SettleMentMonth As Long StrickPrice As Long OpenPrice As Double HighPrice As Double LowPrice As Double RefPrice As Double bDenominator As DoubleEndType Public Function WindowProc(ByVal hWnd AsLong, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As LongOnError Resume Next Select Case uMsg ' 變動值 3,5,6,74,153,... Case WM_COPYDATA' 固定74 Dim CD As COPYDATASTRUCT Dim data As String, B(0 To 255) As Byte Dim sData(8) As String Dim sID As String Dim iCount, i As Integer iCount = 0 Call CopyMemory(CD, ByVal lParam, Len(CD)) If CD.dwData = 2 Then Call CopyMemory(B(0), ByVal CD.lpData,CD.cbData) data = StrConv(B, vbUnicode) For i = 1 To Len(data) If Mid(data, i,1) = "," Then iCount = iCount+ 1 Else sData(iCount) =sData(iCount) + Mid(data, i, 1) End If Next i sID = Trim(Trim(sData(1)) + Str(sData(2) + 2000) + Format(sData(3),"00")) '** 顯示接收的報價 Form1.Text8.Text = sData(4) Form1.Text9.Text = sData(5) Form1.Text10.Text = sID End If EndSelect WindowProc = CallWindowProc(lpPrevWndProc, hWnd, uMsg, wParam, lParam) End Function ‘*** 以下為Fomr1**** '** 登入帳號密碼按鈕Private Sub Command1_Click() strID= Text1.TextstrPass = Text2.Text CallFFstart(strID, strPass)End Sub
Public Sub FFstart(ByVal sID As String,ByVal sPW As String) Dim sCap As String 'sCap = Form1.Caption sCap = "VB6 - form1" '***不知是否正確? Get_hWnd = FindWindow(vbNullString, sCap) If Get_hWnd = 0 Then sCap = "VB6 -Project1" Get_hWnd =FindWindow(vbNullString, sCap) If Get_hWnd = 0 Then Get_hWnd = Form1.hWnd End If End If FFInit = Certify(strSource, sID, sPW, Get_hWnd)'身份認證 If FFInit = 1 Then FFOdr = 0 Form1.Text3.Text = "身分認證成功" '**認證這邊OK Else Form1.Text3.Text = "海外認證失敗" End If End Sub '** 接收報價的按鈕Private Sub Command2_Click() If(FFInit = 1) And (FFOdr = 0) Then FFOdr = ApiSendCmd(2, 2) '*** 我一直卡在這邊，VB6直接當機 ! lpPrevWndProc =SetWindowLong(Get_hWnd, GWL_WNDPROC, AddressOf WindowProc) Text4.Text = "訂閱報價成功" EndIf End Sub
ethanliang 發表於 13-4-1 14:28 static/image/common/back.gif
sunny兄，您好：1. 請問您，在VB6內，是否可以成功執行VBA範例的報價 ?2. 我都卡在 『接收報價』按鈕裡， ...
我是沒有常常當機, 偶爾會當,不過它寫的不完整,
因為沒有把程序還回去給視窗,所以會當機是可預料的,
而且又牽涉記憶體存取,
所以只要一點沒弄好程式就會當了,
只是我重點放在秀出明細資料,
所以也沒去管要把它寫好,
何況我不是很熟這種 WinProc 結構,
最後我還是找不到我要的資料.
就放棄了.
所以如果您會卡在 ApiSendCmd 的話,
試試在前面用 On Error Resume Next 來跳過錯誤看看,
進一步可以用 If ( Err.Number <> 0 ) Then 秀出錯誤訊息看看.
這可能跟作業系統或環境有關 .
突然想到,
您要用編譯好的執行檔測試,
不要在 VB 裡按箭頭執行喔 ~
不然這種程式在 VB 裡跑很容易當的.
sCap = "VB6 - form1"
Get_hWnd = FindWindow(vbNullString, sCap)
這裡我是直接用 Get_hWnd = Form1.hWnd
因為 Excel 沒有這屬性所以要動用到 FindWindow,
如果讓程式直接執行就不需要這麼麻煩了.
如果要報價下單不同家API 是我的話會用multi-process 因為怕有沒發現的相容問題造成bug
不過VB的話 我不懂 不要問我
sunny 發表於 13-4-1 15:27 static/image/common/back.gif
sCap = "VB6 - form1"
Get_hWnd = FindWindow(vbNullString, sCap)
這裡我是直接用 Get_hWnd = Form1.hWnd ...
sunny兄，您好：1. 我自己連續弄了好多天，一直當機， 鍵盤都快被我敲壞了，就是弄不好。 2. 剛剛依您的指點，改一下，就成功了， 現在已經可以看到報價了， 真的非常感謝您。 3. 若是您方便，是否可以請您吃麥當勞或是喝星巴克咖啡， 當面謝謝您的超大力幫忙。