mdlformat.bas

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

Attribute VB_Name = "MdlFormat"
'#########################################################################
'获取关键字中的信息
'参数：RtnValue返回值 KeyWord 要读取的信息 Node_Key 关键字
'返回Boolean 调用FrmMain
'#########################################################################
Public Function GetValue(RtnValue As String, KeyWord As String, Node_Key As String) As Boolean
On Error GoTo Err
Dim FindStr As String
Dim StartPos As Integer
Dim StartPos2 As Integer
RtnValue = ""
Select Case UCase(KeyWord)
   Case "WHERE" '查询子句
       FindStr = "@W"
   Case "ORDER" '排序子句
       FindStr = "@O"
   Case "NODE_ID", "VOLUME_ID", "FILE_ID", "ID" '对象序列号
       FindStr = "@I"
   Case "FIELD_NAME_EN", "FIELD_NAME" '数据库中子段名称, "FIELD_NAME"
       FindStr = "@F"
   Case "TABLE_NAME" '表名
       FindStr = "@T"
   Case "VALUE" '子段的值
       FindStr = "@V"
   Case "CATALOGNO"
       FindStr = "@C"
   '文件状态+移交标志+销毁标志+借阅状态
   '卷盒标志+组卷标志+移交标志+销毁标志
   Case "STATUS"
       FindStr = "@S"
   Case "VIEW_LIST" '显示列表类型
       FindStr = "@L"
   Case "DICT_TYPE" '数据字典类型
       FindStr = "@D"
   Case "TYPE_CODE", "TYPE", "DATA_TYPE" '档案类型,显示类型,数据类型
       FindStr = "@P"
   Case "INDEX" '节点索引值
       FindStr = "@X"
   Case "VOLUME_INDEX" '节点索引值
       FindStr = "@VX"
   Case "NODE_INDEX" '节点索引值
       FindStr = "@NX"
   Case "IS_NULL" '字段是否允许为空
       FindStr = "@N"
   Case "IS_DEFINED" '字段是否为自定义
       FindStr = "@DF"
   Case "1", "2", "3", "4", "5", "6"
       FindStr = "@" + KeyWord
   Case Else
       MsgBox UCase(KeyWord)
End Select

StartPos = InStr(1, Node_Key, FindStr)
If StartPos <> 0 Then
   StartPos2 = InStr(StartPos + 1, Node_Key, "@")
   If StartPos2 <> 0 Then
      RtnValue = Mid(Node_Key, StartPos + Len(FindStr), StartPos2 - StartPos - Len(FindStr))
   Else
      RtnValue = Mid(Node_Key, StartPos + Len(FindStr))
   End If
Else
   GoTo Err
End If
RtnValue = Trim(RtnValue)
GetValue = True
Exit Function
Err:
   GetValue = False
   RtnValue = ""
End Function


'参数：pOrgString原始字符串 pRemoveString 要删除的字符串
'     pRemoveType 删除方式 0首尾都要删除 1首删除 2尾删除
'返回Boolean 调用FrmMain
'#########################################################################
Public Function RemoveString(pOrgString As String, pRemoveString As String, pRemoveType As Integer) As String
On Error GoTo Err
Dim tStrLen As Integer '删除的字符串长度
pOrgString = Trim(pOrgString)
pRemoveString = Trim(pRemoveString)
tStrLen = Len(pRemoveString)
RemoveString = pOrgString
If pRemoveType = 0 Or pRemoveType = 1 Then '首删除
   If Mid(pOrgString, 1, tStrLen) = pRemoveString Then RemoveString = Mid(pOrgString, tStrLen + 1)
End If
If pRemoveType = 0 Or pRemoveType = 2 Then '尾删除
   If Right(pOrgString, tStrLen) = pRemoveString Then RemoveString = Mid(pOrgString, 1, Len(pOrgString) - tStrLen)
End If
Exit Function
Err:
   RemoveString = pOrgString
End Function





Public Function ConvertFieldValue(pField_Value As Variant, pSystem_Dict_Type As Integer, pField_Name As String, pTable_Type As Integer) As String
On Error GoTo Err
Dim tRst
Dim tStr As String
tStr = ConvertNull(pField_Value)
If pSystem_Dict_Type <> 0 Then
   If gConvert_To_Dict = True Then
      ConvertFieldValue = Trim(Convert_Dict_Value(pSystem_Dict_Type, tStr, 0))
   Else
      GoTo Err
   End If
   Exit Function
End If
If pTable_Type = 0 Then '案卷表
    Select Case UCase(pField_Name)
       Case "TYPE_CODE" '档案类型
         Set tRst = gDbs.OpenRecordset("select TYPE_NAME from ARCHIVE_TYPE where TYPE_CODE='" + tStr + "'")
         If tRst.EOF Then GoTo Err
         ConvertFieldValue = tRst.Fields(0)
       Case "TYPE" '组卷类型
         If tStr = "0" Then
           ConvertFieldValue = "案卷"
         ElseIf tStr = "0" Then
           ConvertFieldValue = "档案盒"
         End If
       Case "BORROW_STATUS"
         If tStr = "0" Then
           ConvertFieldValue = "未借阅"
         ElseIf tStr = "1" Then
           ConvertFieldValue = "实物已借阅"
         ElseIf tStr = "2" Then
           ConvertFieldValue = "已还"
         End If
       Case "TRANSFER_FLAG"
         If tStr = "0" Then
           ConvertFieldValue = "未移交"
         ElseIf tStr = "1" Then
           ConvertFieldValue = "已移交"
         End If
       Case "DESTRUCTION_FLAG"
         If tStr = "0" Then
           ConvertFieldValue = "未销毁"
         ElseIf tStr = "1" Then
           ConvertFieldValue = "已销毁"
         End If
       Case "STATUS"
         If tStr = "0" Then
           ConvertFieldValue = "未归档"
         ElseIf tStr = "1" Then
           ConvertFieldValue = "已归档"
         ElseIf tStr = "2" Then
           ConvertFieldValue = "暂组卷"
         ElseIf tStr = "3" Then
           ConvertFieldValue = "已封卷"
         ElseIf tStr = "4" Then
           ConvertFieldValue = "暂组盒"
         ElseIf tStr = "5" Then
           ConvertFieldValue = "已封盒"
         End If
       Case Else
         GoTo Err
    
    End Select
ElseIf pTable_Type = 2 Then
    If UCase(pField_Name) = "USER_ID" Then
         Set tRst = gDbs.OpenRecordset("select user_name from user_table where user_id=" + tStr)
         If tRst.EOF Then GoTo Err
         ConvertFieldValue = tRst.Fields(0)
    Else
         GoTo Err
    End If
ElseIf pTable_Type = 2 Then
    If UCase(pField_Name) = "RIGHTS" Then
       If tStr = "1" Then
          ConvertFieldValue = "可查看"
       ElseIf tStr = "2" Then
          ConvertFieldValue = "可打印"
       ElseIf tStr = "3" Then
          ConvertFieldValue = "可修改"
       ElseIf tStr = "0" Then
          ConvertFieldValue = "无权限"
       End If
    Else
       GoTo Err
    End If
Else
    GoTo Err

End If

Exit Function
Err:
   ConvertFieldValue = tStr
End Function

'#########################################################################
'数据字典转换
'参数：p_Type数据字典中的代码类型 pOrg_Value要转换的值 可以是code 或code对应的值
'     pConvertType转换类型 0代码->值 1值->代码
'返回：String 返回的值
'#########################################################################
Public Function Convert_Dict_Value(p_Type As Integer, pOrg_Value As String, pConvertType As Integer) As String
On Error GoTo Err
Dim tRst
If p_Type = 0 Or gConvert_To_Dict = False Then GoTo Err

'0代码->值
If pConvertType = 0 Then
   Set tRst = gDbs.OpenRecordset("select name from system_dict where int(code)=" + Trim(pOrg_Value) + " and type=" + CStr(p_Type))
   If tRst.EOF Then GoTo Err
'1值->代码
ElseIf pConvertType = 0 Then
   Set tRst = gDbs.OpenRecordset("select code from system_dict where name='" + pOrg_Value + "' and type=" + CStr(p_Type))
   If tRst.EOF Then GoTo Err
Else
   GoTo Err
End If
Convert_Dict_Value = tRst.Fields(0)
Exit Function
Err:
   Convert_Dict_Value = pOrg_Value
End Function