V
vbfgm
Unregistered / Unconfirmed
GUEST, unregistred user!
这个问题的核心是：
Dim StkDrv2 As IStockDriver2
Set StkDrv2 = m_stkdrv.Object ' 获取接口
StkDrv2.EnableNewFormat = True ' 启用新格式，不能退出老格式
以上的VB代码如何用Delphi来编写，
请高手仔细看一下源码：
官方VB 、自编Delphi、导入后的STOCKLib_TLB.pas
===========================================================
以下是官方提供的通视卡接收VB演示程序：
'这个程序已通过验证能够正常接收
Dim OneHis As New StockHisData '变量onhis定义为一个stockhisdata集合
Dim OneMin As New StockMinData
Dim OneStk As New StockReport
'新添加的代码,用于新格式接收
Dim StkReport2 As IStockReport2
Private Sub Form_Load() '窗体初始化
a = "通视信息卡,ID号=" + m_stkdrv.RcvIDCode
a = a + vbCrLf + "驱动程序版本 = " + m_stkdrv.Version 'vbCrLf换行回车
a = a + vbCrLf + "支持深圳6位代码新格式"
m_Out.Text = a
'以下为新添加的代码，,用于新格式接收
Dim StkDrv2 As IStockDriver2
Set StkDrv2 = m_stkdrv.Object ' 获取接口
StkDrv2.EnableNewFormat = True ' 启用新格式，不能退出老格式
Set StkDrv2 = Nothing ' 释放接口
Set StkReport2 = OneStk
'以上用于新格式接收的代码如何转化为DelPhi代码？！！！
End Sub
Private Sub Form_Unload(Cancel As Integer) '窗体关闭事件
m_stkdrv.Stop
End Sub
Private Sub m_end_Click() '停止按钮
m_stkdrv.Stop
End Sub
Private Sub m_setup_Click() '设置按钮
m_stkdrv.Setup (1)
End Sub
Private Sub m_start_Click() '开始按钮
m_stkdrv.Receive
End Sub
'基本资料事件
Private Sub m_stkdrv_OnBaseFile(ByVal strFileName As String, ByVal Market As Integer, ByVal nFileLen As Long, ByVal pBuf As Long) '按值传递参数
Dim DstTxt As String
DstText = strFileName
DstText = DstText + " "
DstText = DstText & nFileLen
DstText = DstText + " "
txt = m_stkdrv.ToString(nFileLen, pBuf)
DstText = DstText + Left(txt, 50)
m_BaseOut.Text = DstText
End Sub
'下面是接收历史数据事件
Private Sub m_stkdrv_OnHistory(ByVal nPacketNum As Long, ByVal pBuf As Long)
Call OneHis.Attach(nPacketNum, pBuf)
Dim DstTxt As String
nPackNum = OneHis.PacketNum
DstTxt = "收到" & nPackNum & "个数据包" + vbCrLf
Dim Buf As OLE_RCV_HISTORY
Dim OldLabel As String
For i = 0 To nPackNum - 1
Buf = OneHis.ElementAt(i)
If (StrComp(Buf.m_strLabel, OldLabel) <> 0) Then
OldLabel = Buf.m_strLabel
DstTxt = DstTxt & OneHis.strLabel
DstTxt = DstTxt + " "
DstTxt = DstTxt & OneHis.OpenPrice
DstTxt = DstTxt + " "
DstTxt = DstTxt & OneHis.Volume
DstTxt = DstTxt + " "
DstTxt = DstTxt & OneHis.Time
DstTxt = DstTxt + vbCrLf
End If
Next i
m_HisOut.Text = DstTxt
End Sub
'下面是接收分时数据事件
Private Sub m_stkdrv_OnMinData(ByVal nPacket As Long, ByVal pBuf As Long)
Call OneMin.Attach(nPacket, pBuf)
nPackNum = OneMin.PacketNum
Dim DstTxt As String
Dim Buf As OLE_RCV_MINUTE
Dim OldLabel As String
DstTxt = "收到" & nPackNum & "个分时数据" + vbCrLf
For i = 0 To nPackNum - 1
Buf = OneMin.ElementAt(i)
If (StrComp(Buf.m_strLabel, OldLabel) <> 0) Then
OldLabel = Buf.m_strLabel
DstTxt = DstTxt & Buf.m_strLabel
DstTxt = DstTxt + " "
DstTxt = DstTxt & Buf.m_fPrice
DstTxt = DstTxt + " "
DstTxt = DstTxt & Buf.m_fVolume
DstTxt = DstTxt + " "
DstTxt = DstTxt & Buf.m_Time
DstTxt = DstTxt + vbCrLf
End If
Next i
m_Min.Text = DstTxt
End Sub
'以下为公告新闻事件
Private Sub m_stkdrv_OnNewsFile(ByVal NewsType As Long, ByVal SerialNo As Long, ByVal pFileName As String, ByVal nFileLen As Long, ByVal pBuf As Long)
Dim DstText As String
If NewsType = 2 Then
DstText = "上交所公告"
End If
If NewsType = 4 Then
DstText = "深交所公告"
End If
If NewsType = 6 Then
DstText = "财经报道"
End If
DstText = DstText + "<"
DstText = DstText & SerialNo
DstText = DstText + "> "
txt = m_stkdrv.ToString(nFileLen, pBuf)
DstText = DstText + Left(txt, 50)
m_NewsOut.Text = DstText
End Sub
'下面是接收行情数据事件
Private Sub m_stkdrv_OnReport(ByVal nPacket As Long, ByVal pBuf As Long) '行情接收
Call OneStk.Attach(nPacket, pBuf)
Dim DstTxt As String
'新添加的代码，接收新格式
Dim Buf As OLE_RCV_REPORT2
For i = 0 To nPacket - 1
Buf = StkReport2.ElementAt(i)
DstTxt = DstTxt & Buf.m_Time
DstTxt = DstTxt + " "
DstTxt = DstTxt + Buf.m_strLabel
DstTxt = DstTxt + " "
DstTxt = DstTxt + Buf.m_strName
DstTxt = DstTxt + " "
DstTxt = DstTxt & Buf.m_fNewPrice
DstTxt = DstTxt + " "
DstTxt = DstTxt & Buf.m_fAmount
DstTxt = DstTxt + " "
DstTxt = DstTxt & Buf.m_fVolume
DstTxt = DstTxt + " "
DstTxt = DstTxt & Buf.m_fBuyPrice(0)
DstTxt = DstTxt + " "
DstTxt = DstTxt & Buf.m_fBuyVolume(0)
DstTxt = DstTxt + vbCrLf
Next i
m_Out.Text = DstTxt
End Sub
==========================================================
以下是我自己编写的Delphi演示程序，所遇到的问题都已标明，
编译无问题。
//通视卡驱动程序通过 '组件'-'导入ActiveX控件' 的方法实现。（当然你要先安装通视卡驱动程序）
{
这个程序是仿照通视卡股票接收 VB 演示程序编写的，但是它有如下问题：
1：不能接收行情事件（即买卖盘）可以接收新闻、基本资料事件，不知道如何做才能接收6档买卖盘
2：接收时，收到事件时，总是显示 :
"Access Violation at address 5106178E in module project1.exe,read of address 00000000 "
(510678E随接收事件的不同而不同）
}
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, OleCtrls, STOCKLib_TLB, StdCtrls, ExtCtrls, OleCtnrs;
//STOCKLib_TLB为通视卡股票接收驱动程序的pas库
type
TForm1 = class(TForm)
m_stkdrv:TStockDriver;
Panel1: TPanel;
m_start: TButton;
m_setup: TButton;
m_end: TButton;
Panel2: TPanel;
Panel3: TPanel;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
m_out: TMemo;
m_min: TMemo;
m_HisOut: TMemo;
m_NewsOut: TMemo;
m_BaseOut: TMemo;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure m_endClick(Sender: TObject);
procedure m_setupClick(Sender: TObject);
procedure m_startClick(Sender: TObject);
procedure m_stkdrvReport(ASender: TObject; nPacket, pBuf: Integer);
procedure m_stkdrvMinData(ASender: TObject; nPacket, pBuf: Integer);
procedure m_stkdrvHistory(ASender: TObject; nPacketNum, pBuf: Integer);
procedure m_stkdrvNewsFile(ASender: TObject; NewsType,
SerialNo: Integer; const pFileName: WideString; nFileLen,
pBuf: Integer);
procedure m_stkdrvBaseFile(ASender: TObject;
const strFileName: WideString; Market: Smallint; nFileLen,
pBuf: Integer);
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
OneHis:CoStockHisData;//costockhisData 为STOCKLib_TLB中的一个类
OneMin:CoStockMinData; // CoStockMinData 为STOCKLib_TLB中的一个类
OneStk:CoStockReport; // CoStockReport 为STOCKLib_TLB中的一个类
//StkReport2:IStockReport2;//新格式接收
implementation
{$R *.dfm}
//窗体初始化
procedure TForm1.FormCreate(Sender: TObject);
var
a:string;
// StkDrv2:IStockDriver2;
begin
m_out.Lines.Clear;//清空
a:='通视信息卡，ID号='+ m_stkdrv.RcvIDCode+#13#10;
a:=a+'驱动程序版本 =' + m_stkdrv.Version+#13#10;
a:=a+'支持深圳6位代码新格式'+#13#10;
m_out.Lines.add(a); //显示
//以下是欲采用新接口的代码，请高手填写
end;
//窗体关闭事件
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
m_stkdrv.Stop;//关闭窗体时停止接收
end;
//停止接收按钮
procedure TForm1.m_endClick(Sender: TObject);
begin
m_stkdrv.Stop;//停止接收
end;
//设置接收按钮
procedure TForm1.m_setupClick(Sender: TObject);
begin
m_stkdrv.Setup(1);//显示设置窗口
end;
//启动接收按钮
procedure TForm1.m_startClick(Sender: TObject);
begin
if m_stkdrv.ReceiveEx=1 //启动接收
then showmessage('通视卡启动正常')
else showmessage('通视卡启动错误');
end;
//下面是接收行情数据事件
procedure TForm1.m_stkdrvReport(ASender: TObject; nPacket, pBuf: Integer); //行情接收事件
var
i:integer;
DstTxt:AnsiString;
buf:OLE_RCV_REPORT;// OLE_RCV_REPORT 为STOCKLib_TLB中的一个压缩型记录类型
begin
m_out.Lines.Clear;//清空
OneStk.create.attach(nPacket,pBuf); //create为STOCKLib_TLB中的一个函数
DstTxt:= '收到'+ inttostr(nPacket) +'个信息包' + #13#10;
m_out.Lines.add(DstTxt);
for i:=0 to npacket-1 do
begin
buf:=OneStk.create.ElementAt; //设置数组的序号，并返回类型为OLE_RCV_REPORT的行情数据，
m_out.Lines.add(DateTimeToStr(buf.m_Time)+' ');//交易时间
m_out.Lines.add(ansistring(buf.m_strLabel) +' ');//代码
m_out.lines.add(ansistring(buf.m_strName) +' ');//名称
m_out.lines.add(floattostr(buf.m_fLastClose )+' ');//昨收盘
m_out.lines.add(floattostr(buf.m_fOpen) +' ');//今开盘
m_out.lines.add(floattostr(buf.m_fNewPrice)+' ');//最新价
m_out.lines.add(floattostr(buf.m_fHigh)+' ');//最高价
m_out.lines.add(floattostr(buf.m_fLow )+' ');//最低价
m_out.lines.add(floattostr(buf.m_fVolume )+' ');//成交量
m_out.lines.add(floattostr(buf.m_fAmount )+' ');//成交金额
m_out.lines.add(floattostr(buf.m_fbuyprice[0])+' ');//买盘价
m_out.lines.add(floattostr(buf.m_fBuyPrice[1])+' ');//买盘价
m_out.lines.add(floattostr(buf.m_fBuyPrice[2])+' ');//买盘价
m_out.lines.add(floattostr(buf.m_fBuyVolume[0])+' ');//买盘量
m_out.lines.add(floattostr(buf.m_fBuyVolume[1])+' ');//买盘量
m_out.lines.add(floattostr(buf.m_fBuyVolume[2])+' ');//买盘量
m_out.lines.add(floattostr(buf.m_fSellPrice[0])+' ');//卖盘价
m_out.lines.add(floattostr(buf.m_fSellPrice[1])+' ');//卖盘价
m_out.lines.add(floattostr(buf.m_fSellPrice[2])+' ');//卖盘价
m_out.lines.add(floattostr(buf.m_fSellVolume[0])+' ');//卖盘量
m_out.lines.add(floattostr(buf.m_fSellVolume[1])+' ');//卖盘量
m_out.lines.add(floattostr(buf.m_fSellVolume[2])+#13#10);//卖盘量
m_stkdrv.EnableReportEvent:=0;
end;
m_stkdrv.EnableReportEvent:=0;
end;
//下面是接收分时数据事件
procedure TForm1.m_stkdrvMinData(ASender: TObject; nPacket, pBuf: Integer);
var
nPackNum,i:integer;
DstTxt:ansistring;
buf:OLE_RCV_MINUTE;
begin
m_min.Lines.Clear; //清空
oneMin.Create.Attach(nPacket,pBuf);
nPackNum:=OneMin.Create.PacketNum;
DstTxt:='收到'+ inttostr(nPackNum) +'个分时数据' + #13#10;
m_min.Lines.add(DstTxt); //显示分时数据个数
for i:=0 to nPackNum-1 do
begin
Buf:=OneMin.create.ElementAt; //设置数组的序号，并返回类型为OLE_RCV_REPORT的行情数据，
m_min.Lines.add(ansistring(buf.m_strLabel) +' ');//代码
m_min.Lines.add(DateTimeToStr(buf.m_Time)+' ');//交易时间
m_min.Lines.add(floattostr(buf.m_fPrice)+' ');//新价
m_min.Lines.add(floattostr(buf.m_fVolume )+' ');//成交量
m_min.Lines.add(floattostr(buf.m_fAmount )+ #13#10);//成交金额
m_stkdrv.EnableMinEvent :=0;
end;
end;
//下面是接收历史数据事件
procedure TForm1.m_stkdrvHistory(ASender: TObject; nPacketNum, pBuf: Integer);
var
nPackNum,i:integer;
DstTxt:ansistring;
buf:OLE_RCV_HISTORY;
begin
m_HisOut.Lines.clear; //清空
oneHis.Create.Attach(nPacketNum,pBuf);
nPackNum:=OneHis.Create.PacketNum;
DstTxt:= '收到'+ inttostr(nPackNum) +'个历史日线数据包' + #13#10;
m_HisOut.Lines.add(dsttxt); //显示数据包数
for i:=0 to nPackNum-1 do
begin
Buf:= OneHis.create.ElementAt; //设置数组的序号，并返回类型为OLE_RCV_REPORT的行情数据，
m_HisOut.Lines.add(ansistring(buf.m_strLabel) +' ');//代码
m_HisOut.Lines.add(DateTimeToStr(buf.m_Time)+' ');//交易时间
m_HisOut.Lines.add(floattostr(buf.m_fClose)+' ');//收盘
m_HisOut.Lines.add(floattostr(buf.m_fOpen) +' ');//开盘
m_HisOut.Lines.add(floattostr(buf.m_fHigh)+' ');//最高价
m_HisOut.Lines.add(floattostr(buf.m_fLow )+' ');//最低价
m_HisOut.Lines.add(floattostr(buf.m_fVolume )+' ');//成交量
m_HisOut.Lines.add(floattostr(buf.m_fAmount )+ ' ');//成交金额
m_HisOut.Lines.add(intToStr(buf.m_nAdvance)+' '); //
m_HisOut.Lines.add(intToStr(buf.m_nDecline)+#13#10);//
m_stkdrv.EnableHisEvent :=0;
end;
case buf.m_Market of
$00004853:showmessage('OLE_SH_MARKETEx ');
// OLE_SZ_MARKETEx = $00005A53;
//OLE_HK_MARKETEx = $00004B48;
end;
end;
//以下为公告新闻事件
procedure TForm1.m_stkdrvNewsFile(ASender: TObject; NewsType,
SerialNo: Integer; const pFileName: WideString; nFileLen, pBuf: Integer);
var
DstText:ansistring;
begin
m_NewsOut.Lines.Clear;
case NewsType of
2
stText:='上交所公告';
4stText:='上交所公告';
6stText:='财经报道';
end;
DstText:= DstText + '<'+intToStr(SerialNo)+'>'+ansistring(pFileName);
m_NewsOut.Lines.add(DstText);
m_stkdrv.EnableNewsEvent:=0;
end;
//补基本资料事件
procedure TForm1.m_stkdrvBaseFile(ASender: TObject;
const strFileName: WideString; Market: Smallint; nFileLen,
pBuf: Integer);
var
DstText:ansistring;
begin
m_baseout.Lines.Clear;
DstText:=ansistring(strFileName)+' '+inttostr(nFileLen)+#13#10;
m_Baseout.Lines.Add(DstText);
end;
end.
============================================================
//以下为导入后的STOCKLib_TLB.pas源码
unit STOCKLib_TLB;
// ************************************************************************ //
// WARNING
// -------
// The types declared in this file were generated from data read from a
// Type Library. If this type library is explicitly or indirectly (via
// another type library referring to this type library) re-imported, or the
// 'Refresh' command of the Type Library Editor activated while editing the
// Type Library, the contents of this file will be regenerated and all
// manual modifications will be lost.
// ************************************************************************ //
// PASTLWTR : 1.2
// File generated on 2004-5-14 16:04:26 from Type Library described below.
// ************************************************************************ //
// Type Lib: C:/WINNT/system32/stock.dll (1)
// LIBID: {4F6A9E80-C79C-11D2-B401-00C04FCCA334}
// LCID: 0
// Helpfile:
// HelpString: TongShi StockDriver 1.0 Type Library
// DepndLst:
// (1) v2.0 stdole, (C:/WINNT/system32/stdole2.tlb)
// ************************************************************************ //
{$TYPEDADDRESS OFF} // Unit must be compiled without type-checked pointers.
{$WARN SYMBOL_PLATFORM OFF}
{$WRITEABLECONST ON}
{$VARPROPSETTER ON}
interface
uses Windows, ActiveX, Classes, Graphics, OleCtrls, OleServer, StdVCL, Variants;
// *********************************************************************//
// GUIDS declared in the TypeLibrary. Following prefixes are used:
// Type Libraries : LIBID_xxxx
// CoClasses : CLASS_xxxx
// DISPInterfaces : DIID_xxxx
// Non-DISP interfaces: IID_xxxx
// *********************************************************************//
const
// TypeLibrary Major and minor versions
STOCKLibMajorVersion = 1;
STOCKLibMinorVersion = 0;
LIBID_STOCKLib: TGUID = '{4F6A9E80-C79C-11D2-B401-00C04FCCA334}';
DIID__IStockDriverEvents: TGUID = '{9FD507CB-E42F-11D2-B30C-00C04FCCA334}';
IID_IStockReport: TGUID = '{E518BAC6-E53B-11D2-B30C-00C04FCCA334}';
IID_IStockReport2: TGUID = '{7B53644A-4B6F-4AE4-8CD7-67C683DC8D9E}';
IID_IStockMinData: TGUID = '{78B9E8B1-E5FA-11D2-B30C-00C04FCCA334}';
IID_IStockHisData: TGUID = '{A22E1441-E61B-11D2-B30C-00C04FCCA334}';
IID_IStockDriver: TGUID = '{9FD507C9-E42F-11D2-B30C-00C04FCCA334}';
IID_IStockDriver2: TGUID = '{7EC46973-C25F-42E3-B22E-806D3FC5C20E}';
CLASS_StockDriver: TGUID = '{9FD507CA-E42F-11D2-B30C-00C04FCCA334}';
CLASS_StockReport: TGUID = '{E518BAC7-E53B-11D2-B30C-00C04FCCA334}';
CLASS_StockMinData: TGUID = '{E518BAC9-E53B-11D2-B30C-00C04FCCA334}';
CLASS_StockHisData: TGUID = '{E518BACB-E53B-11D2-B30C-00C04FCCA334}';
// *********************************************************************//
// Declaration of Enumerations defined in Type Library
// *********************************************************************//
// Constants for enum OLE_MARKET_ENUM
type
OLE_MARKET_ENUM = TOleEnum;
const
OLE_SH_MARKETEx = $00004853;
OLE_SZ_MARKETEx = $00005A53;
OLE_HK_MARKETEx = $00004B48;
type
// *********************************************************************//
// Forward declaration of types defined in TypeLibrary
// *********************************************************************//
_IStockDriverEvents = dispinterface;
IStockReport = interface;
IStockReportDisp = dispinterface;
IStockReport2 = interface;
IStockReport2Disp = dispinterface;
IStockMinData = interface;
IStockMinDataDisp = dispinterface;
IStockHisData = interface;
IStockHisDataDisp = dispinterface;
IStockDriver = interface;
IStockDriverDisp = dispinterface;
IStockDriver2 = interface;
IStockDriver2Disp = dispinterface;
// *********************************************************************//
// Declaration of CoClasses defined in Type Library
// (NOTE: Here we map each CoClass to its Default Interface)
// *********************************************************************//
StockDriver = IStockDriver;
StockReport = IStockReport;
StockMinData = IStockMinData;
StockHisData = IStockHisData;
// *********************************************************************//
// Declaration of structures, unions and aliases.
// *********************************************************************//
OLE_RCV_REPORT = packed record
m_Time: TDateTime;
m_Market: OLE_MARKET_ENUM;
m_strLabel: WideString;
m_strName: WideString;
m_fLastClose: Single;
m_fOpen: Single;
m_fHigh: Single;
m_fLow: Single;
m_fNewPrice: Single;
m_fVolume: Single;
m_fAmount: Single;
m_fBuyPrice: array[0..2] of Single;
m_fBuyVolume: array[0..2] of Single;
m_fSellPrice: array[0..2] of Single;
m_fSellVolume: array[0..2] of Single;
end;
OLE_RCV_REPORT2 = packed record
m_Time: TDateTime;
m_Market: OLE_MARKET_ENUM;
m_strLabel: WideString;
m_strName: WideString;
m_fLastClose: Single;
m_fOpen: Single;
m_fHigh: Single;
m_fLow: Single;
m_fNewPrice: Single;
m_fVolume: Single;
m_fAmount: Single;
m_fBuyPrice: array[0..2] of Single;
m_fBuyVolume: array[0..2] of Single;
m_fSellPrice: array[0..2] of Single;
m_fSellVolume: array[0..2] of Single;
m_fBuyPrice4: Single;
m_fBuyVolume4: Single;
m_fSellPrice4: Single;
m_fSellVolume4: Single;
m_fBuyPrice5: Single;
m_fBuyVolume5: Single;
m_fSellPrice5: Single;
m_fSellVolume5: Single;
end;
OLE_RCV_MINUTE = packed record
m_Time: TDateTime;
m_Market: OLE_MARKET_ENUM;
m_strLabel: WideString;
m_fPrice: Single;
m_fVolume: Single;
m_fAmount: Single;
end;
OLE_RCV_HISTORY = packed record
m_strLabel: WideString;
m_Market: OLE_MARKET_ENUM;
m_Time: TDateTime;
m_fOpen: Single;
m_fHigh: Single;
m_fLow: Single;
m_fClose: Single;
m_fVolume: Single;
m_fAmount: Single;
m_nAdvance: SYSINT;
m_nDecline: SYSINT;
end;
// *********************************************************************//
// DispIntf: _IStockDriverEvents
// Flags: (4096) Dispatchable
// GUID: {9FD507CB-E42F-11D2-B30C-00C04FCCA334}
// *********************************************************************//
_IStockDriverEvents = dispinterface
['{9FD507CB-E42F-11D2-B30C-00C04FCCA334}']
procedure OnReport(nPacket: Integer; pBuf: Integer); dispid 1;
procedure OnMinData(nPacket: Integer; pBuf: Integer); dispid 2;
procedure OnHistory(nPacketNum: Integer; pBuf: Integer); dispid 3;
procedure OnNewsFile(NewsType: Integer; SerialNo: Integer; const pFileName: WideString;
nFileLen: Integer; pBuf: Integer); dispid 4;
procedure OnBaseFile(const strFileName: WideString; Market: Smallint; nFileLen: Integer;
pBuf: Integer); dispid 5;
end;
// *********************************************************************//
// Interface: IStockReport
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {E518BAC6-E53B-11D2-B30C-00C04FCCA334}
// *********************************************************************//
IStockReport = interface(IDispatch)
['{E518BAC6-E53B-11D2-B30C-00C04FCCA334}']
procedure Attach(nPacketNum: Integer; pDataBuf: Integer); safecall;
function Get_ArrayIndexer: Smallint; safecall;
procedure Set_ArrayIndexer(pVal: Smallint); safecall;
function Get_strLabel: WideString; safecall;
function Get_Time: TDateTime; safecall;
function Get_strName: WideString; safecall;
function Get_Market: OLE_MARKET_ENUM; safecall;
function Get_LastClose: Single; safecall;
function Get_OpenPrice: Single; safecall;
function Get_HighPrice: Single; safecall;
function Get_LowPrice: Single; safecall;
function Get_NewPrice: Single; safecall;
function Get_Volume: Single; safecall;
function Get_Amount: Single; safecall;
function Get_BuyPrice(i: Smallint): Single; safecall;
function Get_BuyVolume(i: Smallint): Single; safecall;
function Get_SellPrice(i: Smallint): Single; safecall;
function Get_SellVolume(i: Smallint): Single; safecall;
function Get_ElementAt(nNo: SYSINT): OLE_RCV_REPORT; safecall;
property ArrayIndexer: Smallint read Get_ArrayIndexer write Set_ArrayIndexer;
property strLabel: WideString read Get_strLabel;
property Time: TDateTime read Get_Time;
property strName: WideString read Get_strName;
property Market: OLE_MARKET_ENUM read Get_Market;
property LastClose: Single read Get_LastClose;
property OpenPrice: Single read Get_OpenPrice;
property HighPrice: Single read Get_HighPrice;
property LowPrice: Single read Get_LowPrice;
property NewPrice: Single read Get_NewPrice;
property Volume: Single read Get_Volume;
property Amount: Single read Get_Amount;
property BuyPrice[i: Smallint]: Single read Get_BuyPrice;
property BuyVolume[i: Smallint]: Single read Get_BuyVolume;
property SellPrice[i: Smallint]: Single read Get_SellPrice;
property SellVolume[i: Smallint]: Single read Get_SellVolume;
property ElementAt[nNo: SYSINT]: OLE_RCV_REPORT read Get_ElementAt;
end;
// *********************************************************************//
// DispIntf: IStockReportDisp
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {E518BAC6-E53B-11D2-B30C-00C04FCCA334}
// *********************************************************************//
IStockReportDisp = dispinterface
['{E518BAC6-E53B-11D2-B30C-00C04FCCA334}']
procedure Attach(nPacketNum: Integer; pDataBuf: Integer); dispid 1;
property ArrayIndexer: Smallint dispid 3;
property strLabel: WideString readonly dispid 4;
property Time: TDateTime readonly dispid 5;
property strName: WideString readonly dispid 6;
property Market: OLE_MARKET_ENUM readonly dispid 7;
property LastClose: Single readonly dispid 8;
property OpenPrice: Single readonly dispid 9;
property HighPrice: Single readonly dispid 10;
property LowPrice: Single readonly dispid 11;
property NewPrice: Single readonly dispid 12;
property Volume: Single readonly dispid 13;
property Amount: Single readonly dispid 14;
property BuyPrice[i: Smallint]: Single readonly dispid 15;
property BuyVolume[i: Smallint]: Single readonly dispid 16;
property SellPrice[i: Smallint]: Single readonly dispid 17;
property SellVolume[i: Smallint]: Single readonly dispid 18;
property ElementAt[nNo: SYSINT]: {??OLE_RCV_REPORT}OleVariant readonly dispid 19;
end;
// *********************************************************************//
// Interface: IStockReport2
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {7B53644A-4B6F-4AE4-8CD7-67C683DC8D9E}
// *********************************************************************//
IStockReport2 = interface(IDispatch)
['{7B53644A-4B6F-4AE4-8CD7-67C683DC8D9E}']
function Get_ElementAt(nNo: SYSINT): OLE_RCV_REPORT2; safecall;
property ElementAt[nNo: SYSINT]: OLE_RCV_REPORT2 read Get_ElementAt;
end;
// *********************************************************************//
// DispIntf: IStockReport2Disp
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {7B53644A-4B6F-4AE4-8CD7-67C683DC8D9E}
// *********************************************************************//
IStockReport2Disp = dispinterface
['{7B53644A-4B6F-4AE4-8CD7-67C683DC8D9E}']
property ElementAt[nNo: SYSINT]: {??OLE_RCV_REPORT2}OleVariant readonly dispid 1;
end;
// *********************************************************************//
// Interface: IStockMinData
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {78B9E8B1-E5FA-11D2-B30C-00C04FCCA334}
// *********************************************************************//
IStockMinData = interface(IDispatch)
['{78B9E8B1-E5FA-11D2-B30C-00C04FCCA334}']
procedure Attach(nPacketNum: Smallint; pDataBuf: Integer); safecall;
function Get_ArrayIndexer: Smallint; safecall;
function Get_strLabel: WideString; safecall;
function Get_Market: OLE_MARKET_ENUM; safecall;
function Get_Time: TDateTime; safecall;
function Get_Price: Single; safecall;
function Get_Volume: Single; safecall;
function Get_Amount: Single; safecall;
function Get_PacketNum: Smallint; safecall;
procedure Next; safecall;
function Get_ElementAt(i: Integer): OLE_RCV_MINUTE; safecall;
property ArrayIndexer: Smallint read Get_ArrayIndexer;
property strLabel: WideString read Get_strLabel;
property Market: OLE_MARKET_ENUM read Get_Market;
property Time: TDateTime read Get_Time;
property Price: Single read Get_Price;
property Volume: Single read Get_Volume;
property Amount: Single read Get_Amount;
property PacketNum: Smallint read Get_PacketNum;
property ElementAt[i: Integer]: OLE_RCV_MINUTE read Get_ElementAt;
end;
// *********************************************************************//
// DispIntf: IStockMinDataDisp
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {78B9E8B1-E5FA-11D2-B30C-00C04FCCA334}
// *********************************************************************//
IStockMinDataDisp = dispinterface
['{78B9E8B1-E5FA-11D2-B30C-00C04FCCA334}']
procedure Attach(nPacketNum: Smallint; pDataBuf: Integer); dispid 1;
property ArrayIndexer: Smallint readonly dispid 2;
property strLabel: WideString readonly dispid 3;
property Market: OLE_MARKET_ENUM readonly dispid 4;
property Time: TDateTime readonly dispid 5;
property Price: Single readonly dispid 6;
property Volume: Single readonly dispid 7;
property Amount: Single readonly dispid 8;
property PacketNum: Smallint readonly dispid 9;
procedure Next; dispid 10;
property ElementAt[i: Integer]: {??OLE_RCV_MINUTE}OleVariant readonly dispid 11;
end;
// *********************************************************************//
// Interface: IStockHisData
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {A22E1441-E61B-11D2-B30C-00C04FCCA334}
// *********************************************************************//
IStockHisData = interface(IDispatch)
['{A22E1441-E61B-11D2-B30C-00C04FCCA334}']
procedure Attach(nPacket: Integer; pBuf: Integer); safecall;
function Get_ArrayIndexer: Integer; safecall;
function Get_strLabel: WideString; safecall;
function Get_Market: OLE_MARKET_ENUM; safecall;
function Get_OpenPrice: Single; safecall;
function Get_Time: TDateTime; safecall;
function Get_HighPrice: Single; safecall;
function Get_LowPrice: Single; safecall;
function Get_ClosePrice: Single; safecall;
function Get_Volume: Single; safecall;
function Get_Amount: Single; safecall;
function Get_AdvanceNum: Integer; safecall;
function Get_DeclineNum: Integer; safecall;
function Get_PacketNum: Integer; safecall;
procedure Next; safecall;
function Get_ElementAt(i: Integer): OLE_RCV_HISTORY; safecall;
property ArrayIndexer: Integer read Get_ArrayIndexer;
property strLabel: WideString read Get_strLabel;
property Market: OLE_MARKET_ENUM read Get_Market;
property OpenPrice: Single read Get_OpenPrice;
property Time: TDateTime read Get_Time;
property HighPrice: Single read Get_HighPrice;
property LowPrice: Single read Get_LowPrice;
property ClosePrice: Single read Get_ClosePrice;
property Volume: Single read Get_Volume;
property Amount: Single read Get_Amount;
property AdvanceNum: Integer read Get_AdvanceNum;
property DeclineNum: Integer read Get_DeclineNum;
property PacketNum: Integer read Get_PacketNum;
property ElementAt[i: Integer]: OLE_RCV_HISTORY read Get_ElementAt;
end;
// *********************************************************************//
// DispIntf: IStockHisDataDisp
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {A22E1441-E61B-11D2-B30C-00C04FCCA334}
// *********************************************************************//
IStockHisDataDisp = dispinterface
['{A22E1441-E61B-11D2-B30C-00C04FCCA334}']
procedure Attach(nPacket: Integer; pBuf: Integer); dispid 1;
property ArrayIndexer: Integer readonly dispid 2;
property strLabel: WideString readonly dispid 3;
property Market: OLE_MARKET_ENUM readonly dispid 4;
property OpenPrice: Single readonly dispid 5;
property Time: TDateTime readonly dispid 6;
property HighPrice: Single readonly dispid 7;
property LowPrice: Single readonly dispid 8;
property ClosePrice: Single readonly dispid 9;
property Volume: Single readonly dispid 10;
property Amount: Single readonly dispid 11;
property AdvanceNum: Integer readonly dispid 12;
property DeclineNum: Integer readonly dispid 13;
property PacketNum: Integer readonly dispid 14;
procedure Next; dispid 15;
property ElementAt[i: Integer]: {??OLE_RCV_HISTORY}OleVariant readonly dispid 16;
end;
// *********************************************************************//
// Interface: IStockDriver
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {9FD507C9-E42F-11D2-B30C-00C04FCCA334}
// *********************************************************************//
IStockDriver = interface(IDispatch)
['{9FD507C9-E42F-11D2-B30C-00C04FCCA334}']
procedure Set_BackColor(pclr: OLE_COLOR); safecall;
function Get_BackColor: OLE_COLOR; safecall;
function Get_Channel: WideString; safecall;
function Get_Provider: WideString; safecall;
function Get_RcvIDCode: WideString; safecall;
function Get_Version: WideString; safecall;
function Get_TotalNumber: Integer; safecall;
procedure Receive; safecall;
procedure Stop; safecall;
procedure Setup(bShowWnd: Integer); safecall;
function Get_EnableReportEvent: Smallint; safecall;
procedure Set_EnableReportEvent(pVal: Smallint); safecall;
function Get_EnableMinEvent: Smallint; safecall;
procedure Set_EnableMinEvent(pVal: Smallint); safecall;
function Get_EnableHisEvent: Smallint; safecall;
procedure Set_EnableHisEvent(pVal: Smallint); safecall;
function Get_EnableNewsEvent: Smallint; safecall;
procedure Set_EnableNewsEvent(pVal: Smallint); safecall;
function Get_EnableBaseFileEvent: Smallint; safecall;
procedure Set_EnableBaseFileEvent(pVal: Smallint); safecall;
function Get_STKNumInMarket: Integer; safecall;
function ToString(nBufLen: SYSINT; pBuf: Integer): WideString; safecall;
function ReceiveEx: Integer; safecall;
property BackColor: OLE_COLOR read Get_BackColor write Set_BackColor;
property Channel: WideString read Get_Channel;
property Provider: WideString read Get_Provider;
property RcvIDCode: WideString read Get_RcvIDCode;
property Version: WideString read Get_Version;
property TotalNumber: Integer read Get_TotalNumber;
property EnableReportEvent: Smallint read Get_EnableReportEvent write Set_EnableReportEvent;
property EnableMinEvent: Smallint read Get_EnableMinEvent write Set_EnableMinEvent;
property EnableHisEvent: Smallint read Get_EnableHisEvent write Set_EnableHisEvent;
property EnableNewsEvent: Smallint read Get_EnableNewsEvent write Set_EnableNewsEvent;
property EnableBaseFileEvent: Smallint read Get_EnableBaseFileEvent write Set_EnableBaseFileEvent;
property STKNumInMarket: Integer read Get_STKNumInMarket;
end;
// *********************************************************************//
// DispIntf: IStockDriverDisp
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {9FD507C9-E42F-11D2-B30C-00C04FCCA334}
// *********************************************************************//
IStockDriverDisp = dispinterface
['{9FD507C9-E42F-11D2-B30C-00C04FCCA334}']
property BackColor: OLE_COLOR dispid -501;
property Channel: WideString readonly dispid 1;
property Provider: WideString readonly dispid 2;
property RcvIDCode: WideString readonly dispid 3;
property Version: WideString readonly dispid 4;
property TotalNumber: Integer readonly dispid 5;
procedure Receive; dispid 6;
procedure Stop; dispid 7;
procedure Setup(bShowWnd: Integer); dispid 8;
property EnableReportEvent: Smallint dispid 9;
property EnableMinEvent: Smallint dispid 10;
property EnableHisEvent: Smallint dispid 11;
property EnableNewsEvent: Smallint dispid 12;
property EnableBaseFileEvent: Smallint dispid 13;
property STKNumInMarket: Integer readonly dispid 14;
function ToString(nBufLen: SYSINT; pBuf: Integer): WideString; dispid 15;
function ReceiveEx: Integer; dispid 16;
end;
// *********************************************************************//
// Interface: IStockDriver2
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {7EC46973-C25F-42E3-B22E-806D3FC5C20E}
// *********************************************************************//
IStockDriver2 = interface(IDispatch)
['{7EC46973-C25F-42E3-B22E-806D3FC5C20E}']
function Get_EnableNewFormat: Integer; safecall;
procedure Set_EnableNewFormat(pVal: Integer); safecall;
property EnableNewFormat: Integer read Get_EnableNewFormat write Set_EnableNewFormat;
end;
// *********************************************************************//
// DispIntf: IStockDriver2Disp
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {7EC46973-C25F-42E3-B22E-806D3FC5C20E}
// *********************************************************************//
IStockDriver2Disp = dispinterface
['{7EC46973-C25F-42E3-B22E-806D3FC5C20E}']
property EnableNewFormat: Integer dispid 1;
end;
// *********************************************************************//
// OLE Control Proxy class declaration
// Control Name : TStockDriver
// Help String : StockDriver Class
// Default Interface: IStockDriver
// Def. Intf. DISP? : No
// Event Interface: _IStockDriverEvents
// TypeFlags : (2) CanCreate
// *********************************************************************//
TStockDriverOnReport = procedure(ASender: TObject; nPacket: Integer; pBuf: Integer) of object;
TStockDriverOnMinData = procedure(ASender: TObject; nPacket: Integer; pBuf: Integer) of object;
TStockDriverOnHistory = procedure(ASender: TObject; nPacketNum: Integer; pBuf: Integer) of object;
TStockDriverOnNewsFile = procedure(ASender: TObject; NewsType: Integer; SerialNo: Integer;
const pFileName: WideString;
nFileLen: Integer; pBuf: Integer) of object;
TStockDriverOnBaseFile = procedure(ASender: TObject; const strFileName: WideString;
Market: Smallint; nFileLen: Integer;
pBuf: Integer) of object;
TStockDriver = class(TOleControl)
private
FOnReport: TStockDriverOnReport;
FOnMinData: TStockDriverOnMinData;
FOnHistory: TStockDriverOnHistory;
FOnNewsFile: TStockDriverOnNewsFile;
FOnBaseFile: TStockDriverOnBaseFile;
FIntf: IStockDriver;
function GetControlInterface: IStockDriver;
protected
procedure CreateControl;
procedure InitControlData; override;
public
procedure Receive;
procedure Stop;
procedure Setup(bShowWnd: Integer);
function ToString(nBufLen: SYSINT; pBuf: Integer): WideString;
function ReceiveEx: Integer;
property ControlInterface: IStockDriver read GetControlInterface;
property DefaultInterface: IStockDriver read GetControlInterface;
property Channel: WideString index 1 read GetWideStringProp;
property Provider: WideString index 2 read GetWideStringProp;
property RcvIDCode: WideString index 3 read GetWideStringProp;
property Version: WideString index 4 read GetWideStringProp;
property TotalNumber: Integer index 5 read GetIntegerProp;
property STKNumInMarket: Integer index 14 read GetIntegerProp;
published
property Anchors;
property ParentColor;
property TabStop;
property Align;
property DragCursor;
property DragMode;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property TabOrder;
property Visible;
property OnDragDrop;
property OnDragOver;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnStartDrag;
property BackColor: TColor index -501 read GetTColorProp write SetTColorProp stored False;
property EnableReportEvent: Smallint index 9 read GetSmallintProp write SetSmallintProp stored False;
property EnableMinEvent: Smallint index 10 read GetSmallintProp write SetSmallintProp stored False;
property EnableHisEvent: Smallint index 11 read GetSmallintProp write SetSmallintProp stored False;
property EnableNewsEvent: Smallint index 12 read GetSmallintProp write SetSmallintProp stored False;
property EnableBaseFileEvent: Smallint index 13 read GetSmallintProp write SetSmallintProp stored False;
property OnReport: TStockDriverOnReport read FOnReport write FOnReport;
property OnMinData: TStockDriverOnMinData read FOnMinData write FOnMinData;
property OnHistory: TStockDriverOnHistory read FOnHistory write FOnHistory;
property OnNewsFile: TStockDriverOnNewsFile read FOnNewsFile write FOnNewsFile;
property OnBaseFile: TStockDriverOnBaseFile read FOnBaseFile write FOnBaseFile;
end;
// *********************************************************************//
// The Class CoStockReport provides a Create and CreateRemote method to
// create instances of the default interface IStockReport exposed by
// the CoClass StockReport. The functions are intended to be used by
// clients wishing to automate the CoClass objects exposed by the
// server of this typelibrary.
// *********************************************************************//
CoStockReport = class
class function Create: IStockReport;
class function CreateRemote(const MachineName: string): IStockReport;
end;
// *********************************************************************//
// The Class CoStockMinData provides a Create and CreateRemote method to
// create instances of the default interface IStockMinData exposed by
// the CoClass StockMinData. The functions are intended to be used by
// clients wishing to automate the CoClass objects exposed by the
// server of this typelibrary.
// *********************************************************************//
CoStockMinData = class
class function Create: IStockMinData;
class function CreateRemote(const MachineName: string): IStockMinData;
end;
// *********************************************************************//
// The Class CoStockHisData provides a Create and CreateRemote method to
// create instances of the default interface IStockHisData exposed by
// the CoClass StockHisData. The functions are intended to be used by
// clients wishing to automate the CoClass objects exposed by the
// server of this typelibrary.
// *********************************************************************//
CoStockHisData = class
class function Create: IStockHisData;
class function CreateRemote(const MachineName: string): IStockHisData;
end;
procedure Register;
resourcestring
dtlServerPage = 'ActiveX';
dtlOcxPage = 'ActiveX';
implementation
uses ComObj;
procedure TStockDriver.InitControlData;
const
CEventDispIDs: array [0..4] of DWORD = (
$00000001, $00000002, $00000003, $00000004, $00000005);
CControlData: TControlData2 = (
ClassID: '{9FD507CA-E42F-11D2-B30C-00C04FCCA334}';
EventIID: '{9FD507CB-E42F-11D2-B30C-00C04FCCA334}';
EventCount: 5;
EventDispIDs: @CEventDispIDs;
LicenseKey: nil (*HR:$80004002*);
Flags: $00000001;
Version: 401);
begin
ControlData := @CControlData;
TControlData2(CControlData).FirstEventOfs := Cardinal(@@FOnReport) - Cardinal(Self);
end;
procedure TStockDriver.CreateControl;
procedure DoCreate;
begin
FIntf := IUnknown(OleObject) as IStockDriver;
end;
begin
if FIntf = nil then DoCreate;
end;
function TStockDriver.GetControlInterface: IStockDriver;
begin
CreateControl;
Result := FIntf;
end;
procedure TStockDriver.Receive;
begin
DefaultInterface.Receive;
end;
procedure TStockDriver.Stop;
begin
DefaultInterface.Stop;
end;
procedure TStockDriver.Setup(bShowWnd: Integer);
begin
DefaultInterface.Setup(bShowWnd);
end;
function TStockDriver.ToString(nBufLen: SYSINT; pBuf: Integer): WideString;
begin
Result := DefaultInterface.ToString(nBufLen, pBuf);
end;
function TStockDriver.ReceiveEx: Integer;
begin
Result := DefaultInterface.ReceiveEx;
end;
class function CoStockReport.Create: IStockReport;
begin
Result := CreateComObject(CLASS_StockReport) as IStockReport;
end;
class function CoStockReport.CreateRemote(const MachineName: string): IStockReport;
begin
Result := CreateRemoteComObject(MachineName, CLASS_StockReport) as IStockReport;
end;
class function CoStockMinData.Create: IStockMinData;
begin
Result := CreateComObject(CLASS_StockMinData) as IStockMinData;
end;
class function CoStockMinData.CreateRemote(const MachineName: string): IStockMinData;
begin
Result := CreateRemoteComObject(MachineName, CLASS_StockMinData) as IStockMinData;
end;
class function CoStockHisData.Create: IStockHisData;
begin
Result := CreateComObject(CLASS_StockHisData) as IStockHisData;
end;
class function CoStockHisData.CreateRemote(const MachineName: string): IStockHisData;
begin
Result := CreateRemoteComObject(MachineName, CLASS_StockHisData) as IStockHisData;
end;
procedure Register;
begin
RegisterComponents(dtlOcxPage, [TStockDriver]);
end;
end.
Dim StkDrv2 As IStockDriver2
Set StkDrv2 = m_stkdrv.Object ' 获取接口
StkDrv2.EnableNewFormat = True ' 启用新格式，不能退出老格式
以上的VB代码如何用Delphi来编写，
请高手仔细看一下源码：
官方VB 、自编Delphi、导入后的STOCKLib_TLB.pas
===========================================================
以下是官方提供的通视卡接收VB演示程序：
'这个程序已通过验证能够正常接收
Dim OneHis As New StockHisData '变量onhis定义为一个stockhisdata集合
Dim OneMin As New StockMinData
Dim OneStk As New StockReport
'新添加的代码,用于新格式接收
Dim StkReport2 As IStockReport2
Private Sub Form_Load() '窗体初始化
a = "通视信息卡,ID号=" + m_stkdrv.RcvIDCode
a = a + vbCrLf + "驱动程序版本 = " + m_stkdrv.Version 'vbCrLf换行回车
a = a + vbCrLf + "支持深圳6位代码新格式"
m_Out.Text = a
'以下为新添加的代码，,用于新格式接收
Dim StkDrv2 As IStockDriver2
Set StkDrv2 = m_stkdrv.Object ' 获取接口
StkDrv2.EnableNewFormat = True ' 启用新格式，不能退出老格式
Set StkDrv2 = Nothing ' 释放接口
Set StkReport2 = OneStk
'以上用于新格式接收的代码如何转化为DelPhi代码？！！！
End Sub
Private Sub Form_Unload(Cancel As Integer) '窗体关闭事件
m_stkdrv.Stop
End Sub
Private Sub m_end_Click() '停止按钮
m_stkdrv.Stop
End Sub
Private Sub m_setup_Click() '设置按钮
m_stkdrv.Setup (1)
End Sub
Private Sub m_start_Click() '开始按钮
m_stkdrv.Receive
End Sub
'基本资料事件
Private Sub m_stkdrv_OnBaseFile(ByVal strFileName As String, ByVal Market As Integer, ByVal nFileLen As Long, ByVal pBuf As Long) '按值传递参数
Dim DstTxt As String
DstText = strFileName
DstText = DstText + " "
DstText = DstText & nFileLen
DstText = DstText + " "
txt = m_stkdrv.ToString(nFileLen, pBuf)
DstText = DstText + Left(txt, 50)
m_BaseOut.Text = DstText
End Sub
'下面是接收历史数据事件
Private Sub m_stkdrv_OnHistory(ByVal nPacketNum As Long, ByVal pBuf As Long)
Call OneHis.Attach(nPacketNum, pBuf)
Dim DstTxt As String
nPackNum = OneHis.PacketNum
DstTxt = "收到" & nPackNum & "个数据包" + vbCrLf
Dim Buf As OLE_RCV_HISTORY
Dim OldLabel As String
For i = 0 To nPackNum - 1
Buf = OneHis.ElementAt(i)
If (StrComp(Buf.m_strLabel, OldLabel) <> 0) Then
OldLabel = Buf.m_strLabel
DstTxt = DstTxt & OneHis.strLabel
DstTxt = DstTxt + " "
DstTxt = DstTxt & OneHis.OpenPrice
DstTxt = DstTxt + " "
DstTxt = DstTxt & OneHis.Volume
DstTxt = DstTxt + " "
DstTxt = DstTxt & OneHis.Time
DstTxt = DstTxt + vbCrLf
End If
Next i
m_HisOut.Text = DstTxt
End Sub
'下面是接收分时数据事件
Private Sub m_stkdrv_OnMinData(ByVal nPacket As Long, ByVal pBuf As Long)
Call OneMin.Attach(nPacket, pBuf)
nPackNum = OneMin.PacketNum
Dim DstTxt As String
Dim Buf As OLE_RCV_MINUTE
Dim OldLabel As String
DstTxt = "收到" & nPackNum & "个分时数据" + vbCrLf
For i = 0 To nPackNum - 1
Buf = OneMin.ElementAt(i)
If (StrComp(Buf.m_strLabel, OldLabel) <> 0) Then
OldLabel = Buf.m_strLabel
DstTxt = DstTxt & Buf.m_strLabel
DstTxt = DstTxt + " "
DstTxt = DstTxt & Buf.m_fPrice
DstTxt = DstTxt + " "
DstTxt = DstTxt & Buf.m_fVolume
DstTxt = DstTxt + " "
DstTxt = DstTxt & Buf.m_Time
DstTxt = DstTxt + vbCrLf
End If
Next i
m_Min.Text = DstTxt
End Sub
'以下为公告新闻事件
Private Sub m_stkdrv_OnNewsFile(ByVal NewsType As Long, ByVal SerialNo As Long, ByVal pFileName As String, ByVal nFileLen As Long, ByVal pBuf As Long)
Dim DstText As String
If NewsType = 2 Then
DstText = "上交所公告"
End If
If NewsType = 4 Then
DstText = "深交所公告"
End If
If NewsType = 6 Then
DstText = "财经报道"
End If
DstText = DstText + "<"
DstText = DstText & SerialNo
DstText = DstText + "> "
txt = m_stkdrv.ToString(nFileLen, pBuf)
DstText = DstText + Left(txt, 50)
m_NewsOut.Text = DstText
End Sub
'下面是接收行情数据事件
Private Sub m_stkdrv_OnReport(ByVal nPacket As Long, ByVal pBuf As Long) '行情接收
Call OneStk.Attach(nPacket, pBuf)
Dim DstTxt As String
'新添加的代码，接收新格式
Dim Buf As OLE_RCV_REPORT2
For i = 0 To nPacket - 1
Buf = StkReport2.ElementAt(i)
DstTxt = DstTxt & Buf.m_Time
DstTxt = DstTxt + " "
DstTxt = DstTxt + Buf.m_strLabel
DstTxt = DstTxt + " "
DstTxt = DstTxt + Buf.m_strName
DstTxt = DstTxt + " "
DstTxt = DstTxt & Buf.m_fNewPrice
DstTxt = DstTxt + " "
DstTxt = DstTxt & Buf.m_fAmount
DstTxt = DstTxt + " "
DstTxt = DstTxt & Buf.m_fVolume
DstTxt = DstTxt + " "
DstTxt = DstTxt & Buf.m_fBuyPrice(0)
DstTxt = DstTxt + " "
DstTxt = DstTxt & Buf.m_fBuyVolume(0)
DstTxt = DstTxt + vbCrLf
Next i
m_Out.Text = DstTxt
End Sub
==========================================================
以下是我自己编写的Delphi演示程序，所遇到的问题都已标明，
编译无问题。
//通视卡驱动程序通过 '组件'-'导入ActiveX控件' 的方法实现。（当然你要先安装通视卡驱动程序）
{
这个程序是仿照通视卡股票接收 VB 演示程序编写的，但是它有如下问题：
1：不能接收行情事件（即买卖盘）可以接收新闻、基本资料事件，不知道如何做才能接收6档买卖盘
2：接收时，收到事件时，总是显示 :
"Access Violation at address 5106178E in module project1.exe,read of address 00000000 "
(510678E随接收事件的不同而不同）
}
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, OleCtrls, STOCKLib_TLB, StdCtrls, ExtCtrls, OleCtnrs;
//STOCKLib_TLB为通视卡股票接收驱动程序的pas库
type
TForm1 = class(TForm)
m_stkdrv:TStockDriver;
Panel1: TPanel;
m_start: TButton;
m_setup: TButton;
m_end: TButton;
Panel2: TPanel;
Panel3: TPanel;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
m_out: TMemo;
m_min: TMemo;
m_HisOut: TMemo;
m_NewsOut: TMemo;
m_BaseOut: TMemo;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure m_endClick(Sender: TObject);
procedure m_setupClick(Sender: TObject);
procedure m_startClick(Sender: TObject);
procedure m_stkdrvReport(ASender: TObject; nPacket, pBuf: Integer);
procedure m_stkdrvMinData(ASender: TObject; nPacket, pBuf: Integer);
procedure m_stkdrvHistory(ASender: TObject; nPacketNum, pBuf: Integer);
procedure m_stkdrvNewsFile(ASender: TObject; NewsType,
SerialNo: Integer; const pFileName: WideString; nFileLen,
pBuf: Integer);
procedure m_stkdrvBaseFile(ASender: TObject;
const strFileName: WideString; Market: Smallint; nFileLen,
pBuf: Integer);
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
OneHis:CoStockHisData;//costockhisData 为STOCKLib_TLB中的一个类
OneMin:CoStockMinData; // CoStockMinData 为STOCKLib_TLB中的一个类
OneStk:CoStockReport; // CoStockReport 为STOCKLib_TLB中的一个类
//StkReport2:IStockReport2;//新格式接收
implementation
{$R *.dfm}
//窗体初始化
procedure TForm1.FormCreate(Sender: TObject);
var
a:string;
// StkDrv2:IStockDriver2;
begin
m_out.Lines.Clear;//清空
a:='通视信息卡，ID号='+ m_stkdrv.RcvIDCode+#13#10;
a:=a+'驱动程序版本 =' + m_stkdrv.Version+#13#10;
a:=a+'支持深圳6位代码新格式'+#13#10;
m_out.Lines.add(a); //显示
//以下是欲采用新接口的代码，请高手填写
end;
//窗体关闭事件
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
m_stkdrv.Stop;//关闭窗体时停止接收
end;
//停止接收按钮
procedure TForm1.m_endClick(Sender: TObject);
begin
m_stkdrv.Stop;//停止接收
end;
//设置接收按钮
procedure TForm1.m_setupClick(Sender: TObject);
begin
m_stkdrv.Setup(1);//显示设置窗口
end;
//启动接收按钮
procedure TForm1.m_startClick(Sender: TObject);
begin
if m_stkdrv.ReceiveEx=1 //启动接收
then showmessage('通视卡启动正常')
else showmessage('通视卡启动错误');
end;
//下面是接收行情数据事件
procedure TForm1.m_stkdrvReport(ASender: TObject; nPacket, pBuf: Integer); //行情接收事件
var
i:integer;
DstTxt:AnsiString;
buf:OLE_RCV_REPORT;// OLE_RCV_REPORT 为STOCKLib_TLB中的一个压缩型记录类型
begin
m_out.Lines.Clear;//清空
OneStk.create.attach(nPacket,pBuf); //create为STOCKLib_TLB中的一个函数
DstTxt:= '收到'+ inttostr(nPacket) +'个信息包' + #13#10;
m_out.Lines.add(DstTxt);
for i:=0 to npacket-1 do
begin
buf:=OneStk.create.ElementAt; //设置数组的序号，并返回类型为OLE_RCV_REPORT的行情数据，
m_out.Lines.add(DateTimeToStr(buf.m_Time)+' ');//交易时间
m_out.Lines.add(ansistring(buf.m_strLabel) +' ');//代码
m_out.lines.add(ansistring(buf.m_strName) +' ');//名称
m_out.lines.add(floattostr(buf.m_fLastClose )+' ');//昨收盘
m_out.lines.add(floattostr(buf.m_fOpen) +' ');//今开盘
m_out.lines.add(floattostr(buf.m_fNewPrice)+' ');//最新价
m_out.lines.add(floattostr(buf.m_fHigh)+' ');//最高价
m_out.lines.add(floattostr(buf.m_fLow )+' ');//最低价
m_out.lines.add(floattostr(buf.m_fVolume )+' ');//成交量
m_out.lines.add(floattostr(buf.m_fAmount )+' ');//成交金额
m_out.lines.add(floattostr(buf.m_fbuyprice[0])+' ');//买盘价
m_out.lines.add(floattostr(buf.m_fBuyPrice[1])+' ');//买盘价
m_out.lines.add(floattostr(buf.m_fBuyPrice[2])+' ');//买盘价
m_out.lines.add(floattostr(buf.m_fBuyVolume[0])+' ');//买盘量
m_out.lines.add(floattostr(buf.m_fBuyVolume[1])+' ');//买盘量
m_out.lines.add(floattostr(buf.m_fBuyVolume[2])+' ');//买盘量
m_out.lines.add(floattostr(buf.m_fSellPrice[0])+' ');//卖盘价
m_out.lines.add(floattostr(buf.m_fSellPrice[1])+' ');//卖盘价
m_out.lines.add(floattostr(buf.m_fSellPrice[2])+' ');//卖盘价
m_out.lines.add(floattostr(buf.m_fSellVolume[0])+' ');//卖盘量
m_out.lines.add(floattostr(buf.m_fSellVolume[1])+' ');//卖盘量
m_out.lines.add(floattostr(buf.m_fSellVolume[2])+#13#10);//卖盘量
m_stkdrv.EnableReportEvent:=0;
end;
m_stkdrv.EnableReportEvent:=0;
end;
//下面是接收分时数据事件
procedure TForm1.m_stkdrvMinData(ASender: TObject; nPacket, pBuf: Integer);
var
nPackNum,i:integer;
DstTxt:ansistring;
buf:OLE_RCV_MINUTE;
begin
m_min.Lines.Clear; //清空
oneMin.Create.Attach(nPacket,pBuf);
nPackNum:=OneMin.Create.PacketNum;
DstTxt:='收到'+ inttostr(nPackNum) +'个分时数据' + #13#10;
m_min.Lines.add(DstTxt); //显示分时数据个数
for i:=0 to nPackNum-1 do
begin
Buf:=OneMin.create.ElementAt; //设置数组的序号，并返回类型为OLE_RCV_REPORT的行情数据，
m_min.Lines.add(ansistring(buf.m_strLabel) +' ');//代码
m_min.Lines.add(DateTimeToStr(buf.m_Time)+' ');//交易时间
m_min.Lines.add(floattostr(buf.m_fPrice)+' ');//新价
m_min.Lines.add(floattostr(buf.m_fVolume )+' ');//成交量
m_min.Lines.add(floattostr(buf.m_fAmount )+ #13#10);//成交金额
m_stkdrv.EnableMinEvent :=0;
end;
end;
//下面是接收历史数据事件
procedure TForm1.m_stkdrvHistory(ASender: TObject; nPacketNum, pBuf: Integer);
var
nPackNum,i:integer;
DstTxt:ansistring;
buf:OLE_RCV_HISTORY;
begin
m_HisOut.Lines.clear; //清空
oneHis.Create.Attach(nPacketNum,pBuf);
nPackNum:=OneHis.Create.PacketNum;
DstTxt:= '收到'+ inttostr(nPackNum) +'个历史日线数据包' + #13#10;
m_HisOut.Lines.add(dsttxt); //显示数据包数
for i:=0 to nPackNum-1 do
begin
Buf:= OneHis.create.ElementAt; //设置数组的序号，并返回类型为OLE_RCV_REPORT的行情数据，
m_HisOut.Lines.add(ansistring(buf.m_strLabel) +' ');//代码
m_HisOut.Lines.add(DateTimeToStr(buf.m_Time)+' ');//交易时间
m_HisOut.Lines.add(floattostr(buf.m_fClose)+' ');//收盘
m_HisOut.Lines.add(floattostr(buf.m_fOpen) +' ');//开盘
m_HisOut.Lines.add(floattostr(buf.m_fHigh)+' ');//最高价
m_HisOut.Lines.add(floattostr(buf.m_fLow )+' ');//最低价
m_HisOut.Lines.add(floattostr(buf.m_fVolume )+' ');//成交量
m_HisOut.Lines.add(floattostr(buf.m_fAmount )+ ' ');//成交金额
m_HisOut.Lines.add(intToStr(buf.m_nAdvance)+' '); //
m_HisOut.Lines.add(intToStr(buf.m_nDecline)+#13#10);//
m_stkdrv.EnableHisEvent :=0;
end;
case buf.m_Market of
$00004853:showmessage('OLE_SH_MARKETEx ');
// OLE_SZ_MARKETEx = $00005A53;
//OLE_HK_MARKETEx = $00004B48;
end;
end;
//以下为公告新闻事件
procedure TForm1.m_stkdrvNewsFile(ASender: TObject; NewsType,
SerialNo: Integer; const pFileName: WideString; nFileLen, pBuf: Integer);
var
DstText:ansistring;
begin
m_NewsOut.Lines.Clear;
case NewsType of
2
stText:='上交所公告';4
stText:='上交所公告';6
stText:='财经报道';end;
DstText:= DstText + '<'+intToStr(SerialNo)+'>'+ansistring(pFileName);
m_NewsOut.Lines.add(DstText);
m_stkdrv.EnableNewsEvent:=0;
end;
//补基本资料事件
procedure TForm1.m_stkdrvBaseFile(ASender: TObject;
const strFileName: WideString; Market: Smallint; nFileLen,
pBuf: Integer);
var
DstText:ansistring;
begin
m_baseout.Lines.Clear;
DstText:=ansistring(strFileName)+' '+inttostr(nFileLen)+#13#10;
m_Baseout.Lines.Add(DstText);
end;
end.
============================================================
//以下为导入后的STOCKLib_TLB.pas源码
unit STOCKLib_TLB;
// ************************************************************************ //
// WARNING
// -------
// The types declared in this file were generated from data read from a
// Type Library. If this type library is explicitly or indirectly (via
// another type library referring to this type library) re-imported, or the
// 'Refresh' command of the Type Library Editor activated while editing the
// Type Library, the contents of this file will be regenerated and all
// manual modifications will be lost.
// ************************************************************************ //
// PASTLWTR : 1.2
// File generated on 2004-5-14 16:04:26 from Type Library described below.
// ************************************************************************ //
// Type Lib: C:/WINNT/system32/stock.dll (1)
// LIBID: {4F6A9E80-C79C-11D2-B401-00C04FCCA334}
// LCID: 0
// Helpfile:
// HelpString: TongShi StockDriver 1.0 Type Library
// DepndLst:
// (1) v2.0 stdole, (C:/WINNT/system32/stdole2.tlb)
// ************************************************************************ //
{$TYPEDADDRESS OFF} // Unit must be compiled without type-checked pointers.
{$WARN SYMBOL_PLATFORM OFF}
{$WRITEABLECONST ON}
{$VARPROPSETTER ON}
interface
uses Windows, ActiveX, Classes, Graphics, OleCtrls, OleServer, StdVCL, Variants;
// *********************************************************************//
// GUIDS declared in the TypeLibrary. Following prefixes are used:
// Type Libraries : LIBID_xxxx
// CoClasses : CLASS_xxxx
// DISPInterfaces : DIID_xxxx
// Non-DISP interfaces: IID_xxxx
// *********************************************************************//
const
// TypeLibrary Major and minor versions
STOCKLibMajorVersion = 1;
STOCKLibMinorVersion = 0;
LIBID_STOCKLib: TGUID = '{4F6A9E80-C79C-11D2-B401-00C04FCCA334}';
DIID__IStockDriverEvents: TGUID = '{9FD507CB-E42F-11D2-B30C-00C04FCCA334}';
IID_IStockReport: TGUID = '{E518BAC6-E53B-11D2-B30C-00C04FCCA334}';
IID_IStockReport2: TGUID = '{7B53644A-4B6F-4AE4-8CD7-67C683DC8D9E}';
IID_IStockMinData: TGUID = '{78B9E8B1-E5FA-11D2-B30C-00C04FCCA334}';
IID_IStockHisData: TGUID = '{A22E1441-E61B-11D2-B30C-00C04FCCA334}';
IID_IStockDriver: TGUID = '{9FD507C9-E42F-11D2-B30C-00C04FCCA334}';
IID_IStockDriver2: TGUID = '{7EC46973-C25F-42E3-B22E-806D3FC5C20E}';
CLASS_StockDriver: TGUID = '{9FD507CA-E42F-11D2-B30C-00C04FCCA334}';
CLASS_StockReport: TGUID = '{E518BAC7-E53B-11D2-B30C-00C04FCCA334}';
CLASS_StockMinData: TGUID = '{E518BAC9-E53B-11D2-B30C-00C04FCCA334}';
CLASS_StockHisData: TGUID = '{E518BACB-E53B-11D2-B30C-00C04FCCA334}';
// *********************************************************************//
// Declaration of Enumerations defined in Type Library
// *********************************************************************//
// Constants for enum OLE_MARKET_ENUM
type
OLE_MARKET_ENUM = TOleEnum;
const
OLE_SH_MARKETEx = $00004853;
OLE_SZ_MARKETEx = $00005A53;
OLE_HK_MARKETEx = $00004B48;
type
// *********************************************************************//
// Forward declaration of types defined in TypeLibrary
// *********************************************************************//
_IStockDriverEvents = dispinterface;
IStockReport = interface;
IStockReportDisp = dispinterface;
IStockReport2 = interface;
IStockReport2Disp = dispinterface;
IStockMinData = interface;
IStockMinDataDisp = dispinterface;
IStockHisData = interface;
IStockHisDataDisp = dispinterface;
IStockDriver = interface;
IStockDriverDisp = dispinterface;
IStockDriver2 = interface;
IStockDriver2Disp = dispinterface;
// *********************************************************************//
// Declaration of CoClasses defined in Type Library
// (NOTE: Here we map each CoClass to its Default Interface)
// *********************************************************************//
StockDriver = IStockDriver;
StockReport = IStockReport;
StockMinData = IStockMinData;
StockHisData = IStockHisData;
// *********************************************************************//
// Declaration of structures, unions and aliases.
// *********************************************************************//
OLE_RCV_REPORT = packed record
m_Time: TDateTime;
m_Market: OLE_MARKET_ENUM;
m_strLabel: WideString;
m_strName: WideString;
m_fLastClose: Single;
m_fOpen: Single;
m_fHigh: Single;
m_fLow: Single;
m_fNewPrice: Single;
m_fVolume: Single;
m_fAmount: Single;
m_fBuyPrice: array[0..2] of Single;
m_fBuyVolume: array[0..2] of Single;
m_fSellPrice: array[0..2] of Single;
m_fSellVolume: array[0..2] of Single;
end;
OLE_RCV_REPORT2 = packed record
m_Time: TDateTime;
m_Market: OLE_MARKET_ENUM;
m_strLabel: WideString;
m_strName: WideString;
m_fLastClose: Single;
m_fOpen: Single;
m_fHigh: Single;
m_fLow: Single;
m_fNewPrice: Single;
m_fVolume: Single;
m_fAmount: Single;
m_fBuyPrice: array[0..2] of Single;
m_fBuyVolume: array[0..2] of Single;
m_fSellPrice: array[0..2] of Single;
m_fSellVolume: array[0..2] of Single;
m_fBuyPrice4: Single;
m_fBuyVolume4: Single;
m_fSellPrice4: Single;
m_fSellVolume4: Single;
m_fBuyPrice5: Single;
m_fBuyVolume5: Single;
m_fSellPrice5: Single;
m_fSellVolume5: Single;
end;
OLE_RCV_MINUTE = packed record
m_Time: TDateTime;
m_Market: OLE_MARKET_ENUM;
m_strLabel: WideString;
m_fPrice: Single;
m_fVolume: Single;
m_fAmount: Single;
end;
OLE_RCV_HISTORY = packed record
m_strLabel: WideString;
m_Market: OLE_MARKET_ENUM;
m_Time: TDateTime;
m_fOpen: Single;
m_fHigh: Single;
m_fLow: Single;
m_fClose: Single;
m_fVolume: Single;
m_fAmount: Single;
m_nAdvance: SYSINT;
m_nDecline: SYSINT;
end;
// *********************************************************************//
// DispIntf: _IStockDriverEvents
// Flags: (4096) Dispatchable
// GUID: {9FD507CB-E42F-11D2-B30C-00C04FCCA334}
// *********************************************************************//
_IStockDriverEvents = dispinterface
['{9FD507CB-E42F-11D2-B30C-00C04FCCA334}']
procedure OnReport(nPacket: Integer; pBuf: Integer); dispid 1;
procedure OnMinData(nPacket: Integer; pBuf: Integer); dispid 2;
procedure OnHistory(nPacketNum: Integer; pBuf: Integer); dispid 3;
procedure OnNewsFile(NewsType: Integer; SerialNo: Integer; const pFileName: WideString;
nFileLen: Integer; pBuf: Integer); dispid 4;
procedure OnBaseFile(const strFileName: WideString; Market: Smallint; nFileLen: Integer;
pBuf: Integer); dispid 5;
end;
// *********************************************************************//
// Interface: IStockReport
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {E518BAC6-E53B-11D2-B30C-00C04FCCA334}
// *********************************************************************//
IStockReport = interface(IDispatch)
['{E518BAC6-E53B-11D2-B30C-00C04FCCA334}']
procedure Attach(nPacketNum: Integer; pDataBuf: Integer); safecall;
function Get_ArrayIndexer: Smallint; safecall;
procedure Set_ArrayIndexer(pVal: Smallint); safecall;
function Get_strLabel: WideString; safecall;
function Get_Time: TDateTime; safecall;
function Get_strName: WideString; safecall;
function Get_Market: OLE_MARKET_ENUM; safecall;
function Get_LastClose: Single; safecall;
function Get_OpenPrice: Single; safecall;
function Get_HighPrice: Single; safecall;
function Get_LowPrice: Single; safecall;
function Get_NewPrice: Single; safecall;
function Get_Volume: Single; safecall;
function Get_Amount: Single; safecall;
function Get_BuyPrice(i: Smallint): Single; safecall;
function Get_BuyVolume(i: Smallint): Single; safecall;
function Get_SellPrice(i: Smallint): Single; safecall;
function Get_SellVolume(i: Smallint): Single; safecall;
function Get_ElementAt(nNo: SYSINT): OLE_RCV_REPORT; safecall;
property ArrayIndexer: Smallint read Get_ArrayIndexer write Set_ArrayIndexer;
property strLabel: WideString read Get_strLabel;
property Time: TDateTime read Get_Time;
property strName: WideString read Get_strName;
property Market: OLE_MARKET_ENUM read Get_Market;
property LastClose: Single read Get_LastClose;
property OpenPrice: Single read Get_OpenPrice;
property HighPrice: Single read Get_HighPrice;
property LowPrice: Single read Get_LowPrice;
property NewPrice: Single read Get_NewPrice;
property Volume: Single read Get_Volume;
property Amount: Single read Get_Amount;
property BuyPrice[i: Smallint]: Single read Get_BuyPrice;
property BuyVolume[i: Smallint]: Single read Get_BuyVolume;
property SellPrice[i: Smallint]: Single read Get_SellPrice;
property SellVolume[i: Smallint]: Single read Get_SellVolume;
property ElementAt[nNo: SYSINT]: OLE_RCV_REPORT read Get_ElementAt;
end;
// *********************************************************************//
// DispIntf: IStockReportDisp
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {E518BAC6-E53B-11D2-B30C-00C04FCCA334}
// *********************************************************************//
IStockReportDisp = dispinterface
['{E518BAC6-E53B-11D2-B30C-00C04FCCA334}']
procedure Attach(nPacketNum: Integer; pDataBuf: Integer); dispid 1;
property ArrayIndexer: Smallint dispid 3;
property strLabel: WideString readonly dispid 4;
property Time: TDateTime readonly dispid 5;
property strName: WideString readonly dispid 6;
property Market: OLE_MARKET_ENUM readonly dispid 7;
property LastClose: Single readonly dispid 8;
property OpenPrice: Single readonly dispid 9;
property HighPrice: Single readonly dispid 10;
property LowPrice: Single readonly dispid 11;
property NewPrice: Single readonly dispid 12;
property Volume: Single readonly dispid 13;
property Amount: Single readonly dispid 14;
property BuyPrice[i: Smallint]: Single readonly dispid 15;
property BuyVolume[i: Smallint]: Single readonly dispid 16;
property SellPrice[i: Smallint]: Single readonly dispid 17;
property SellVolume[i: Smallint]: Single readonly dispid 18;
property ElementAt[nNo: SYSINT]: {??OLE_RCV_REPORT}OleVariant readonly dispid 19;
end;
// *********************************************************************//
// Interface: IStockReport2
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {7B53644A-4B6F-4AE4-8CD7-67C683DC8D9E}
// *********************************************************************//
IStockReport2 = interface(IDispatch)
['{7B53644A-4B6F-4AE4-8CD7-67C683DC8D9E}']
function Get_ElementAt(nNo: SYSINT): OLE_RCV_REPORT2; safecall;
property ElementAt[nNo: SYSINT]: OLE_RCV_REPORT2 read Get_ElementAt;
end;
// *********************************************************************//
// DispIntf: IStockReport2Disp
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {7B53644A-4B6F-4AE4-8CD7-67C683DC8D9E}
// *********************************************************************//
IStockReport2Disp = dispinterface
['{7B53644A-4B6F-4AE4-8CD7-67C683DC8D9E}']
property ElementAt[nNo: SYSINT]: {??OLE_RCV_REPORT2}OleVariant readonly dispid 1;
end;
// *********************************************************************//
// Interface: IStockMinData
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {78B9E8B1-E5FA-11D2-B30C-00C04FCCA334}
// *********************************************************************//
IStockMinData = interface(IDispatch)
['{78B9E8B1-E5FA-11D2-B30C-00C04FCCA334}']
procedure Attach(nPacketNum: Smallint; pDataBuf: Integer); safecall;
function Get_ArrayIndexer: Smallint; safecall;
function Get_strLabel: WideString; safecall;
function Get_Market: OLE_MARKET_ENUM; safecall;
function Get_Time: TDateTime; safecall;
function Get_Price: Single; safecall;
function Get_Volume: Single; safecall;
function Get_Amount: Single; safecall;
function Get_PacketNum: Smallint; safecall;
procedure Next; safecall;
function Get_ElementAt(i: Integer): OLE_RCV_MINUTE; safecall;
property ArrayIndexer: Smallint read Get_ArrayIndexer;
property strLabel: WideString read Get_strLabel;
property Market: OLE_MARKET_ENUM read Get_Market;
property Time: TDateTime read Get_Time;
property Price: Single read Get_Price;
property Volume: Single read Get_Volume;
property Amount: Single read Get_Amount;
property PacketNum: Smallint read Get_PacketNum;
property ElementAt[i: Integer]: OLE_RCV_MINUTE read Get_ElementAt;
end;
// *********************************************************************//
// DispIntf: IStockMinDataDisp
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {78B9E8B1-E5FA-11D2-B30C-00C04FCCA334}
// *********************************************************************//
IStockMinDataDisp = dispinterface
['{78B9E8B1-E5FA-11D2-B30C-00C04FCCA334}']
procedure Attach(nPacketNum: Smallint; pDataBuf: Integer); dispid 1;
property ArrayIndexer: Smallint readonly dispid 2;
property strLabel: WideString readonly dispid 3;
property Market: OLE_MARKET_ENUM readonly dispid 4;
property Time: TDateTime readonly dispid 5;
property Price: Single readonly dispid 6;
property Volume: Single readonly dispid 7;
property Amount: Single readonly dispid 8;
property PacketNum: Smallint readonly dispid 9;
procedure Next; dispid 10;
property ElementAt[i: Integer]: {??OLE_RCV_MINUTE}OleVariant readonly dispid 11;
end;
// *********************************************************************//
// Interface: IStockHisData
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {A22E1441-E61B-11D2-B30C-00C04FCCA334}
// *********************************************************************//
IStockHisData = interface(IDispatch)
['{A22E1441-E61B-11D2-B30C-00C04FCCA334}']
procedure Attach(nPacket: Integer; pBuf: Integer); safecall;
function Get_ArrayIndexer: Integer; safecall;
function Get_strLabel: WideString; safecall;
function Get_Market: OLE_MARKET_ENUM; safecall;
function Get_OpenPrice: Single; safecall;
function Get_Time: TDateTime; safecall;
function Get_HighPrice: Single; safecall;
function Get_LowPrice: Single; safecall;
function Get_ClosePrice: Single; safecall;
function Get_Volume: Single; safecall;
function Get_Amount: Single; safecall;
function Get_AdvanceNum: Integer; safecall;
function Get_DeclineNum: Integer; safecall;
function Get_PacketNum: Integer; safecall;
procedure Next; safecall;
function Get_ElementAt(i: Integer): OLE_RCV_HISTORY; safecall;
property ArrayIndexer: Integer read Get_ArrayIndexer;
property strLabel: WideString read Get_strLabel;
property Market: OLE_MARKET_ENUM read Get_Market;
property OpenPrice: Single read Get_OpenPrice;
property Time: TDateTime read Get_Time;
property HighPrice: Single read Get_HighPrice;
property LowPrice: Single read Get_LowPrice;
property ClosePrice: Single read Get_ClosePrice;
property Volume: Single read Get_Volume;
property Amount: Single read Get_Amount;
property AdvanceNum: Integer read Get_AdvanceNum;
property DeclineNum: Integer read Get_DeclineNum;
property PacketNum: Integer read Get_PacketNum;
property ElementAt[i: Integer]: OLE_RCV_HISTORY read Get_ElementAt;
end;
// *********************************************************************//
// DispIntf: IStockHisDataDisp
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {A22E1441-E61B-11D2-B30C-00C04FCCA334}
// *********************************************************************//
IStockHisDataDisp = dispinterface
['{A22E1441-E61B-11D2-B30C-00C04FCCA334}']
procedure Attach(nPacket: Integer; pBuf: Integer); dispid 1;
property ArrayIndexer: Integer readonly dispid 2;
property strLabel: WideString readonly dispid 3;
property Market: OLE_MARKET_ENUM readonly dispid 4;
property OpenPrice: Single readonly dispid 5;
property Time: TDateTime readonly dispid 6;
property HighPrice: Single readonly dispid 7;
property LowPrice: Single readonly dispid 8;
property ClosePrice: Single readonly dispid 9;
property Volume: Single readonly dispid 10;
property Amount: Single readonly dispid 11;
property AdvanceNum: Integer readonly dispid 12;
property DeclineNum: Integer readonly dispid 13;
property PacketNum: Integer readonly dispid 14;
procedure Next; dispid 15;
property ElementAt[i: Integer]: {??OLE_RCV_HISTORY}OleVariant readonly dispid 16;
end;
// *********************************************************************//
// Interface: IStockDriver
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {9FD507C9-E42F-11D2-B30C-00C04FCCA334}
// *********************************************************************//
IStockDriver = interface(IDispatch)
['{9FD507C9-E42F-11D2-B30C-00C04FCCA334}']
procedure Set_BackColor(pclr: OLE_COLOR); safecall;
function Get_BackColor: OLE_COLOR; safecall;
function Get_Channel: WideString; safecall;
function Get_Provider: WideString; safecall;
function Get_RcvIDCode: WideString; safecall;
function Get_Version: WideString; safecall;
function Get_TotalNumber: Integer; safecall;
procedure Receive; safecall;
procedure Stop; safecall;
procedure Setup(bShowWnd: Integer); safecall;
function Get_EnableReportEvent: Smallint; safecall;
procedure Set_EnableReportEvent(pVal: Smallint); safecall;
function Get_EnableMinEvent: Smallint; safecall;
procedure Set_EnableMinEvent(pVal: Smallint); safecall;
function Get_EnableHisEvent: Smallint; safecall;
procedure Set_EnableHisEvent(pVal: Smallint); safecall;
function Get_EnableNewsEvent: Smallint; safecall;
procedure Set_EnableNewsEvent(pVal: Smallint); safecall;
function Get_EnableBaseFileEvent: Smallint; safecall;
procedure Set_EnableBaseFileEvent(pVal: Smallint); safecall;
function Get_STKNumInMarket: Integer; safecall;
function ToString(nBufLen: SYSINT; pBuf: Integer): WideString; safecall;
function ReceiveEx: Integer; safecall;
property BackColor: OLE_COLOR read Get_BackColor write Set_BackColor;
property Channel: WideString read Get_Channel;
property Provider: WideString read Get_Provider;
property RcvIDCode: WideString read Get_RcvIDCode;
property Version: WideString read Get_Version;
property TotalNumber: Integer read Get_TotalNumber;
property EnableReportEvent: Smallint read Get_EnableReportEvent write Set_EnableReportEvent;
property EnableMinEvent: Smallint read Get_EnableMinEvent write Set_EnableMinEvent;
property EnableHisEvent: Smallint read Get_EnableHisEvent write Set_EnableHisEvent;
property EnableNewsEvent: Smallint read Get_EnableNewsEvent write Set_EnableNewsEvent;
property EnableBaseFileEvent: Smallint read Get_EnableBaseFileEvent write Set_EnableBaseFileEvent;
property STKNumInMarket: Integer read Get_STKNumInMarket;
end;
// *********************************************************************//
// DispIntf: IStockDriverDisp
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {9FD507C9-E42F-11D2-B30C-00C04FCCA334}
// *********************************************************************//
IStockDriverDisp = dispinterface
['{9FD507C9-E42F-11D2-B30C-00C04FCCA334}']
property BackColor: OLE_COLOR dispid -501;
property Channel: WideString readonly dispid 1;
property Provider: WideString readonly dispid 2;
property RcvIDCode: WideString readonly dispid 3;
property Version: WideString readonly dispid 4;
property TotalNumber: Integer readonly dispid 5;
procedure Receive; dispid 6;
procedure Stop; dispid 7;
procedure Setup(bShowWnd: Integer); dispid 8;
property EnableReportEvent: Smallint dispid 9;
property EnableMinEvent: Smallint dispid 10;
property EnableHisEvent: Smallint dispid 11;
property EnableNewsEvent: Smallint dispid 12;
property EnableBaseFileEvent: Smallint dispid 13;
property STKNumInMarket: Integer readonly dispid 14;
function ToString(nBufLen: SYSINT; pBuf: Integer): WideString; dispid 15;
function ReceiveEx: Integer; dispid 16;
end;
// *********************************************************************//
// Interface: IStockDriver2
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {7EC46973-C25F-42E3-B22E-806D3FC5C20E}
// *********************************************************************//
IStockDriver2 = interface(IDispatch)
['{7EC46973-C25F-42E3-B22E-806D3FC5C20E}']
function Get_EnableNewFormat: Integer; safecall;
procedure Set_EnableNewFormat(pVal: Integer); safecall;
property EnableNewFormat: Integer read Get_EnableNewFormat write Set_EnableNewFormat;
end;
// *********************************************************************//
// DispIntf: IStockDriver2Disp
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {7EC46973-C25F-42E3-B22E-806D3FC5C20E}
// *********************************************************************//
IStockDriver2Disp = dispinterface
['{7EC46973-C25F-42E3-B22E-806D3FC5C20E}']
property EnableNewFormat: Integer dispid 1;
end;
// *********************************************************************//
// OLE Control Proxy class declaration
// Control Name : TStockDriver
// Help String : StockDriver Class
// Default Interface: IStockDriver
// Def. Intf. DISP? : No
// Event Interface: _IStockDriverEvents
// TypeFlags : (2) CanCreate
// *********************************************************************//
TStockDriverOnReport = procedure(ASender: TObject; nPacket: Integer; pBuf: Integer) of object;
TStockDriverOnMinData = procedure(ASender: TObject; nPacket: Integer; pBuf: Integer) of object;
TStockDriverOnHistory = procedure(ASender: TObject; nPacketNum: Integer; pBuf: Integer) of object;
TStockDriverOnNewsFile = procedure(ASender: TObject; NewsType: Integer; SerialNo: Integer;
const pFileName: WideString;
nFileLen: Integer; pBuf: Integer) of object;
TStockDriverOnBaseFile = procedure(ASender: TObject; const strFileName: WideString;
Market: Smallint; nFileLen: Integer;
pBuf: Integer) of object;
TStockDriver = class(TOleControl)
private
FOnReport: TStockDriverOnReport;
FOnMinData: TStockDriverOnMinData;
FOnHistory: TStockDriverOnHistory;
FOnNewsFile: TStockDriverOnNewsFile;
FOnBaseFile: TStockDriverOnBaseFile;
FIntf: IStockDriver;
function GetControlInterface: IStockDriver;
protected
procedure CreateControl;
procedure InitControlData; override;
public
procedure Receive;
procedure Stop;
procedure Setup(bShowWnd: Integer);
function ToString(nBufLen: SYSINT; pBuf: Integer): WideString;
function ReceiveEx: Integer;
property ControlInterface: IStockDriver read GetControlInterface;
property DefaultInterface: IStockDriver read GetControlInterface;
property Channel: WideString index 1 read GetWideStringProp;
property Provider: WideString index 2 read GetWideStringProp;
property RcvIDCode: WideString index 3 read GetWideStringProp;
property Version: WideString index 4 read GetWideStringProp;
property TotalNumber: Integer index 5 read GetIntegerProp;
property STKNumInMarket: Integer index 14 read GetIntegerProp;
published
property Anchors;
property ParentColor;
property TabStop;
property Align;
property DragCursor;
property DragMode;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property TabOrder;
property Visible;
property OnDragDrop;
property OnDragOver;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnStartDrag;
property BackColor: TColor index -501 read GetTColorProp write SetTColorProp stored False;
property EnableReportEvent: Smallint index 9 read GetSmallintProp write SetSmallintProp stored False;
property EnableMinEvent: Smallint index 10 read GetSmallintProp write SetSmallintProp stored False;
property EnableHisEvent: Smallint index 11 read GetSmallintProp write SetSmallintProp stored False;
property EnableNewsEvent: Smallint index 12 read GetSmallintProp write SetSmallintProp stored False;
property EnableBaseFileEvent: Smallint index 13 read GetSmallintProp write SetSmallintProp stored False;
property OnReport: TStockDriverOnReport read FOnReport write FOnReport;
property OnMinData: TStockDriverOnMinData read FOnMinData write FOnMinData;
property OnHistory: TStockDriverOnHistory read FOnHistory write FOnHistory;
property OnNewsFile: TStockDriverOnNewsFile read FOnNewsFile write FOnNewsFile;
property OnBaseFile: TStockDriverOnBaseFile read FOnBaseFile write FOnBaseFile;
end;
// *********************************************************************//
// The Class CoStockReport provides a Create and CreateRemote method to
// create instances of the default interface IStockReport exposed by
// the CoClass StockReport. The functions are intended to be used by
// clients wishing to automate the CoClass objects exposed by the
// server of this typelibrary.
// *********************************************************************//
CoStockReport = class
class function Create: IStockReport;
class function CreateRemote(const MachineName: string): IStockReport;
end;
// *********************************************************************//
// The Class CoStockMinData provides a Create and CreateRemote method to
// create instances of the default interface IStockMinData exposed by
// the CoClass StockMinData. The functions are intended to be used by
// clients wishing to automate the CoClass objects exposed by the
// server of this typelibrary.
// *********************************************************************//
CoStockMinData = class
class function Create: IStockMinData;
class function CreateRemote(const MachineName: string): IStockMinData;
end;
// *********************************************************************//
// The Class CoStockHisData provides a Create and CreateRemote method to
// create instances of the default interface IStockHisData exposed by
// the CoClass StockHisData. The functions are intended to be used by
// clients wishing to automate the CoClass objects exposed by the
// server of this typelibrary.
// *********************************************************************//
CoStockHisData = class
class function Create: IStockHisData;
class function CreateRemote(const MachineName: string): IStockHisData;
end;
procedure Register;
resourcestring
dtlServerPage = 'ActiveX';
dtlOcxPage = 'ActiveX';
implementation
uses ComObj;
procedure TStockDriver.InitControlData;
const
CEventDispIDs: array [0..4] of DWORD = (
$00000001, $00000002, $00000003, $00000004, $00000005);
CControlData: TControlData2 = (
ClassID: '{9FD507CA-E42F-11D2-B30C-00C04FCCA334}';
EventIID: '{9FD507CB-E42F-11D2-B30C-00C04FCCA334}';
EventCount: 5;
EventDispIDs: @CEventDispIDs;
LicenseKey: nil (*HR:$80004002*);
Flags: $00000001;
Version: 401);
begin
ControlData := @CControlData;
TControlData2(CControlData).FirstEventOfs := Cardinal(@@FOnReport) - Cardinal(Self);
end;
procedure TStockDriver.CreateControl;
procedure DoCreate;
begin
FIntf := IUnknown(OleObject) as IStockDriver;
end;
begin
if FIntf = nil then DoCreate;
end;
function TStockDriver.GetControlInterface: IStockDriver;
begin
CreateControl;
Result := FIntf;
end;
procedure TStockDriver.Receive;
begin
DefaultInterface.Receive;
end;
procedure TStockDriver.Stop;
begin
DefaultInterface.Stop;
end;
procedure TStockDriver.Setup(bShowWnd: Integer);
begin
DefaultInterface.Setup(bShowWnd);
end;
function TStockDriver.ToString(nBufLen: SYSINT; pBuf: Integer): WideString;
begin
Result := DefaultInterface.ToString(nBufLen, pBuf);
end;
function TStockDriver.ReceiveEx: Integer;
begin
Result := DefaultInterface.ReceiveEx;
end;
class function CoStockReport.Create: IStockReport;
begin
Result := CreateComObject(CLASS_StockReport) as IStockReport;
end;
class function CoStockReport.CreateRemote(const MachineName: string): IStockReport;
begin
Result := CreateRemoteComObject(MachineName, CLASS_StockReport) as IStockReport;
end;
class function CoStockMinData.Create: IStockMinData;
begin
Result := CreateComObject(CLASS_StockMinData) as IStockMinData;
end;
class function CoStockMinData.CreateRemote(const MachineName: string): IStockMinData;
begin
Result := CreateRemoteComObject(MachineName, CLASS_StockMinData) as IStockMinData;
end;
class function CoStockHisData.Create: IStockHisData;
begin
Result := CreateComObject(CLASS_StockHisData) as IStockHisData;
end;
class function CoStockHisData.CreateRemote(const MachineName: string): IStockHisData;
begin
Result := CreateRemoteComObject(MachineName, CLASS_StockHisData) as IStockHisData;
end;
procedure Register;
begin
RegisterComponents(dtlOcxPage, [TStockDriver]);
end;
end.