cashcode.asp

星级酒店管理系统（附带系统自写控件源码）

<%

 '给出消费总报表
  Sub WriteList
  
      On Error Resume Next
  
      Dim nColor
      Dim nRecord
      Dim sDLink                                           
      Dim bColorChange
      bColorChange=0
      nColor="#FAEFE4"
      nRecord=0

      Do while Not objRS.Eof                                   
         response.write "<tr>" & vbcrlf

        '给出ID
         response.write "<td width='20' bgcolor='" & nColor & "' align='center'>"
         response.write objRs("ID") & "</td>" & vbcrlf
        '给出时间
         response.write "<td width='70' bgcolor='" & nColor & "' align='Center'>"
         response.write objRs("DDate") & "</td>"  & vbcrlf         
        '给出时
         response.write "<td bgcolor='" & nColor & "' align='Center'>"         
         response.write objRs("lHour")
         response.write "</td>" & vbcrlf          
        '给出分
         response.write "<td bgcolor='" & nColor & "' align='Center'>"
         response.write objRs("lMinute")  
         response.write "</td>" & vbcrlf     
        '给出支出
         response.write "<td bgcolor='" & nColor & "' align='right'>"
         If objRs("DDirect")=0 Then
            response.write FormatNumber(objRs("DMoney"),2,-1)
            QuaTotal=QuaTotal+objRs("DMoney")
          Else
            response.write "0"
         End If   
         response.write "</td>" & vbcrlf  
        '给出实收
         response.write "<td bgcolor='" & nColor & "' align='right'>"         
         If objRs("DDirect")=1 Then
            response.write FormatNumber(objRs("DMoney"),2,-1)
            AmoTotal=AmoTotal+objRs("DMoney") 
          Else
            response.write "0"
         End If   
         response.write "</td>" & vbcrlf                    
        '给出详细说明
         response.write "<td bgcolor='" & nColor & "' align='Left'>"
         response.write objRs("DReason")  
         response.write "</td>" & vbcrlf  
        '给出操作员
         response.write "<td bgcolor='" & nColor & "' align='Left'>"
         response.write objRs("DOperator")  
         response.write "</td>" & vbcrlf  
        '给出支出方式
         response.write "<td bgcolor='" & nColor & "' align='Left'>"
         response.write objRs("tmpStr")  
         response.write "</td>" & vbcrlf                             
         response.write "</tr>"  & vbcrlf          
         
         objRs.Movenext        
  
       If  bColorChange=0 Then                   '变换网络底色
           BColorChange=1
           nColor="#FFFFFF"
       Else
           nColor="#FAEFE4"
           BColorChange=0
       End if     
       nRecord=nRecord+1
    Loop
    sTotal=nRecord                              '共有多少条记录
End Sub

'写入支付方式
Sub WritePayMethod(ID)
    
    On Error Resume Next
       
    Dim cnPayDB
    Dim cnPayRS
    Dim sTmp
    
    Set cnPayDB=CreateObject("ADODB.Connection")
    Set cnPayRS=CreateObject("ADODB.Recordset")       
    
        OpenDatabase cnPayDB       

        sTmp="Select Class From PayType"    
        cnPayRs.Open sTmp,cnPayDB,adOpenDynamic,adLockreadonly,adcmdText               
        If Not cnPayRS.Eof Then
         '给出支付方式列表
          Do While Not cnPayRs.Eof
             If cnPayRs.Eof Then Exit Do
                sTmp=cnPayRs("Class")                
                If sTmp=ID And ID<>"" Then
                    response.write "<option Selected value='" & ID & "'>" & sTmp & "</Option>"
                   Else                         
                    response.write "<option  value='" & sTmp & "'>" & sTmp & "</Option>" 
                End If
                cnPayRs.MoveNext
           Loop
         End If                
         cnPayRs.Close
         Set cnPayRs=Nothing                      
         CloseDatabase cnPayDB    
End Sub

'写入操作员列表
Sub WriteOperator(ID)
    
    On Error Resume Next
       
    Dim cnOprDB
    Dim cnOprRS
    Dim sTmp1
    
    Set cnOprDB=CreateObject("ADODB.Connection")
    Set cnOprRS=CreateObject("ADODB.Recordset")       
    
        OpenDatabase cnOprDB       

        sTmp1="Select 操作员 From Main"    
        cnOprRs.Open sTmp1,cnOprDB,adOpenDynamic,adLockreadonly,adcmdText               
        If Not cnOprRS.Eof Then
         '给出操作员列表
          Do While Not cnOprRs.Eof
             If cnOprRs.Eof Then Exit Do
                sTmp1=cnOprRs("操作员")                
                If sTmp1=ID And ID<>"" Then
                    response.write "<option Selected value='" & ID & "'>" & sTmp1 & "</Option>"
                   Else                         
                    response.write "<option  value='" & sTmp1 & "'>" & sTmp1 & "</Option>" 
                End If
                cnOprRs.MoveNext
           Loop
         End If                
         cnOprRs.Close
         Set cnOprRs=Nothing                      
         CloseDatabase cnOprDB        
End Sub

'写入服务员列表
Sub WriteWaiter(ID)

    On Error Resume Next
       
    Dim cnWaiDB
    Dim cnWaiRS
    Dim sTmp2
    
    Set cnWaiDB=CreateObject("ADODB.Connection")
    Set cnWaiRS=CreateObject("ADODB.Recordset")       
    
        OpenDatabase cnWaiDB       

        sTmp2="Select DName From tbdGuest"    
        cnWaiRs.Open sTmp2,cnWaiDB,adOpenDynamic,adLockreadonly,adcmdText               
        If Not cnWaiRS.Eof Then
         '给出服务员列表
          Do While Not cnWaiRs.Eof
             If cnWaiRs.Eof Then Exit Do
                sTmp2=cnOprRs("DName")                
                If sTmp2=ID And ID<>"" Then
                    response.write "<option Selected value='" & ID & "'>" & sTmp2 & "</Option>"
                   Else                         
                    response.write "<option  value='" & sTmp2 & "'>" & sTmp2 & "</Option>" 
                End If
                cnWaiRs.MoveNext
           Loop
         End If                
         cnWaiRs.Close
         Set cnWaiRs=Nothing                      
         CloseDatabase cnWaiDB
    
End Sub

%>