【新提醒】博易大师数据转飞狐交易师 VBS

这源码是本人写的！

当前做了个文华的，请大家测试，寻求破解方案！

先给个最小博易大师可以转成交量的版本！

Sub PoboToFoxtrader(nowPath,dateNum)    '从博易大师读取数据，转化为飞狐的文本格式，存放在“C:\TXTDAYB”目录
    strFile =nowPath+"\pobo\Data\nyefut\Day\CONC.day"    '博易大师日线文件（美国原油连续）
    fileName="C:\TXTDAYB\NYNYCONC.TXT"                       '导出的文件（飞狐交易师标准文本文件）
    PoboToFoxtraderTXT strFile,fileName,dateNum
   
    strFile =nowPath+"\pobo\Data\ldfut\Day\LMCDE.day"    '伦铜三月
    fileName="C:\TXTDAYB\LMLMCUD3.TXT"
    PoboToFoxtraderTXT strFile,fileName,dateNum
   
    strFile =nowPath+"\pobo\Data\ldfut\Day\LMZDE.day"    '伦锌三月
    fileName="C:\TXTDAYB\LMLMZND3.TXT"
    PoboToFoxtraderTXT strFile,fileName,dateNum
   
    strFile =nowPath+"\pobo\Data\jpfut\Day\RBT0.day"    '日本橡胶连续
    fileName="C:\TXTDAYB\JPJPRBT0.TXT"
    PoboToFoxtraderTXT strFile,fileName,dateNum
   
    strFile =nowPath+"\pobo\Data\index\Day\CRNI.day"    'CRB商品指数
    fileName="C:\TXTDAYB\IDIDCRNI.TXT"
    PoboToFoxtraderTXT strFile,fileName,dateNum
   
    strFile =nowPath+"\pobo\Data\index\Day\USD.day"      '美元指数
    fileName="C:\TXTDAYB\IDIDUSD0.TXT"
    PoboToFoxtraderTXT strFile,fileName,dateNum
   
    strFile =nowPath+"\pobo\Data\money\day\EURUSD.day"    '欧元美元
    fileName="C:\TXTDAYB\WHEURUSD.TXT"
    PoboToFoxtraderTXT strFile,fileName,dateNum
   
    strFile =nowPath+"\pobo\Data\index\Day\INDI.day"    '道琼斯指数
    fileName="C:\TXTDAYB\IDIDDJI0.TXT"
    PoboToFoxtraderTXT strFile,fileName,dateNum
   
   
    strFile =nowPath+"\pobo\Data\index\Day\HSI.day"    '恒生指数
    fileName="C:\TXTDAYB\IDIDHSI0.TXT"
    PoboToFoxtraderTXT strFile,fileName,dateNum
   
   
    strFile =nowPath+"\pobo\Data\ccgfut\Day\SOCH.day"    '美豆油03
    fileName="C:\TXTDAYB\CBCBSOC.TXT"
    PoboToFoxtraderTXT strFile,fileName,dateNum
End Sub '脚本主程序结束  

Sub PoboToFoxtraderTXT(strFile,fileName,dateNum)
    Const ForReading = 1, ForWriting = 2, ForAppending = 8
    Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0
    Dim objStream, fso, jiaGe(10)
    Set objStream = CreateObject("ADODB.Stream")
    objStream.Type = 1
    objStream.Open
    objStream.LoadFromFile strFile
    If dateNum=0 Then
        dateNum= objStream.Size/32
    ElseIf dateNum < objStream.Size/32  Then
        dateNum=dateNum
    Else
        dateNum=objStream.Size/32
    End If
    objStream.position = objStream.Size-dateNum*32
    For i = 1 To dateNum
        readFile = AscB(objStream.Read(1))+AscB(objStream.Read(1))*256+AscB(objStream.Read(1))*256*256+AscB(objStream.Read(1))*256*256*256
        nian = readFile\1048576
        yue  = readFile\65536-nian*16+100
        ri   = (readFile Mod 65536)\256\8+100
        riQi = CStr(nian)+"/"+Right(CStr(yue),2)+"/"+Right(CStr(ri),2)
        For j = 1 To 4
            readFile = AscB(objStream.Read(1))+AscB(objStream.Read(1))*256+AscB(objStream.Read(1))*256*256+AscB(objStream.Read(1))*256*256*256
            jiaGe(j) =CStr(readFile/1000)+" "
        Next
        '成交量和持仓量数据结构为浮点数，暂时支持整数部分的转换输出！
        For j = 5 To 6
            readFile = AscB(objStream.Read(1))+AscB(objStream.Read(1))*256+AscB(objStream.Read(1))*256*256+AscB(objStream.Read(1))*256*256*256
            fd1 = readFile\&H40000000  '符号位 一般是正数，不处理
            fd2 = (readFile-readFile Mod &H800000)/&H800000-&H7F  '阶码
            If fd2 <0 Then '成交量为零
                fd2 = 0
                fd3 = 0
            Else
                fd3 = readFile Mod &H800000    '小数部分
                ii=1
                For jj=1 To (23-fd2)
                    ii=ii*2
                Next
                fd3 = (fd3+&H800000)\ii
            End If
            If j=6 Then
                fd3 = fd3*10000
            End If
            jiaGe(j) =CStr(fd3)+" "
        Next
        shuChu = shuChu+riQi+" "+jiaGe(2)+jiaGe(3)+jiaGe(4)+jiaGe(1)+jiaGe(5)+jiaGe(6)+vbCrLf
        riQi=""
        objStream.position = objStream.position+4   '跳过最后四个字节
    Next
    objStream.Close
    Set objStream =  Nothing
    Set fso=CreateObject("Scripting.FileSystemObject")
    If fso.FolderExists("C:\TXTDAYB") Then
        i=0
    Else
        fso.CreateFolder ("C:\TXTDAYB")
    End If
    Set MyFile=fso.OpenTextFile(fileName,ForWriting,True,TristateFalse)
    MyFile.WriteLine shuChu
    MyFile.close
    Set MyFile = Nothing
    Set fso = Nothing
End Sub