apiouttest.frm

金算盘软件代码

        strCustomerName = "GASOFT"
    #End If
    If blnIsReportTatol Then
        lngRetVal = RegOpenKeyEx(HKEY_LOCAL_MACHINE, "Software\" & strCustomerName & "\RPT", 0&, _
                                 KEY_ALL_ACCESS, hlngKey)
    Else
        lngRetVal = RegOpenKeyEx(HKEY_LOCAL_MACHINE, "Software\" & strCustomerName & "\ET", 0&, _
                                 KEY_ALL_ACCESS, hlngKey)
'        lngRetVal = RegOpenKeyEx(HKEY_CURRENT_USER, "Software\Hejian\电子表格\System", 0&, _
'                                 KEY_ALL_ACCESS, hlngKey)
    End If
    strValueData = String$(50, " ")
    lngValueDataLen = Len(strValueData)
    lngRetVal = RegQueryValueEx(hlngKey, "CheckFile", 0&, _
                lngValueDataType, strValueData, lngValueDataLen)
    REGGetSetting = Trim(strValueData)
    lngRetVal = RegCloseKey(hlngKey)

End Function
Private Sub WebMain_BeforeNavigate2(ByVal pDisp As Object, URL As Variant, Flags As Variant, TargetFrameName As Variant, PostData As Variant, Headers As Variant, Cancel As Boolean)
    Dim strCommand As String
    strCommand = URL
    If (VBA.Left(strCommand, 8)) = "command:" Then
        strCommand = Mid(strCommand, 9)
        Cancel = True
        RunCommand strCommand
    End If
End Sub


Private Sub RunCommand(strCommand As String)
'    If strCommand = "电子表格" Then
'       Dim ret As String
'
'       ret = REGGetSetting
'       ret = Trim(ret)
'       If Dir(ret) = "" Or Len(ret) <= 0 Then
'          ShowMsg Me.hwnd, "未发现电子表运行程序，请重新安装电子表！", vbCritical + vbOKOnly
'       Else
'          On Error Resume Next
'          x1.AcntInit gclsBase.BaseFile, gclsBase.BaseDate
'          Shell ret, vbNormalFocus
'       End If
'    Else
    ExecuteCommand strCommand
'    End If
End Sub

Private Sub ExecuteCommand(strCommand As String)
    Dim strPageContent As String
    Dim strItemCommand As String
    Dim lngDepart As Long
    lngDepart = InStr(strCommand, "_")
    If lngDepart > 0 Then
        strPageContent = Left(strCommand, lngDepart - 1)
        strItemCommand = Right(strCommand, Len(strCommand) - lngDepart)
    Else
        Exit Sub
    End If
    Select Case strPageContent
        Case "电子表格"
            Dim ret As String
            Dim blnIsReportTatol As Boolean
            blnIsReportTatol = False
            If strItemCommand = "报表汇总" Then
                blnIsReportTatol = True
            End If
            ret = REGGetSetting(blnIsReportTatol)
            ret = Trim(ret)
            If Right(ret, 1) = Chr(0) Then
                ret = Left(ret, Len(ret) - 1)
            End If
            If Dir(ret) = "" Or Len(ret) <= 0 Then
              If blnIsReportTatol Then
                MsgBox "未发现报表汇总运行程序，请重新安装报表汇总！", vbCritical + vbOKOnly
              Else
                MsgBox "未发现电子表运行程序，请重新安装电子表！", vbCritical + vbOKOnly
              End If
               Exit Sub
            Else
               On Error Resume Next
               Dim strBaseFilename As String
               strBaseFilename = Right(gclsBase.BaseFile, Len(gclsBase.BaseFile) - InStr(gclsBase.BaseFile, "/"))
               x1.AcntInit strBaseFilename, gclsBase.BaseDate
            End If
            Select Case strItemCommand
                Case "电子表"
                    Me.Enabled = False
                    Shell ret, vbNormalFocus
                    Me.Enabled = True
                Case "资产负债表"
                    Me.Enabled = False
                    Shell ret + " -Addin ORAZCFZB.ZCFZBAddin", vbNormalFocus
                    Me.Enabled = True
                Case "损益表"
                    Me.Enabled = False
                    Shell ret + " -Addin ORASYB.SYBAddIn", vbNormalFocus
                    Me.Enabled = True
                Case "现金流量表"
                    Me.Enabled = False
                    Shell ret + " -Addin ORAXJLLB.XJLLBAddIn", vbNormalFocus
                    Me.Enabled = True
                Case "报表汇总"
                    Me.Enabled = False
                    Shell ret, vbNormalFocus
'                    Shell ret + " -Addin ORAReportTask.MergAddin", vbNormalFocus
                    Me.Enabled = True
                Case "收支表"
                    Me.Enabled = False
                    Shell ret + " -Addin ORASYB.SYBAddIn", vbNormalFocus
                    Me.Enabled = True
            End Select
        Case "基础设置"
            Select Case strItemCommand
                Case "会计科目"
                    If frmMain.mnuListAccount.Enabled Then
                        Me.Enabled = False
                        frmMain.mnuListAccount_Click
                        Me.Enabled = True
                    Else
                        ShowMsg Me.hwnd, "没有“会计科目”的权限！", vbCritical + vbOKOnly, App.title
                    End If
                Case "科目期初"
                    If frmMain.mnuListAccountInit.Enabled Then
                        Me.Enabled = False
                        frmMain.mnuListAccountInit_Click
                        Me.Enabled = True
                    Else
                        ShowMsg Me.hwnd, "没有“科目期初”的权限！", vbCritical + vbOKOnly, App.title
                    End If
                Case "财务预算"
                    If frmMain.mnuListBudget.Enabled Then
                        Me.Enabled = False
                        frmMain.mnuListBudget_Click
                        Me.Enabled = True
                    Else
                        ShowMsg Me.hwnd, "没有“财务预算”的权限！", vbCritical + vbOKOnly, App.title
                    End If
                Case "往来单位"
                    If frmMain.mnuListCustomer.Enabled Then
                        Me.Enabled = False
                        frmMain.mnuListCustomer_Click
                        Me.Enabled = True
                    Else
                        ShowMsg Me.hwnd, "没有“往来单位”的权限！", vbCritical + vbOKOnly, App.title
                    End If
                Case "往来期初"
                    If frmMain.mnuListCustomerInit.Enabled Then
                        Me.Enabled = False
                        frmMain.mnuListCustomerInit_Click
                        Me.Enabled = True
                    Else
                        ShowMsg Me.hwnd, "没有“往来期初”的权限！", vbCritical + vbOKOnly, App.title
                    End If
                Case "部门职员"
                    If frmMain.mnuListDepartment.Enabled Then
                        Me.Enabled = False
                        frmMain.mnuListDepartment_Click
                        Me.Enabled = True
                    Else
                        ShowMsg Me.hwnd, "没有“部门职员”的权限！", vbCritical + vbOKOnly, App.title
                    End If
                    
                #If Not conHos = 1 Then
                Case "商品劳务"
                    
                    If frmMain.mnuListItem.Enabled Then
                        Me.Enabled = False
                        frmMain.mnuListItem_Click
                        Me.Enabled = True
                    Else
                        ShowMsg Me.hwnd, "没有“商品劳务”的权限！", vbCritical + vbOKOnly, App.title
                    End If
                Case "商品期初"
                    If frmMain.mnuListItemInit.Enabled Then
                        Me.Enabled = False
                        frmMain.mnuListItemInit_Click
                        Me.Enabled = True
                    Else
                        ShowMsg Me.hwnd, "没有“商品期初”的权限！", vbCritical + vbOKOnly, App.title
                    End If
                Case "经营预算"
                    If frmMain.mnuListFance.Enabled Then
                        Me.Enabled = False
                        frmMain.mnuListFance_Click
                        Me.Enabled = True
                    Else
                        ShowMsg Me.hwnd, "没有“经营预算”的权限！", vbCritical + vbOKOnly, App.title
                    End If
                Case "固资编码"
                    If frmMain.mnuListFixedAsset.Enabled Then
                        Me.Enabled = False
                        frmMain.mnuListFixedAsset_Click
                        Me.Enabled = True
                    Else
                        ShowMsg Me.hwnd, "没有“固资编码”的权限！", vbCritical + vbOKOnly, App.title
                    End If
                Case "固资期初"
                    If frmMain.mnuListFixedInit.Enabled Then
                        Me.Enabled = False
                        frmMain.mnuListFixedInit_Click
                        Me.Enabled = True
                    Else
                        ShowMsg Me.hwnd, "没有“固资期初”的权限！", vbCritical + vbOKOnly, App.title
                    End If
                #End If
                Case "帐套属性"
                    If frmMain.mnuFileProperty.Enabled Then
                        Me.Enabled = False
                        frmMain.mnuFileProperty_Click
                        Me.Enabled = True
                    Else
                        ShowMsg Me.hwnd, "没有“帐套属性”的权限！", vbCritical + vbOKOnly, App.title
                    End If
                Case "单据格式"
                    If frmMain.mnuToolReceipt.Enabled Then
                        Me.Enabled = False
                        frmMain.mnuToolReceipt_Click
                        Me.Enabled = True
                    Else
                        ShowMsg Me.hwnd, "没有“单据格式”的权限！", vbCritical + vbOKOnly, App.title
                    End If
                Case "财务分工"
                    If frmMain.mnuToolRight.Enabled Then
                        Me.Enabled = False
                        frmMain.mnuToolRight_Click
                        Me.Enabled = True
                    Else
                        ShowMsg Me.hwnd, "没有“财务分工”的权限！", vbCritical + vbOKOnly, App.title
                    End If
                #If conHos = 1 Then
                 Case "保险单位"
                   If frmMain.mnuListInsureCustom.Enabled Then
                     Me.Enabled = False
                     frmMain.mnuListInsureCustom_Click
                     Me.Enabled = True
                   Else
                      MsgBox "没有”保险单位“的权限！", vbCritical + vbOKOnly, App.title
                   End If
                 Case "保险个人"
                   If frmMain.mnuListInsurePerson.Enabled Then
                     Me.Enabled = False
                     frmMain.mnuListInsurePerson_Click
                     Me.Enabled = True
                   Else
                      MsgBox "没有“保险个人”的权限！", vbCritical + vbOKOnly, App.title
                   End If
                 Case "医疗机构"
                    If frmMain.mnuListHospital.Enabled Then
                     Me.Enabled = False
                     frmMain.mnuListHospital_Click
                     Me.Enabled = True
                    Else
                      MsgBox "没有“医疗机构”的权限！", vbCritical + vbOKOnly, App.title
                    End If
                 Case "筹资比例"
                    If frmMain.mnuListReceiveStandard.Enabled Then
                       Me.Enabled = False
                       frmMain.mnuListReceiveStandard_Click
                       Me.Enabled = True
                    Else
                      MsgBox "没有“筹资比例”的权限！", vbCritical + vbOKOnly, App.title
                    End If
                Case "起付标准"
                    If frmMain.mnuListPaymentStandard.Enabled Then
                       Me.Enabled = False
                       frmMain.mnuListPaymentStandard_Click
                       Me.Enabled = True
                    Else
                      MsgBox "没有“起付标准”的权限！", vbCritical + vbOKOnly, App.title
                    End If
                Case "利率设置"
                    If frmMain.mnuListRateSet.Enabled Then
                       Me.Enabled = False