mmain.bas

来自「一个关于电脑管理汽车的软件」· BAS 代码 · 共 91 行

Attribute VB_Name = "mMain"
Option Explicit
Private Type FilterType
 Filters(0 To 2)
End Type
Global gCnn As MYSQL_CONNECTION
Global oCnn As ADODB.Connection
Global SQL As String
Global VarInitData As New InitData
Global VarFunction As New ClassFunction
Global VarPic As New ClassPic
Public CurrentOperate As String
Public GFilters As FilterType
Public GPopedomBS() As Boolean
Public GKeyBS() As Long
Public GKeyCount As Long
Public GPriceRef(0 To 2) As Double
Public GUserRef(0 To 7) As String
Public GSellGoodsWay As Integer
Public VarCrystal As New CrystalClass




Public Sub FillCombo(pCombo As ComboBox, pField As String, pTable As String, Optional WhereClause As String = "", Optional AddBlank As Boolean = False, Optional ClearFirst As Boolean = True, Optional PreserveValue As Boolean = True)
Dim pRs As MYSQL_RS
Dim theTemp As String, TempArray() As String, i As Long
Dim OrigValue As String
On Error Resume Next
    If PreserveValue Then OrigValue = pCombo
    If ClearFirst Then pCombo.Clear
    If AddBlank Then pCombo.AddItem ""
    Set pRs = New MYSQL_RS
    Set pRs = gCnn.Execute("Select Distinct " & pField & " From " & pTable & " " & WhereClause & " Order by " & pField)
    If Not pRs.EOF Then
        theTemp = Trim$(pRs.GetString(, ""))
        TempArray = Split(theTemp, vbCrLf)
        For i = 0 To UBound(TempArray)
            If Trim$(TempArray(i)) <> "" Then pCombo.AddItem Trim$(TempArray(i))
        Next i
    End If
    If PreserveValue Then pCombo = OrigValue
    pRs.CloseRecordset
    Set pRs = Nothing
End Sub

Public Function QuoteBak(txt As Variant, Optional IsDateValue As Boolean = False) As String
    If IsDateValue Then
        If IsDate(txt) Then
            QuoteBak = UnixDateFormat(txt, True)
        Else
            QuoteBak = "NULL"
        End If
    Else
        txt = Replace(txt, "'", "\'")
        Do While InStr(txt, "\\'")
            txt = Replace(txt, "\\'", "\'")
        Loop
        
        Do While InStr(txt, "\\")
            txt = Replace(txt, "\\", "\'")
        Loop
        txt = Replace(txt, "\", "\\'")
    
        QuoteBak = "'" & txt & "'"
    End If
End Function
Public Function Quote(txt As Variant, Optional IsDateValue As Boolean = False) As String
    If IsDateValue Then
        If IsDate(txt) Then
            Quote = UnixDateFormat(txt, True)
        Else
            Quote = "NULL"
        End If
    Else
     Quote = "'" & txt & "'"
    End If
End Function
Public Function UnixDateFormat(DateString As Variant, Optional QuoteIt As Boolean, Optional IncludeTime As Boolean = False) As String
Dim theTemp As String
    If IsDate(DateString) Then
        theTemp = Format(DateString, "yyyy") & "-" & Format(DateString, "mm") & "-" & Format(DateString, "dd")
        If IncludeTime Then theTemp = theTemp & " " & Format(DateString, "hh:nn:ss")
        If QuoteIt Then theTemp = Quote(theTemp)
    Else
        theTemp = " NULL "
    End If
    UnixDateFormat = theTemp
End Function