mdlfunction.bas

雨点进销存软件,绝对可以用,大家可以拿来使用

Attribute VB_Name = "MdlFunction"
'####################################################################
'数据库连接函数
'####################################################################
Public Sub CntDb()
On Error GoTo ErrHandle
Dim gRs As Recordset
'gDSN = "zz"
'gPwd = "790625"
'gUserID = "zl"
'gDbsName = "student"
'CntStr = "ODBC"

'DBEngine.CreateWorkspace(gDSN, "", "", dbUseODBC)
'Set gRs = gDbStu.OpenRecordset("select * from stu_info")
'gWrks.OpenDatabase(gDSN, dbDriverNoPrompt, False, "ODBC" + ";dsn=" + gDSN + ";uid=" + gUserID + ";pwd=" + gPwd + ";database=" + gDbsName)

Set gWrks = CreateWorkspace("", "admin", "", dbUseODBC)
Set gDbFish = gWrks.OpenDatabase("fishsale", _
        dbDriverNoPrompt, True, _
      "ODBC;DATABASE=Fishsale;UID=sa;PWD=asdf;DSN=fishsale")

Exit Sub
ErrHandle:
    MsgBox "数据库连接不上，系统终止", vbOKOnly + vbExclamation, "错误提示"
    End
End Sub

Public Sub CloseDB()
On Error GoTo Err
'If Not (rd Is Nothing) Then rd.Close

If Not (gDbFish Is Nothing) Then gDbFish.Close
If Not (gWrks Is Nothing) Then gWrks.Close
If Not (gRst Is Nothing) Then gRst.Close
If Not (rs Is Nothing) Then rs.Close
If Not (ro Is Nothing) Then ro.Close

Err:
End Sub
Public Sub Main()
Call CntDb
gComputerName = GetComPuter
'FrmMain.Show 1
FrmStart.Show 1
'FrmSum.Show 1


End Sub

'空字符串转换
Public Function ConvertNull(p_Field_Value As Variant) As String
On Error GoTo Err
If IsNull(p_Field_Value) = True Then GoTo Err
ConvertNull = Trim(CStr(p_Field_Value))
Exit Function
Err:
  ConvertNull = ""
End Function

Public Function Convert_Value(pOrg_Value As Variant, pConvertType As Integer, pData_Type As Integer, pIs_In_Where As Boolean, pPermit_Null As Boolean) As String
On Error GoTo Err
Dim tData_Type As Integer '1字符,2数字,3日期
Dim tDate As Date

'如果为空
If IsNull(pOrg_Value) = True Then
    If pPermit_Null = True Then
       Convert_Value = "NULL"
    ElseIf pPermit_Null = False Then
       If (pConvertType = 0 And pData_Type = 3) Or (pConvertType = 1 And pData_Type = 4) Then
          Convert_Value = "0"
       ElseIf (pConvertType = 1 And pData_Type = 1) Or (pConvertType = 0 And pData_Type = 11) Then
          Convert_Value = Format(Date, "yyyy-mm-dd")
       Else
          Convert_Value = ""
       End If
    End If
    Exit Function
End If

'获取字段类型
If pConvertType = 0 Then
    Select Case pData_Type 'pData_Type为数据库中的数据类型
       Case 3 '日期
          tData_Type = 1
       Case 2 '数字
          tData_Type = 3
       Case 1 '1, 12 '字符
          tData_Type = 2
       Case Else
          MsgBox "数据类型" + CStr(pData_Type)
   End Select
   
ElseIf pConvertType = 1 Then
   Select Case pData_Type 'pData_Type为自定义的数据类型
       Case 3 '日期
          tData_Type = 1
       Case 1 '字符
          tData_Type = 2
       Case 2 '数字
          tData_Type = 3
   End Select
End If

Select Case tData_Type
   Case 1 '日期
       '日期转换
       If Len(CStr(pOrg_Value)) = 8 And InStr(1, CStr(pOrg_Value), "-") And InStr(1, CStr(pOrg_Value), "/") <> 0 And InStr(1, CStr(pOrg_Value), "\") <> 0 Then
          pOrg_Value = Mid(pOrg_Value, 1, 4) + "/" + Mid(pOrg_Value, 5, 2) + "/" + Mid(pOrg_Value, 7, 2)
       ElseIf IsDate(pOrg_Value) = True Then
          Convert_Value = Format(pOrg_Value, "yyyy-mm-dd")
       Else
          If pPermit_Null Then GoTo Err
          Convert_Value = Format(Date, "yyyy-mm-dd")
       End If
   Case 2, 3 '字符'数值
       Convert_Value = Trim(CStr(pOrg_Value))
End Select

If pIs_In_Where Then
    Select Case tData_Type
       Case 1 '日期
          Convert_Value = "'" + Convert_Value + "'"
'          Convert_Value = "TO_DATE('" + Convert_Value + "','YYYY\MM\DD')"
       Case 2 '字符'
           Convert_Value = "'" + Convert_Value + "'"
       Case 3 '数值
           Convert_Value = "'" + Convert_Value + "'"
    End Select
End If
Exit Function
Err:
   If pPermit_Null = True Then
      Convert_Value = "NULL"
   Else
      Convert_Value = ""
   End If
End Function

Public Function SaveEventLog(pType As String, pObjectType As Integer, pTypeCode As String, pObjectNo As String, pRemark As String) As Boolean
On Error GoTo Err

SaveEventLog = True
Exit Function
Err:
   SaveEventLog = False
   
End Function