selectstock.bas

股票分析

Attribute VB_Name = "SelectStock"
Public Function getRiseOrDown() As Integer

     Dim i, j As Integer
     Dim txt, filename, GoalTxt As String
     'Dim myDFS1, myDFS2 As SCStockDayStruct
     Dim StartPrice, EndPrice As Long
     Dim FileNumber As Long
     On Error GoTo myEnd
     txt = Dir(DayDir)
     i = 0
     filename = ""
     GoalTxt = ""
     While txt <> ""
         i = i + 1
         filename = DayDir + txt
         StartPrice = 0
         EndPrice = 0
        ' MsgBox FileName
         Open filename For Binary As #1 Len = Len(DFS)
         'MsgBox Not EOF(1)
         While Not EOF(1)
             Get #1, , DFS
             If DFS.myDate = 20030102 Then
                StartPrice = DFS.ClosePrice
             End If
             If DFS.myDate = 20030114 Then
                EndPrice = DFS.ClosePrice
             End If
         Wend
         If EndPrice <> 0 And StartPrice <> 0 Then
            If EndPrice < StartPrice And StartPrice < 1000 Then
               'MsgBox "startprice=" + CStr(StartPrice) + vbCrLf + " endprince=" + CStr(EndPrice)
               If Mid(txt, 3, 3) = "000" Or Mid(txt, 3, 3) = "600" Then GoalTxt = GoalTxt + txt + vbCrLf
            
            End If
         End If

         Close #1
         txt = Dir()
        
         'MsgBox txt
         'If i > 100 Then GoTo myOut
     Wend
myOut:
     Form1.Text1.Text = GoalTxt
     
     MsgBox "Process End."
     getRiseOrDown = 1
     Exit Function
myEnd:
     getRiseOrDown = 0
End Function
Public Function getRise() As Integer

    Dim myExcel As Excel.Workbook
    Dim myWork As Excel.Worksheet
    Dim myExcelFileName, myFileName, txt As String
    Dim i, j As Integer
    Dim StartPrice, EndPrice As Long
    On Error GoTo myEnd
    myExcelFileName = MainDir + "ssgoal.xls"
    Set myExcel = Workbooks.Open(myExcelFileName)            'Open("m:\Stock Operation System\sn_600899\Stock Data In Long.xls")
    Set myWork = myExcel.Worksheets.Add
    
    myWork.Cells(1, 1) = "变化率"
     
     txt = Dir(DayDir)
     i = 1: j = 1
     myFileName = ""
     GoalTxt = ""
     While txt <> ""
       If Mid(txt, 1, 5) = "SH600" Or Mid(txt, 1, 5) = "SZ000" Then
         myFileName = DayDir + txt
         StartPrice = 0
         EndPrice = 0
         Open myFileName For Binary As #1 Len = Len(DFS)
         While Not EOF(1)
             Get #1, , DFS
             If DFS.myDate = StartDate Then
                StartPrice = DFS.ClosePrice
             End If
             If DFS.myDate = EndDate Then
                EndPrice = DFS.ClosePrice
             End If
         Wend
         If TopPrice <> 0 Then
            If EndPrice >= LowPrice * 100 And EndPrice <= TopPrice * 100 Then
               i = i + 1
               myWork.Cells(i, 1) = txt
               myWork.Cells(i, 2) = StartDate
               myWork.Cells(i, 4) = EndDate
               myWork.Cells(i, 3) = StartPrice
               myWork.Cells(i, 5) = EndPrice
               If EndPrice <> 0 And StartPrice <> 0 Then
                  myWork.Cells(i, 6) = EndPrice / StartPrice
               End If
            End If
         Else
            i = i + 1
            myWork.Cells(i, 1) = txt
            myWork.Cells(i, 2) = StartDate
            myWork.Cells(i, 4) = EndDate
            myWork.Cells(i, 3) = StartPrice
            myWork.Cells(i, 5) = EndPrice
            If EndPrice <> 0 And StartPrice <> 0 Then
               myWork.Cells(i, 6) = EndPrice / StartPrice
            End If
         End If
       End If
         Close #1
         txt = Dir()
        
     Wend
myOut:

    
 
 
    myWork.SaveAs myExcelFileName
myEnd:
    myExcel.Close
    
    Set myWork = Nothing
    Set myExcel = Nothing

End Function
Public Function getDownOfToday() As Integer

    Dim myExcel As Excel.Workbook
    Dim myWork As Excel.Worksheet
    Dim myExcelFileName, myFileName, txt As String
    Dim i, j, DateLong As Integer
    Dim StartPrice, EndPrice, TodayPrice, LastPrice As Long
    On Error GoTo myEnd
    myExcelFileName = MainDir + "ssgoal.xls"
    Set myExcel = Workbooks.Open(myExcelFileName)            'Open("m:\Stock Operation System\sn_600899\Stock Data In Long.xls")
    Set myWork = myExcel.Worksheets.Add
    
    myWork.Cells(1, 1) = "今天" + CStr(Date) + "的价位之下的天数："
     
     txt = Dir(DayDir)
     i = 1: j = 1
     myFileName = ""
     GoalTxt = ""
     While txt <> ""
       If Mid(txt, 1, 5) = "SH600" Or Mid(txt, 1, 5) = "SZ000" Then
         myFileName = DayDir + txt
         StartPrice = 0
         EndPrice = 0
         Open myFileName For Binary As #1 Len = Len(DFS)
         While Not EOF(1)
              Get #1, , DFS
              If DFS.ClosePrice <> 0 Then TodayPrice = DFS.ClosePrice
         Wend
         'seek(lof(myfilename)-len(dfs))
         Close #1
         DateLong = 0
         If TopPrice <> 0 Then
          If TodayPrice >= LowPrice * 100 And TodayPrice <= TopPrice * 100 Then
            Open myFileName For Binary As #1 Len = Len(DFS)
            While Not EOF(1)
                Get #1, , DFS
                If DFS.ClosePrice <= TodayPrice Then
                    DateLong = DateLong + 1
                End If
            Wend
            i = i + 1
            myWork.Cells(i, 1) = txt
            myWork.Cells(i, 2) = TodayPrice
            myWork.Cells(i, 3) = DateLong
          End If
        Else
            Open myFileName For Binary As #1 Len = Len(DFS)
            While Not EOF(1)
                Get #1, , DFS
                If DFS.ClosePrice <= TodayPrice Then
                    DateLong = DateLong + 1
                End If
            Wend
            i = i + 1
            myWork.Cells(i, 1) = txt
            myWork.Cells(i, 2) = TodayPrice
            myWork.Cells(i, 3) = DateLong

          
          
         End If
         Close #1
        End If
         txt = Dir()
        
     Wend
myOut:

    
 
 
    myWork.SaveAs myExcelFileName
myEnd:
    myExcel.Close
    
    Set myWork = Nothing
    Set myExcel = Nothing

getDownOfToday = 1


End Function
Public Function getCompOneStockAndAllStock() As Integer

    Dim myExcel As Excel.Workbook
    Dim myWork As Excel.Worksheet
    Dim myExcelFileName, myFileName, txt As String
    Dim i, j, k, DateCount, flg, DateComp, y, pflg As Integer
    Dim StartPrice, EndPrice, TodayPrice, LastPrice, tempDate As Long
    Dim AllStock(6000) As SH999999DayFileStruct
    Dim OneStock(6000) As SCStockDayStruct
On Error GoTo myEnd
    myExcelFileName = MainDir + "ssgoal.xls"
    Set myExcel = Workbooks.Open(myExcelFileName)            'Open("m:\Stock Operation System\sn_600899\Stock Data In Long.xls")
    Set myWork = myExcel.Worksheets.Add    '.Worksheets(5)
    Erase AllStock, OneStock
    y = 1
    If StartDate <> 0 And EndDate <> 0 Then
       myWork.Cells(y, 1) = "在" + CStr(StartDate) + "-" + CStr(EndDate) + "与大盘相反的天数："
    Else
       myWork.Cells(y, 1) = "在上市以来与大盘相反的天数："
    End If
    
    y = y + 1
    myWork.Cells(y, 1) = "代码："
    myWork.Cells(y, 2) = "总天数："
    myWork.Cells(y, 3) = "与大盘相反天数："

     i = 1: j = 1
     myFileName = DayDir + "sh999999.day"
     Open myFileName For Binary As #1 Len = Len(SHDP)
          While Not EOF(1)
              Get #1, , SHDP
              AllStock(i).ClosePoint = SHDP.ClosePoint
              AllStock(i).LowPoint = SHDP.LowPoint
              AllStock(i).myDate = SHDP.myDate
              AllStock(i).NoUnderstand = SHDP.NoUnderstand
              AllStock(i).OpenPoint = SHDP.OpenPoint
              AllStock(i).TopPoint = SHDP.TopPoint
              AllStock(i).TotalPrice = SHDP.TotalPrice