pub_memo.bas

学生信息管理系统(VB+sql)+毕业论文2万字 (338 回复) 排课管理系统vb (278 回复) 求vb+acess做的超市销售管理...毕业设计(酒店管理系统+报告(分析==)) (306 回

   t_m = Pub_wx_nb(t_rec, "WX", new_lx)
   Pub_kftj = t_m
'
Case "C1500"  '&&& 办公房建立+1/解除-1
   t_m = Pub_wx_nb(t_rec, "NB", new_lx)
   Pub_kftj = t_m
'
Case "B0400", "B0410" '&&& 不同类型换房 &  长包房换房"
   If kftj_cbf = LoadResString(SYS_CBLX) Then
      kf_cb = True
   Else
      kf_cb = False
   End If
   t_m = Pub_hf(t_rec, new_s_day, new_e_day, new_lx, old_s_day, old_e_day, old_lx, kf_cb)
   Pub_kftj = t_m
'
Case "G0400"  '&&& 前厅离店客帐结算 & 长包房结算
   If kftj_cbf = LoadResString(SYS_CBLX) Then
      kf_cb = True
   Else
      kf_cb = False
   End If
   t_m = Pub_ld(t_rec, new_s_day, old_e_day, new_lx, kf_cb)
   Pub_kftj = t_m
'
Case "B0200", "B0220", "B0150" '&&& 前厅修改客房类数, 日期或同住登记
   If kftj_cbf = LoadResString(SYS_CBLX) Then
      t_m = True
   Else
      If old_e_day > new_e_day Then  '&& 提前离店
         t_m = Pub_xg(t_rec, new_e_day + 1, old_e_day, new_lx, "0")
      Else                      '&& 滞后离店
         t_m = Pub_xg(t_rec, old_e_day + 1, new_e_day, new_lx, "1")
      End If
   End If
   Pub_kftj = t_m
'
Case Else
   MsgBox "无法识别的功能调用 !"
   t_m = False
   Pub_kftj = t_m
End Select
If e Then
   LOCK_REC.Edit
     LOCK_REC!CZY = "***"
   LOCK_REC.Update
End If
End Function
'
Private Function Pub_wx_nb(t_rec As Recordset, T_NAME As String, t_arra_lx As Variant) As Boolean
'**  完成维修,办公,长包用房管理
'** 涉及到 房源,剩余和(办公/维修/长包)
Dim KFTJ_I As Integer
Dim T_FN As String, T_SY As String, T_FY As String, T_LXX As Integer
't_rec.FindFirst "cstr(rq)='" & CStr(Date) & "'"
'If t_rec.NoMatch Then
'    pub_wx_nb = False
'    Exit Function
'End If
If InStr(1, "WX,NB,CB", T_NAME) = 0 Then
   Pub_wx_nb = False
   Exit Function
End If

Dim FIEL_STR As String
FIEL_STR = ""
For KFTJ_I = 1 To SYS_LXN
   T_FN = T_NAME + "_LX" + CStr(KFTJ_I)
   T_SY = "SY_LX" + CStr(KFTJ_I)
   T_FY = "FY_LX" + CStr(KFTJ_I)
   T_LXX = t_arra_lx(KFTJ_I)
   FIEL_STR = FIEL_STR & T_FN & "=" & T_FN & "+(" & T_LXX & "),"
   FIEL_STR = FIEL_STR & T_SY & "=" & T_SY & "-(" & T_LXX & "),"
   If InStr(1, "WX,CB", T_NAME) = 0 Then
       FIEL_STR = FIEL_STR & T_FY & "=" & T_FY & "-(" & T_LXX & "),"
   End If
Next
FIEL_STR = Left(FIEL_STR, Len(FIEL_STR) - 1)
PUB_data.Execute "UPDATE KF_KFLY SET " & FIEL_STR & " WHERE  CSTR(RQ)>'" & CStr(Date - 1) & "'"
Pub_wx_nb = True
End Function
Private Function Pub_hf(t_rec As Recordset, new_s_day, new_e_day, n_arra_lx, old_s_day, old_e_day, o_arra_lx, kf_cb) As Boolean
'external array n_arra_lx,o_arra_lx
'*  完成换房登记
'*NEW_S_DAY  新房入住日期  (当天日期)
'*NEW_E_DAY  新房离店日期  (原离店日期)
'*N_ARRA_LX  新房的类型 N_ARRA_LX(新类型)=1
'*OLD_S_DAY  换房日期 (当天日期)
'*OLD_E_DAY  原离店日期
'*O_ARRA_LX  原房的类型 O_ARRA_LX(原类型)=1
'*PUB_CODE
Dim T_S_DAY As Date, T_SY As String, T_CB As String, T_ZR As String, KFTJ_I As Integer, T_LXX As Integer
't_rec.FindFirst "cstr(rq)='" & CStr(new_s_day) & "'"
'If t_rec.NoMatch Then
'    pub_hf = False
'    Exit Function
'End If
T_S_DAY = new_s_day
'Do While T_S_DAY < new_e_day + 1
   Dim FIEL_STR As String
   FIEL_STR = ""
   For KFTJ_I = 1 To SYS_LXN
      T_SY = "SY_LX" + CStr(KFTJ_I)
      T_CB = "CB_LX" + CStr(KFTJ_I)
      T_ZR = "ZR_LX" + CStr(KFTJ_I)
      If n_arra_lx(KFTJ_I) <> 0 Then
         T_LXX = n_arra_lx(KFTJ_I)
'         t_rec.Edit
'         t_rec.Fields(T_SY) = t_rec.Fields(T_SY) - T_LXX
         FIEL_STR = FIEL_STR & T_SY & "=" & T_SY & "-(" & T_LXX & "),"
         If kf_cb Then
'            t_rec.Fields(T_CB) = t_rec.Fields(T_CB) + T_LXX
            FIEL_STR = FIEL_STR & T_CB & "=" & T_CB & "+(" & T_LXX & "),"
         Else
'            t_rec.Fields(T_ZR) = t_rec.Fields(T_ZR) + T_LXX
            FIEL_STR = FIEL_STR & T_ZR & "=" & T_ZR & "+(" & T_LXX & "),"
         End If
'         t_rec.Update
      End If
   Next
'   T_S_DAY = T_S_DAY + 1
'   t_rec.MoveNext
'Loop
FIEL_STR = Left(FIEL_STR, Len(FIEL_STR) - 1)
PUB_data.Execute "UPDATE KF_KFLY SET " & FIEL_STR & " WHERE  CSTR(RQ)>'" & CStr(T_S_DAY - 1) & "' AND CSTR(RQ)<'" & CStr(new_e_day + 1) & "'" 'T_S_DAY < new_e_day + 1
Pub_hf = True
End Function

Private Function Pub_rz(t_rec As Recordset, new_s_day, new_e_day, new_lx, old_s_day, old_e_day, old_lx, kf_cb, kftj_code) As Boolean
'external array new_lx,old_lx
'*  完成入住登记
'* 0 无预订 1 有预订
'*
Dim T_S_DAY As Date, t_thzt As Integer, KFTJ_I As Integer
Dim T_SY As String, T_CB As String, T_ZR As String, T_YD As String, T_LXX_N As Integer, T_LXX_O As Integer

T_S_DAY = Date
   Dim FIEL_STR As String
   FIEL_STR = ""
   For KFTJ_I = 1 To SYS_LXN
      If new_lx(KFTJ_I + 1) <> 0 Or old_lx(KFTJ_I + 1) <> 0 Then
         T_SY = "SY_LX" & CStr(KFTJ_I)   't_rec.Fields(6 * sys_lxn + KFTJ_I)
         T_CB = "CB_LX" & CStr(KFTJ_I)   't_rec.Fields(3 * sys_lxn + KFTJ_I)
         T_ZR = "ZR_LX" & CStr(KFTJ_I)   't_rec.Fields(2 * sys_lxn + KFTJ_I)
         T_YD = "YD_LX" & CStr(KFTJ_I)   't_rec.Fields(sys_lxn + KFTJ_I)
         T_LXX_N = new_lx(KFTJ_I)
         T_LXX_O = old_lx(KFTJ_I)
         If kf_cb Then
            FIEL_STR = FIEL_STR & T_CB & "=" & T_CB & "+(" & T_LXX_N & "),"
         Else
            FIEL_STR = FIEL_STR & T_ZR & "=" & T_ZR & "+(" & T_LXX_N & "),"
         End If
         If kftj_code = 1 Then '   &&& 0 无预订 1 有预订
             FIEL_STR = FIEL_STR & T_YD & "=" & T_YD & "-(" & T_LXX_N & "),"
             FIEL_STR = FIEL_STR & T_SY & "=" & T_SY & "-(" & T_LXX_N & ")+(" & T_LXX_O & "),"
         Else
             FIEL_STR = FIEL_STR & T_SY & "=" & T_SY & "-(" & T_LXX_N & "),"
         End If
      End If
   Next
If Len(Trim(FIEL_STR)) <> 0 Then
    FIEL_STR = Left(FIEL_STR, Len(FIEL_STR) - 1)
    PUB_data.Execute "UPDATE KF_KFLY SET " & FIEL_STR & " WHERE  CSTR(RQ)>'" & CStr(T_S_DAY - 1) & "' AND CSTR(RQ)<'" & CStr(new_e_day + 1) & "'" 'T_S_DAY < new_e_day + 1
End If
Pub_rz = True

End Function

Private Function Pub_ld(t_rec As Recordset, start_day, end_day, t_arra_lx, kf_cb) As Boolean
'*  完成离店登记
'*  START_DAT  入住日期
'*  END_DAT    入住登记时或是修改过的离店日期 (提前离开, 也是如此)
'*  T_ARRA_LX  数组
'*  LD_ID=0 非付帐人离店, 退房离店
Dim T_S_DAY As String, KFTJ_I As Integer
Dim T_SY As String, T_CB As String, T_ZR As String, T_LXX As Integer
T_S_DAY = Date
't_rec.FindFirst "cstr(rq)='" & CStr(T_S_DAY) & "'"
'If t_rec.NoMatch Then
'    pub_ld = False
'    Exit Function
'End If
'Do While T_S_DAY < end_day + 1
   Dim FIEL_STR As String
   FIEL_STR = ""
   For KFTJ_I = 1 To SYS_LXN
      If t_arra_lx(KFTJ_I) <> 0 Then
         T_SY = "SY_LX" + CStr(KFTJ_I)
         T_CB = "CB_LX" + CStr(KFTJ_I)
         T_ZR = "ZR_LX" + CStr(KFTJ_I)
         T_LXX = t_arra_lx(KFTJ_I)
'         t_rec.Edit
         If kf_cb Then
            FIEL_STR = FIEL_STR & T_CB & "=" & T_CB & "-(" & T_LXX & "),"
            FIEL_STR = FIEL_STR & T_SY & "=" & T_SY & "+(" & T_LXX & "),"
'            t_rec.Fields(T_CB) = t_rec.Fields(T_CB) - T_LXX
'            t_rec.Fields(T_SY) = t_rec.Fields(T_SY) + T_LXX
         Else
            FIEL_STR = FIEL_STR & T_ZR & "=" & T_ZR & "+(" & T_LXX & "),"
            FIEL_STR = FIEL_STR & T_SY & "=" & T_SY & "+(" & T_LXX & "),"
'            t_rec.Fields(T_ZR) = t_rec.Fields(T_ZR) - T_LXX
'            t_rec.Fields(T_SY) = t_rec.Fields(T_SY) + T_LXX
         End If
'         t_rec.Update
      End If
   Next
'   T_S_DAY = T_S_DAY + 1
'   t_rec.MoveNext
'Loop
FIEL_STR = Left(FIEL_STR, Len(FIEL_STR) - 1)
PUB_data.Execute "UPDATE KF_KFLY SET " & FIEL_STR & " WHERE  CSTR(RQ)>'" & CStr(T_S_DAY - 1) & "' AND CSTR(RQ)<'" & CStr(end_day + 1) & "'" 'T_S_DAY < eND_day + 1
Pub_ld = True
End Function
'
Private Function Pub_xg(t_rec As Recordset, start_day, end_day, t_arra_lx, t_code) As Boolean
Dim T_S_DAY As Date, KFTJ_I As Integer
Dim T_SY As String, T_ZR As String, T_LXX As Integer

't_rec.FindFirst "cstr(rq)='" & CStr(start_day) & "'"
'If t_rec.NoMatch Then
'    pub_xg = False
'    Exit Function
'End If
T_S_DAY = start_day
'Do While T_S_DAY < end_day + 1
   Dim FIEL_STR As String
   FIEL_STR = ""
   For KFTJ_I = 1 To SYS_LXN
      T_SY = "SY_LX" + CStr(KFTJ_I)
      T_ZR = "ZR_LX" + CStr(KFTJ_I)
      If t_arra_lx(KFTJ_I) <> 0 Then
         If t_code = "0" Then '&& 0 提前离店 1 滞后离店
            T_LXX = -t_arra_lx(KFTJ_I)
         Else
            T_LXX = t_arra_lx(KFTJ_I)
         End If
'         t_rec.Edit
            FIEL_STR = FIEL_STR & T_ZR & "=" & T_ZR & "+(" & T_LXX & "),"
'            t_rec.Fields(T_ZR) = t_rec.Fields(T_ZR) + T_LXX
'            T_LXX = -T_LXX
            FIEL_STR = FIEL_STR & T_SY & "=" & T_SY & "-(" & T_LXX & "),"
'            t_rec.Fields(T_SY) = t_rec.Fields(T_SY) + T_LXX
'         t_rec.Update
      End If
   Next
'   T_S_DAY = T_S_DAY + 1
'   t_rec.MoveNext
'Loop
FIEL_STR = Left(FIEL_STR, Len(FIEL_STR) - 1)
PUB_data.Execute "UPDATE KF_KFLY SET " & FIEL_STR & " WHERE  CSTR(RQ)>'" & CStr(T_S_DAY - 1) & "' AND CSTR(RQ)<'" & CStr(end_day + 1) & "'" 'T_S_DAY < new_e_day + 1
Pub_xg = True

End Function



Public Function Pub_ordr(new_s_day As Date, new_e_day As Date, pub_code As String) As Boolean

'*  使客房利用情况统计表中的日期连续
Dim fy_str As String, yd_str As String, zr_str As String, cb_str As String, wx_str As String, nb_str As String, sy_str As String
Dim FIEL_STR As String, t_rec As Recordset
Dim i As Integer
Dim LOCK_REC As Recordset
Dim t As New HOTEL_TOOLS, e As Boolean
e = False
Set LOCK_REC = PUB_data.OpenRecordset("select * from SYS_LOCK", 2, 0, 2)
If Not LOCK_REC.BOF Then
   LOCK_REC.MoveLast
   LOCK_REC.MoveFirst
End If
LOCK_REC.FindFirst "TRIM(TABLENAME)='KF_KFLY'"
Do While LOCK_REC!CZY <> SYS_USER
   If LOCK_REC!CZY = "***" Then
      LOCK_REC.Edit
        LOCK_REC!CZY = SYS_USER
      LOCK_REC.Update
      e = True
   Else
      Call t.pub_msg("客房利用情况表正被其他人使用，请稍后")
      LOCK_REC.Requery
      If Not LOCK_REC.BOF Then
         LOCK_REC.MoveLast
         LOCK_REC.MoveFirst
      End If
      LOCK_REC.FindFirst "TRIM(TABLENAME)='KF_KFLY'"
   End If
Loop
fy_str = ""
yd_str = ""
zr_str = ""
cb_str = ""
wx_str = ""
nb_str = ""
sy_str = ""
For i = 1 To SYS_LXN
    fy_str = fy_str + "fy_lx" + CStr(i) + ","
    yd_str = yd_str + "yd_lx" + CStr(i) + ","
    zr_str = zr_str + "zr_lx" + CStr(i) + ","
    cb_str = cb_str + "cb_lx" + CStr(i) + ","
    wx_str = wx_str + "wx_lx" + CStr(i) + ","
    nb_str = nb_str + "nb_lx" + CStr(i) + ","
    sy_str = sy_str + "sy_lx" + CStr(i) + ","

Next
FIEL_STR = fy_str + yd_str + zr_str + cb_str + wx_str + nb_str + sy_str + "rq,lock_no"
Set t_rec = PUB_data.OpenRecordset("select " & FIEL_STR & " from KF_KFLY ORDER BY RQ", 2, 0, 2)
If Not t_rec.BOF Then
   t_rec.MoveLast
End If

Dim ordr_day As Date                       '新增记录结束日
Dim t_fields() As Single        't_rec 新增记录内容
Dim m_rq As Date, m_lock_no As Integer             't_rec!rq

ReDim t_fields(SYS_LXN * 7)

ordr_day = new_e_day
If new_s_day > new_e_day Then
   ordr_day = new_s_day
End If
t_rec.FindFirst "CSTR(rq)='" & CStr(ordr_day) & "'"
If Not t_rec.NoMatch Then
   Pub_ordr = True
End If
t_rec.MoveLast
m_rq = t_rec!rq
For i = 0 To SYS_LXN * 7 - 1
    t_fields(i) = t_rec.Fields(i)
Next
m_rq = m_rq + 1
For i = 0 To SYS_LXN - 1
   t_fields(2 * SYS_LXN + i) = 0
   t_fields(SYS_LXN + i) = SYS_CBYD(i + 1)
   t_fields(6 * SYS_LXN + i) = t_fields(i) - t_fields(SYS_LXN + i) - t_fields(2 * SYS_LXN + i) - t_fields(3 * SYS_LXN + i) - t_fields(4 * SYS_LXN + i) ' && 内部用房不处理
Next
m_lock_no = 0
Do While m_rq < ordr_day + 1
    t_rec.AddNew
    For i = 0 To SYS_LXN * 7 - 1
       t_rec.Fields(i) = t_fields(i)
    Next
    t_rec!rq = m_rq
    t_rec!LOCK_NO = m_lock_no
    t_rec.Update
    m_rq = m_rq + 1
Loop
t_rec.Close
If e Then
   LOCK_REC.Edit
     LOCK_REC!CZY = "***"
   LOCK_REC.Update
End If
End Function


Private Function Pub_yd(t_rec As Recordset, start_day As Date, end_day As Date, t_arra_lx As Variant, t_code As String) As Boolean
'**  完成预订建立/解除, 由PUB_CODE决定, 用于预订建立/解除, 有预订入住登记
'** 涉及到 预订,剩余两栏
Dim T_S_DAY As Date, KFTJ_I As Integer
Dim T_YD As String, T_SY As String, T_LXX As Integer
If start_day < Date Then
   T_S_DAY = Date
Else
   T_S_DAY = start_day
End If
't_rec.FindFirst "cstr(rq)='" & CStr(T_S_DAY) & "'"
'If Not t_rec.NoMatch And t_code = "0" Then ' 解除
'   pub_yd = False
'   Exit Function
'End If
'Do While T_S_DAY < end_day + 1
   Dim FIEL_STR As String
   FIEL_STR = ""
   For KFTJ_I = 1 To SYS_LXN
      T_YD = "YD_LX" + CStr(KFTJ_I)
      T_SY = "SY_LX" + CStr(KFTJ_I)