Attribute VB_Name = "Module2"
Option Explicit

Public Declare Function GetSystemDefaultLangID Lib "kernel32" () As Integer
Public Declare Sub sleep Lib "kernel32" Alias "Sleep" (ByVal dwMilliseconds As Long)

Private 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
Private 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 i1 As Integer, i2 As Integer

Public ResFile(255) As String

Public rr(255) As String, rr1(255) As String, rr2(255) As Boolean, s(255) As String, s1(255) As Double, sa(255) As String, er(255) As Boolean, TM(255) As Boolean

Public dbn(255) As Integer, tm2 As Boolean

Public cnstr As String

Function GetSetting(index As Integer, strSection As String, strKey As String, Optional strDefVal As String = "") As String
    Dim strBuff As String
    strBuff = String(255, " ")
    Call GetPrivateProfileString(strSection, strKey, strDefVal, strBuff, 256, ResFile(index))
    strBuff = Trim(strBuff)
    GetSetting = Left(strBuff, Len(strBuff) - 1)
End Function

Function SaveSetting(index As Integer, strSection As String, strKey As String, strVal As String)
    Call WritePrivateProfileString(strSection, strKey, strVal, ResFile(index))
End Function

Function FileGet(FileName) As String
Dim FileNo As Integer
Dim FileString As String
FileNo = FreeFile
Open FileName For Binary As #FileNo
FileString = Space(FileLen(FileName))
Get #FileNo, , FileString
Close #FileNo
FileGet = FileString
End Function

Function FilePut(FileName As String, SS As String)
Dim FileNo As Integer
Dim FileString As String
FileNo = FreeFile
Open FileName For Binary As #FileNo
Put #FileNo, , SS
Close #FileNo
End Function

Function GET_STR(FIL As String, TABL As String, TJ As String)  '从资料表中取字段值
Dim R0 As New ADODB.Recordset
Dim cn0 As New ADODB.Connection
Dim SS As String, TT As String, SQL As String
Dim i As Integer
On Error Resume Next
SS = Split(cnstr, vbCrLf, -1, vbTextCompare)(dbn(0)) & ",,"
TT = "Data Source=" & Split(SS, ",", -1, vbTextCompare)(0) & "; "
If Trim(Split(SS, ",", -1, vbTextCompare)(1)) <> "" Then TT = TT & "UID=" & Split(SS, ",", -1, vbTextCompare)(1) & "; "
If Trim(Split(SS, ",", -1, vbTextCompare)(2)) <> "" Then TT = TT & "PWD=" & Split(SS, ",", -1, vbTextCompare)(2) & ";"
cn0.Open TT

SQL = "SELECT * FROM " & TABL & " WHERE " & TJ
R0.CursorLocation = adUseClient
R0.Open SQL, cn0, adOpenDynamic, adLockPessimistic
GET_STR = R0(FIL)
If InStr(1, FIL, "-") > 0 Then
    GET_STR = 0
    For i = 0 To UBound(Split(FIL, "-", -1, vbTextCompare))
        If i = 0 Then
            GET_STR = R0(Split(FIL, "-", -1, vbTextCompare)(i))
        Else
            GET_STR = GET_STR - R0(Split(FIL, "-", -1, vbTextCompare)(i))
        End If
    Next i
End If
If InStr(1, FIL, "+") > 0 Then
    GET_STR = 0
    For i = 0 To UBound(Split(FIL, "+", -1, vbTextCompare))
         GET_STR = GET_STR + R0(Split(FIL, "+", -1, vbTextCompare)(i))
    Next i
End If
End Function

Function GET_BIG(FIL As String, TABL As String, TJ As String)  '从资料表中取最大字段值
Dim R0 As New ADODB.Recordset
Dim cn0 As New ADODB.Connection
Dim SS As String, TT As String, SQL As String
Dim i As Integer
On Error Resume Next
SS = Split(cnstr, vbCrLf, -1, vbTextCompare)(dbn(0)) & ",,"
TT = "Data Source=" & Split(SS, ",", -1, vbTextCompare)(0) & "; "
If Trim(Split(SS, ",", -1, vbTextCompare)(1)) <> "" Then TT = TT & "UID=" & Split(SS, ",", -1, vbTextCompare)(1) & "; "
If Trim(Split(SS, ",", -1, vbTextCompare)(2)) <> "" Then TT = TT & "PWD=" & Split(SS, ",", -1, vbTextCompare)(2) & ";"
cn0.Open TT

SQL = "SELECT * FROM " & TABL & " WHERE " & TJ & " ORDER BY " & FIL & " DESC"
R0.CursorLocation = adUseClient
R0.Open SQL, cn0, adOpenDynamic, adLockPessimistic
If R0.RecordCount = 0 Then
     GET_BIG = 0
Else
    GET_BIG = R0(FIL)
End If
End Function

Function GET_SUM(FIL As String, TABL As String, TJ As String)  '资料表中字段汇总
Dim R0 As New ADODB.Recordset
Dim cn0 As New ADODB.Connection
Dim SS As String, TT As String, SQL As String
Dim i As Integer
On Error Resume Next
SS = Split(cnstr, vbCrLf, -1, vbTextCompare)(dbn(0)) & ",,"
TT = "Data Source=" & Split(SS, ",", -1, vbTextCompare)(0) & "; "
If Trim(Split(SS, ",", -1, vbTextCompare)(1)) <> "" Then TT = TT & "UID=" & Split(SS, ",", -1, vbTextCompare)(1) & "; "
If Trim(Split(SS, ",", -1, vbTextCompare)(2)) <> "" Then TT = TT & "PWD=" & Split(SS, ",", -1, vbTextCompare)(2) & ";"
cn0.Open TT

SQL = "SELECT * FROM " & TABL & " WHERE " & TJ
R0.CursorLocation = adUseClient
R0.Open SQL, cn0, adOpenDynamic, adLockPessimistic
GET_SUM = 0
Do While Not R0.EOF
    GET_SUM = GET_SUM + R0(FIL)
    R0.MoveNext
Loop
End Function

Function GET_COUNT(FIL As String, TABL As String, TJ As String)  '资料表中字段计数
Dim R0 As New ADODB.Recordset
Dim cn0 As New ADODB.Connection
Dim SS As String, TT As String, SQL As String
Dim i As Integer
On Error Resume Next
SS = Split(cnstr, vbCrLf, -1, vbTextCompare)(dbn(0)) & ",,"
TT = "Data Source=" & Split(SS, ",", -1, vbTextCompare)(0) & "; "
If Trim(Split(SS, ",", -1, vbTextCompare)(1)) <> "" Then TT = TT & "UID=" & Split(SS, ",", -1, vbTextCompare)(1) & "; "
If Trim(Split(SS, ",", -1, vbTextCompare)(2)) <> "" Then TT = TT & "PWD=" & Split(SS, ",", -1, vbTextCompare)(2) & ";"
cn0.Open TT

SQL = "SELECT * FROM " & TABL & " WHERE " & TJ
R0.CursorLocation = adUseClient
R0.Open SQL, cn0, adOpenDynamic, adLockPessimistic
GET_COUNT = 0
Do While Not R0.EOF
    GET_COUNT = GET_COUNT + 1
    R0.MoveNext
Loop
End Function

'所有偶数位的数字代码求和为a
'将上步中的a乘以3为a0
'所有奇数位的数字代码求和为b
'将a0和b相加为c
'取c的个位数d
'用10减去d即为校验位数值
Function TM_jy(TM As String) As Integer
Dim a As Integer, a0 As Integer, b As Integer, c As Integer
a = Val(Mid(TM, 2, 1)) + Val(Mid(TM, 4, 1)) + Val(Mid(TM, 6, 1)) + Val(Mid(TM, 8, 1)) + Val(Mid(TM, 10, 1)) + Val(Mid(TM, 12, 1))
a0 = a * 3
b = Val(Mid(TM, 1, 1)) + Val(Mid(TM, 3, 1)) + Val(Mid(TM, 5, 1)) + Val(Mid(TM, 7, 1)) + Val(Mid(TM, 9, 1)) + Val(Mid(TM, 11, 1))
c = a0 + b
TM_jy = 10 - Right(c, 1)
If TM_jy = 10 Then TM_jy = 0
End Function

