mod_public.bas

一个公司的客户财产管理系统vb源码

Attribute VB_Name = "Mod_Public"
Option Explicit
Option Base 1

'定义了包装箱唛中每箱最大多装数量
Public Const MaxNumbers As Integer = 10
'定义了数据库连接时用到的变量
Public Cn As ADODB.Connection       '定义了公共ADO连接
Public Rs As ADODB.Recordset        '定义了公共ADO记录集
Public Cn_Area As ADODB.Connection  '定义了与客户地区ADO连接
Public Rs_Area As ADODB.Recordset   '定义了与客户地区ADO记录集
Public Cn_CR As ADODB.Connection    '定义了与客户财产ADO连接
Public Rs_CR As ADODB.Recordset     '定义了与客户财产ADO记录集
Public Cn_OutCR As ADODB.Connection    '定义了与客户财产ADO连接
Public Rs_OutCR As ADODB.Recordset     '定义了与客户财产ADO记录集


Public Cn_Common As ADODB.Connection '定义了公共ADO连接
Public Rs_Common As ADODB.Recordset  '定义了公共ADO记录集
Public Cn_SpecBill As ADODB.Connection  '定义了与规格单ADO连接
Public Rs_SpecBill As ADODB.Recordset   '定义了与规格单ADO记录集
Public Cn_SpecBill_Temp As ADODB.Connection  '定义了与规格单ADO连接
Public Rs_SpecBill_Temp As ADODB.Recordset   '定义了与规格单ADO记录集

Public Cn_StemperSpecBill As ADODB.Connection  '定义了与规格单ADO连接
Public Rs_StemperSpecBill As ADODB.Recordset   '定义了与规格单ADO记录集
Public Cn_StemperSpecBill_Temp As ADODB.Connection  '定义了与规格单ADO连接
Public Rs_StemperSpecBill_Temp As ADODB.Recordset   '定义了与规格单ADO记录集

Public Cn_OutStemperSpecBill As ADODB.Connection  '定义了外卖母盘规格单ADO连接
Public Rs_OutStemperSpecBill As ADODB.Recordset   '定义了外卖母盘规格单ADO记录集
Public Cn_OutStemperSpecBill_Temp As ADODB.Connection  '定义了外卖母盘规格单ADO连接
Public Rs_OutStemperSpecBill_Temp As ADODB.Recordset   '定义了外卖母盘规格单ADO记录集

Public Cn_BoxSign As ADODB.Connection   '定义了箱唛ADO连接
Public Rs_BoxSign As ADODB.Recordset    '定义了箱唛ADO记录集
Public Cn_BoxSignTemp As ADODB.Connection   '定义了箱唛ADO连接
Public Rs_BoxSignTemp As ADODB.Recordset    '定义了箱唛ADO记录集

Public Cn_Commission As ADODB.Connection   '定义了委托书ADO连接
Public Rs_Commission As ADODB.Recordset    '定义了委托书ADO记录集


'定义了客户财产窗体时用到的变量
Public YN_Area_Customer_Add As Boolean
Public YN_Area_Customer_Rename As Boolean
Public YN_Customer_Riches_Add As Boolean
Public YN_Customer_Riches_Repair As Boolean
Public YN_Customer_Riches_View As Boolean

Public AreaCustomer_Key As String
Public AreaCustomer_Text As String
Public Str_AreaCode As String
Public Str_AreaName As String
Public Str_CustomerCode As String
Public Str_CustomerName As String

'定义了财产查找窗体时用到的变量
Public StrCondition As String
Public StrField As String

'定义了部门及用户窗体时用到的变量
Public GroupUser As String
Public Group_Add As Boolean
Public Group_Edit As Boolean
Public User_Add As Boolean
Public User_Edit As Boolean

'定义了新建规格单时用到的变量
Public Spec_Bill_Code As String
Public Str_SpecBill_ProductRequire As String
Public Str_SpecBill_ProductConsignment As String
Public Str_SpecBill_BoxSign As String
Public Str_SpecBill_ConsignmentTime As String
Public Bln_NewSpecBillRepair As Boolean
Public Bln_NewSpecBillView As Boolean
Public Bln_SpecBillRepair As Boolean
Public Bln_SpecBillView As Boolean

'定义了新建母盘规格单时用到的变量
Public StemperSpecBill_Code As String
Public Str_StemperSpecBill_ConsignmentTime As String
Public Str_StemperSpecBill_SpecialRequest As String
Public Bln_NewStemperSpecBillRepair As Boolean
Public Bln_NewStemperSpecBillView As Boolean
Public Bln_StemperSpecBillRepair As Boolean
Public Bln_StemperSpecBillView As Boolean

'定义了STAT录入、检查窗体时用到的变量
'Public STAT_View As Boolean
'Public STAT_Repair As Boolean

'定义了用户登陆时用到的变量
Public OperatorName As String
Public OperatorPass As String
Public OperatorDepartment As String
Public OperatorLevel As String
'Public OperatorName As String
'Public OperatorName As String

'定义了数据备份时用到的变量
Public str_Data_Path As String
Public str_File_Name As String

'定义了数据恢复时用到的变量
Public str_FileName_Reocver As String

'******************************************************************************'
'                            获得计算机名子
Public Computer_Name As String
Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Public Function ComputerName() As String
On Error GoTo err
  Dim Length As Long
  Length = 225
  Computer_Name = String(Length, Chr(0))
  GetComputerName Computer_Name, Length
  Computer_Name = Left(Computer_Name, Length)
Exit Function
err:
   MsgBox err.Description, vbCritical
End Function

Public Function TDBGrid_CusRiches_Refresh(ByVal StrMesgboxInfo As String)
On Error GoTo err
   If OperatorDepartment = "营销部" And YN_Customer_Riches_Add = True And YN_Customer_Riches_Repair = False And YN_Customer_Riches_View = False Then
     Frm_Customer_Riches.TDBGrid_CusRiches.Close
     If Rs_CR.State = 1 Then Rs_CR.Close
     Rs_CR.Open "select * from Customer_Riches where 内编码 like '%'+ '" & AreaCustomer_Key & "'+'%'" & _
                "order by 节目名称,母盘号码", Cn_CR, adOpenKeyset, adLockOptimistic, adCmdText
     Set Frm_Customer_Riches.TDBGrid_CusRiches.DataSource = Rs_CR
     Frm_Customer_Riches.TDBGrid_CusRiches.Refresh
   End If
   MsgBox StrMesgboxInfo
   Call DGrid_Width_Set(Frm_Customer_Riches)
   Frm_Customer_Riches.StatusBar1.Panels(7).text = "记录总数： " & Str(Rs_CR.RecordCount)
Exit Function
err:
   MsgBox err.Description, vbCritical
End Function
'******************************************************************************'
'                            设置数据库连接
Public Function Cs() As String
On Error GoTo err
    '1、HLOT-SERVER
    Cs = "Provider=MSDASQL.1;Persist Security Info=False;Extended Properties=DSN=CUSTOMER_RICHES;UID=sa;APP=Visual Basic;WSID=HLOT-SERVER;DATABASE=Customer_Riches;LANGUAGE=简体中文;Network=DBMSSOCN;QueryLog_On=Yes;StatsLog_On=Yes;Regional=Yes"
    
    '2、HLOT-IT
'    Cs = "Provider=MSDASQL.1;Persist Security Info=False;Extended Properties=DSN=CUSTOMER_RICHES;UID=sa;APP=Visual Basic;WSID=HLOT-IT;DATABASE=Customer_Riches;LANGUAGE=简体中文;Network=DBMSSOCN;QueryLog_On=Yes;StatsLog_On=Yes;Regional=Yes"
Exit Function
err:
   MsgBox err.Description, vbCritical
End Function

'******************************************************************************'
'                             回车键移动光标
Public Sub ENTER(KeyCode As Integer)
On Error GoTo err
 If KeyCode = vbKeyReturn Then
'   KeyCode = vbTab
   SendKeys "{tab}"
 End If
Exit Sub
err:
   MsgBox err.Description, vbCritical
End Sub

'******************************************************************************
'                   设置DATAGRID的列宽
Public Sub DGrid_Width_Set(ForName As Form)
On Error GoTo err
  Dim i As Integer
  
  For i = 0 To 35
    ForName.TDBGrid_CusRiches.Splits(0).Columns(i).DividerStyle = dbgCustomColor
    ForName.TDBGrid_CusRiches.Splits(0).Columns(i).DividerColor = RGB(148, 190, 231)
  Next

  ForName.TDBGrid_CusRiches.RowDividerStyle = dbgCustomColor
  ForName.TDBGrid_CusRiches.RowDividerColor = RGB(148, 190, 231)

  ForName.TDBGrid_CusRiches.Columns(0).Width = 600
  ForName.TDBGrid_CusRiches.Columns(1).Width = 600
  ForName.TDBGrid_CusRiches.Columns(2).Width = 600