浏览器

开发平台：
Visual Basic

mMix.bas：源码内容
							Attribute VB_Name = "mMix"
Option Explicit
'---------------------------------------------------------------------------------------
' Procedure : Mid2
' DateTime  : ?/?/200? ??:??
' Author    : Lingll
' Purpose   :
'8/5/2005   :strconv使用了LocaleID参数
'---------------------------------------------------------------------------------------
Public Function Mid2(nStr$, Optional Start& = 1, Optional Length&, Optional nEnd$) As String
Dim tmpStr  As String
Dim tEndLen As Long
'Dim rtn$
tmpStr = StrConv(nStr, vbFromUnicode, LocaleID_CurUse)
tEndLen = LenB(StrConv(nEnd, vbFromUnicode, LocaleID_CurUse))
If LenB(tmpStr) > Length + tEndLen Then
    Mid2 = Replace(StrConv(LeftB$(tmpStr, Length), vbUnicode, LocaleID_CurUse), Chr(0), "") & nEnd
Else
    Mid2 = nStr
End If
End Function
Public Function BooleanToBool(nVal As Boolean) As Long
If nVal Then
    BooleanToBool = 1
Else
    BooleanToBool = 0
End If
End Function
Public Function BoolToBoolean(ByVal nVal As Long) As Boolean
BoolToBoolean = (nVal = 1)
End Function
'检查 nUrl 是否类似 nFilterUrl,有通配符 *
Public Function MatchUrl(nFilterUrl As String, nUrl As String) As Boolean
Dim tFUrlArr() As String
Dim i&, ub&, pos1&
Dim rtn As Boolean
tFUrlArr = Split(nFilterUrl, "*")
ub = UBound(tFUrlArr)
pos1 = 1
rtn = True
For i = 0 To ub
    If tFUrlArr(i) <> "" Then
        pos1 = InStr(pos1, nUrl, tFUrlArr(i), vbTextCompare)
        If pos1 > 0 Then
            Select Case i
                Case 0
                    If pos1 <> 1 Then
                        rtn = False
                        Exit For
                    End If
                Case ub
                    If pos1 + Len(tFUrlArr(i)) - 1 <> Len(nUrl) Then
                        rtn = False
                        Exit For
                    End If
            End Select
            pos1 = pos1 + Len(tFUrlArr(i))
        Else
            rtn = False
            Exit For
        End If
    End If
Next i
MatchUrl = rtn
End Function
Public Function GetWindowTextVb(vHwnd&, Optional vBffLen& = 255) As String
Dim tArr() As Byte
ReDim tArr(0 To vBffLen - 1)
Dim tstr$
tstr = Space(vBffLen)
Dim tRLen&
tRLen = GetWindowText(vHwnd, VarPtr(tArr(0)), vBffLen)
Debug.Print tRLen
If tRLen > 0 Then
    If tRLen < vBffLen Then
        ReDim Preserve tArr(0 To tRLen - 1)
    End If
    GetWindowTextVb = StrConv(tArr(), vbUnicode)
Else
    GetWindowTextVb = ""
End If
End Function
'获得扩展名
Public Function GetExtendName(vFile$) As String
Dim tPos&
On Error Resume Next
tPos = InStrRev(vFile, ".")
If tPos > 0 Then
    GetExtendName = Mid$(vFile, tPos + 1)
Else
    GetExtendName = vbNullString
End If
End Function
'获得文件夹
Public Function GetFileFolder(vPath$) As String
Dim tPos&
tPos = InStrRev(vPath, "")
If tPos > 0 Then
    GetFileFolder = Mid$(vPath, 1, tPos - 1)
Else
    GetFileFolder = vbNullString
End If
End Function
'---------------------------------------------------------------------------------------
' Procedure : SwapData
' DateTime  : 2005-4-15 21:56
' Author    : Lingll
' Purpose   : 交换数据,pointer方式
'---------------------------------------------------------------------------------------
Public Sub SwapData(lpt1&, lpt2&)
Dim tPtr&
CopyMemory tPtr, ByVal lpt1, 4
CopyMemory ByVal lpt1, ByVal lpt2, 4
CopyMemory ByVal lpt2, tPtr, 4
End Sub
'Private Function GetAscNM(vStr$, vPos&) As Long
'Dim tAsc&
'CopyMemory tAsc, StrPtr(vStr) + vPos * 2
'End Function
'Public Function IntToLong(vVal As Integer) As Long
'Dim rtn&
'CopyMemory rtn, vVal, 2
'IntToLong = rtn
'End Function
'---------------------------------------------------------------------------------------
' Procedure : CompareString
' DateTime  : 2005-4-19 02:24
' Author    : Lingll
' Purpose   : 比较string,主要是针对中文
'---------------------------------------------------------------------------------------
Private Function CompareString(vLow$, vHigh$) As Boolean
    Dim bResult As Boolean
    
    Dim i&, j&
    Dim lLow&, lHigh&
    Dim aLow&, aHigh&
    Dim tVal&
    
    lLow = Len(vLow)
    lHigh = Len(vHigh)
    
    bResult = False
    For i = 1 To lHigh
        If lLow < i Then
            bResult = True
            Exit For
        Else
            tVal = 0
            CopyMemory tVal, ByVal VarPtr(Asc(Mid(vLow, i, 1))), 2
            aLow = tVal
            
            tVal = 0
            CopyMemory tVal, ByVal VarPtr(Asc(Mid(vHigh, i, 1))), 2
            aHigh = tVal
            
'            aLow = IntToLong(Asc(Mid(vLow, i, 1)))
'            aHigh = IntToLong(Asc(Mid(vHigh, i, 1)))
            If aLow < aHigh Then
                bResult = True
                Exit For
            ElseIf aLow > aHigh Then
                bResult = False
                Exit For
            End If
        End If
    Next i
    CompareString = bResult
End Function
'---------------------------------------------------------------------------------------
' Procedure : SortString
' DateTime  : 2005-4-19 01:44
' Author    : Lingll
' Purpose   : 对string排序,SmallToBig:是否由小到大
'               需要 SwapData sub
'---------------------------------------------------------------------------------------
Public Sub SortString(vStr() As String, pStart&, pEnd&, _
        Optional SmallToBig As Boolean = True)
Dim i&, j&
For i = pEnd To pStart + 1 Step -1
    For j = pStart To i - 1
        If CompareString(LCase$(vStr(j + 1)), LCase$(vStr(j))) = SmallToBig Then
            SwapData VarPtr(vStr(j)), VarPtr(vStr(j + 1))
        End If
    Next j
Next i
End Sub

						