apiouttest.frm

金算盘软件代码

VERSION 5.00
Object = "{EAB22AC0-30C1-11CF-A7EB-0000C05BAE0B}#1.1#0"; "SHDOCVW.DLL"
Begin VB.Form frmNavigate 
   AutoRedraw      =   -1  'True
   BorderStyle     =   1  'Fixed Single
   Caption         =   "业务流程"
   ClientHeight    =   4890
   ClientLeft      =   1890
   ClientTop       =   2295
   ClientWidth     =   7140
   HelpContextID   =   10009
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   MinButton       =   0   'False
   ScaleHeight     =   4890
   ScaleWidth      =   7140
   Begin SHDocVwCtl.WebBrowser WebMain 
      Height          =   6735
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   10515
      ExtentX         =   18547
      ExtentY         =   11880
      ViewMode        =   1
      Offline         =   0
      Silent          =   0
      RegisterAsBrowser=   0
      RegisterAsDropTarget=   1
      AutoArrange     =   -1  'True
      NoClientEdge    =   0   'False
      AlignLeft       =   0   'False
      ViewID          =   "{0057D0E0-3573-11CF-AE69-08002B2E1262}"
      Location        =   ""
   End
End
Attribute VB_Name = "frmNavigate"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
''流程图
Option Explicit
'电子表格的引用声明
Private Enum HKEY
    HKEY_CLASSES_ROOT = &H80000000
    HKEY_CURRENT_USER = &H80000001
    HKEY_LOCAL_MACHINE = &H80000002
    HKEY_USERS = &H80000003
    HKEY_PERFORMANCE_DATA = &H80000004
    HKEY_CURRENT_CONFIG = &H80000005
    HKEY_DYN_DATA = &H80000006
End Enum
Private Const READ_CONTROL = &H20000
Private Const KEY_QUERY_VALUE = &H1
Private Const KEY_SET_VALUE = &H2
Private Const KEY_CREATE_SUB_KEY = &H4
Private Const KEY_ENUMERATE_SUB_KEYS = &H8
Private Const KEY_NOTIFY = &H10
Private Const KEY_CREATE_LINK = &H20
Private Const KEY_READ = KEY_QUERY_VALUE + KEY_ENUMERATE_SUB_KEYS + KEY_NOTIFY + READ_CONTROL
Private Const KEY_WRITE = KEY_SET_VALUE + KEY_CREATE_SUB_KEY + READ_CONTROL
Private Const KEY_EXECUTE = KEY_READ
Private Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL

Private Type SECURITY_ATTRIBUTES
    nLength As Long
    lpSecurityDescriptor As Long
    bInheritHandle As Boolean
End Type

Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type
Private Declare Function RegCloseKey Lib "advapi32" (ByVal HKEY As Long) As Long
Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal HKEY As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, ByRef phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal HKEY As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByVal lpData As String, ByRef lpcbData As Long) As Long
'Private Declare Function RegCreateKeyEx Lib "advapi32" Alias "RegCreateKeyExA" (ByVal HKEY As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, ByRef lpSecurityAttributes As SECURITY_ATTRIBUTES, ByRef phkResult As Long, ByRef lpdwDisposition As Long) As Long
'Private Declare Function RegDeleteKey Lib "advapi32" Alias "RegDeleteKeyA" (ByVal HKEY As Long, ByVal lpSubKey As String) As Long
'Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal HKEY As Long, ByVal lpValueName As String) As Long
'Private Declare Function RegSetValueEx Lib "advapi32" Alias "RegSetValueExA" (ByVal HKEY As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long
'Private Declare Function RegQueryInfoKey Lib "advapi32.dll" Alias "RegQueryInfoKeyA" (ByVal HKEY As Long, ByVal lpClass As String, lpcbClass As Long, lpReserved As Long, lpcSubKeys As Long, lpcbMaxSubKeyLen As Long, lpcbMaxClassLen As Long, lpcValues As Long, lpcbMaxValueNameLen As Long, lpcbMaxValueLen As Long, lpcbSecurityDescriptor As Long, lpftLastWriteTime As FILETIME) As Long
'Private Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal HKEY As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long
'Private Declare Function RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" (ByVal HKEY As Long, ByVal dwIndex As Long, ByVal lpName As String, lpcbName As Long, lpReserved As Long, ByVal lpClass As String, lpcbClass As Long, lpftLastWriteTime As FILETIME) As Long
'Private Declare Function RegSaveKey Lib "advapi32.dll" Alias "RegSaveKeyA" (ByVal HKEY As Long, ByVal lpFile As String, lpSecurityAttributes As Any) As Long
'取数函数
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private mstrURL As String       '期末结帐
Private mstrURLHome As String   '当前主URL
Private x1 As BaseFunction
Public lngStyle As Long         '风格号
'取得INI文件中的字符串（节名，关键字，默认值，返回字符串，返回字符串长度，文件名）
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 WithEvents mclsMainControl As MainControl               '主控对象
Attribute mclsMainControl.VB_VarHelpID = -1
Private Sub Form_Activate()
'    mclsMainControl_ChildActive
End Sub

Private Sub Form_Load()
    Dim strNagivateName As String
    Dim strBuffer As String * 128
    Dim strURL As String
    Dim ret As Long
    Dim LngAccountType As Long
    On Error GoTo ErrHandle
    '初始化取数函数
    Set x1 = New BaseFunction
    ret = GetWindowsDirectory(strBuffer, 128)
'取得INI文件中帐套类型。
    LngAccountType = GetNagivateInit
    If lngStyle = 1 Then
        If LngAccountType <> 0 Then
            strNagivateName = "mk:@MSITStore:" & Left(strBuffer, ret) & "\HELP\" & "GaMenu.chm" & "::/Index" & LngAccountType & ".htm"
        Else
            strNagivateName = "mk:@MSITStore:" & Left(strBuffer, ret) & "\HELP\" & "GaMenu.chm" & "::/Index1.htm"
        End If
        If Dir(Left(strBuffer, ret) & "\HELP\" & "GaMenu.chm") = "" Then strNagivateName = ""
    Else
        If LngAccountType <> 0 Then
            strNagivateName = "mk:@MSITStore:" & Left(strBuffer, ret) & "\HELP\" & "GaOraMenu.chm" & "::/Index" & LngAccountType & ".htm"
        Else
            strNagivateName = "mk:@MSITStore:" & Left(strBuffer, ret) & "\HELP\" & "GaOraMenu.chm" & "::/Index1.htm"
        End If
        If Dir(Left(strBuffer, ret) & "\HELP\" & "GaOraMenu.chm") = "" Then strNagivateName = ""
    End If
    If strNagivateName = "" Then GoTo ErrHandle
    WebMain.Navigate strNagivateName
    mstrURLHome = strNagivateName
    frmMain.mnuWindowDiagram.Checked = True
  
    Set mclsMainControl = gclsSys.MainControls.Add(Me)
    Exit Sub
ErrHandle:
    ShowMsg Me.hwnd, "流程图功能无效！", vbCritical + vbOKOnly, App.title
    Unload Me
End Sub

'取得帐套类型。1：标准增强版 2：标准版 3：财务版（控制科目） 4：迷你版（财务版非控制科目）
Public Function GetNagivateInit() As Long
    Dim strTempName 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
    GetNagivateInit = 0
    strByteName = "金算盘软件"
    strWinSysPath = Space(255)
    lngSize = Len(strWinSysPath)
    strWinSysPath = App.Path
    '考虑在根目录下的情况
    If Right(strWinSysPath, 1) = "\" Then strWinSysPath = Left(strWinSysPath, Len(strWinSysPath) - 1)
    If Dir(strWinSysPath & "\Account.ini") <> "" Then
        strDefault = "aaa"
        strTempName = Space(255)
        lngSize = Len(strTempName)
        strByteKey = "AccountHtml"
        strININame = strWinSysPath & "\Account.ini"
        
        '取得INI文件中的字符串（节名，关键字，默认值，返回字符串，返回字符串长度，文件名）
        '取得INI文件中帐套类型。1：标准增强版 2：标准版 3：财务版（控制科目） 4：迷你版（财务版非控制科目）
        lngTmp = GetPrivateProfileString(strByteName, strByteKey, strDefault, strTempName, lngSize, strININame)
        strTempName = Left(strTempName, lngTmp)
        If lngTmp = 1 And IsNumeric(strTempName) Then
            If CInt(strTempName) >= 1 And CInt(strTempName) <= 4 Then
                GetNagivateInit = CInt(strTempName)
            End If
        End If
    End If
    If GetNagivateInit <> 10 Then       '标准版
        '未取得INI文件中帐套类型时处理
        #If conVersionType = 1 Then     '标准增强版
            GetNagivateInit = 1
        #Else                           '财务版
            #If conHos = 1 Then         '医疗专版
                GetNagivateInit = 8
            #Else
                If gclsBase.AccountSys = 1 Then
                    '企业单位
                    If gclsBase.ControlAccount Or Not gclsBase.BaseNoControl Then
                        GetNagivateInit = 2
                    Else
                        GetNagivateInit = 21
                    End If
                ElseIf gclsBase.AccountSys = 4 Then
                    '医疗单位
                    If gclsBase.ControlAccount Or Not gclsBase.BaseNoControl Then
                        GetNagivateInit = 3
                    Else
                        GetNagivateInit = 31
                    End If
                ElseIf gclsBase.AccountSys = 3 Or gclsBase.AccountSys = 5 Then
                    '行政单位
                    If gclsBase.ControlAccount Or Not gclsBase.BaseNoControl Then
                        GetNagivateInit = 4
                    Else
                        GetNagivateInit = 41
                    End If
                ElseIf gclsBase.AccountSys = 2 Then
                    '事业单位
                    If gclsBase.ControlAccount Or Not gclsBase.BaseNoControl Then
                        GetNagivateInit = 9
                    Else
                        GetNagivateInit = 91
                    End If
                End If
            #End If
        #End If
        If GetNagivateInit = 0 Then GetNagivateInit = 1
    End If
End Function

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    If mstrURL = "期末结帐" Then frmMain.mnuAccountFinish_Click
    mstrURL = ""
    Me.Enabled = True
End Sub
Public Sub RefreshWeb()
    WebMain.Navigate mstrURLHome
End Sub
Private Sub Form_Resize()
    Dim x As Single, y As Single
    On Error Resume Next
    x = Me.width - Me.ScaleWidth
    y = Me.Height - Me.ScaleHeight
    '386--高度象数点，600--宽度象数点。
    If lngStyle = 1 Then
        Me.Height = 386 * Screen.TwipsPerPixelY + y
        Me.width = 600 * Screen.TwipsPerPixelX + x
    Else
        Me.Height = 430 * Screen.TwipsPerPixelY + y
        Me.width = 630 * Screen.TwipsPerPixelX + x
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
   On Error Resume Next
   Set x1 = Nothing
   gclsSys.MainControls.Remove Me
   
    frmMain.mnuWindowDiagram.Checked = False
   
   lngStyle = 0
   If gclsSys.MainControls.Count = 0 And Not gclsBase.BaseDB Is Nothing Then
      frmMain.tlbMain.Visible = True
   End If
End Sub
Private Sub mclsMainControl_ChildActive()
   SetHelpID 10009  '帮助ID
   gclsSys.CurrFormName = Me.hwnd
End Sub

Public Function REGGetSetting(Optional blnIsReportTatol As Boolean = False) As String

    Dim strKeyPath       As String
    Dim vntValueData     As Variant
    Dim lngRetVal        As Long
    Dim lngCnt           As Long
    Dim hlngKey          As Long
    Dim lngValueDataType As Long
    Dim strValueData     As String
    Dim lngValueDataLen  As Long
    Dim strCustomerName As String
    #If conWan = 1 Then
        strCustomerName = "Winner"
    #Else