rec.cls

这是一个航空公司用来计算货物运价的系统。

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "REC"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True

'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'此模块用于存放对运单运价记录的查询
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'****************************************************************************
'函数名 SEL1
'作  用 综合型运单运价数据的查询
'输入参数 起始站【dep】 到达站【dest】 航班号【fltno】 起始日期【dat0】 结束日期【dat1】
'返回值 记录集
'作  者 blue
'日  期 2000-12-22
'****************************************************************************

Public Function sel1(ByVal DEP As String, ByVal DEST As String, ByVal fltno As String, ByVal dat0 As Date, ByVal dat1 As Date) As ADODB.Recordset
On Error GoTo HANDLE0
    
    Dim CON0 As New ADODB.Connection
    Dim RS0 As New ADODB.Recordset
    
    Dim SQL, SQL0 As String 'SQL0作为临时的条件限制SQL语句
    
    CON0.ConnectionString = CONSTRING1
    CON0.CursorLocation = adUseClient
    CON0.Open
    
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!
'生成临时SQL语句SQL0
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    '起始站
    If DEP <> "" Then
    SQL0 = "dep='" & DEP & "'"
    End If
    '到达站
    If DEST <> "" Then
    If SQL0 <> "" Then
    SQL0 = SQL0 & " and dest= '" & Trim(DEST) & "'"
    Else
    SQL0 = "dest='" & DEST & "'"
    End If
    End If
    '航班号
    If fltno <> "" Then
    If SQL0 <> "" Then
    SQL0 = SQL0 & " and fltno='" & fltno & "'"
    Else
    SQL0 = "fltno='" & fltno & "'"
    End If
    End If
    '起始日期
    If dat0 <> "2000-1-1" Then
    If SQL0 <> "" Then
    SQL0 = SQL0 & " and fdate>='" & dat0 & "'"
    Else
    SQL0 = "fdate>='" & dat0 & "'"
    End If
    End If
    '终止日期
    If dat1 <> "2000-1-1" Then
    If SQL0 <> "" Then
    SQL0 = SQL0 & " and fdate<='" & dat1 & "'"
    Else
    SQL0 = "fdate<='" & dat1 & "'"
    End If
    End If
    
    '初始SQL语句
    SQL = "select * from TBL_FARE_LF"
    
    '最终SQL语句得生成
    If SQL0 <> "" Then
    SQL = SQL & " where " & SQL0
    End If
    RS0.Open SQL, CON0, adOpenForwardOnly, adLockReadOnly
    Set sel1 = RS0
    
OVER0:
    SQL = ""
    SQL0 = ""
    Set RS0 = Nothing
    Set CON0 = Nothing
Exit Function
HANDLE0:
    Set sel1 = Nothing
    Resume OVER0
End Function

'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'此模块用于存放对运单标准表种固定数据的存储操作
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'****************************************************************************
'函数名 SEL0
'作  用 综合型运价数据的查询
'输入参数 货物编码【hwbm】 运价类新【yjlx】 起始站【qsz】 到达站【ddz】 承运人【cys】
'返回值 记录集
'作  者 blue
'日  期 2000-12-20
'****************************************************************************
Public Function sel0(ByVal hwbm As String, ByVal yjlx As String, ByVal qsz As String, ByVal ddz As String, ByVal cys As String) As ADODB.Recordset

On Error GoTo HANDLE
    
    Dim CON As New ADODB.Connection
    Dim RS As New ADODB.Recordset
    
    Dim SQL, SQL0 As String 'SQL0作为临时的条件限制SQL语句
    
    CON.ConnectionString = CONSTRING1
    CON.CursorLocation = adUseClient
    CON.Open
    
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!
'生成临时SQL语句SQL0
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    '货物编码
    If hwbm <> "" Then
    SQL0 = "gsno='" & hwbm & "'"
    End If
    '运价类型
    If yjlx <> "" And Val(yjlx) > 0 Then
        If SQL0 <> "" Then
            SQL0 = SQL0 & " and fflag='" & Trim(yjlx) & "'"
        Else
            SQL0 = "fflag='" & Trim(yjlx) & "'"
        End If
    End If
    '起始站
    If qsz <> "" Then
        If SQL0 <> "" Then
            SQL0 = SQL0 & " and dep='" & qsz & "'"
        Else
            SQL0 = "dep='" & qsz & "'"
        End If
    End If
    '到达站
    If ddz <> "" Then
        If SQL0 <> "" Then
            SQL0 = SQL0 & " and dest='" & ddz & "'"
        Else
            SQL0 = "dest='" & ddz & "'"
        End If
    End If
    '承运商
    If cys <> "" Then
        If SQL0 <> "" Then
            SQL0 = SQL0 & " and carrier='" & cys & "'"
        Else
            SQL0 = "carrier='" & cys & "'"
        End If
    End If
    
    '初始SQL语句
    SQL = "select * from TBL_FARE_BZ"
    
    '最终SQL语句得生成
    If SQL0 <> "" Then
    SQL = SQL & " where " & SQL0 & "Order by bz_id"
    End If
    RS.Open SQL, CON, adOpenForwardOnly, adLockReadOnly
    Set sel0 = RS
    
OVER:
    SQL = ""
    SQL0 = ""
    Set RS = Nothing
    Set CON = Nothing
Exit Function
HANDLE:
    Set sel0 = Nothing
    Resume OVER
End Function

'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'此模块用于更新运价静态数据
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'****************************************************************************
'函数名 UP0
'作  用 对运价静态数据的维护
'输入参数 货物的运价【从M~3000的九个记录，cur1~cur9，全部采用字符串输入】
'         代理商编码：cys     货物编码：gsno    附加百分比：fjbf    运价编码：bz_id
'返回值 布尔值
'作  者 blue
'日  期 2000-12-22
'****************************************************************************
Public Function up0(ByVal cur1, cur2, cur3, cur4, cur5, cur6, cur7, cur8, cur9, gsno, cys, fjl, BZ_ID, fflag As String) As Boolean
    On Error GoTo HANDLE
    '前期数据定义
    Dim i As Integer
    Dim CON As New ADODB.Connection
    Dim SQL As String
    CON.ConnectionString = CONSTRING1
    CON.CursorLocation = adUseClient
    CON.Open
    '生成SQL语句
    If fflag = "2" Then
    SQL = "update TBL_FARE_BZ set fjbf='" & Val(fjl) / 100 & "',GSNO='" & gsno & "',CARRIER='" & cys & "' where bz_id='" & Val(BZ_ID) & "'"
    Else
    SQL = "update TBL_FARE_BZ set "
    If Val(cur1) > 0 Then
        SQL = SQL & "j0='" & Val(cur1) & "',"
    Else
        SQL = SQL & "j0=null,"
    End If
    If Val(cur2) > 0 Then
        SQL = SQL & "j1='" & Val(cur2) & "',"
    Else
        SQL = SQL & "j1=null,"
    End If
    SQL = SQL & "j2='" & Val(cur3) & "',j3='" & Val(cur4) & "',j4='" & Val(cur5) & "',j5='" & Val(cur6) & "',j6='" & Val(cur7) & "',"
    If Val(cur8) > 0 Then
        SQL = SQL & "j7='" & Val(cur8) & "',j8='" & Val(cur9) & "',GSNO='" & gsno & "',CARRIER='" & cys & "' where bz_id='" & Val(BZ_ID) & "'"
    Else
        SQL = SQL & "j7=null,j8=null,GSNO='" & gsno & "',CARRIER='" & cys & "' where bz_id='" & Val(BZ_ID) & "'"
    End If
    End If
    '执行SQL语句
    CON.Execute (SQL), i
    If i >= 0 Then
       up0 = True
    Else
       up0 = False
    End If
'结束函数
OVER:
    SQL = ""
    Set CON = Nothing
    Exit Function
HANDLE:
    Resume OVER
End Function

'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'此模块用于更新运价静态数据
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'****************************************************************************
'函数名 UP1
'作  用 对运价静态数据的维护
'输入参数 货物运单运价可供修改的数据
'         代理商编码：dls     货物编码：gsno    计费重量：jfzl    销售运价：xsyj 实际运费：sjyf 流水记录号：lf_id
'返回值 布尔值
'作  者 blue
'日  期 2000-12-22
'****************************************************************************
Public Function up1(ByVal dls, gsno, lf_id As String, ByVal jfzl, xsyj, sjyf As Variant) As Boolean
    On Error GoTo HANDLE
    '前期数据定义
    Dim i As Integer
    Dim CON As New ADODB.Connection
    Dim SQL As String
    CON.ConnectionString = CONSTRING1
    CON.CursorLocation = adUseClient
    CON.Open
    '生成SQL语句
    SQL = "update TBL_FARE_LF set CARRIER'" & Trim(dls) & "',GOODSCODE='" & Trim(gsno) & "',jweight='" & jfzl & "',yfare='" & xsyj & "',fare='" & sjyf & "' where lf_id='" & Val(Trim(lf_id)) & "'"
   '执行SQL语句
    CON.Execute (SQL), i
    If i >= 0 Then
       up1 = True
    Else
       up1 = False
    End If
'结束函数
OVER:
    SQL = ""
    Set CON = Nothing
    Exit Function
HANDLE:
    Resume OVER
End Function
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'此模块用于新增运价静态数据
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'****************************************************************************
'函数名 INS0
'作  用 对运价静态数据的维护
'输入参数 数据插入SQL语句
'返回值 布尔值
'作  者 blue
'日  期 2000-12-22
'****************************************************************************
Public Function INS0(ByVal SQL As String) As Boolean
    On Error GoTo HANDLE
    '前期数据定义
    Dim i As Integer
    Dim CON As New ADODB.Connection
    CON.ConnectionString = CONSTRING1
    CON.CursorLocation = adUseClient
    CON.Open
    '执行SQL语句
    CON.Execute (SQL), i
    If i >= 0 Then
       INS0 = True
    Else
       INS0 = False
    End If
'结束函数
OVER:
    Set CON = Nothing
    Exit Function
HANDLE:
    Resume OVER
End Function

'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'此模块用于判断运价静态数据记录是否重复
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'****************************************************************************
'函数名 CHK0
'作  用 对运价静态数据的维护
'输入参数 数据查询SQL语句
'返回值 布尔值
'作  者 blue
'日  期 2000-12-22
'****************************************************************************
Public Function CHK0(ByVal SQL As String) As Boolean
On Error GoTo HANDLE
    Dim CON As New ADODB.Connection
    Dim RS As New ADODB.Recordset
    CON.ConnectionString = CONSTRING1
    CON.CursorLocation = adUseClient
    CON.Open
    RS.Open SQL, CON, adOpenForwardOnly, adLockReadOnly
        If RS.EOF Then
            CHK0 = False
        Else
            CHK0 = True
        End If
OVER:
    Set RS = Nothing
    Set CON = Nothing
Exit Function
HANDLE:
    Resume OVER
End Function

'****************************************************************************
'函数名 DEL0
'作  用 删除指定的运价静态数据
'输入参数 数据查询SQL语句
'返回值 布尔值
'作  者 blue
'日  期 2000-12-23
'****************************************************************************
Public Function DEL0(ByVal BZ_ID As String) As Boolean
    On Error GoTo HANDLE
    '前期数据定义
    Dim i As Integer
    Dim CON As New ADODB.Connection
    Dim SQL As String
    CON.ConnectionString = CONSTRING1
    CON.CursorLocation = adUseClient
    CON.Open
    SQL = "delete from tbl_fare_bz where bz_id='" & BZ_ID & "'"
   '执行SQL语句
    CON.Execute (SQL), i
    If i >= 0 Then
       DEL0 = True
    Else
       DEL0 = False
    End If
'结束函数
OVER:
    SQL = ""
    Set CON = Nothing
    Exit Function
HANDLE:
    Resume OVER
End Function

'****************************************************************************
'函数名 SEL2
'作  用 根据指定的日期、起始站、到达站、货物编码、代理商信息选择合适的运价信息，供系统运算
'输入参数 日期：【fdate】  起始站【dep】 到达站【dest】  货物编码【gsno】 代理商【carrier】
'返回值 布尔值
'作  者 blue
'日  期 2000-12-23
'****************************************************************************
Public Function sel2(ByVal FDATE As Date, ByVal DEP, DEST, gsno, CARRIER As String) As ADODB.Recordset
On Error GoTo HANDLE
    Dim CON As New ADODB.Connection
    Dim RS As New ADODB.Recordset
    Dim RP As New ADODB.Recordset
    Dim SQL As String
    CON.ConnectionString = CONSTRING1
    CON.CursorLocation = adUseClient
    CON.Open
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!
'生成SQL语句SQL
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    '首先查找是否指定商品运价
    SQL = "select j0,j1,j2,j3,j4,j5,j6,j7,j8,fflag from tbl_fare_bz where dep='" & Trim(DEP) & "' and dest='" & Trim(DEST) & "' and gsno='" & Trim(gsno) & "' and carrier='" & Trim(CARRIER) & "' and begdate<='" & FDATE & "' and enddate>='" & FDATE & "' and fflag='3'"
    RS.Open SQL, CON, adOpenForwardOnly, adLockReadOnly
    If RS.EOF Then
        '不存在指定商品运价，则选择普通商品运价
        'SQL = ""
        SQL = "select j0,j1,j2,j3,j4,j5,j6,j7,j8,fflag from tbl_fare_bz where dep='" & Trim(DEP) & "' and dest='" & Trim(DEST) & "' and gsno='" & Trim(gsno) & "' and carrier='" & Trim(CARRIER) & "' and begdate<='" & FDATE & "' and enddate>='" & FDATE & "' and fflag='1'"
        RP.Open SQL, CON, adOpenForwardOnly, adLockReadOnly
            Set sel2 = RP
    Else
        '存在指定商品运价，则只返回指定商品运价
        Set sel2 = RS
    End If
OVER:
    SQL = ""
    Set RS = Nothing
    Set RP = Nothing
    Set CON = Nothing
Exit Function
HANDLE:
    Resume OVER
End Function

'****************************************************************************
'函数名 SEL3
'作  用 根据指定的日期、起始站、到达站、货物编码、代理商信息选择合适的运价信息，供系统运算
'输入参数 日期：【fdate】  起始站【dep】 到达站【dest】  货物编码【gsno】 代理商【carrier】
'返回值 字符串
'作  者 blue
'日  期 2000-12-23
'****************************************************************************
Public Function sel3(ByVal FDATE As Date, ByVal DEP, DEST, gsno, CARRIER As String) As String
On Error GoTo HANDLE
    Dim CON As New ADODB.Connection
    Dim RC As New ADODB.Recordset
    Dim SQL As String
    CON.ConnectionString = CONSTRING1
    CON.CursorLocation = adUseClient
    CON.Open
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!
'生成SQL语句SQL
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    '首先查找是否指定商品运价
            SQL = "select fjbf from tbl_fare_bz where dep='" & Trim(DEP) & "' and dest='" & Trim(DEST) & "' and gsno='" & Trim(gsno) & "' and carrier='" & Trim(CARRIER) & "' and begdate<='" & FDATE & "' and enddate>='" & FDATE & "' and fflag='2'"
            RC.Open SQL, CON, adOpenForwardOnly, adLockReadOnly
            If RC.EOF = False Then '否则直接将记录集RS置给SEL2
                sel3 = RC.Fields(0)
            Else
                sel3 = ""
            End If
OVER:
    SQL = ""
    Set RC = Nothing
    Set CON = Nothing
Exit Function
HANDLE:
    Resume OVER
End Function