module1.bas

杭州舟远信息技术连锁有限公司的棋牌管理系统源代码

Attribute VB_Name = "Module1"
Option Explicit



Global objConn As ADODB.Connection
Global SYS_USER As String, SYS_GWMC As String, SYS_NAME As String, SYS_GWDM As String, SYS_RIGHT As String, SYS_UR As String, SYS_LOGIN As String
Public m_IniFileCnt As Integer      '最大同时读取文件的数量

Private ary_profile_info
Private get_position As Integer

'************************************************************************************
'* 功    能 : 给单列的ComboBox控件赋值
'* 作 成 者 : shooting
'* 生成日期 : 1999.03.10
'* 修改日期 : 1999.03.10
'* 参数说明 : tp_data   --  数据库名
'*            tp_table  --  表名
'*            tp_field  --  所选字段名
'*            tp_cm     --  COMBOX名
'************************************************************************************
Public Sub PUB_GetCMSG(tp_table As String, tp_field As String, tp_cm As Control)
On Error Resume Next
    Dim i As Integer
    Dim temp_rec  As ADODB.Recordset
    
    tp_cm.Clear
    
    'Set temp_rec = tp_data.OpenRecordset("SELECT " & Trim(tp_field) & " FROM " & Trim(tp_table) & " ORDER BY " & Trim(tp_field), 4, 0, 2)
    Set temp_rec = New ADODB.Recordset
    temp_rec.Source = "SELECT " & Trim(tp_field) & " FROM " & Trim(tp_table) & " ORDER BY " & Trim(tp_field)
    Set temp_rec.ActiveConnection = objConn
    temp_rec.CursorType = adOpenDynamic
    temp_rec.LockType = adLockOptimistic
    temp_rec.Open
    If Not temp_rec.BOF Then
        'temp_rec.MoveLast
        temp_rec.MoveFirst
        
        Do While Not temp_rec.EOF
            tp_cm.AddItem Trim(temp_rec.Fields(Trim(tp_field)))
            temp_rec.MoveNext
        Loop
    End If
    temp_rec.Close
    Set temp_rec = Nothing
    
End Sub


'************************************************************************************
'* 功    能 : 用竖列给ComboBox控件复合增加赋值
'* 作 成 者 : shooting
'* 生成日期 : 2005.03.10
'* 修改日期 : 2005.03.10
'* 参数说明 : tp_data   --  数据库名
'*            tp_table  --  表名
'*            tp_field  --  所选字段名
'*            tp_cm     --  COMBOX名
'************************************************************************************
Public Sub N_GetCMSG(tp_table As String, tp_field As String, tp_cm As Control)
On Error Resume Next
    Dim i As Integer
    Dim temp_rec  As ADODB.Recordset
    
    'tp_cm.Clear
    
    'Set temp_rec = tp_data.OpenRecordset("SELECT " & Trim(tp_field) & " FROM " & Trim(tp_table) & " ORDER BY " & Trim(tp_field), 4, 0, 2)
    Set temp_rec = New ADODB.Recordset
    temp_rec.Source = "SELECT " & Trim(tp_field) & " FROM " & Trim(tp_table) & " ORDER BY " & Trim(tp_field)
    Set temp_rec.ActiveConnection = objConn
    temp_rec.CursorType = adOpenDynamic
    temp_rec.LockType = adLockOptimistic
    temp_rec.Open
    If Not temp_rec.BOF Then
        'temp_rec.MoveLast
        temp_rec.MoveFirst
        
        Do While Not temp_rec.EOF
            tp_cm.AddItem Trim(temp_rec.Fields(Trim(tp_field)))
            temp_rec.MoveNext
        Loop
    End If
    temp_rec.Close
    Set temp_rec = Nothing
    
End Sub

'************************************************************************************
'* 功    能 : 用横列给ComboBox控件复合增加赋值
'* 作 成 者 : shooting
'* 生成日期 : 2005.03.10
'* 修改日期 : 2005.03.10
'* 参数说明 : tp_data   --  数据库名
'*            tp_table  --  表名
'*            tp_field  --  所选字段名
'*            tp_cm     --  COMBOX名
'************************************************************************************
Public Sub N_GetCMSG_H(tp_table As String, tp_cm As Control)
On Error Resume Next
    Dim i As Integer
    Dim temp_rec  As ADODB.Recordset
    Dim temp_s As String
    'tp_cm.Clear
    i = 1
    temp_s = "SELECT * FROM  " & Trim(tp_table)
    
    'MsgBox temp_s
    'Set temp_rec = tp_data.OpenRecordset(Trim(temp_s), 2, 0, 2)
    Set temp_rec = New ADODB.Recordset
    temp_rec.Source = temp_s
    Set temp_rec.ActiveConnection = objConn
    temp_rec.CursorType = adOpenDynamic
    temp_rec.LockType = adLockOptimistic
    temp_rec.Open
    temp_rec.MoveFirst
    
    Do While Trim(temp_rec.Fields(i)) <> "o" And i < 50
        tp_cm.AddItem Trim(temp_rec.Fields(i))
        i = i + 1
    Loop
    temp_rec.Close
    Set temp_rec = Nothing
    
End Sub




'第一个参数是ini文件名，第二个参数是行标题，第三个参数是在该部分中需要取的属性的名称
Public Function Get_ProfileInfo(ByVal in_IniFileName As String, ByVal in_Section As String, ByVal in_Keyword As String) As String
On Error Resume Next
    Dim ret_index

    Get_ProfileInfo = ""
    m_IniFileCnt = 100
    
    If sub_findfilename(in_IniFileName) = True Then
        ret_index = get_position
    Else
        ret_index = sub_readfile(in_IniFileName)
    End If
    
    Get_ProfileInfo = sub_findprofileinfo(ret_index, in_Section, in_Keyword)
End Function


Private Function sub_findfilename(ByVal fname As String) As Boolean
On Error Resume Next
    Dim i
    
    sub_findfilename = False
    If VarType(ary_profile_info) <> 0 Then
        For i = 0 To UBound(ary_profile_info, 1)
            If ary_profile_info(i, 0, 0) = "" Then
                Exit For
            Else
                If fname = ary_profile_info(i, 0, 0) Then
                    sub_findfilename = True
                    Exit For
                End If
            End If
        Next
    End If
    
    get_position = i
End Function


Private Function sub_readfile(ByVal fname As String) As Integer
On Error Resume Next
    Dim fs, inifile
    Dim buff
    Dim ary_tmp_dat
    Dim i, j, k
    Dim tmp_dim1
    Dim tmp_dim3_max

    Set fs = CreateObject("Scripting.FileSystemObject")
    Set inifile = fs.OpenTextFile("C:\" & fname, 1, 2) '这里改成你存放ini文件的位置

    i = 0
    buff = ""
    Do While Not inifile.AtEndOfStream
        buff = buff & inifile.ReadLine & ","
        i = i + 1
    Loop
    buff = Left(buff, Len(buff) - 1)
    inifile.Close
    'Set  _rec= Nothing
    
    ary_tmp_dat = Split(buff, ",")
    
    If VarType(ary_profile_info) = 0 Then
        tmp_dim1 = 0
        tmp_dim3_max = i

        ary_profile_info = Array()
        ReDim ary_profile_info(m_IniFileCnt - 1, 1, tmp_dim3_max)
    Else
        For k = LBound(ary_profile_info, 1) To UBound(ary_profile_info, 1)
            If ary_profile_info(k, 0, 0) = "" Then
                tmp_dim1 = k
                Exit For
            End If
        Next
        
        If UBound(ary_profile_info, 3) > i Then
            tmp_dim3_max = UBound(ary_profile_info, 3)
        Else
            tmp_dim3_max = i
        End If
    
        ReDim Preserve ary_profile_info(m_IniFileCnt - 1, 1, tmp_dim3_max)
    End If
    
    ary_profile_info(tmp_dim1, 0, 0) = fname
    For j = 0 To i - 1
        ary_profile_info(tmp_dim1, 1, j) = ary_tmp_dat(j)
    Next
    
    sub_readfile = tmp_dim1
End Function


Private Function sub_findprofileinfo(ByVal in_index As String, ByVal section As String, ByVal keyword As String) As String
On Error Resume Next
    Dim search_flg
    Dim ary_max
    Dim i
    Dim buff, buff2
    
    sub_findprofileinfo = ""
    
    search_flg = True
    ary_max = UBound(ary_profile_info, 3)
    
    For i = 0 To ary_max
        buff = ary_profile_info(in_index, 1, i)
        If Trim(section) = Trim(buff) Then
            buff2 = ""
            Do While i <= ary_max And Not InStr(1, "[", buff2) And search_flg = True
                i = i + 1
                
                buff2 = ary_profile_info(in_index, 1, i)
                If Left(buff2, Len(keyword)) = keyword Then
                    sub_findprofileinfo = Mid(buff2, Len(keyword) + 4, Len(buff2) - Len(keyword) + 3)
                    Exit Do
                End If
            Loop
            search_flg = False
        End If
        
        If search_flg = False Then Exit For
    Next
End Function



Public Function fGetMaxComID(table As String, COMID As String) As Variant
    Dim ADORS As ADODB.Recordset
    Dim strsql As String
    
    strsql = "SELECT ISNULL(MAX(" + COMID + "), 0) AS ID FROM " + table
    Set ADORS = New ADODB.Recordset
    'ADORS.Open strsql, adoConn, adOpenKeyset
    ADORS.Source = strsql
    Set ADORS.ActiveConnection = objConn
    ADORS.CursorType = adOpenDynamic
    ADORS.LockType = adLockOptimistic
    ADORS.Open
    If Not ADORS.EOF And Trim(ADORS.Fields("ID")) <> 0 Then
        fGetMaxComID = Val(Trim(ADORS.Fields("ID")))
    Else
        fGetMaxComID = 1000000000
    End If
    ADORS.Close
    Set ADORS = Nothing
End Function

Public Function addcj(JE As Variant)
On Error Resume Next
Dim xf_Rec As ADODB.Recordset
'Dim sp_rec As ADODB.Recordset
Set xf_Rec = New ADODB.Recordset
xf_Rec.Source = "select * from N_cj "
Set xf_Rec.ActiveConnection = objConn
xf_Rec.CursorType = adOpenDynamic
xf_Rec.LockType = adLockOptimistic
xf_Rec.Open
 xf_Rec.Fields("je") = Val(Trim(xf_Rec.Fields("je"))) + Val(JE)
xf_Rec.Update
xf_Rec.Close
Set xf_Rec = Nothing
End Function

Public Function delcj(JE As Variant)
On Error Resume Next
Dim xf_Rec As ADODB.Recordset
'Dim sp_rec As ADODB.Recordset
Set xf_Rec = New ADODB.Recordset
xf_Rec.Source = "select * from N_cj "
Set xf_Rec.ActiveConnection = objConn
xf_Rec.CursorType = adOpenDynamic
xf_Rec.LockType = adLockOptimistic
xf_Rec.Open
 xf_Rec.Fields("je") = Val(Trim(xf_Rec.Fields("je"))) - Val(JE)
xf_Rec.Update
xf_Rec.Close
Set xf_Rec = Nothing
End Function

Public Function kr_tf(m_zh As String, m_fjh As String)
On Error Resume Next
Dim xf_Rec As ADODB.Recordset
Dim krqd_rec As ADODB.Recordset
Dim fj_rec As ADODB.Recordset
Dim intrtn  As Integer
Dim count As Variant
Dim temp As ADODB.Recordset

Set krqd_rec = New ADODB.Recordset
krqd_rec.Source = "SELECT * FROM DT_KRQD WHERE ZH ='" & Trim(m_zh) & "'"
Set krqd_rec.ActiveConnection = objConn
krqd_rec.CursorType = adOpenDynamic
krqd_rec.LockType = adLockOptimistic
krqd_rec.Open

If krqd_rec.EOF Then
    MsgBox "帐号错误！"
    krqd_rec.Close
    Set krqd_rec = Nothing
    Exit Function
End If
'Call Command8_Click
'MsgBox "退111las"
count = chick_ff(m_zh)


'MsgBox "退" + Val(count)

                        
Set fj_rec = New ADODB.Recordset
fj_rec.Source = "SELECT * FROM N_FJ WHERE FHID = '" & Trim(m_fjh) & "'"
Set fj_rec.ActiveConnection = objConn
fj_rec.CursorType = adOpenDynamic
fj_rec.LockType = adLockOptimistic
fj_rec.Open