?? hcconst.bas
字號:
'CuiDong Efficiency-A 2000/06/19 效率優化A OK
Dim rsl As New UfRecordset
If UnitName = "" Then
IsUnitNameExist = False
Exit Function
End If
' Set rsl = dbsZJ.OpenRecordset("FD_AccUnit", dbOpenDynaset) 'CuiDong Efficiency-A 2000/06/19 效率優化A
Set rsl = dbsZJ.OpenRecordset("Select cUnitName From FD_AccUnit Where cUnitName = '" & UnitName & "'", dbOpenDynaset) 'CuiDong Efficiency-A 2000/06/19 效率優化A
' rsl.FindFirst "cUnitName = '" & UnitName & "'" 'CuiDong Efficiency-A 2000/06/19 效率優化A
' If rsl.NoMatch Then 'CuiDong Efficiency-A 2000/06/19 效率優化A
If rsl.EOF Or rsl.BOF Then 'CuiDong Efficiency-A 2000/06/19 效率優化A
IsUnitNameExist = False
Exit Function
End If
IsUnitNameExist = True
Set rsl = Nothing
End Function
'求存款日期
Public Function SaveBillDay(AccCode As String) As Date
'CuiDong Efficiency-A 2000/06/19 效率優化A OK
Dim rsSav As New UfRecordset
' Set rsSav = dbsZJ.OpenRecordset("FD_Sav", dbOpenDynaset) 'CuiDong Efficiency-A 2000/06/19 效率優化A
Set rsSav = dbsZJ.OpenRecordset("Select dbill_date From FD_Sav Where cAccID = '" & AccCode & "'", dbOpenDynaset) 'CuiDong Efficiency-A 2000/06/19 效率優化A
With rsSav
' .FindFirst "cAccID = '" & AccCode & "'" 'CuiDong Efficiency-A 2000/06/19 效率優化A
' If Not .NoMatch Then 'CuiDong Efficiency-A 2000/06/19 效率優化A
If Not (.EOF Or .BOF) Then 'CuiDong Efficiency-A 2000/06/19 效率優化A
SaveBillDay = !dbill_date
End If
End With
CloseRS rsSav
End Function
'金額格式化
Public Function MoneyFormat(money As Variant) As String
If money = "" Then
MoneyFormat = ""
Exit Function
End If
MoneyFormat = Format(money, "##,###,###,##0.00")
End Function
Public Function BillNameToCode(BillName As String) As String
'CuiDong Efficiency-A 2000/06/19 效率優化A OK
Dim rsClass As New UfRecordset
' Set rsClass = dbsZJ.OpenRecordset("FD_Class", dbOpenDynaset) 'CuiDong Efficiency-A 2000/06/19 效率優化A
Set rsClass = dbsZJ.OpenRecordset("Select cSign From FD_Class Where cText = '" & BillName & "'", dbOpenDynaset) 'CuiDong Efficiency-A 2000/06/19 效率優化A
With rsClass
' .FindFirst "cText = '" & BillName & "'" 'CuiDong Efficiency-A 2000/06/19 效率優化A
' If .NoMatch Then 'CuiDong Efficiency-A 2000/06/19 效率優化A
If .EOF Or .BOF Then 'CuiDong Efficiency-A 2000/06/19 效率優化A
BillNameToCode = ""
Exit Function
End If
BillNameToCode = !cSign
End With
Set rsClass = Nothing
End Function
Public Function BillTxtToNumBh(TxtBh As String) As String
If TxtBh <> "" Then
BillTxtToNumBh = BillNameToCode(left(TxtBh, InStr(1, TxtBh, "-") - 1)) & right(TxtBh, 8)
End If
End Function
'獲取利息單最大號
Public Function GetLXDMaxBh()
Dim rsTemp As New UfRecordset
Set rsTemp = dbsZJ.OpenRecordset("Select Max(cCarID) As MaxID From FD_CadAcr", dbOpenSnapshot)
With rsTemp
If .EOF Then
GetLXDMaxBh = "00000000"
Else
If Not IsNull(!MaxID) Then
GetLXDMaxBh = right(!MaxID, 8)
Else
GetLXDMaxBh = "00000000"
End If
End If
End With
rsTemp.oClose
End Function
'重新注冊
Public Sub ReLogin()
Dim i As Integer, oldzth As String
On Error GoTo errLogExit
If Forms.count > 3 Then
If Forms.count = 4 Then
For i = 0 To Forms.count - 1
If Forms(i).Caption = "RightMenu" Then GoTo Continue
Next i
End If
MsgBox "請先退出所有任務后,再重新注冊!", vbInformation, zjGl_Name
Exit Sub
End If
oldzth = zjLogInfo.cAcc_Id
Continue:
i = 0
If zjLogInfo.Login("FD") Then
If zjLogInfo.curDate > Date Then
If zjLogInfo.LogState = 100 Then
GoTo errLogExit
Else
'V8.50 章景峰
g_sDataSourceName = zjLogInfo.UfDbName
g_sMenuDSN = mID(zjLogInfo.UfDbName, 1, InStrRev(zjLogInfo.UfDbName, "=")) & "UFSystem"
'MsgBox "登錄時間不能大于本計算機時間！", vbCritical, zjGl_Name 'cuidong 2001.12.06
If MsgBox("登錄日期（" & Format(zjLogInfo.curDate, "YYYY-MM-DD") & "）在系統日期（" & Format(Date, "YYYY-MM-DD") & "）之后，繼續運行嗎？", vbInformation + vbYesNo + vbDefaultButton1, zjGl_Name) = vbNo Then 'cuidong 2001.12.06
i = i + 1
If i > 1 Then
GoTo errLogExit
Else
GoTo Continue
End If
End If
End If
End If
If zjLogInfo.LogState = 100 Then
zjLogInfo.ClearError
Exit Sub
End If
dbsZJ.oClose
Set dbsZJ = Nothing
dbsZJ.OpenDatabase zjLogInfo.UfDbName, False, False, ";PWD=" & zjLogInfo.SysPassword
'判斷啟用日期
If Pd_qyrqsz() <> 1 Then GoTo errLogExit
Screen.MousePointer = vbHourglass
'--- From 810 To 811
UpgradeTo811
Set aClsPub = New clsPub
aClsPub.InitPubs2 "FD", zjLogInfo.UfSystemDb, dbsZJ, zjLogInfo.cAcc_Id, zjLogInfo.cIYear, zjLogInfo.cUserId, zjLogInfo.curDate, zjLogInfo.SysPassword
Set mDbTemp = aClsPub.DataMdbTemp
'導入科目級次
LoadKmGrade
'----zcl change start 2001-02-16
Dim vDemo As Variant
zjLogInfo.GetAccInfo 10000, vDemo
g_bIsDemo = Not CBool(vDemo)
If g_bIsDemo Then
frmMain.Caption = "資金管理(演示/教學版)"
End If
'----zcl change end
With frmMain.stbInfo
.Panels(2).Text = "操作員:" & zjLogInfo.cUserName & IIf(zjLogInfo.IsAdmin, "(賬套主管)", "")
.Panels(3).Text = "業務日期:" & Format(zjLogInfo.curDate, "yyyy-mm-dd")
.Panels(1).Text = "賬套:[" & zjLogInfo.cAcc_Id & "]" & zjLogInfo.cAccName
.Panels(1).width = frmMain.width - .Panels(2).width - .Panels(3).width - .Panels(4).width
End With
Auth_Right
If oldzth <> zjLogInfo.cAcc_Id Then
With zjNotecom
.DBName = zjLogInfo.UfSystemDb.Name
.UseTName = "UA_User"
.NoteShow zjLogInfo.cUserName, Format(zjLogInfo.curDate, "yyyy-mm-dd")
End With
IsAutoAlarm
End If
Screen.MousePointer = vbDefault
End If
Set oV.connDB = dbsZJ.DbConnect
Set oUniFind.UfDatabase = dbsZJ
Exit Sub
errLogExit:
ShowLogErrMsg
Unload frmMain
End Sub
'注冊時錯誤處理
Public Sub ShowLogErrMsg()
On Error Resume Next
With zjLogInfo
If .LogState <> 0 And .LogState <> 100 Then
Beep
MsgBox GetLoginErrStr(.LogState), vbCritical, zjGl_Name
End If
.ClearError
End With
On Error GoTo 0
End Sub
Public Function GetLoginErrStr(ByVal nErrNo As Integer) As String
GetLoginErrStr = zjLogInfo.ShareString
' Select Case nErrNo
' Case 1
' GetLoginErrStr = "缺少參數(1)。"
' Case 2
' GetLoginErrStr = "未用(2)。"
' Case 3
' GetLoginErrStr = "已經有賬套獨占任務運行(3)。"
' Case 4
' GetLoginErrStr = "已經有年度獨占任務運行(4)。"
' Case 5
' GetLoginErrStr = "服務對象已經卸載(5)。"
' Case 6
' GetLoginErrStr = "打不開系統數據庫(6)。"
' Case 7
' GetLoginErrStr = "環境錯誤，可能是服務端程序的DCOM配置不正常，或網絡不正常等因素(7)。"
' Case 8
' GetLoginErrStr = "子系統未安裝(8)。"
' Case 9
' GetLoginErrStr = "未用(9)。"
' Case 10
' GetLoginErrStr = "未檢測到加密盒" & Chr(13) & "或此子系統登錄數超過加密盒額定最大操作員數(10)。"
' Case 11
' GetLoginErrStr = "未用(11)。"
' Case 12
' GetLoginErrStr = "共享路徑無效(12)。"
' Case 13
' GetLoginErrStr = "不能共享路徑(13)。"
' Case 14
' GetLoginErrStr = "必須設置共享方式為〖共享級訪問控制〗(14)。"
' Case 15
' GetLoginErrStr = "未知的共享錯誤(15)。"
' Case 16
' GetLoginErrStr = "打不開年度數據庫(16)。"
' Case 17
' GetLoginErrStr = "年度數據庫不是當前賬套的數據庫(17)。"
' Case 18
' GetLoginErrStr = "任務對象中年度和賬套號無效(18)。"
' Case 19
' GetLoginErrStr = "打開賬套錯誤(19)。"
' Case 20
' GetLoginErrStr = "用戶沒有當前子系統的權限(20)。"
' Case 21
' GetLoginErrStr = "本年已經有其他互斥任務運行(21)。"
' Case 22
' GetLoginErrStr = "無此任務號，不能釋放任務(22)。"
' Case 23
' GetLoginErrStr = "任務對象不合法，TaskId為空(23)。"
' Case 100
' GetLoginErrStr = "登錄過程被取消(100)。"
' Case 101
' GetLoginErrStr = "沒有賬套或年度〖賬套/年度沒有創建或被輸出〗(101)。"
' Case 102
' GetLoginErrStr = "當前子系統當前賬套當前年度沒有任何用戶(102)。"
' Case 103
' GetLoginErrStr = "口令不對(103)。"
' Case 104
' GetLoginErrStr = "未用(104)。"
' Case 105
' GetLoginErrStr = "重新注冊時，子系統號不一致(105)。"
' Case 106
' GetLoginErrStr = "未用(106)。"
' Case 107
' GetLoginErrStr = "不能執行系統管理或跟系統管理連接。可能是:" & Chr(13) & " 1.[UFAdmin.EXE]沒有正確安裝。" & Chr(13) & " 2.[UFAdmin.EXE]沒有正確注冊。" & Chr(13) & " 3.[UFAdmin.EXE]被移動位置。" & Chr(13) & " 4.[UFSystem.MDB]被損壞。" & Chr(13) & " 5.如果是網絡應用，也可能是網絡連接不正常。" & Chr(13) & " 6.如果是網絡應用，服務端應用超級用戶組的用戶登錄." & Chr(13) & " 7.服務端有關配置被破壞。" & Chr(13) & "請檢查上述情況，確認后再登錄(107)。"
' Case 108
' GetLoginErrStr = "未用(108)。"
' Case 109
' GetLoginErrStr = "沒有設置當前程序的ProcessId或者程序意外終止(109)。"
' Case 200
' GetLoginErrStr = "演示數據已經過期(200)。"
' Case Else
' GetLoginErrStr = "不明錯誤(" & nErrNo & ")。"
' End Select
End Function
'科目及輔助項參照
Public Sub ShowAssRef(AssType As RefType, ParaRet As String, RetMode As SwitchMode, Optional xmdl As String)
On Error GoTo errHandle
Select Case AssType
Case iKm
Dim objSubRef As New KmRef.clsKmRef
Dim tempView As New clsViewAbout
Set objSubRef.NewZwPub = aClsPub
Set objSubRef.NewLogIn = zjLogInfo
objSubRef.RefDirect
tempView.Viewpara1 = aClsPub.ViewVar.Viewpara1
objSubRef.DRSetAttrib tempView
objSubRef.DRReference
objSubRef.DRGetAttrib tempView
Set aClsPub.ViewVar = tempView
If tempView.Isreturn Then
If RetMode = AS_CODE Then
ParaRet = tempView.Viewreturn1
Else
ParaRet = tempView.Viewreturn2
End If
End If
Set objSubRef = Nothing
Set tempView = Nothing
Case iItem
Dim objxmRef As New ItemRef.clsXmRef
Dim tempView1 As New clsViewAbout
tempView1.Viewpara1 = xmdl
tempView1.Viewpara2 = ParaRet
Set objxmRef.ObjLogin = zjLogInfo
Set objxmRef.MyZwPub = aClsPub
objxmRef.DRSetAttrib tempView1
objxmRef.DRReference
objxmRef.DRGetAttrib tempView1
If tempView1.Isreturn Then
If RetMode = AS_CODE Then
ParaRet = tempView1.Viewreturn1
Else
ParaRet = tempView1.Viewreturn2
End If
End If
Set objxmRef = Nothing
Set tempView1 = Nothing
Case Else
Dim vParaA As Variant
Dim objRefAll As New ClsRefer
objRefAll.DRSetAttrib 0, dbsZJ
objRefAll.DRSetAttrib 1, AssType
objRefAll.DRSetAttrib 2, ParaRet
objRefAll.DRSetAttrib 3, True
If objRefAll.DRReference = True Then
If AssType = iPerson Or AssType = iDepart Then
If RetMode = AS_CODE Then
objRefAll.DRGetAttrib 1, vParaA
Else
objRefAll.DRGetAttrib 2, vParaA
End If
ElseIf AssType = iCustomer Or AssType = iVendor Then
If RetMode = AS_CODE Then
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -