frmopenaccount.frm

金算盘软件代码

    #End If
    strWinSysPath = Space(255)
    lngSize = Len(strWinSysPath)
    
    '取得WINDOWS系统的路径（返回路径及长度）
    lngTmp = GetWindowsDirectory(strWinSysPath, lngSize)
    'strWinSysPath = Left(strWinSysPath, lngTmp)
    strWinSysPath = App.Path
    If Dir(strWinSysPath & "\Account.ini") = "" Then
        If Dir(App.Path & "\SysBase.GDB") = "" Then
            strBasePathFile = ""
            Exit Function
        Else
            strBasePathFile = App.Path & "\SysBase.GDB"
        End If
    Else
        strDefault = "JJ9800ZZ001"
        strTmpPath = Space(255)
        lngSize = Len(strTmpPath)
        strByteKey = "SYSBASE"
        strININame = strWinSysPath & "\Account.ini"
        
        '取得INI文件中的字符串（节名，关键字，默认值，返回字符串，返回字符串长度，文件名）
        '取得INI文件中样板数据库路径
        lngTmp = GetPrivateProfileString(strByteName, strByteKey, strDefault, strTmpPath, lngSize, strININame)
        strTmpPath = Left(strTmpPath, lngTmp)
        If lngTmp > 0 Then
            If Dir(strTmpPath) = "" Then
                If Dir(App.Path & "\SysBase.GDB") = "" Then
                    strBasePathFile = ""
                    Exit Function
                Else
                    strBasePathFile = App.Path & "\SysBase.GDB"
                End If
            Else
                strBasePathFile = strTmpPath
            End If
        Else
            If Dir(App.Path & "\SysBase.GDB") = "" Then
                strBasePathFile = ""
                Exit Function
            Else
                strBasePathFile = App.Path & "\SysBase.GDB"
            End If
        End If
    End If
    GetTempletBasePathFileName = True
End Function

'设置菜单可用属性
Private Sub UpdateMenuStatus()
    With frmMain
        .mnuEditCopy.Enabled = False
        .mnuEditEdit.Enabled = False
        .mnuEditNew.Enabled = False
        .mnuEditDel.Enabled = False
        .mnuEditInsLine.Enabled = False
        .mnuEditDelLine.Enabled = False
        .mnuEditNotepad.Enabled = False
        .mnuEditPaste.Enabled = False
        .mnuEditCut.Enabled = False
        .mnuEditInActive.Enabled = False
        .mnuEditShowAll.Enabled = False
        .mnuEditUse.Enabled = False
        .mnuEditShowList.Enabled = False
        .mnuEditSearch.Enabled = False
        .mnuEditColumn.Enabled = False
        .mnuEditFilter.Enabled = False
'        .mnuFilePrint.Enabled = False
'        .mnuFilePrintReceipt.Enabled = False
'        .mnuFilePrintSetup.Enabled = False
    End With
End Sub

Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    If Not m_blnIsSuccess And mstrOldFile <> "" Then
        If gclsBase.OpenDatabase(mstrOldFile, False, True) Then SetMenuRight
    End If
    frmMain.UpdateMenuStatus
    frmMain.UpdateStatus
    
    Utility.ClearListRecordSet
    Utility.RemoveFormResPicture (1001)
    Utility.RemoveFormResPicture (1002)
    Utility.RemoveFormResPicture (139)
'    Utility.RemoveFormResPicture (1009)
End Sub

Private Sub lstAccount_DblClick()
    cmdOKorCanel_Click 0
End Sub

Private Function ActiveAccount() As Boolean
    Dim strSql As String
    Dim LogDate As String
    Dim recCurr As rdoResultset
    ActiveAccount = False
    strSql = "Select * From Business "
    Set recCurr = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If recCurr.RowCount = 0 Then
        ShowMsg hwnd, "此帐套没有用户档案", vbCritical, Me.Caption
        Exit Function
    End If
    strSql = "select  strStartDate,strEndDate From AccountYear"
    Set recCurr = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If recCurr.EOF Then
        ShowMsg hwnd, "此帐套没有预置会计年度", vbCritical, Me.Caption
        Exit Function
    Else
        LogDate = gclsBase.BaseDate ' frmLogin.dteLogin.Text
        Do While Not recCurr.EOF
            If Format(LogDate, "yyyy-mm-dd") >= Format(recCurr!strStartDate, "yyyy-mm-dd") And Format(LogDate, "yyyy-mm-dd") <= Format(recCurr!strEndDate, "yyyy-mm-dd") Then
                ActiveAccount = True
                Exit Function
            End If
            recCurr.MoveNext
        Loop
         ShowMsg hwnd, "注册日期不在预置会计年度中", vbCritical, Me.Caption
         ActiveAccount = False
    End If
End Function
Public Function GetDemostrateDatePathFile(ByRef strBasePathFile As String) As Boolean
    Dim strTmpPath As String
    Dim strININame As String
    Dim strDefault As String
    Dim lngTmp As Long
    Dim lngSize As Long
    Dim strByteName As String
    Dim strByteKey As String
    Dim strWinSysPath As String
      
    GetDemostrateDatePathFile = False
    #If conVersionType = 1 Then
        strByteName = "金算盘商务管理软件标准版"
    #Else
        #If conVersionType = 2 Then
            strByteName = "金算盘商务管理软件行政事业版"
        #Else
            #If conVersionType = 4 Then
                strByteName = "金算盘商务管理软件实达专用版"
            #Else
                #If conVersionType = 8 Then
                    strByteName = "金算盘商务管理软件标准版"
                #End If
            #End If
        #End If
    #End If
    strWinSysPath = Space(255)
    lngSize = Len(strWinSysPath)
    
    '取得WINDOWS系统的路径（返回路径及长度）
'    lngTmp = GetWindowsDirectory(strWinSysPath, lngSize)
    'strWinSysPath = Left(strWinSysPath, lngTmp)
    strWinSysPath = App.Path
    If Dir(strWinSysPath & "\Account.ini") = "" Then
        If Dir(App.Path & "\Data\演示数据.gdb") = "" Then
            strBasePathFile = ""
            Exit Function
        Else
            strBasePathFile = App.Path & "\Data\演示数据.gdb"
        End If
    Else
        strDefault = "JJ9800ZZ001"
        strTmpPath = Space(255)
        lngSize = Len(strTmpPath)
        strByteKey = "DATA"
        strININame = strWinSysPath & "\Account.ini"
        
        '取得INI文件中的字符串（节名，关键字，默认值，返回字符串，返回字符串长度，文件名）
        '取得INI文件中样板数据库路径
        lngTmp = GetPrivateProfileString(strByteName, strByteKey, strDefault, strTmpPath, lngSize, strININame)
        strTmpPath = Left(strTmpPath, lngTmp)
        If lngTmp > 0 Then
            If Dir(strTmpPath) = "" Then
                If Dir(App.Path & "\Data\演示数据.gdb") = "" Then
                    strBasePathFile = ""
                    Exit Function
                Else
                    strBasePathFile = App.Path & "\Data\演示数据.gdb"
                End If
            Else
                strBasePathFile = strTmpPath
            End If
        Else
            If Dir(App.Path & "\Data\演示数据.gdb") = "" Then
                strBasePathFile = ""
                Exit Function
            Else
                strBasePathFile = App.Path & "\Data\演示数据.gdb"
            End If
        End If
    End If
    Dim intCount As Integer
    Dim strFile
    For intCount = 0 To 9
        strFile = GetSetting(App.title, "FET", "File" & intCount, "")
        If strFile <> "" Then
            If Len(Dir(strFile)) > 0 Then
                If strFile = strBasePathFile Then
                    strBasePathFile = ""
                    Exit Function
                End If
            End If
        End If
    Next
    GetDemostrateDatePathFile = True
End Function
Private Function WorkSpacePath() As String
    Dim strTmpPath As String
    Dim strININame As String
    Dim strDefault As String
    Dim lngTmp As Long
    Dim lngSize As Long
    Dim strByteName As String
    Dim strByteKey As String
    Dim strWinSysPath As String
      
    WorkSpacePath = ""
    #If conVersionType = 1 Then
        strByteName = "金算盘商务管理软件标准版"
    #Else
        #If conVersionType = 2 Then
            strByteName = "金算盘商务管理软件行政事业版"
        #Else
            #If conVersionType = 4 Then
                strByteName = "金算盘商务管理软件实达专用版"
            #Else
                #If conVersionType = 8 Then
                    strByteName = "金算盘商务管理软件标准版"
                #End If
            #End If
        #End If
    #End If
    strWinSysPath = Space(255)
    lngSize = Len(strWinSysPath)
    
    '取得WINDOWS系统的路径（返回路径及长度）
'    lngTmp = GetWindowsDirectory(strWinSysPath, lngSize)
    'strWinSysPath = Left(strWinSysPath, lngTmp)
    strWinSysPath = App.Path
    If Dir(strWinSysPath & "\Account.ini") = "" Then
        If Not PathExist(App.Path & "\Data") Then
            WorkSpacePath = App.Path
            Exit Function
        Else
            WorkSpacePath = App.Path & "\Data"
        End If
    Else
        strDefault = "JJ9800ZZ001"
        strTmpPath = Space(255)
        lngSize = Len(strTmpPath)
        strByteKey = "DATA"
        strININame = strWinSysPath & "\Account.ini"
        
        '取得INI文件中的字符串（节名，关键字，默认值，返回字符串，返回字符串长度，文件名）
        '取得INI文件中样板数据库路径
        lngTmp = GetPrivateProfileString(strByteName, strByteKey, strDefault, strTmpPath, lngSize, strININame)
        strTmpPath = Left(strTmpPath, lngTmp)
        If lngTmp > 0 Then
            If Not PathExist(strTmpPath) Then
                If Not PathExist(App.Path & "\Data") Then
                    WorkSpacePath = App.Path
                    Exit Function
                Else
                    WorkSpacePath = App.Path & "\Data"
                End If
            Else
                WorkSpacePath = strTmpPath
            End If
        Else
            If Not PathExist(App.Path & "\Data") Then
                WorkSpacePath = App.Path
                Exit Function
            Else
                WorkSpacePath = App.Path & "\Data"
            End If
        End If
    End If
    
End Function
Private Function PathExist(ByVal strPath As String) As Boolean
On Error GoTo Handler
    ChDir strPath
    PathExist = True
    Exit Function
Handler:
    PathExist = False
End Function
Public Function CheckFileNotExistInLocal(ByVal strFile As String) As Boolean
    Dim intCount As Integer
    Dim strTemp As String
    CheckFileNotExistInLocal = True
    If Len(Dir(strFile)) = 0 Then
        CheckFileNotExistInLocal = False
        Exit Function
    End If
    For intCount = 0 To 9
        strTemp = GetSetting(App.title, "FET", "File" & intCount, "")
        If strTemp <> "" Then
            If strTemp = strFile Then
                CheckFileNotExistInLocal = False
                Exit Function
            End If
        End If
    Next
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'   Author:Caiqike
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Function GetAccountlistFilePathName() As String
    '取帐套目录文件名
    Dim strTmpPath As String
    Dim strININame As String
    Dim strDefault As String
    Dim lngTmp As Long
    Dim lngSize As Long
    Dim strByteName As String
    Dim strByteKey As String
    Dim strWinSysPath As String
    On Error GoTo ErrHandle
    GetAccountlistFilePathName = ""
    
    #If conVersionType = 1 Then
        strByteName = "金算盘商务管理软件标准版"
    #Else
        #If conVersionType = 2 Then
            strByteName = "金算盘商务管理软件行政事业版"
        #Else
            #If conVersionType = 4 Then
                strByteName = "金算盘商务管理软件实达专用版"
            #Else
                #If conVersionType = 8 Then
                    strByteName = "金算盘商务管理软件标准版"
                #End If
            #End If
        #End If
    #End If
    #If conWan = 1 Then
        strByteName = "万能软件"
    #Else
        strByteName = "金算盘软件"
    #End If
    '取得路径（返回路径及长度）
    strWinSysPath = App.Path
    
    If Dir(strWinSysPath & "\Account.ini") <> "" Then
        strDefault = ""
        strTmpPath = Space(255)
        lngSize = Len(strTmpPath)
        strByteKey = "ACCOUNTLIST"
        strININame = strWinSysPath & "\Account.ini"
        '取得INI文件中的字符串（节名，关键字，默认值，返回字符串，返回字符串长度，文件名）
        '取得INI文件中样板数据库路径
        lngTmp = GetPrivateProfileString(strByteName, strByteKey, strDefault, strTmpPath, lngSize, strININame)
        strTmpPath = Left(strTmpPath, lngTmp)
        If lngTmp > 0 Then
            If Dir(strTmpPath) <> "" Then
                GetAccountlistFilePathName = strTmpPath
            End If
        End If
    Else
        GetAccountlistFilePathName = "\\CHSORASVR\backup\GACCOUNT.ini"
        GetAccountlistFilePathName = "\\CHSORASVR\GaSoft\yd27\GACCOUNT.ini"
    End If
    Exit Function
ErrHandle:
    On Error Resume Next
    GetAccountlistFilePathName = "\\CHSORASVR\backup\GACCOUNT.ini"
End Function