strings.cls

非常实用的VB函数,包括SQL字符转换

            Else
               KeyStr = GetNextFormatCode("", FormatStr)
            End If
            gRegCode = True
        Else
            FormatStr = IIf(Trim(FormatStr) <> "", Trim(FormatStr), "###")
            KeyStr = GetNextFormatCode("", FormatStr)
            gRegCode = False
        End If
        rs.Close
        If KeyStr = "" Then
            MsgBox "编码已满，请拓展编码格式！", 48
            GetPrimaryKey = ""
            Exit Function
        End If
        Do While True  '''''''''''*
            strSQL = "Select Count(" & FieldName & ") As Exist from " & TableName & _
                     " Where " & FieldName & "='" & hStr & TranMark(KeyStr) & "'"
            rs.Open strSQL, cn, adOpenStatic, adLockReadOnly
            Exist = rs!Exist
            rs.Close
            If Exist = 0 Then
                  Exit Do
            End If
            KeyStr = GetNextFormatCode(Trim(KeyStr), FormatStr)
            If KeyStr = "" Then
                MsgBox "编码已满，请拓展编码格式！", 48
                GetPrimaryKey = ""
                Exit Function
            End If
        Loop         ''''''''''''*
        
        If gRegCode Then
            strSQL = "Update PrimaryKey set KeyStr='" & TranMark(KeyStr) & "' where TableName='" & TableName & "'"
            cn.Execute (strSQL)
        End If
        GetPrimaryKey = hStr & KeyStr
     Else
        If CheckFormat Then   '需检查用户编码格式
            If FormatStr = "" Then   '取编码格式
                strSQL = "Select KeyStr,FormatStr from PrimaryKey where TableName='" & TableName & "' And FieldName='" & FieldName & "'"
                rs.Open strSQL, cn, adOpenStatic, adLockReadOnly
                FormatStr = IIf(Trim(rs!FormatStr) <> "", Trim(rs!FormatStr), "###")
                rs.Close
            End If
            If hStr = "" Then
                If Not CodeIsFormated(KeyStr, FormatStr) Then
                    MsgBox "编码不符合格式！", 48
                    GetPrimaryKey = ""
                    Exit Function
                End If
            Else
                If Left(KeyStr, Len(hStr)) <> hStr Or Not CodeIsFormated(Mid(KeyStr, Len(hStr) + 1), FormatStr) Then
                    MsgBox "编码不符合格式！", 48
                    GetPrimaryKey = ""
                    Exit Function
                End If
            End If
        End If
        strSQL = "Select Count(" & FieldName & ") As Exist from " & TableName & _
                 " Where " & FieldName & "='" & TranMark(KeyStr) & "'"
        rs.Open strSQL, cn, adOpenStatic, adLockReadOnly
        Exist = rs!Exist
        rs.Close
        If Exist <> 0 Then
            MsgBox "此代码已使用！", 0 + 48, "操作提示"
            GetPrimaryKey = ""
            Exit Function
        End If
        GetPrimaryKey = KeyStr
     End If
      '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
     
     Exit Function
er:
     MsgBox "数据库访问错误(或找不到[PrimaryKey]表),请检查数据库!"
     GetPrimaryKey = ""
End Function
''

Public Function GetSubString(ByVal nStr As String, ByVal Indirect As String, ByVal n As Integer) As String
    Dim lo1 As Integer
    Dim lo2 As Integer
    Dim I As Integer
    I = 0
    lo1 = 0
    lo2 = InStr(1, nStr, Indirect)
    Do While lo2 <> 0
        GetSubString = Mid(nStr, lo1 + 1, lo2 - lo1 - 1)
        lo1 = lo2
        lo2 = InStr(lo2 + 1, nStr, Indirect)
        I = I + 1
        If I = n Then
          Exit Function
        End If
    Loop
    I = I + 1
    If I = n Then
       GetSubString = Mid(nStr, lo1 + 1)
    Else
       GetSubString = ""
    End If
End Function


Public Function GetSubStringN(ByVal nStr As String, ByVal Indirect As String) As Integer
    Dim lo1 As Integer
    Dim lo2 As Integer
    Dim I As Integer
    GetSubStringN = 0
    If nStr = "" Then
        Exit Function
    End If
    If Indirect = "" Then
        Exit Function
    End If
    lo1 = 0
    lo2 = InStr(1, nStr, Indirect)
    Do While lo2 <> 0
        lo1 = lo2
        lo2 = InStr(lo2 + 1, nStr, Indirect)
        GetSubStringN = GetSubStringN + 1
    Loop
    GetSubStringN = GetSubStringN + 1
End Function

Public Function GetNextFormatCode(ByVal CodeStr As String, ByVal FormatStr As String, Optional Desc As Boolean) As String
   If FormatStr = "" Then
     Exit Function
   End If
   Dim I As Integer
   Dim c As String
   Dim lastC As String
   Dim TryNext As Boolean
   Dim nD As Single, nM As Single, nY As Single, DateStr As String
   nD = 0
   nM = 0
   nY = 0
   DateStr = Format(Date, "YYYYMMDD")
   I = Len(FormatStr)
   TryNext = True
   Do While True
       c = Mid(FormatStr, I, 1)
       lastC = Mid(CodeStr, I, 1)
       Select Case c
        Case "#"   '数字字符
            If Desc Then  '数字字符递增 9-0
                 If TryNext Then
                      If lastC <> "0" Then
                         TryNext = False
                         If lastC < "0" Or lastC > "9" Then
                            GetNextFormatCode = "9" & GetNextFormatCode
                         Else
                            GetNextFormatCode = Trim(Str(Val(lastC) - 1)) & GetNextFormatCode
                         End If
                      Else
                         GetNextFormatCode = "9" & GetNextFormatCode
                      End If
                 Else
                      GetNextFormatCode = IIf(lastC >= "0" And lastC <= "9", lastC, "9") & GetNextFormatCode
                 End If
               
            Else    '数字字符递增 0-9
                 If TryNext Then
                      If lastC <> "9" Then
                         TryNext = False
                         GetNextFormatCode = IIf(lastC = "", "0", Trim(Str(Val(lastC) + 1))) & GetNextFormatCode
                      Else
                         GetNextFormatCode = "0" & GetNextFormatCode
                      End If
                 Else
                      GetNextFormatCode = IIf(lastC >= "0" And lastC <= "9", lastC, "0") & GetNextFormatCode
                 End If
            End If
        Case "@"    '大写字母字符
           If Desc Then '字母字符递减 Z-A
                 If TryNext Then
                      If lastC <> "A" Then
                         TryNext = False
                         If lastC < "A" Or lastC > "Z" Then
                             GetNextFormatCode = "Z" & GetNextFormatCode
                         Else
                             GetNextFormatCode = Trim(Chr(Asc(lastC) - 1)) & GetNextFormatCode
                         End If
                      Else
                         GetNextFormatCode = "Z" & GetNextFormatCode
                      End If
                 Else
                      GetNextFormatCode = IIf(lastC >= "A" And lastC <= "Z", lastC, "Z") & GetNextFormatCode
                 End If
            
            Else '字母字符递增 A-Z
                 If TryNext Then
                      If lastC <> "Z" Then
                         TryNext = False
                         If lastC < "A" Or lastC > "Z" Then
                             GetNextFormatCode = "A" & GetNextFormatCode
                         Else
                             GetNextFormatCode = Trim(Chr(Asc(lastC) + 1)) & GetNextFormatCode
                         End If
                      Else
                         GetNextFormatCode = "A" & GetNextFormatCode
                      End If
                 Else
                      GetNextFormatCode = IIf(lastC >= "A" And lastC <= "Z", lastC, "A") & GetNextFormatCode
                 End If
            End If
        Case "*"    '小写字母字符
            If Desc Then '字母字符递减 z-a
                 If TryNext Then
                      If lastC <> "a" Then
                         TryNext = False
                         If lastC < "a" Or lastC > "z" Then
                             GetNextFormatCode = "z" & GetNextFormatCode
                         Else
                             GetNextFormatCode = Trim(Chr(Asc(lastC) - 1)) & GetNextFormatCode
                         End If
                      Else
                         GetNextFormatCode = "z" & GetNextFormatCode
                      End If
                 Else
                      GetNextFormatCode = IIf(lastC >= "a" And lastC <= "z", lastC, "z") & GetNextFormatCode
                 End If
            
            Else '字母字符递增 a-z
                 If TryNext Then
                      If lastC <> "z" Then
                         TryNext = False
                         If lastC < "a" Or lastC > "z" Then
                             GetNextFormatCode = "a" & GetNextFormatCode
                         Else
                             GetNextFormatCode = Trim(Chr(Asc(lastC) + 1)) & GetNextFormatCode
                         End If
                      Else
                         GetNextFormatCode = "a" & GetNextFormatCode
                      End If
                 Else
                      GetNextFormatCode = IIf(lastC >= "a" And lastC <= "z", lastC, "a") & GetNextFormatCode
                 End If
            End If
        Case "d"  '取当前日值
            GetNextFormatCode = Mid(DateStr, 8 - nD, 1) + GetNextFormatCode
            nD = IIf(nD = 1, 0, nD + 1)
        Case "m"   '取当前月值
            GetNextFormatCode = Mid(DateStr, 6 - nM, 1) + GetNextFormatCode
            nM = IIf(nM = 1, 0, nM + 1)
        Case "y"   '取当前年值
            GetNextFormatCode = Mid(DateStr, 4 - nY, 1) + GetNextFormatCode
            nY = IIf(nY = 3, 0, nY + 1)
        Case Else   '其它固定字符
           GetNextFormatCode = c & GetNextFormatCode
       End Select
       If I = 1 Then
          If TryNext Then      '编码已到极限，无法再递增或递减，函数返回空串。
             GetNextFormatCode = ""
          End If
          Exit Function
       End If
       I = I - 1
    Loop
End Function
'Public Function GetNextFormatCode(ByVal CodeStr As String, ByVal FormatStr As String, Optional Desc As Boolean) As String
'   If FormatStr = "" Then
'     Exit Function
'   End If
'   Dim i As Integer
'   Dim c As String
'   Dim lastC As String
'   Dim TryNext As Boolean
'   Dim nD As Single, nM As Single, nY As Single, DateStr As String
'   Dim Conversion As Boolean '标志是下一字符是否被转意
'   nD = 0
'   nM = 0
'   nY = 0
'   DateStr = Format(Date, "YYYYMMDD")
'   i = Len(FormatStr)
'   TryNext = True
'   Do While True
'       c = Mid(FormatStr, i, 1)
'       lastC = Mid(CodeStr, i, 1)
'       Select Case c
'        Case "#"   '数字字符
'           If Conversion Then
'                GetNextFormatCode = c & GetNextFormatCode
'                Conversion = False
'           Else
'                If Desc Then  '数字字符递增 9-0
'                     If TryNext Then
'                          If lastC <> "0" Then
'                             TryNext = False
'                             If lastC < "0" Or lastC > "9" Then
'                                GetNextFormatCode = "9" & GetNextFormatCode
'                             Else
'                                GetNextFormatCode = Trim(Str(Val(lastC) - 1)) & GetNextFormatCode
'                             End If
'                          Else
'                             GetNextFormatCode = "9" & GetNextFormatCode
'                          End If
'                     Else
'                          GetNextFormatCode = IIf(lastC >= "0" And lastC <= "9", lastC, "9") & GetNextFormatCode
'                     End If
'
'                Else    '数字字符递增 0-9
'                     If TryNext Then
'                          If lastC <> "9" Then
'                             TryNext = False
'                             GetNextFormatCode = IIf(lastC = "", "0", Trim(Str(Val(lastC) + 1))) & GetNextFormatCode
'                          Else