Security_Log = False
                End If
                aDo_userGroup.MoveNext
            Loop
            aDo_userGroup.Close
            Set aDo_userGroup = Nothing
        End If
        If Security_Log = False Then
            Tsxx = "沒有權限,請與管理員聯系！   "
            Call Xtxxts(Tsxx, 0, 4)
        End If
    End If
    
    '------------------------------------
    If (LogTF = 1 And Security_Log = True) Or LogTF = 2 Then
        If State = True Then
            Ssql = "insert into System_Log(GeginDate,userid,WorkstationName,WorkList,SystemName,NetUserName,State)" _
            & " values(getdate()," & UserCode & ",'" & MachineName & "','" & Trim("" & aDo_gnbm!gnms) & "','" & "財務總帳管理系統" & "','" & NTDomainUserName & "','進入')"
        Else
            Ssql = "insert into System_Log(GeginDate,userid,WorkstationName,WorkList,SystemName,NetUserName,State)" _
            & " values(getdate()," & UserCode & ",'" & MachineName & "','" & Trim("" & aDo_gnbm!gnms) & "','" & "財務總帳管理系統" & "','" & NTDomainUserName & "','完成')"
        End If
        Cw_DataEnvi.DataConnect.Execute Ssql
    End If
    aDo_gnbm.Close
    Set aDo_gnbm = Nothing
    
End Function

Public Function MachineName() As String                                         '取得當前工作站名
    
    Dim sBuffer As String * 255
    If GetComputerName(sBuffer, 255&) <> 0 Then
        MachineName = Left$(sBuffer, InStr(sBuffer, vbNullChar) - 1)
    Else
        MachineName = "(未知)"
    End If
    
End Function

Public Function NTDomainUserName() As String                                    '取得當前網絡用戶名
    
    Dim strBuffer As String * 255
    Dim lngBufferLength As Long
    Dim lngRet As Long
    Dim strTemp As String
    
    lngBufferLength = 255
    lngRet = GetUserName(strBuffer, lngBufferLength)
    strTemp = UCase(Trim$(strBuffer))
    NTDomainUserName = Left$(strTemp, lngBufferLength - 1)
    
End Function

Public Function GetPY(a1 As String) As String                                   '返回拼音碼字符串
    
    '輸入參數:a1 輸入字符串
    
    Dim jsqte As Long
    Dim t1 As String
    GetPY = ""
    If Len(Trim(a1)) = 0 Then
        Exit Function
    End If
    For jsqte = 1 To Len(Trim(a1))
        t1 = Mid(a1, jsqte, 1)
        If Asc(t1) < 0 Then
            If Asc(t1) < Asc("啊") Then
                GetPY = GetPY + t1
                GoTo L1
            End If
            If Asc(t1) >= Asc("啊") And Asc(t1) < Asc("芭") Then
                GetPY = GetPY + "A"
                GoTo L1
            End If
            If Asc(t1) >= Asc("芭") And Asc(t1) < Asc("擦") Then
                GetPY = GetPY + "B"
                GoTo L1
            End If
            If Asc(t1) >= Asc("擦") And Asc(t1) < Asc("搭") Then
                GetPY = GetPY + "C"
                GoTo L1
            End If
            If Asc(t1) >= Asc("搭") And Asc(t1) < Asc("蛾") Then
                GetPY = GetPY + "D"
                GoTo L1
            End If
            If Asc(t1) >= Asc("蛾") And Asc(t1) < Asc("發") Then
                GetPY = GetPY + "E"
                GoTo L1
            End If
            If Asc(t1) >= Asc("發") And Asc(t1) < Asc("噶") Then
                GetPY = GetPY + "F"
                GoTo L1
            End If
            If Asc(t1) >= Asc("噶") And Asc(t1) < Asc("哈") Then
                GetPY = GetPY + "G"
                GoTo L1
            End If
            If Asc(t1) >= Asc("哈") And Asc(t1) < Asc("擊") Then
                GetPY = GetPY + "H"
                GoTo L1
            End If
            If Asc(t1) >= Asc("擊") And Asc(t1) < Asc("喀") Then
                GetPY = GetPY + "J"
                GoTo L1
            End If
            If Asc(t1) >= Asc("喀") And Asc(t1) < Asc("垃") Then
                GetPY = GetPY + "K"
                GoTo L1
            End If
            If Asc(t1) >= Asc("垃") And Asc(t1) < Asc("媽") Then
                GetPY = GetPY + "L"
                GoTo L1
            End If
            If Asc(t1) >= Asc("媽") And Asc(t1) < Asc("拿") Then
                GetPY = GetPY + "M"
                GoTo L1
            End If
            If Asc(t1) >= Asc("拿") And Asc(t1) < Asc("哦") Then
                GetPY = GetPY + "N"
                GoTo L1
            End If
            If Asc(t1) >= Asc("哦") And Asc(t1) < Asc("啪") Then
                GetPY = GetPY + "O"
                GoTo L1
            End If
            If Asc(t1) >= Asc("啪") And Asc(t1) < Asc("期") Then
                GetPY = GetPY + "P"
                GoTo L1
            End If
            If Asc(t1) >= Asc("期") And Asc(t1) < Asc("然") Then
                GetPY = GetPY + "Q"
                GoTo L1
            End If
            If Asc(t1) >= Asc("然") And Asc(t1) < Asc("撒") Then
                GetPY = GetPY + "R"
                GoTo L1
            End If
            If Asc(t1) >= Asc("撒") And Asc(t1) < Asc("塌") Then
                GetPY = GetPY + "S"
                GoTo L1
            End If
            If Asc(t1) >= Asc("塌") And Asc(t1) < Asc("挖") Then
                GetPY = GetPY + "T"
                GoTo L1
            End If
            If Asc(t1) >= Asc("挖") And Asc(t1) < Asc("昔") Then
                GetPY = GetPY + "W"
                GoTo L1
            End If
            If Asc(t1) >= Asc("昔") And Asc(t1) < Asc("壓") Then
                GetPY = GetPY + "X"
                GoTo L1
            End If
            If Asc(t1) >= Asc("壓") And Asc(t1) < Asc("匝") Then
                GetPY = GetPY + "Y"
                GoTo L1
            End If
            If Asc(t1) >= Asc("匝") Then
                GetPY = GetPY + "Z"
                GoTo L1
            End If
        Else
            If UCase(t1) <= "Z" And UCase(t1) >= "A" Then
                GetPY = GetPY + UCase(t1)
            Else
                GetPY = t1
            End If
        End If
L1:
    Next jsqte
    
End Function

'<<<<<<<<<<<<<<<<<<<<<
Public Function Item_Info()  '項目查詢連接
    
    Dim aDo_Item As New Recordset
    Dim Ssql As String
    Set aDo_Item = Cw_DataEnvi.DataConnect.Execute("select * from DEV_item")
    
    With aDo_Item
        Do While Not .EOF
            If !yncode = 1 And Trim(aDo_Item!TableName) = "CorrelationList" Then
                If !YNRoot = 1 Then
                    Ssql = Ssql & ",N_" & !ItemFieldName & "=(select ListName from DEV_CorrelationList c where convert(varchar(18),c.ListCode)=b." & !ItemFieldName & ")"
                Else
                    Ssql = Ssql & ",N_" & !ItemFieldName & "=(select ListName from DEV_CorrelationList c where convert(varchar(18),c.ListCode)=a." & !ItemFieldName & ")"
                End If
                '-----------------
            Else
                If !yncode = 1 Then
                    If !YNRoot = 1 Then
                        Ssql = Ssql & ",N_" & !ItemFieldName & "=(select " & aDo_Item!CloumnName2 & " from " & aDo_Item!TableName & " c where c." & aDo_Item!CloumnName1 & "=b." & !ItemFieldName & ")"
                    Else
                        Ssql = Ssql & ",N_" & !ItemFieldName & "=(select " & aDo_Item!CloumnName2 & " from " & aDo_Item!TableName & " c where c." & aDo_Item!CloumnName1 & "=a." & !ItemFieldName & ")"
                    End If
                End If
            End If
            .MoveNext
        Loop
        Ssql = "select b.dcode,b.tcode,b.lcode,b.dname,b.manage,b.dxh,b.mader,b.zflag,b.mlevel,b.pdate,b.state,b.dno,b.conno,a.*,N_Lcode=(select isname from DEV_ItemSort c where convert(varchar(18),c.isid)=b.lcode)" & Ssql & " FROM DEV_RootInfo a,DEV_main b"
    End With
    Item_Info = Ssql
    
End Function

'====================單據編號格式化==============
Public Function BillCodeFormat(BillCode As String, Code As String) As String
    BillCode = Trim(BillCode): Code = Trim(Code)
    Dim Profix  As String       '前綴
    Dim Glida As Integer        '流水方式
    Dim CodeLen As Integer      '代碼長度
    Dim aDo_re As New Recordset
    Set aDo_re = Cw_DataEnvi.DataConnect.Execute("select * from Gy_BillNumber where BillCode='" & Trim(BillCode) & "'")
    If aDo_re.RecordCount > 0 Then
        Profix = aDo_re!Profix
        Glida = aDo_re!Glida
        CodeLen = aDo_re!CodeLen
    Else
        BillCodeFormat = "": Exit Function
    End If
    aDo_re.Close
    If Len(Code) >= Len(Profix) + CodeLen Then BillCodeFormat = Code: Exit Function
    If Glida = 0 Then
        If Len(Code) >= Len(Profix) Then
            If Profix <> Mid(Code, 1, Len(Profix)) Then
                BillCodeFormat = Profix & String(CodeLen - Len(Code), "0") & Code
            Else
                If Len(Code) = Len(Profix) Then BillCodeFormat = Code: Exit Function
                BillCodeFormat = Profix & String(CodeLen - Len(Code), "0") & Mid(Code, Len(Profix) + 1, Len(Code))
            End If
        Else
            BillCodeFormat = Profix & String(CodeLen - Len(Code), "0") & Code: Exit Function
        End If
    Else
        If Len(Code) >= Len(Profix) Then
            If Profix <> Mid(Code, 1, Len(Profix)) Then
                BillCodeFormat = Profix & Code
            Else
                BillCodeFormat = Code
            End If
        End If
    End If
    
    
End Function

'====================單據ID處理==================
Public Function CreatBillID(BillCode As String) As Integer
    '參數說明： BillCode 單據編碼
    Dim BillType As String
    Dim aDo_re As New Recordset
    Set aDo_re = Cw_DataEnvi.DataConnect.Execute("select * from Gy_BillNumber where BillCode='" & Trim(BillCode) & "'")
    If aDo_re.RecordCount > 0 Then
        CreatBillID = aDo_re!IDNow
        BillType = aDo_re!BillType
    End If
    aDo_re.Close
    Cw_DataEnvi.DataConnect.Execute "update  Gy_BillNumber set IDNow=IDNow+1 where BillType='" & Trim(BillType) & "'"
End Function

'====================單據編碼處理==================
Public Function CreatBillCode(BillCode As String, Optional Add As Boolean = False, Optional KjYear As Integer, Optional Period As Integer, Optional WhCode As String) As String
    
    '參數說明： BillCode 單據編碼，KjYear 會計年度，Period 會計期間，WhCode 倉庫編碼,Add 編號是累加(True 加，False,否)
    Dim BillCodeMode As Integer '編碼方式
    Dim Profix  As String       '前綴
    Dim Glida As Integer        '流水方式
    Dim CodeLen As Integer      '代碼長度
    Dim aDo_re As New Recordset
    Set aDo_re = Cw_DataEnvi.DataConnect.Execute("select * from Gy_BillNumber where BillCode='" & Trim(BillCode) & "'")
    With aDo_re
        If .RecordCount > 0 Then
            BillCodeMode = !BillCodeMode
            Profix = !Profix
            Glida = !Glida
            CodeLen = !CodeLen
            .Close
        Else
            Exit Function
        End If
    End With
    
    Select Case BillCodeMode
    Case 0 '單據方式
        '=============
        Select Case Glida
        Case 0
            Set aDo_re = Cw_DataEnvi.DataConnect.Execute("select * from Gy_Maxnum where BillCode='" & Trim(BillCode) & "'")
            If aDo_re.RecordCount < 1 Then '當編號記錄沒有時
                Cw_DataEnvi.DataConnect.Execute "insert into Gy_Maxnum(BillCode,NowNumber) VALUES ('" & Trim(BillCode) & "',1)"
                CreatBillCode = Trim(Profix) & String(CodeLen - 1, "0") & 1
            Else
                CreatBillCode = Trim(Profix) & String(CodeLen - Len(aDo_re!NowNumBer), "0") & aDo_re!NowNumBer
            End If
            If Add = True Then
                Cw_DataEnvi.DataConnect.Execute "update Gy_Maxnum set NowNumBer=NowNumBer+1  where BillCode='" & Trim(BillCode) & "'"
            End If
            Exit Function
        Case 1
            Set aDo_re = Cw_DataEnvi.DataConnect.Execute("select * from Gy_Maxnum where BillCode='" & Trim(BillCode) & "' and KjYear= " & KjYear)
            If aDo_re.RecordCount < 1 Then '當前年記錄沒有時
                Cw_DataEnvi.DataConnect.Execute "insert into Gy_Maxnum(BillCode,Kjyear,NowNumber) VALUES ('" & Trim(BillCode) & "'," & KjYear & ",1)"
                CreatBillCode = Trim(Profix) & KjYear & String(CodeLen - 1 - Len(Trim(