modulemain.bas

仓库扫描管理系统

Attribute VB_Name = "ModuleMain"
Option Explicit
Option Compare Text

Public wrks As Workspace
' 全局数据库名
Public g_db As Database
' access数据库名称
Public g_dbPath As String
' access数据库路径
Public g_dbName As String
' 备份路径
'Public g_backupPath As String
' 店铺ID
Public g_store As String
'数据库服务器名
Public g_dbserver As String
' 条形码长度
Public g_barcode_length As Integer
' 产品编号起始位置
Public g_barcode_product_start As Integer
' 重量起始位置
Public g_barcode_weight_start As Integer
' 重量基数(及除数)
Public g_barcode_weight_base As Integer
' 重量小数位数，与重量基数对应
Public g_barcode_weight_scale As String
' 条码中顺序号(编号)的长度 :条码中不包含顺序号则其值为零
Public g_barcode_sequenceno_len As Integer
' 硬盘信息字符串
Public g_HddInfo As String
' 试用版本
Public g_TestVersionMsg As String
' 注册码
Public g_registerNumber As String

' 当前登陆用户编号
Public g_userCode As String
' 当前登陆用户名
Public g_userName As String
' 当前登陆用户组
Public g_userGroup As Integer
' 公司名称
Public g_companyName As String
' 输出到Excel中的当前行(最大行号)
Public g_curMaxOutputRow As String
' 出入库单输出到Excel中的总列数
Public g_billColCount As Long
'  针对第几个客户版本序号，从1开始按照自然数顺序递增。
Public g_CustomerSN As Integer
'   定义输出到Excel表格中的行高
Public g_rowHeight As Double
'   是否输出毛重
Public g_outputSkinWeight As Boolean

Sub Main()
    g_outputSkinWeight = False
'  针对第几个客户版本序号，从1开始按照自然数顺序递增。
'   g_CustomerSN为3时候 条码编号为18位 而且条码编号不可设置
    g_CustomerSN = 2
    g_TestVersionMsg = ""
    g_store = "001"
    g_dbName = "hunterPOS.mdb"
    g_dbserver = App.Path       ' "\\hunter"
    g_dbPath = g_dbserver & "\DB-Access\" & g_dbName
'    g_backupPath = "" & g_dbserver & "\backup\" & g_dbName
    createConnection
   
    g_billColCount = 12
    ' 获取公司名称
    g_companyName = getCompanyName()
    ' 获取行高
    g_rowHeight = getRowHeight()
    ' 设置条码格式
    setBarcodeFarmat
    '  获取硬盘信息
    g_HddInfo = getHddInfo()
    ' 生成注册码
    g_registerNumber = EncryptString(g_HddInfo)
    form_login.Show
End Sub
' 清零库存
Sub resetStock()
    Dim strPwd As String
    strPwd = InputBox("请输入您的帐户", "提示", "")
    If strPwd = "" Then
        Exit Sub
    End If

    Dim destFilePath As String
    Dim rsPwd As Recordset
    Set rsPwd = g_db.OpenRecordset("select * from hp_sysParas where (((hp_sysParas.paraCode)='resetStockPwd'))")
    If rsPwd.RecordCount = 0 Then
        MsgBox "对不起，尚未创建帐户，请与管理员联系！", vbCritical, "警告！"
        Exit Sub
    End If
    If rsPwd.RecordCount > 0 And rsPwd.Fields("paraValue") <> strPwd Then
        MsgBox "对不起，没有该帐户！", vbCritical, "警告！"
        Exit Sub
    End If

    Dim strPath, sql As String
    strPath = "C:\Program Files\HP\"
    If Dir(strPath, vbDirectory) = "" Then
      MkDir strPath
    End If
    destFilePath = strPath + "system" + CStr(Format(Now, "YYYYMMDDHHMMSS"))
    If destFilePath <> "" And g_dbPath <> destFilePath Then
        closeConnection
        FileCopy g_dbPath, destFilePath
'   删除出入库数据
On Error GoTo dberr
        createConnection
        wrks.BeginTrans
        sql = " delete from hpos_StockOutBill_Dtl "
        g_db.Execute (sql)
        sql = " delete from hpos_StockOutBill_Master "
        g_db.Execute (sql)
        sql = " delete from hpos_StockIncomeBill_Dtl "
        g_db.Execute (sql)
        sql = " delete from hpos_StockIncomeBill_Master "
        g_db.Execute (sql)
        wrks.CommitTrans
        MsgBox "恭喜您，操作成功!", vbInformation, "提示"
        Exit Sub
dberr:
        wrks.Rollback
        Exit Sub
    Else
        MsgBox "系统错误，请与管理员联系！", vbCritical, "警告"
    End If
End Sub
'打开数据库(创建数据库链接)
Public Sub createConnection()
    If g_db Is Nothing Then
        Set wrks = CreateWorkspace("", "admin", "")
        Set g_db = wrks.OpenDatabase(g_dbPath, False, False)
    End If
End Sub
'关闭数据库链接
Public Sub closeConnection()
    If Not (g_db Is Nothing) Then
            g_db.Close
            Set g_db = Nothing
            wrks.Close
            Set wrks = Nothing
     End If
End Sub

Public Function getCompanyName() As String
    Dim rsCompanyName As Recordset
    Set rsCompanyName = g_db.OpenRecordset("SELECT paraValue FROM hp_sysParas WHERE paraCode='companyName'")
    If rsCompanyName.RecordCount <> 1 Then
        getCompanyName = ""
    Else
        getCompanyName = rsCompanyName.Fields("paraValue")
    End If
End Function
Public Function getRowHeight() As Double
    Dim rs As Recordset
    Set rs = g_db.OpenRecordset("SELECT paraValue FROM hp_sysParas WHERE paraCode='rowHeight'")
    If rs.RecordCount <> 1 Then
        getRowHeight = 18.5     ' 默认为40行
    Else
        getRowHeight = CDbl(rs.Fields("paraValue"))
    End If
End Function
Public Function getNextPK(tableName As String, pkField As String) As Long
  Dim rst As Recordset
  Set rst = g_db.OpenRecordset("SELECT MAX(CLNG(" & pkField & ")) as pk from " & tableName)
  If IsNull(rst.Fields("pk")) Then
    getNextPK = 1
  Else
      getNextPK = CLng(rst.Fields("pk")) + 1
  End If
End Function
Public Function getNextBillNo(tableName As String, fldName As String) As String
    Dim strDate As String ' YYYYMMDD
    Dim strBillNo As String
    Dim rsBillNo As Recordset
'    strDate = CStr(Year(Date)) & CStr(Month(Date)) & CStr(Day(Date))
    strDate = Format(Date, "YYYYMMDD")
    Set rsBillNo = g_db.OpenRecordset("select MAX(" + fldName + ")  from " + tableName + " where " + fldName + " like '" + strDate + "*'")
    If (rsBillNo.RecordCount = 0 Or IsNull(rsBillNo.Fields(0))) Then
        strBillNo = strDate + "001"
    Else
'        strBillNo = Mid(rsBillNo.Fields(0), 1, 7) + CStr(CInt(Mid(rsBillNo.Fields(0), 8, 4)) + 1)
        Dim nextSn As Integer
        nextSn = CInt(Mid(rsBillNo.Fields(0), 9, 3)) + 1
        strBillNo = strDate + String(3 - Len(CStr(nextSn)), "0") + CStr(nextSn)
    End If
    getNextBillNo = strBillNo
End Function

' 字符串加密
Public Function EncryptString(Text As String) As String
    Dim i, k As Integer
    Dim intTmp As Long
    Dim strTmp As String
    intTmp = 0
    strTmp = ""
    For i = 1 To Len(Text)
    ' ascii码加1的字母
        k = Asc(Mid(Text, Len(Text) - i + 1, 1)) + 1
        ' 数字或者字符的ascii码值
        If (k >= 48 And k <= 57) Or (k >= 65 And k <= 90) Or (k >= 97 And k <= 122) Then
            strTmp = strTmp & Chr(k)
        Else
            strTmp = strTmp & "P"
        End If
    Next i
    EncryptString = strTmp
'    For i = 1 To Len(Text)
'        intTmp = intTmp + Asc(Mid(Text, i, 1))
'    Next i
'    EncryptString = CStr(intTmp * 123)
End Function

' 字符串倒置重排
Public Function UpendString(Text As String) As String
    Dim i As Integer
    Dim strTmp As String
    strTmp = ""
    For i = 1 To Len(Text)
        strTmp = strTmp & Mid(Text, Len(Text) - i + 1, 1)
    Next i
    UpendString = strTmp
End Function
'  返回true 表示注册通过，false 表示未注册通过
Public Function validRegister() As Boolean
    ' 校验是否注册  每个表超过10条记录便提示输入注册码
    Dim rsIncomeBill As Recordset
    Dim rsOutBill As Recordset
    Dim rsOrganize As Recordset
    Dim rsProducts As Recordset
    Dim rsRegistNo As Recordset
    Set rsIncomeBill = g_db.OpenRecordset("SELECT COUNT(*) FROM hpos_StockIncomeBill_Master")
    Set rsOutBill = g_db.OpenRecordset("SELECT COUNT(*) FROM hpos_StockOutBill_Master")
    Set rsOrganize = g_db.OpenRecordset("SELECT COUNT(*) FROM hpos_organization")
    Set rsProducts = g_db.OpenRecordset("SELECT COUNT(*) FROM hpos_products")
    Set rsRegistNo = g_db.OpenRecordset("SELECT COUNT(*) FROM hp_sysParas WHERE paraCode='registerNumber' and paraValue='" & g_registerNumber & "'")
    Dim iCount As Integer
    iCount = 30
    If rsRegistNo.Fields(0) = 0 Then
        g_TestVersionMsg = "--试用版"
    End If
    If rsRegistNo.Fields(0) = 0 And (rsIncomeBill.Fields(0) > iCount Or rsOutBill.Fields(0) > iCount Or rsOrganize.Fields(0) > iCount Or rsProducts.Fields(0) > iCount) Then
        validRegister = False
        Exit Function
    End If
    validRegister = True
End Function

' 设置条码格式
Public Sub setBarcodeFarmat()
    Dim intBarcodeFormat As Integer
    Dim rsBCFormat As Recordset
    Set rsBCFormat = g_db.OpenRecordset("SELECT paraValue FROM hp_sysParas WHERE paraCode='barcodeFormat'")
    If rsBCFormat.RecordCount <> 1 Then
        MsgBox "设置条形码格式出错，请与管理员联系！", vbInformation, "提示"
        End
    Else
        intBarcodeFormat = CInt(rsBCFormat.Fields("paraValue"))
    End If
    g_barcode_length = 13
    g_barcode_sequenceno_len = 0
    If g_CustomerSN = 3 Then
        g_barcode_length = 18
        g_barcode_sequenceno_len = 5
    End If
    ' 格式一：条码格式1+重量/100重量取条形码的第8位到第12位除以100
    If intBarcodeFormat = 1 Then
        g_barcode_product_start = 3
        g_barcode_weight_start = 8
        g_barcode_weight_base = 100
    End If
    ' 格式二：条码格式1+重量/1000重量取条形码的第8位到第12位除以1000
    If intBarcodeFormat = 2 Then
        g_barcode_product_start = 3
        g_barcode_weight_start = 8
        g_barcode_weight_base = 1000
    End If
    ' 格式三：条码格式2+重量/100重量取条形码的第7位到第12位除以100
    If intBarcodeFormat = 3 Then
        g_barcode_product_start = 3
        g_barcode_weight_start = 7
        g_barcode_weight_base = 100
    End If