clssystem.cls

来自「物流管理系统」· CLS 代码 · 共 96 行

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

Public DB As New clsDataBase
Public err As String

Public Sub Initialize()

    Dim DBConnect As String

    DBConnect = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & AppPath & "db.mdb;Persist Security Info=True"
    If DB.openDataBase(DBConnect) Then
        Call DataRefurbish
    Else
        MsgBox "数据库无法打开!", vbCritical, "信息提示"
        End
    End If
 End Sub

Private Sub Class_Initialize()

    AppPath = App.Path & IIf(Right$(App.Path, 1) = "\", vbNullString, "\")
End Sub

Private Sub DataRefurbish()

    
End Sub

Public Function TextTolong(ByVal dblNum)

    If IsNumeric(dblNum) Then
        TextTolong = CLng(dblNum)
    Else
        TextTolong = 0
    End If
End Function

Public Function TextToNum(ByVal dblNum)

    If IsNumeric(dblNum) Then
        TextToNum = CCur(dblNum)
    Else
        TextToNum = 0
    End If
End Function

'转换数字,用以存入数据库
Public Function NumToInsert(ByVal lngNum)

    If IsNumeric(lngNum) Then
        NumToInsert = CDbl(lngNum)
    Else
        NumToInsert = "Null"
    End If
End Function

'转换字符串,用以存入数据库
Public Function StrToInsert(ByVal str)

    Dim s
    s = str
    If IsNull(s) Then
        StrToInsert = "Null"
    ElseIf Trim(s) = "" Then
        StrToInsert = "Null"
    Else
        StrToInsert = "'" & Replace(s, "'", "''") & "'"
    End If
End Function

'转换字符串为TEXT格式,用以在浏览器控件上显示
Function StrToText(ByVal str)
    Dim s
    s = str
    If IsNull(s) Then
        StrToText = ""
    Else
        StrToText = s
    End If
End Function