Attribute VB_Name = "MdlFunction"
Option Explicit

Public gMakeCDExe As String '刻盤(pán)程序路徑
Public Const XTTS = "系統(tǒng)提示" '提示信息
Public Const gRegSubKey = "SOFTWARE\方正奧德計(jì)算機(jī)系統(tǒng)有限公司\文件管理" '注冊(cè)表子鍵
Public gErrDescription As String '錯(cuò)誤描述
Public Const LXGLY = "請(qǐng)立即與管理員聯(lián)系！" '提示信息

'####################################################################
'系統(tǒng)主函數(shù)
'####################################################################
Public Sub Main()
On Error GoTo Err

If App.PrevInstance Then
   MsgBox "刻盤(pán)程序正在運(yùn)行。不能多次啟動(dòng)！", vbOKOnly Or vbInformation, XTTS
   End
End If

If LoadReg = False Then
   If CreateReg = False Then GoTo Err
End If
If LoadReg = False Then GoTo Err

FrmCreateCD.Show

Exit Sub
Err:
   MsgErr "系統(tǒng)初始化", "1001", gErrDescription, True, LXGLY, Err.Description
   End
End Sub

'####################################################################
'系統(tǒng)初始化讀注冊(cè)表函數(shù)，返回值Boolean
'####################################################################
Public Function LoadReg() As Boolean
On Error GoTo Err
Dim t As String

If RegGetString(HKEY_LOCAL_MACHINE, gRegSubKey + "\OPTION", "MakeCDExe", gMakeCDExe) = False Then
   gMakeCDExe = "c:\smartstor archive\runfsapi.exe"
End If

LoadReg = True
Exit Function
Err:
   LoadReg = False
End Function

'####################################################################
'系統(tǒng)初始化創(chuàng)建注冊(cè)表函數(shù)，返回值Boolean
'####################################################################
Public Function CreateReg() As Boolean
On Error GoTo Err

If RegSetString(HKEY_LOCAL_MACHINE, gRegSubKey + "\OPTION", "MakeCDExe", "c:\smartstor archive\runfsapi.exe") = False Then GoTo Err
CreateReg = True
Exit Function
Err:
   CreateReg = False
End Function

'####################################################################
'系統(tǒng)報(bào)錯(cuò)函數(shù)，返回值Boolean
'####################################################################
Public Sub MsgErr(ErrSource As String, ErrCode As String, ErrDes As String, ViewMsgBox As Boolean, PromptStr As String, SysErr As String)
On Error GoTo Err
If ViewMsgBox = True Then
   If PromptStr = "" Then
      MsgBox "錯(cuò)誤來(lái)源：" + ErrSource + Chr(10) + "錯(cuò)誤代碼：" + ErrCode + Chr(10) + "錯(cuò)誤描述：" + ErrDes + Chr(10) + "系統(tǒng)描述：" + Err.Description, vbExclamation, "系統(tǒng)錯(cuò)誤"
   Else
      MsgBox "錯(cuò)誤來(lái)源：" + ErrSource + Chr(10) + "錯(cuò)誤代碼：" + ErrCode + Chr(10) + "錯(cuò)誤描述：" + ErrDes + Chr(10) + "系統(tǒng)描述：" + Err.Description + Chr(13) + Chr(13) + PromptStr, vbExclamation, "系統(tǒng)錯(cuò)誤"
   End If
End If
'寫(xiě)日志
Close #1
Open App.Path + "\ErrorLog.txt" For Append As #1
   Print #1, "錯(cuò)誤時(shí)間：" + Format(Date, "yyyy-mm-dd") + " " + Format(Time, "hh:mm:ss")
   Print #1, "錯(cuò)誤來(lái)源：" + ErrSource + " 錯(cuò)誤描述：" + ErrDes
   Print #1, "錯(cuò)誤代碼：" + ErrCode + " 系統(tǒng)描述：" + SysErr
   Print #1, ""
Close #1
Err:
End Sub


' "Software\方正奧德計(jì)算機(jī)系統(tǒng)有限公司\SystemManage\"
Public Function GetRegVal(SubKey As String, RtnString As String) As Boolean
On Error GoTo Err
Dim Reg_Size As Long
Dim Reg_buffer As String
Dim Reg_Result As Long
Reg_buffer = String$(1024, 0)
Reg_Size = 1024
Reg_Result = RegQueryValue(HKEY_LOCAL_MACHINE, SubKey, Reg_buffer, Reg_Size)
If Reg_Result <> 0 And Reg_Result <> 13 Then GoTo Err
If InStr(1, Reg_buffer, ";") <= 1 Then
   RtnString = Left(Trim(Reg_buffer), Reg_Size - 1)
Else
   RtnString = Left(Trim(Reg_buffer), InStr(1, Reg_buffer, ";") - 1)
End If
GetRegVal = True
Exit Function
Err:
   GetRegVal = False
End Function

'#####################################################################################
'獲取系統(tǒng)路徑
'#####################################################################################
Public Function GetSysPath() As String
On Error GoTo ErrHandle
Dim lngResult As Long
Dim lpBuffer$
Dim StrGetWin As String
lpBuffer = Space$(2048)
lngResult = GetWindowsDirectory(lpBuffer, Len(lpBuffer))
StrGetWin = Left(Trim(lpBuffer), Len(Trim(lpBuffer)) - 1)
GetSysPath = StrGetWin
Exit Function
ErrHandle:
   MsgBox "系統(tǒng)錯(cuò)誤" + Chr(10) + "錯(cuò)誤描述：" + Err.Description
End Function

'#####################################################################################
'獲取IE路徑
'#####################################################################################
Public Function GetIEPath(r_IE_Path As String) As Boolean
On Error GoTo Err
r_IE_Path = ""

If RegGetString(HKEY_LOCAL_MACHINE, "Software\Microsoft\IE4\Setup", "Path", r_IE_Path) = False Then GoTo Err
r_IE_Path = Replace(r_IE_Path, "%programfiles%", "c:\program files")
If Dir(r_IE_Path + "\Iexplore.exe") = "" Then GoTo Err
r_IE_Path = r_IE_Path + "\Iexplore.exe"
GetIEPath = True
Exit Function
Err:
   r_IE_Path = ""
   GetIEPath = False
End Function