module1.bas

大型商业学分统计系统原代码说明 1.如果在向导设置班级数为8时,此数值为班级总数

Attribute VB_Name = "Module1"
Public NHB As String
Public DD As String
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'Const MAX_FILENAME_LEN = 260
'Private Declare Function FindExecutable Lib "shell32.dll" Alias "FindExecutableA" (ByVal lpFile As String, ByVal lpDirectory As String, ByVal lpResult As String) As Long
'Private Sub Form_Load()
'    Dim i As Integer, s2 As String
'   Const sFile = "C:\Windows\explorer.exe"
'    If Dir(sFile) = "" Or sFile = "" Then
'        MsgBox "File not found!", vbCritical
'        Exit Sub
'    Else
'    MsgBox "yy"                         '发现文件是否存在
'   End If
'    s2 = String(MAX_FILENAME_LEN, 32)
'    i = FindExecutable(sFile, vbNullString, s2)
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'
'Public Declare Function GetVolumeInformation Lib "kernel32" Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long
'Public Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
'Public Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
'
'Dim n As Integer
'Dim registry As String * 255
'Dim inifilename As String
'
''取得硬盘的序列号的函数
'Function GetSerialNumber(strDrive As String) As Long
'Dim SerialNum As Long '定义序列号
'Dim Res As Long
'Dim Temp1 As String
'Dim Temp2 As String
'Temp1 = String$(255, Chr$(0))
'Temp2 = String$(255, Chr$(0))
''调用windows的API函数来获得硬盘序列号
'Res = GetVolumeInformation(strDrive, Temp1, Len(Temp1), SerialNum, 0, 0, Temp2, Len(Temp2))
'GetSerialNumber = SerialNum
'End Function
'Private Sub Command1_Click()
'If Text1.Text = Mid$(EnCrypt1.EnCrypt(Crypt(StrReverse(Mid$(GetSerialNumber("c:\"), 2)), "65831")), 5) Then
'
'MsgBox "注册成功"
'End If
'End Sub
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Function GetProfile(strFileName As String, strSection As String, strName As String) As String
    '这个函数是用来对INI文件进行读操作的
    '函数说明:
    'strFileName 是所要读取的文件名
    'strSection  是这个文件中的一个节点名
    'strName 是所要查找的字段名
    '返回值：
    '薛向华 1998/05/13
    strSectionTemp = ""
    strNameTemp = ""
    strreturn = ""
    On Error GoTo ErrSrchSection
    Open strFileName For Input As #1
    ' 下面这段程序是用来查找节点的
    Do While Not EOF(1)
        strCharA = INPUT(1, #1)
        If strCharA = "[" Then
            Do While Not EOF(1)
                strCharB = INPUT(1, #1)
                If strCharB = "]" Then Exit Do
                strSectionTemp = strSectionTemp & strCharB
            Loop
        End If
        If strSectionTemp = strSection Then
            strCharA = INPUT(2, #1)
            Exit Do
        Else
            strSectionTemp = ""
        End If
    Loop
    On Error GoTo ErrReadFile
aa:
    '下面这段程序是用来查找所要查找的字段的
    strNameTemp = ""
    Do While Not EOF(1)
        strCharA = INPUT(1, #1)
        If strCharA <> "=" Then
            strNameTemp = strNameTemp & strCharA  '得到名称
        Else
            Exit Do
        End If
    Loop
    If strNameTemp = strName Then
        Line Input #1, strreturn  '如果找到与它匹配的字段名，就返回得到的值
    Else
        Line Input #1, strreturn  '如果未找到与它匹配的字段名，就继续找
        GoTo aa
    End If
    Close #1
    GetProfile = strreturn
    Exit Function
ErrReadFile:
    Dim inrRet As Integer
    intret = MsgBox("校名未找到", vbAbortRetryIgnore, "错误信息")
    Select Case intret
        Case vbAbort
            GetProfile = ""
            Close #1
            Exit Function
        Case vbRetry
            Resume
        Case vbIgnore
            Resume Next
    End Select
ErrSrchSection:
    MsgBox "校名未找到,请重新设置校名", vbOKOnly
    GetProfile = ""
    Close #1
End Function
'三项和=平均分*0.3 + 优秀分*0.3 + 合格率*0.4