参考代码
使用公式，在查看股票时，会自动按照不同的数据周期，对应在飞狐目录下 user 目录下生成对应的 out(0,1,2,3,4,5) 的数据库文件
复制内容到剪贴板
代码:
dt:datatype;
gpdm:=stklabel; scdm:=marketlabel;
fc:=close; fo:=open; fl:=low; fh:=high; fv:=vol;
dy:=year; dm:=month; dd:=day;
ts:=intpart(time/10000);
tf:=intpart((time-ts*10000)/100);
tm:=time-ts*10000-tf*100;
//exit;
<%
vfo=ffl.vardata("fo")
vfh=ffl.vardata("fh")
vfl=ffl.vardata("fl")
vfc=ffl.vardata("fc")
vfv=ffl.vardata("fv")
gpdm=ffl.vardata("gpdm")
scdm=ffl.vardata("scdm")
dt=ffl.vardata("dt")
vdy=ffl.vardata("dy")
vdm=ffl.vardata("dm")
vdd=ffl.vardata("dd")
vts=ffl.vardata("ts")
vtf=ffl.vardata("tf")
vtm=ffl.vardata("tm")
n=ffl.vardata("n")
Const Jet3x = 4 'Access97数据库格式
Const Jet4x = 5 'Access2000数据库格式
'创建 Access2000 数据库,位于飞狐安装目录user子目录下,按照不同数据类型保存对应的OUT*.mdb数据文件
FileName = "e:\foxtrader\user\out" & dt & ".mdb" '这里根据自己飞狐所在的目录修改
TableName = scdm & gpdm
Set fso = CreateObject("Scripting.FileSystemObject")
If (Not fso.FileExists(FileName)) Then
CreateNewMDB FileName, Jet4x
End If
On Error Resume Next
CreateNewTable TableName
Dim Conn,RS
WriteTable FileName, TableName
last=ubound(vfc)
if Rs.RecordCount<last+1 then
if Rs.RecordCountstart=0 then start=0 else start=last
for i=start to last
vdate=DateSerial(vdy(i), vdm(i), vdd(i))
vtime=TimeSerial(vts(i), vtf(i), vtm(i))
Rs.AddNew
Rs.Fields("日期")=vdate
Rs.Fields("时间")=vtime
Rs.Fields("开盘价")=Round(vfo(i),2)
Rs.Fields("最高价")=Round(vfh(i),2)
Rs.Fields("最低价")=Round(vfl(i),2)
Rs.Fields("收盘价")=Round(vfc(i),2)
Rs.Fields("成交量")=Round(vfv(i),2)
'Rs.Update
next
Rs.UpdateBatch
End if
Set Rs=Nothing
Set Conn=Nothing
Sub WriteTable(FileName,TableName)
Set Conn=CreateObject("ADODB.Connection")
Conn.Provider="Microsoft.Jet.OLEDB.4.0"
Conn.Open FileName
Set Rs=CreateObject("ADODB.Recordset")
Rs.CursorType = 3
Rs.LockType = 3
Rs.Open TableName, Conn
End Sub
Sub OpenTable(TableName) '打开表
Set Conn=CreateObject("ADODB.Connection")
Conn.Provider="Microsoft.Jet.OLEDB.4.0"
Conn.Open FileName
SQL="Select * From TableName"
Set RS=conn.Execute(SQL)
End Sub
Sub CreateNewTable(TableName) '创建新表
Dim conn,rs
Set conn=CreateObject("ADODB.Connection")
Conn.Provider="Microsoft.Jet.OLEDB.4.0"
Conn.Open FileName
SQL="Create Table " & TableName & "([日期]Text(10),[时间]Text(8),[开盘价]Single,[最高价]Single,[最低价]Single,[收盘价]Single,[成交量]Single)"
Set RS=conn.Execute(SQL)
Set Rs=Nothing
Set Conn=Nothing
End Sub
Sub CreateNewMDB(FileName, Format) '创建Access2000数据库
Dim Catalog
Set Catalog = CreateObject("ADOX.Catalog")
Catalog.Create "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Jet OLEDB:Engine Type=" & Format & _
";Data Source=" & FileName
Set CataLog=Nothing
End Sub
%>
