'補足字符串左邊的字段名
'入口參數︰字符串表達式
dim strpbkm
strpbkm=""
Function AddField(ByVal strText,ByVal strEntry)
    Dim strMid
    Dim strFlag
    Dim strBracket
    Dim str1

    If Len(strText) <= 2 Then
    '肯定不是關鍵詞
        AddField = strEntry & "=" & strText
        Exit Function
    End If

    '取出第一個關系表達式左邊的串
    strMid = GetSubStr(strText, strFlag, 2)
    '去掉左邊的括號
    str1 = Left(strMid, 1)
    Do While str1 = "("
        strBracket = strBracket & str1

        strMid = Mid(strMid, 2)

        str1 = Left(strMid, 1)
    Loop

    '確定余下的是否是字段名，如果不是，則加上
    If IsMyField(strMid, False) Then
        AddField = strBracket & strMid & strFlag & strText
    Else
    	AddField = strEntry & "=" & strBracket & strMid & strFlag & strText        
    End If

End Function
Function DO_JournalName(ByVal strKM)
    If strKM = "" Then
        DO_JournalName = ""
        Exit Function
    End If
    
    Dim strRes
    Dim arrKM, intI, intJ
    Dim strTemp, strMid
    Dim arrMidKM
    
    arrKM = Split(strKM, Chr(2))
    
    For intI = 0 To UBound(arrKM)
        strTemp = arrKM(intI)
        
        strTemp = Replace(strTemp, "(", "")
        strTemp = Replace(strTemp, ")", "")
        strTemp = Replace(strTemp, "+", Chr(2))
        strTemp = Replace(strTemp, "*", Chr(2))
        strTemp = Replace(strTemp, "-", Chr(2))
        
        arrMidKM = Split(strTemp, Chr(2))
        For intJ = 0 To UBound(arrMidKM)
            strRes = strRes & "," & "'" & Trim(arrMidKM(intJ)) & "'"
        Next
    Next
    If Len(strRes) > 0 Then
        strRes = Mid(strRes, 2)
    End If
    
    DO_JournalName = strRes
End Function
'分隔字符串
Function SeprateString(ByRef strChar, ByVal strseprator)
    Dim intPos
    Dim sValue
    Dim I
    Dim nYHCount
    nYHCount = 0
    If InStr(strChar, strseprator) = 0 Then
        SeprateString = strChar
        strChar = ""
        Exit Function
    End If
    If strseprator = "=" Then
        sValue = strChar
        For I = 1 To Len(sValue)
            If Mid(sValue, I, 1) = "=" Then
                If (nYHCount Mod 2) = 0 Then
                    SeprateString = Left(strChar, I - 1)
                    strChar = Mid(strChar, I + Len(strseprator))
                    Exit Function
                End If
            ElseIf Mid(sValue, I, 1) = """" Then
                nYHCount = nYHCount + 1
            End If
        Next
        SeprateString = strChar
        strChar = ""
    Else
        intPos = InStr(strChar, strseprator)
        SeprateString = Left(strChar, intPos - 1)
        strChar = Mid(strChar, intPos + Len(strseprator))
    End If  
End Function
Function GetSubStr(ByRef strSource, ByRef strFlag, ByVal intIsLogic)
    Dim intPos
    Dim strMid
    Dim strLogic

    If intIsLogic = 1 Then
        strLogic = "*,+,-,=,>,<,>=,<=,<>,(,)"
    ElseIf intIsLogic = 2 Then
        strLogic = "=,>,<,>=,<=,<>"
    ElseIf intIsLogic = 3 Then
        strLogic = "(,)"
    ElseIf intIsLogic = 4 Then
        strLogic = "*,+,-"
    End If

    For intPos = 1 To Len(strSource)
        strMid = Mid(strSource, intPos, 1)

        If InStr(strLogic, strMid) > 0 Then
            If strMid = ">" Or strMid = "<" Then
                If InStr("=,>", Mid(strSource, intPos + 1, 1)) > 0 Then
                    strMid = Mid(strSource, intPos, 2)
                    GetSubStr = Left(strSource, intPos)
                    strSource = Mid(strSource, intPos + 3)
                    strFlag = strMid
                Else
                    GetSubStr = Left(strSource, intPos)
                    strSource = Mid(strSource, intPos + 1)
                    strFlag = strMid
                End If
            Else
                GetSubStr = Left(strSource, intPos - 1)
                strSource = Mid(strSource, intPos + 1)
                strFlag = strMid
            End If
            Exit function
        End If
    Next
    GetSubStr = strSource
    strSource = ""
    strFlag = ""
End Function
'確定是否是庫中定義的字段
'入口參數︰要確定是否是字段的字母
'@@ 表示任意字段
Function IsMyField(ByVal strChar, ByVal IsField)
    Dim strFF

    strChar= Ucase(strChar)
    strFF = "KEYWORD_C,NAME_C,WRITER,FIRSTWRITER,ORGAN,TITLE_C,REMARK_C,CLASS,任意字段"
    If Trim(strChar) = "" Then
        IsMyField = False
        Exit Function
    End If
    If Not IsField Then strFF = "K,J,A,F,S,T,R,C,M,U,M,Y"

    IsMyField = CBool(InStr("," & strFF & ",", "," & Trim(strChar) & ","))
End Function

'確定是否是關系運算符
Function IsMyRelation(ByVal strChar)
    If Trim(strChar) = "" Then
        IsMyRelation = False
        Exit Function
    End If

    If InStr(",=,>,<,>=,<=,<>,", "," & Trim(strChar) & ",") >0 then
		IsMyRelation = True
    Else
		IsMyRelation = False
    End If
End Function

'確定是否是括號
Function IsBracket(ByVal strChar)
    If Trim(strChar) = "" Then
        IsBracket = False
        Exit Function
    End If
    IsBracket = CBool(InStr(",),(,", "," & Trim(strChar) & ","))
End Function

function IsOperation(byval sChar)
   dim sXX
   
   sXX = ",*,+,-,"
   sChar = "," & sChar & ","
   IsOperation = (Instr(sXX,sChar)>0)
end function
Function GetRigorExpress(ByVal sChar,byval bRigor)
    If sChar = "" Then Exit Function
    
    Dim I,J,bFound,strMid,strNewChar
    
    J = 1
    strMid = Mid(sChar, J, 1)
    Do While IsBracket(strMid) Or IsMyRelation(strMid) Or IsOperation(strMid)
        strMid = Mid(sChar, J, 1)
        J = J + 1
    Loop
    
    If J = 1 Then J = J + 1
    J = J - 1 - 1
    if bRigor then
    	strNewChar = Left(sChar, J) & "["
    else
    	strNewChar = Left(sChar, J) & ""
    end if
    bFound = False
    For I = J + 1 To Len(sChar)
        strMid = Mid(sChar, I, 1)
        
        If IsBracket(strMid) Or IsMyRelation(strMid) Or IsOperation(strMid) Then
            If Not bFound Then
            	if bRigor then
                	strNewChar = strNewChar & "]" & strMid
                else
                	strNewChar = strNewChar & "" & strMid
                end if
            Else
                strNewChar = strNewChar & strMid
            End If
            
            bFound = True
        Else
            If bFound Then
            	if bRigor then
                	strNewChar = strNewChar & "[" & TRIM(strMid)
                else
                	strNewChar = strNewChar & "" & strMid
                end if
            Else
                strNewChar = strNewChar & strMid
            End If
            bFound = False
        End If
    Next
    If Not bFound Then
    	if bRigor then
        	strNewChar = strNewChar & "]"
        else
        	strNewChar = strNewChar & ""
        end if
    End If
    strNewChar = Replace(strNewChar,"[]","")
    
    GetRigorExpress = strNewChar
End Function
Function GetBlueValue(ByVal sValue)
Dim nLeftBracketCount, nRightBracketCount
Dim sTempValue
Dim I, nPos
Dim IsInYH

If sValue = "" Then
    GetBlueValue = ""
    Exit Function
End If

sValue = Trim(sValue)

nLeftBracketCount = 0: nRightBracketCount = 0
IsInYH = false
For I = 1 To Len(sValue)
    If Mid(sValue, I, 1) = "(" Then
        If not IsInYH Then
            nLeftBracketCount = nLeftBracketCount + 1
        End If
    ElseIf Mid(sValue, I, 1) = ")" Then
        If not IsInYH Then
            nRightBracketCount = nRightBracketCount + 1
        End if
    ElseIf Mid(sValue, I, 1) = """" then
    	if IsInYH then
    		IsInYH = false
    	else
    		IsInYH = true
    	end if
    End If
Next

If nLeftBracketCount <> nRightBracketCount Then
    If nLeftBracketCount > nRightBracketCount Then
        For I = 1 To (nLeftBracketCount - nRightBracketCount)
            nPos = InStr(sValue, "(")
            sValue = Left(sValue, nPos - 1) & Mid(sValue, nPos + 1)
        Next
    Else
        sValue = StrReverse(sValue)
        For I = 1 To (nRightBracketCount - nLeftBracketCount)
            nPos = InStr(sValue, ")")
            sValue = Left(sValue, nPos - 1) & Mid(sValue, nPos + 1)
        Next
    	sValue = StrReverse(sValue)
    End if
    sValue = Trim(sValue)
	Do While IsBracket(Left(sValue, 1))
		sValue = Trim(Mid(sValue, 2))
	Loop
	Do While IsBracket(Right(sValue, 1))
		sValue = Trim(Left(sValue, Len(sValue) - 1))
	Loop
End If

sValue = Trim(sValue)
Do While IsOperation(Left(sValue, 1)) Or IsMyRelation(Left(sValue, 1))
sValue = Trim(Mid(sValue, 2))
Loop
Do While IsOperation(Right(sValue, 1)) Or IsMyRelation(Right(sValue, 1))
sValue = Trim(Left(sValue, Len(sValue) - 1))
Loop
GetBlueValue = Trim(sValue)
End Function
function GetShowExpress(ByVal strText, ByVal strEntry)
	if strText="" then exit function
    strText = Replace(strText,"　"," ")
    strText = Replace(strText,"（","(")
    strText = Replace(strText,"）",")")
    strText = Replace(strText,"＋","+")
    strText = Replace(strText,"＊","*")
    strText = Replace(strText,"－","-")
    strText = Replace(strText,"＝","=")
    strText = UCase(strText)
    strText = AddField(strText,strEntry)
    strShow = strText
    strShow = replace(strShow,"M=","題名或關鍵詞=")
    strShow = replace(strShow,"U=","任意字段=")
    strShow = replace(strShow,"A=","作者=")
    strShow = replace(strShow,"F=","第一作者=")
    strShow = replace(strShow,"C=","分類號=")
    strShow = replace(strShow,"S=","機構=")
    strShow = replace(strShow,"K=","關鍵詞=")
    strShow = replace(strShow,"Y=","參考文獻=")
    strShow = replace(strShow,"T=","題名=")
    strShow = replace(strShow,"J=","刊名=")
    strShow = replace(strShow,"R=","文摘=")
    strShow = replace(strShow,"""","")
    GetShowExpress = strShow
end function
function GetExpress(ByVal strText, ByRef strSameMean  ,ByVal strEntry , ByRef strShow ,ByVal bFlag,ByRef strKM)
    if strText="" then exit function
    strText = Replace(strText,"　"," ")
    strText = Replace(strText,"（","(")
    strText = Replace(strText,"）",")")
    strText = Replace(strText,"＋","+")
    strText = Replace(strText,"＊","*")
    strText = Replace(strText,"－","-")
    strText = Replace(strText,"＝","=")
    strText = UCase(strText)
    strText = AddField(strText,strEntry)
    strShow = strText
    strShow = replace(strShow,"M=","題名或關鍵詞=")
    strShow = replace(strShow,"U=","任意字段=")
    strShow = replace(strShow,"A=","作者=")
    strShow = replace(strShow,"F=","第一作者=")
    strShow = replace(strShow,"C=","分類號=")
    strShow = replace(strShow,"S=","機構=")
    strShow = replace(strShow,"K=","關鍵詞=")
    strShow = replace(strShow,"Y=","參考文獻=")
    strShow = replace(strShow,"T=","題名=")
    strShow = replace(strShow,"J=","刊名=")
    strShow = replace(strShow,"R=","文摘=")
    'strShow = replace(strShow,"""","")

	dim sField,sExpress,sMid,I,J,K,sNewExpress,sValue,sXX,sXY
	dim sNewField,bFound,sExtractValue,sBracket
	Dim sOldValue, sBlueValue
	Dim blnDoSameWriter, blnDoSameMean	
	blnDoSameWriter=false : blnDoSameMean=false
	sOldValue = "" : sBlueValue = ""
	I = 0
	
	sMid = SeprateString(strText,"=")
	do While sMid <> ""
		if I=0 then
			sField = sField & "\~" & sMid
		else
			if strText <> "" then
				sXX = RTrim(sMid)
				if Len(sXX)>1 Then
					For J=Len(sXX)-1 to 0 Step -1
						if MId(sXX,J,1) <> " " then
							if IsOperation(MId(sXX,J,1)) Or IsBracket(MId(sXX,J,1)) then
								sField = sField & "\~" & Right(sXX,1)
								sExpress=sExpress & "\~" & Left(sXX,len(sXX)-1)
							else
								sExpress=sExpress & "\~" & sMid & "=" & SeprateString(strText,"=")
							end if
							exit for
						end if
					Next
				Else
					sField = sField & "\~" & Right(RTrim(sMid),1)
					sExpress=sExpress & "\~" & Left(RTrim(sMid),len(RTrim(sMid))-1)
				End if
			else
				if sMid <> "" then sExpress=sExpress & "\~" & sMid
			end if
		end if
	I = I+1
	sMid = SeprateString(strText,"=")
	Loop
	if sField <> "" then sField = Mid(sField,3)
	if sExpress <> "" then sExpress = Mid(sExpress,3)
	
	sMid = SeprateString(sField,"\~")
	sValue = SeprateString(sExpress,"\~")
	do While sMid <> ""
		if Instr(sMid,"U")>0 then
			if IsOperation(Right(RTrim(sValue),1)) then
				sField = Right(RTrim(sValue),1) & sField
				sValue = Left(sValue,len(RTrim(sValue))-1)
			end if
			nJ = Len(sValue)
			for J = nJ to 1 step -1
				sXX = Mid(sValue,J,1)
				if sXX = ")" then
					nK = Len(sMid)
					for K = 1 to nK step 1
						sXY = Mid(sMid,K,1)
						if sXY = "(" then
							sBracket = sXY & sBracket
							sMid = Left(sMid,K-1) & Mid(sMid,K+1)
							k = k+1
						end if
					next
					J = J-1
				end if
			next
			sValue = sBracket & sValue
			sValue = Trim(sValue)
			sValue = Replace(sValue," ","*")
			Do While Instr(sValue,"**")>0
				sValue = Replace(sValue,"**","*")
			Loop
			Do While Instr(sValue,"*+")>0
				sValue = Replace(sValue,"*+","+")
			Loop
			Do While Instr(sValue,"+*")>0
				sValue = Replace(sValue,"+*","*")
			Loop
			Do While Instr(sValue,"*-")>0
				sValue = Replace(sValue,"*-","-")
			Loop
			Do While Instr(sValue,"-*")>0
				sValue = Replace(sValue,"-*","*")
			Loop

			If sValue <> "" Then sNewExpress = sNewExpress & Replace(sMid,"U","任意字段") & "=" & sValue
		else
			if bFlag then
				if Instr(sMid,"R")>0 then
					sExtractValue = GetRigorExpress(sValue,False)
				elseif Instr(sMid,"T")>0 then
					sExtractValue = GetRigorExpress(sValue,False)
				else
					sValue = Replace(sValue, "(", "%0x0028%")
			        sValue = Replace(sValue, ")", "%0x0029%")
					sExtractValue = GetRigorExpress(sValue,True)
				end if
			else
				if Instr(sMid,"J")>0 then
					sValue = Replace(sValue, "(", "%0x0028%")
			        sValue = Replace(sValue, ")", "%0x0029%")
					sExtractValue = GetRigorExpress(sValue,False)
				else
					sExtractValue = GetRigorExpress(sValue,False)
				end if
			end if
			If InStr(sMid, "M") = 0 Then
				sExtractValue = Trim(sExtractValue)
				sExtractValue = Replace(sExtractValue," ","*")
				Do While Instr(sExtractValue,"**")>0
					sExtractValue = Replace(sExtractValue,"**","*")
				Loop
				Do While Instr(sExtractValue,"*+")>0
					sExtractValue = Replace(sExtractValue,"*+","+")
				Loop
				Do While Instr(sExtractValue,"+*")>0
					sExtractValue = Replace(sExtractValue,"+*","*")
				Loop
				Do While Instr(sExtractValue,"*-")>0
					sExtractValue = Replace(sExtractValue,"*-","-")
				Loop
				Do While Instr(sExtractValue,"-*")>0
					sExtractValue = Replace(sExtractValue,"-*","*")
				Loop
			end if
			sBlueValue = GetBlueValue(GetRigorExpress(sValue,False))
			If InStr(sMid, "J") > 0 Then
                strKM = strKM & Chr(2) & sBlueValue
                strKM = Replace(strKM,"""","")
            End If
			if blnDoSameWriter then
				If InStr(sMid, "A") > 0 OR InStr(sMid, "F") > 0 Then
					If strSameWriter = "" Then
						strSameWriter = "A=" & sBlueValue 
					Else
						strSameWriter = strSameWriter & sOldValue & sBlueValue
					End If
				end if
			end if
			if blnDoSameMean then
				If InStr(sMid, "K") > 0 Then
					If strSameMean = "" Then
						strSameMean = "K=" & sBlueValue
					Else
						strSameMean = strSameMean & sOldValue & sBlueValue
					End If
				ElseIf InStr(sMid, "T") > 0 Then
					If strSameMean = "" Then
						strSameMean = "K=" & sBlueValue
					Else
						strSameMean = strSameMean & sOldValue & sBlueValue
					End If
				ElseIf InStr(sMid, "M") > 0 Then
					If strSameMean = "" Then
						strSameMean = "K=" & sBlueValue
					Else
						strSameMean = strSameMean & sOldValue & sBlueValue
					End If
				End If
			End if
			if Instr(sMid,"K")>0 then
				sMid = Replace(sMid,"K","Keyword_C")
			elseif Instr(sMid,"A")>0 then
				sMid = Replace(sMid,"A","Writer")
			elseif Instr(sMid,"F")>0 then
				sMid = Replace(sMid,"F","FirstWriter")
			elseif Instr(sMid,"J")>0 then
				sMid = Replace(sMid,"J","Name_C")
			elseif Instr(sMid,"S")>0 then
				sMid = Replace(sMid,"S","Organ")
			elseif Instr(sMid,"T")>0 then
				sMid = Replace(sMid,"T","Title_C")
			elseif Instr(sMid,"R")>0 then
				sMid = Replace(sMid,"R","Remark_C")
			elseif Instr(sMid,"C")>0 then
				sMid = Replace(sMid,"C","Class")
			elseif Instr(sMid,"Y")>0 then
				sMid = Replace(sMid,"Y","strRef")
			else
				sMid = Replace(sMid,"U","任意字段")
			end if
			if Instr(sMid,"Class")>0 then
				If IsOperation(Right(sExtractValue, 1)) Then
                    sExtractValue = Replace(Left(sExtractValue, Len(sExtractValue) - 1), "-", "%0x002D%") & Right(sExtractValue, 1)
                Else
                    sExtractValue = Replace(sExtractValue, "-", "%0x002D%")
                End If
                If bFlag Then
                    If sExtractValue <> "" Then sNewExpress = sNewExpress & sMid & "=" & sExtractValue
                Else
                    If sExtractValue <> "" Then
                        If IsOperation(Right(sExtractValue, 1)) Then
                            sExtractValue = Replace(Left(sExtractValue, Len(sExtractValue) - 1), "+", "+[") & Right(sExtractValue, 1)
                        Else
                            sExtractValue = Replace(sExtractValue, "+", "+[")
                        End If
                        sNewExpress = sNewExpress & sMid & "=[" & sExtractValue
                    End If
                End If
			Else
				If InStr(sMid, "M") > 0 Then
                    If sExtractValue <> "" Then sNewExpress = sNewExpress & Trim(Left(sMid, Len(RTrim(sMid)) - 1)) & Trim(Left(sExtractValue, InStr(sExtractValue, sBlueValue) - 1)) & "(Keyword_C=(" & replace(sBlueValue," ","*") & ")+Title_C=(" & replace(sBlueValue," ","*") & "))" & Trim(Mid(sExtractValue, InStr(sExtractValue, sBlueValue) + Len(sBlueValue) + 0))
                Else
                    If sExtractValue <> "" Then sNewExpress = sNewExpress & sMid & "=" & sExtractValue
                End If
			End if
		end if
		
		If IsOperation(Right(sExtractValue, 1)) Then sOldValue = Right(sExtractValue, 1)
		I = I+1
		
		sMid = SeprateString(sField,"\~")
		sValue = SeprateString(sExpress,"\~")
	loop
	Dim strMid, strDeal
	Dim nTemp, nBegin, nEnd, strRes
	strRes = ""
	For nTemp = 1 To Len(sNewExpress)
	    strMid = Mid(sNewExpress, nTemp, 1)
	    If strMid = """" Then
	        If nBegin > 0 Then
	            nEnd = nTemp
	            
	            strDeal = Mid(sNewExpress, nBegin + 1, nEnd - nBegin - 1)
	            strDeal = Replace(strDeal, "+", "%0x002B%")
	            strDeal = Replace(strDeal, "-", "%0x002D%")
	            strDeal = Replace(strDeal, "*", "%0x002A%")
	            strDeal = Replace(strDeal, "(", "%0x0028%")
	            strDeal = Replace(strDeal, ")", "%0x0029%")
	            strDeal = Replace(strDeal, "{", "%0x007B%")
	            strDeal = Replace(strDeal, "}", "%0x007D%")
	            strDeal = Replace(strDeal, "=", "%0x003D%")
	            strRes = strRes & strDeal
	            
	            nBegin = 0
	            nEnd = 0
	        Else
	            nBegin = nTemp
	        End If
	    Else
	        If nBegin = 0 Then
	            strRes = strRes & strMid
	        End If
	    End If
	Next
	If nBegin > 0 And nEnd = 0 Then
	    strRes = strRes & Mid(sNewExpress, nBegin)
	End if
	strKM = DO_JournalName(strKM)
	strpbkm = strKM
	strRes = replace(strRes,"[[","[")
	strRes = replace(strRes,"]]","]")
    GetExpress = strRes   
end function
Public Function GetSameValue(ByVal sValue)
    If sValue = "" Then GetSameValue = "": Exit Function
    Dim sMid, sField, sNewValue, sNewExpress
    Dim nI
    
    'get field name
    sNewValue = ""
    sField = SeprateString(sValue, "=")
    sField = Replace(sField, "(", ""): sField = Replace(sField, "（", "")
    For nI = 1 To Len(sValue)
        sMid = Mid(sValue, nI, 1)
        If IsOperation(sMid) Or IsMyRelation(sMid) Or IsBracket(sMid) Then
            If sNewValue <> "" Then
                If sMid <> "=" Then sNewExpress = sNewExpress & "/@/" & sField & "=" & sNewValue
                sNewValue = ""
            End If
        Else
            sNewValue = sNewValue & sMid
        End If
    Next
    If sNewValue <> "" Then
        If sMid <> "=" Then sNewExpress = sNewExpress & "/@/" & sField & "=" & sNewValue
        sNewValue = ""
    End If
    If sNewExpress <> "" Then sNewExpress = Mid(sNewExpress, 4)
    
    GetSameValue = sNewExpress
End Function