start.bas

纯净水进销存管理系统 Ver 2.0是专本针对售水行业的一个进销存软件

Attribute VB_Name = "start"
'****************************************************************************
'人人为我，我为人人
'枕善居收藏整理
'发布日期：2006/12/06
'描    述： 纯净水进销存管理系统 Ver 2.0
'网    站：http://www.Mndsoft.com/  (VB6源码博客)
'网    站：http://www.VbDnet.com/   (VB.NET源码博客,主要基于.NET2005)
'e-mail  ：[e-mail]
'e-mail  ：[e-mail]
'OICQ    ：88382850
'          如果您有新的好的代码别忘记给枕善居哦!
'****************************************************************************
Public ConnStr As String
Public gintDHmode As Integer
Public ygEdit As Integer '员工信息模块,判断是否是编辑;0是添加,1是编辑
Public khEdit As Integer '客户信息模块,判断是否是编辑;0是添加,1是编辑
Public wmEdit As Integer '饮水机信息模块,判断是否是编辑;0是添加,1是编辑
Option Explicit
Public Sub Main()
  If App.PrevInstance = True Then
    MsgBox "程序已经运行，无法再次执行.", vbOKOnly + vbInformation, "系统提示"
    End
  End If
ConnStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\jxcdbase.mdb;Persist Security Info=False"
App.HelpFile = App.Path & "\help.chm"
Load frmlogo
frmlogo.Show
End Sub
Public Function ExeSQL(ByVal sql As String) As ADODB.Recordset
    On Error GoTo ErrHandler:
    
    Dim cn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim strArray() As String
    
    Set cn = New ADODB.Connection
    Set rs = New ADODB.Recordset
    
    strArray = Split(sql)
    cn.Open ConnStr
    
    If StrComp(UCase$(strArray(0)), "select", vbTextCompare) = 0 Then
           rs.Open Trim$(sql), cn, adOpenKeyset, adLockOptimistic
        Set ExeSQL = rs
    Else
        cn.Execute sql
    End If

ExeSQl_Exit:
    Set rs = Nothing
    Set cn = Nothing
    Exit Function
    
ErrHandler:
    ' 显示错误信息
    MsgBox "错误号:" & Err.Number & " 错误信息：" & Err.Description, vbExclamation
    Resume ExeSQl_Exit
 End Function
 Public Function ExeSQLClient(ByVal sql As String) As ADODB.Recordset
    On Error GoTo ErrHandler:
    
    Dim cn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim strArray() As String
    
    Set cn = New ADODB.Connection
    Set rs = New ADODB.Recordset
    
    strArray = Split(sql)
    cn.Open ConnStr
    
    If StrComp(UCase$(strArray(0)), "select", vbTextCompare) = 0 Then
            rs.CursorLocation = adUseClient
           rs.Open Trim$(sql), cn, adOpenKeyset, adLockOptimistic
        Set ExeSQLClient = rs
    Else
        cn.Execute sql
    End If

ExeSQl_Exit:
    Set rs = Nothing
    Set cn = Nothing
    Exit Function
    
ErrHandler:
    ' 显示错误信息
    MsgBox "错误号:" & Err.Number & " 错误信息：" & Err.Description, vbExclamation
    Resume ExeSQl_Exit
 End Function

Public Function gysid(ByVal gysname As String) As String '供应商编号
Dim rsgysid As ADODB.Recordset
Dim sqlgysid As String
sqlgysid = "select 供应商编号 from 供应商表 where 供应商名称='" & Trim(gysname) & "'"
Set rsgysid = ExeSQL(sqlgysid)
If Not rsgysid.EOF Then
    gysid = rsgysid.Fields(0)
Else
    gysid = "nothing"
End If
End Function
Public Function spid(ByVal spname As String) As String '返回商品编号
Dim rsspid As ADODB.Recordset
Dim sqlspid As String
sqlspid = "select 商品编号 from 商品表 where 商品名称='" & Trim(spname) & "'"
Set rsspid = ExeSQL(sqlspid)
If Not rsspid.EOF Then
    spid = rsspid.Fields(0)
Else
    spid = "nothing"
End If
End Function
Public Function spjg(ByVal saleway As String, ByVal spname As String) As Integer '返回商品价格
Dim sqlspjg As String
Dim rsspjg As ADODB.Recordset
If saleway = "零售" Then
sqlspjg = "select 零售价 from 商品表 where 商品名称='" & spname & "'"
Else
sqlspjg = "select 批发价 from 商品表 where 商品名称='" & spname & "'"
End If
Set rsspjg = ExeSQL(sqlspjg)
spjg = rsspjg.Fields(0)
rsspjg.Close
Set rsspjg = Nothing
End Function
Public Function ygid(ByVal ygname As String) As String '返回员工编号的函数
On Error GoTo errorhandle
Dim rsygid As ADODB.Recordset
Dim sqlygid As String
sqlygid = "select 员工编号 from 员工表 where 姓名='" & Trim(ygname) & "'"
Set rsygid = ExeSQL(sqlygid)
If Not rsygid.EOF Then
    ygid = rsygid.Fields(0)
Else
    ygid = "nothing"
End If
Exit Function
errorhandle:
If Err.Number = 13 Then
Resume Next
End If
End Function
Public Function kfid(ByVal kfname As String) As String '求客户编号的函数
Dim rskfid As ADODB.Recordset
Dim sqlkfid As String
sqlkfid = "select 用户编号 from 客户表 where 姓名='" & Trim(kfname) & "'"
Set rskfid = ExeSQL(sqlkfid)
If Not rskfid.EOF Then
    kfid = rskfid.Fields(0)
Else
    kfid = "nothing"
End If
End Function