clsdailishang.cls

来自「音像店(CD刻录)进销存管理系统」· CLS 代码 · 共 259 行

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsDaiLiShang"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
'代理商_ID  自动编号
'代号        文本 10  代理商的字母代号
'名称        文本 20  代理商的单位名称
'老板姓名    文本 16  代理商的老板姓名
'地址        文本 60  代理商的地址
'电话        文本 30

Option Explicit

Public DLS_ID As Long
Public MingCheng As String
Public LBXM As String
Public DZ As String
Public DaiHao As String
Public DH As String

Dim RS As ADODB.Recordset


Public Sub Update(ByVal TmpId As Long)
  SQL = "Update 代理商信息 set 代号='" & Trim(DaiHao) & "',名称='" & Trim(MingCheng) & "',老板姓名='" & Trim(LBXM) & "',地址='" & Trim(DZ) & "',电话='" & Trim(DH) & "' where 代理商_ID=" & Trim(Str(TmpId))
  ExecuteSQL (Trim(SQL))
End Sub

Public Sub Load_Client() '(ByVal TmpType As Integer)
  Dim i As Long
  Erase Arr_Client
  ReDim Arr_Client(0)
  
  SQL = "select 名称 from 代理商信息"
  Set RS = ExecuteSQL(Trim(SQL))
  i = 0
  With RS
    Do While .EOF = False
     ReDim Preserve Arr_Client(i + 1)
     Arr_Client(i) = !名称
     
     i = i + 1
      .MoveNext
    Loop
  End With
End Sub

Public Sub Insert()
  Dim lngTmpID As Long
  
  lngTmpID = GetNewId
  SQL = "Insert into 代理商信息 (代理商_ID,代号,名称,老板姓名,地址,电话) Values(" & Trim(CStr(lngTmpID)) & ",'" & Trim(DaiHao) & "','" & Trim(MingCheng) & "','" & Trim(LBXM) & "','" & Trim(DZ) & "','" & Trim(DH) & "')"
  ExecuteSQL (SQL)
End Sub

Public Sub Init()
  DLS_ID = -1
  MingCheng = ""
  LBXM = ""
  DZ = ""
  DaiHao = ""
  DH = ""
End Sub

Public Function In_DB(ByVal TmpClientName As String) As Boolean
  SQL = "select * from 代理商信息 where 名称='" & Trim(TmpClientName) & "'"
  Set RS = ExecuteSQL(SQL)
  If RS.EOF = False Then
    In_DB = True
  Else
    In_DB = False
  End If
End Function


Public Sub Delete(TmpId As Long)
  SQL = "DELETE from 代理商信息 WHERE 代理商_ID=" & Trim(Str(TmpId))
  ExecuteSQL (Trim(SQL))
End Sub


Public Sub GetInfo(TmpId As Long)
  DLS_ID = TmpId
  If TmpId = 0 Then
    Init
    Exit Sub
  End If
  
  On Error GoTo GetInfo_error
  SQL = "SELECT * FROM 代理商信息 WHERE 代理商_Id=" & Trim(Str(TmpId))
  Set RS = ExecuteSQL(Trim(SQL))
  With RS
    If .EOF = False Then
      DaiHao = !代号
      MingCheng = !名称
      LBXM = !老板姓名
      DZ = !地址
      DH = !电话
    Else
      Init
    End If
  End With
  
GetInfo_exit:
  If Not RS Is Nothing Then
    RS.Close
    Set RS = Nothing
  End If
  Exit Sub
  
GetInfo_error:
  If Err.Description <> "" Then
    MsgBox Err.Description
    Err.Clear
  End If
  Resume GetInfo_exit
End Sub


Public Function GetId(ByVal strDaiHao As String) As Long
  If strDaiHao = "" Then
    GetId = 0
    Exit Function
  End If
  
  On Error GoTo GetId_error
  SQL = "SELECT 代理商_ID FROM 代理商信息 WHERE 代号='" & Trim(strDaiHao) + "'"
  Set RS = ExecuteSQL(Trim(SQL))
  If RS.EOF = False Then
    GetId = RS!代理商_ID
  Else
    GetId = 0
  End If
  
GetId_exit:
  If Not RS Is Nothing Then
    RS.Close
    Set RS = Nothing
  End If
  Exit Function
  
GetId_error:
  If Err.Description <> "" Then
    MsgBox Err.Description
    Err.Clear
  End If
  Resume GetId_exit
End Function


Public Function GetMingCheng(ByVal strDaiHao As String) As String
  If strDaiHao = "" Then
    GetMingCheng = ""
    Exit Function
  End If
  
  On Error GoTo GetMingCheng_error
  SQL = "SELECT 名称 FROM 代理商信息 WHERE 代号='" & Trim(strDaiHao) + "'"
  Set RS = ExecuteSQL(Trim(SQL))
  If RS.EOF = False Then
    GetMingCheng = RS!名称
  Else
    GetMingCheng = ""
  End If
  
GetMingCheng_exit:
  If Not RS Is Nothing Then
    RS.Close
    Set RS = Nothing
  End If
  Exit Function
  
GetMingCheng_error:
  If Err.Description <> "" Then
    MsgBox Err.Description
    Err.Clear
  End If
  Resume GetMingCheng_exit
End Function


Public Function GetDaiHao(ByVal strMingCheng As String) As String
  If strMingCheng = "" Then
    GetDaiHao = ""
    Exit Function
  End If
  
  On Error GoTo GetDaiHao_error
  SQL = "SELECT 代号 FROM 代理商信息 WHERE 名称='" & Trim(strMingCheng) + "'"
  Set RS = ExecuteSQL(Trim(SQL))
  If RS.EOF = False Then
    GetDaiHao = RS!代号
  Else
    GetDaiHao = ""
  End If
  
GetDaiHao_exit:
  If Not RS Is Nothing Then
    RS.Close
    Set RS = Nothing
  End If
  Exit Function
  
GetDaiHao_error:
  If Err.Description <> "" Then
    MsgBox Err.Description
    Err.Clear
  End If
  Resume GetDaiHao_exit
End Function



Private Function GetNewId() As Long
  Dim lngTmpID As Long
  Dim i As Long
  
  On Error GoTo GetNewID_error
  i = 1
  SQL = "select 代理商_ID from 代理商信息 order by 代理商_ID"
  Set RS = ExecuteSQL(Trim(SQL))
  With RS
  Do While .EOF = False
    If !代理商_ID = i Then
      i = i + 1
    Else
      GetNewId = i
      GoTo GetNewID_exit '当代理商_ID不连续时
    End If
    RS.MoveNext
  Loop
  End With
  GetNewId = i '当代理商_ID连续时
  
GetNewID_exit:
  If Not RS Is Nothing Then
    RS.Close
    Set RS = Nothing
  End If
  Exit Function
GetNewID_error:
  If Err.Description <> "" Then
    MsgBox Err.Description
    Err.Clear
  End If
  Resume GetNewID_exit
End Function