本帖最後由 ethanliang 於 13-4-1 14:31 編輯
sunny 發表於 13-4-1 10:30 
因為我直接在 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 Long Public 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) AsLong Public 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 = &H4A Public lpPrevWndProc As Long '存放原窗口函?句柄 Public Get_hWnd As Long Public FFInit As Long Public FFOdr As Long Public strID As String Public strPass As String Public 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 data End 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 Long EndType 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 Double EndType Public Function WindowProc(ByVal hWnd AsLong, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long OnError 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.Text strPass = 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 | 
發表於 13-3-25 14:20
顯身卡
樓主