在好例子网,分享、交流、成长!
您当前所在位置:首页ASP 开发实例VB界面编程 → VB6高级版API浏览器

VB6高级版API浏览器

VB界面编程

下载此实例
  • 开发语言:ASP
  • 实例大小:0.16M
  • 下载次数:33
  • 浏览次数:1233
  • 发布时间:2020-03-30
  • 实例类别:VB界面编程
  • 发 布 人:56390
  • 文件格式:.zip
  • 所需积分:2
 相关标签: 浏览器 API VB6 浏览 vb

实例介绍

【实例简介】VB6高级版API浏览器,可替代内置的WINAPI浏览器,功能更强大,有分类筛选功能,实现快速精准定位,并且附带了几个WIN10风格的控件。
【实例截图】

from clipboard


from clipboard


from clipboard



【核心代码】

Option Explicit

Private Type apiEntry
    DisplayName As String   ' Displayed name (Searchable)
    Library As String       ' Library in which a Sub/Function is located
    Code As String          ' Complete entry code
    EntryType As Integer    ' 1 = Constant, 2 = Declare, 3 = Type
End Type

Private Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long
Private Declare Function LockWindowUpdate Lib "user32" (ByVal hWndLock As Long) As Long

Private Const COLOR_BTNSHADOW = 16
Private Const COLOR_BTNFACE = 15
Private Const COLOR_WINDOW = 5

Private Const WM_KEYDOWN = &H100

Private vCategories As Variant
Private vCategoryDeclares(61) As Variant

Private APIEntries() As apiEntry
Private DLLEntries() As String

Private APIFileLoaded As Boolean
Private ListSearchIndex As Long

Private Sub chkNoComments_Click()
    UpdateFullTextView
End Sub

Private Sub chkScope_Click(Index As Integer)
    UpdateFullTextView
End Sub

Private Sub cmbCategories_Click()
    ChangeListingType cmbEntryType.ListIndex
End Sub

Private Sub cmbEntryType_Click()
    SetCategoriesEnabled cmbEntryType.ListIndex = 1
    ChangeListingType cmbEntryType.ListIndex
End Sub

Private Sub cmbLibraryList_Click()
    ChangeListingType cmbEntryType.ListIndex
End Sub

Private Sub cmdClear_Click()
    lstSelectedItems.Clear

    cmdClear.Enabled = False
    cmdCopy.Enabled = False
    cmdInsert.Enabled = False
    cmdRemove.Enabled = False

    UpdateFullTextView
End Sub

Private Sub cmdCopy_Click()
    Clipboard.SetText CStr(txtItemText.Text), vbCFText
End Sub

Private Sub cmdLoadFile_Click()
    LoadAPIFile App.Path & "\win32api.txt"
End Sub

Private Sub cmdRemove_Click()
    Dim dwSelIndex As Long

    dwSelIndex = lstSelectedItems.ListIndex
    If dwSelIndex > -1 Then
        lstSelectedItems.RemoveItem dwSelIndex
        If dwSelIndex > 0 And lstSelectedItems.ListCount > 0 Then
            dwSelIndex = dwSelIndex - 1
        ElseIf lstSelectedItems.ListCount > 0 Then
            dwSelIndex = 0
        Else
            dwSelIndex = -1
        End If

        If dwSelIndex > -1 Then
            lstSelectedItems.ListIndex = dwSelIndex
        Else
            cmdClear.Enabled = False
            cmdCopy.Enabled = False
            cmdInsert.Enabled = False
            cmdRemove.Enabled = False
        End If

        UpdateFullTextView
    End If
End Sub

Private Sub cmdShow_Click()
    PopupMenu menu_showpopup, , cmdShow.Left, cmdShow.Top   cmdShow.Height
End Sub

Private Sub Form_Load()
    On Local Error Resume Next

    Dim intIndex As Integer

    vCategories = Array("(None)", "Accessibility", "Audio", "Bitmaps", "Brushes", "Console", "Common Controls", "Common Dialog", "Communication", "Cursor", "Devices", "Dialog Boxes", "Errors", "Events", "Event Logs", "Files & Directories", "File System", "Filled Shapes", "Fonts & Text", "Handles", "Help", "Icons", "INI Files", "Input (General)", "Joysticks", "Keyboard", "Lines & Curves", "Libraries", "Math", "Media Control Interface (MCI)", "Memory", "Menus", "Messages", "Mouse", "National Language Support", "OLE", "Painting & Drawing", "Pens", "Pointers", "Printers", "Pipes", "Processes & Threads", "Rectangles", "Regions", "Registry", "Resources", "Shell", "Shutdown", "Strings", "SIDs", "Synchronization", "System Information", "Tape Devices", "Time", "Timers", "Tool Help", "Tokens", "Window Classes", "Window Procedures", "Window Properties", "Windows", "Winsock", "Other")

    vCategoryDeclares(0) = " getsystemmetrics systemparametersinfo "
    vCategoryDeclares(1) = " auxgetdevcaps auxgetnumdevs auxgetvolume auxsetvolume playsound sndplaysound waveoutgetdevcaps waveoutgetnumdevs waveoutgetvolume waveoutsetvolume "
    vCategoryDeclares(2) = " bitblt extfloodfill getpixel setpixel setpixelv stretchblt "
    vCategoryDeclares(3) = " createhatchbrush createsolidbrush getbrushorgex setbrushorgex "
    vCategoryDeclares(4) = " readconsoleoutput writeconsoleoutput readconsoleoutputcharacter readconsoleoutputattribute writeconsoleoutputcharacter writeconsoleoutputattribute fillconsoleoutputcharacter fillconsoleoutputattribute getconsolemode getnumberofconsoleinputevents getconsolescreenbufferinfo getlargestconsolewindowsize getconsolecursorinfo getnumberofconsolemousebuttons setconsolemode setconsoleactivescreenbuffer flushconsoleinputbuffer setconsolescreenbuffersize setconsolecursorposition setconsolecursorinfo scrollconsolescreenbuffer setconsolewindowinfo setconsoletextattribute setconsolectrlhandler generateconsolectrlevent allocconsole freeconsole getconsoletitle setconsoletitle readconsole writeconsole createconsolescreenbuffer getconsolecp setconsolecp getconsoleoutputcp setconsoleoutputcp "
    vCategoryDeclares(5) = " initcommoncontrolsex "
    vCategoryDeclares(6) = " choosecolor choosefont commdlgextendederror getopenfilename getsavefilename printdlg "
    vCategoryDeclares(7) = " setcommstate setcommtimeouts getcommstate getcommtimeouts purgecomm buildcommdcb buildcommdcbandtimeouts transmitcommchar setcommbreak setcommmask clearcommbreak clearcommerror setupcomm escapecommfunction getcommmask getcommproperties getcommmodemstatus waitcommevent "
    vCategoryDeclares(8) = " clipcursor createcursor destroycursor getclipcursor getcursor getcursorpos loadcursor loadcursorfromfile setcursor setcursorpos setsystemcursor showcursor "
    vCategoryDeclares(9) = " createdc deletedc deleteobject getdc getstockobject releasedc selectobject "
    vCategoryDeclares(10) = " messagebox messageboxex messageboxindirect "
    vCategoryDeclares(11) = " beep getlasterror messagebeep setlasterror setlasterrorex "
    vCategoryDeclares(12) = " setevent resetevent pulseevent deregistereventsource registereventsource reportevent "
    vCategoryDeclares(13) = " cleareventlog backupeventlog closeeventlog openeventlog openbackupeventlog readeventlog getnumberofeventlogrecords getoldesteventlogrecord "
    vCategoryDeclares(14) = " copyfile createdirectory createdirectoryex createfile deletefile findclose findfirstfile findnextfile getdiskfreespace getdiskfreespaceex getdrivetype getfileattributes getfileinformationbyhandle getfilesize getfiletime getfileversioninfo getfileversioninfosize getfullpathname getlogicaldrives getlogicaldrivestrings getshortpathname gettempfilename movefile readfile removedirectory setfileattributes setfilepointer setfiletime verqueryvalue writefile openfile sethandlecount lockfile unlockfile lockfileex unlockfileex getfiletype getstdhandle setstdhandle flushfilebuffers deviceiocontrol setendoffile duplicatehandle setcurrentdirectory getcurrentdirectory movefileex findfirstchangenotification findnextchangenotification findclosechangenotification lopen lclose lcreat llseek lread lwrite hread hwrite "
    vCategoryDeclares(15) = " getvolumeinformation setvolumelabel "
    vCategoryDeclares(16) = " chord ellipse fillrect framerect invertrect pie polygon polypolygon rectangle roundrect "
    vCategoryDeclares(17) = " createfont createfontindirect enumfontfamilies enumfontfamiliesex gettextalign settextalign textout "
    vCategoryDeclares(18) = " closehandle "
    vCategoryDeclares(19) = " winhelp "
    vCategoryDeclares(20) = " destroyicon drawicon drawiconex extracticon extracticonex "
    vCategoryDeclares(21) = " getprivateprofileint getprivateprofilestring getprofileint getprofilestring writeprivateprofilestring writeprofilestring getprofilesection writeprofilesection getprivateprofilesection writeprivateprofilesection "
    vCategoryDeclares(22) = " sendinput "
    vCategoryDeclares(23) = " joygetdevcaps joygetnumdevs joygetpos "
    vCategoryDeclares(24) = " getasynckeystate getkeyboardstate getkeystate keybd_event setkeyboardstate "
    vCategoryDeclares(25) = " anglearc arc arcto getarcdirection lineto movetoex polybezier polybezierto polyline polylineto polypolyline setarcdirection "
    vCategoryDeclares(26) = " loadlibrary loadlibraryex loadmodule freelibrary "
    vCategoryDeclares(27) = " muldiv "
    vCategoryDeclares(28) = " mcigeterrorstring mcisendstring "
    vCategoryDeclares(29) = " copymemory fillmemory globalalloc globalfree globallock globalmemorystatus globalmemorystatusex globalunlock movememory zeromemory globalhandle globalrealloc globalsize globalflags localalloc localfree localhandle locallock localrealloc localsize localunlock localflags virtualalloc virtualfree virtualprotect virtualquery virtualprotectex virtualqueryex heapcreate heapdestroy heapalloc heaprealloc heapfree heapsize "
    vCategoryDeclares(30) = " createpopupmenu destroymenu getmenu getmenuitemcount getmenuiteminfo getsystemmenu insertmenuitem removemenu setmenuiteminfo trackpopupmenu trackpopupmenuex "
    vCategoryDeclares(31) = " sendmessage "
    vCategoryDeclares(32) = " getcapture getdoubleclicktime mouse_event releasecapture setcapture setdoubleclicktime swapmousebutton "
    vCategoryDeclares(33) = " getcurrencyformat getdateformat getnumberformat getthreadlocale gettimeformat setthreadlocale "
    vCategoryDeclares(34) = " cotaskmemfree "
    vCategoryDeclares(35) = " getwindowrgn setwindowrgn "
    vCategoryDeclares(36) = " createpen createpenindirect "
    vCategoryDeclares(37) = " isbadreadptr isbadwriteptr isbadstringptr isbadhugereadptr isbadhugewriteptr "
    vCategoryDeclares(38) = " closeprinter enddoc endpage enumjobs enumprinters openprinter startdoc startpage "
    vCategoryDeclares(39) = " createnamedpipe getnamedpipehandlestate callnamedpipe waitnamedpipe createpipe connectnamedpipe disconnectnamedpipe setnamedpipehandlestate getnamedpipeinfo peeknamedpipe transactnamedpipe "
    vCategoryDeclares(40) = " getenvironmentvariable setenvironmentvariable createprocess setprocessshutdownparameters getprocessshutdownparameters getmodulefilename getmodulehandle getprocessheap getprocesstimes openprocess getcurrentprocess getcurrentprocessid exitprocess terminateprocess getexitcodeprocess readprocessmemory writeprocessmemory getthreadcontext setthreadcontext suspendthread resumethread openprocesstoken openthreadtoken createthread createremotethread getcurrentthread getcurrentthreadid setthreadpriority getthreadpriority getthreadtimes exitthread terminatethread getexitcodethread getthreadselectorentry "
    vCategoryDeclares(41) = " copyrect equalrect inflaterect intersectrect isrectempty offsetrect ptinrect setrect setrectempty subtractrect unionrect "
    vCategoryDeclares(42) = " combinergn createellipticrgn createellipticrgnindirect createpolygonrgn createpolypolygonrgn createrectrgn createrectrgnindirect createroundrectrgn equalrgn fillrgn framergn getpolyfillmode getrgnbox invertrgn offsetrgn ptinregion rectinregion setpolyfillmode "
    vCategoryDeclares(43) = " regclosekey regcreatekeyex regdeletekey regdeletevalue regenumkeyex regenumvalue regopenkeyex regqueryvalueex regsetvalueex "
    vCategoryDeclares(44) = " findresource findresourceex beginupdateresource updateresource endupdateresource loadresource lockresource sizeofresource "
    vCategoryDeclares(45) = " exitwindowsdialog pickicondlg restartdialog shaddtorecentdocs shbrowseforfolder shell_notifyicon shellexecute shellexecuteex shemptyrecyclebin shfileoperation shfreenamemappings shgetfileinfo shgetfolderlocation shgetfolderpath shgetpathfromidlist shgetspecialfolderlocation shgetspecialfolderpath shqueryrecyclebin shupdaterecyclebinicon "
    vCategoryDeclares(46) = " lockworkstation "
    vCategoryDeclares(47) = " charlower charupper comparestring lstrcmp lstrcmpi lstrcpy lstrcpyn lstrlen "
    vCategoryDeclares(48) = " isvalidsid equalsid equalprefixsid getsidlengthrequired allocateandinitializesid freesid initializesid getsididentifierauthority getsidsubauthority getsidsubauthoritycount getlengthsid copysid "
    vCategoryDeclares(49) = " waitforsingleobject "
    vCategoryDeclares(50) = " getcomputername getsyscolor getsystemdirectory gettemppath getusername getversionex getwindowsdirectory setsyscolors "
    vCategoryDeclares(51) = " settapeposition gettapeposition preparetape erasetape createtapepartition writetapemark gettapestatus gettapeparameters settapeparameters "
    vCategoryDeclares(52) = " comparefiletime filetimetolocalfiletime filetimetosystemtime getlocaltime getsystemtime getsystemtimeasfiletime gettickcount gettimezoneinformation localfiletimetofiletime setsystemtime systemtimetofiletime getcurrenttime setlocaltime getsysteminfo settimezoneinformation filetimetodosdatetime dosdatetimetofiletime enumtimeformats enumdateformats "
    vCategoryDeclares(53) = " killtimer queryperformancecounter queryperformancefrequency settimer "
    vCategoryDeclares(54) = " createtoolhelp32snapshot process32first process32next "
    vCategoryDeclares(55) = " duplicatetoken gettokeninformation settokeninformation adjusttokenprivileges adjusttokengroups "
    vCategoryDeclares(56) = " getclassinfo getclassinfoex getclasslong getclassname getwindowlong registerclass registerclassex setclasslong setwindowlong unregisterclass "
    vCategoryDeclares(57) = " callwindowproc defwindowproc "
    vCategoryDeclares(58) = " enumpropsex getprop removeprop setprop "
    vCategoryDeclares(59) = " bringwindowtotop createwindowex destroywindow enablewindow enumchildwindows enumthreadwindows enumwindows findwindow findwindowex flashwindow getactivewindow getdesktopwindow getfocus getforegroundwindow getparent gettopwindow getwindow getwindowrect getwindowtext getwindowtextlength getwindowthreadprocessid ischild isiconic iswindow iswindowenabled iszoomed movewindow setactivewindow setfocus setforegroundwindow setparent setwindowpos setwindowtext showwindow windowfrompoint "
    vCategoryDeclares(60) = " closesocket connect gethostbyaddr gethostbyname gethostname htonl htons inet_addr inet_nota recv send socket wsacleanup wsagetlasterror wsastartup "
    vCategoryDeclares(61) = " exitwindowsex sleep sleepex "

    For intIndex = 0 To UBound(vCategories)
        cmbCategories.AddItem vCategories(intIndex)
    Next

    cmbLibraryList.AddItem "(None)"
    cmbLibraryList.ListIndex = 0
    cmbCategories.ListIndex = 0
    cmbEntryType.ListIndex = 1

    menu_showpopup.Visible = False
    LoadAPIFile App.Path & "\win32api.txt"

    Call menu_showpopup_show_Click(1)
End Sub

Private Sub SetCategoriesEnabled(State As Boolean)
    lblInfo(4).ForeColor = IIf(State, 0, GetSysColor(COLOR_BTNSHADOW))
    cmbCategories.BackColor = IIf(State, GetSysColor(COLOR_WINDOW), GetSysColor(COLOR_BTNFACE))
    cmbCategories.Enabled = State

    lblInfo(5).ForeColor = lblInfo(4).ForeColor
    cmbLibraryList.BackColor = cmbCategories.BackColor
    cmbLibraryList.Enabled = State
End Sub

Private Sub SetCategoriesVisible(State As Boolean)
    cmbCategories.Visible = State
    cmbLibraryList.Visible = State

    lblInfo(4).Visible = State
    lblInfo(5).Visible = State
End Sub

Private Sub Form_Resize()
    On Local Error Resume Next

    freDeclareScope.Move Me.ScaleWidth - freDeclareScope.Width - 90, lstItems.Top
    
    lstItems.Width = freDeclareScope.Left - (lstItems.Left * 2) - 60
    txtItemText.Width = lstItems.Width
    txtItemText.Height = Me.ScaleHeight - txtItemText.Top - 90

    txtSearch.Width = lstItems.Width

    cmdLoadFile.Move freDeclareScope.Left, (lstItems.Top   lstItems.Height) - cmdLoadFile.Height

    cmdRemove.Move freDeclareScope.Left, txtItemText.Top
    cmdClear.Move freDeclareScope.Left, cmdRemove.Top   cmdRemove.Height   30
    cmdInsert.Move freDeclareScope.Left, cmdClear.Top   cmdClear.Height   30
    cmdCopy.Move freDeclareScope.Left, cmdInsert.Top   cmdInsert.Height   30

    cmdShow.Move freDeclareScope.Left, (txtItemText.Top   txtItemText.Height) - cmdShow.Height

    lblInfo(6).Move (lstItems.Left   lstItems.Width) - lblInfo(6).Width, lblInfo(2).Top
    lstSelectedItems.Move txtItemText.Left, txtItemText.Top, txtItemText.Width, txtItemText.Height
    
    chkNoComments.Move (lstSelectedItems.Left   lstSelectedItems.Width) - chkNoComments.Width, lblInfo(3).Top
    lblCopyright.Move frmMain.ScaleWidth - lblCopyright.Width - 60, lblInfo(0).Top
End Sub

Private Sub ChangeListingType(intListingType As Integer)
    Dim intIndex As Integer
    Dim dwViewCount As Long, dwTotalCount As Long
    Dim strLibraryFilter As String
    Dim intCatID As Integer
    Dim blnAddItem As Boolean

    If APIFileLoaded Then
        lstItems.Clear
        Call LockWindowUpdate(lstItems.hWnd)

        strLibraryFilter = DLLEntries(cmbLibraryList.ItemData(cmbLibraryList.ListIndex))
        intCatID = cmbCategories.ListIndex

        For intIndex = 0 To UBound(APIEntries)
            If APIEntries(intIndex).EntryType = intListingType   1 Then
                blnAddItem = True

                If strLibraryFilter <> "(None)" Then blnAddItem = (APIEntries(intIndex).Library = strLibraryFilter)
                If intCatID > 0 Then blnAddItem = blnAddItem And (InStr(vCategoryDeclares(intCatID - 1), " " & LCase(APIEntries(intIndex).DisplayName) & " ") > 0)

                If blnAddItem Then
                    lstItems.AddItem APIEntries(intIndex).DisplayName
                    lstItems.ItemData(lstItems.NewIndex) = intIndex
                    dwViewCount = dwViewCount   1
                End If

                dwTotalCount = dwTotalCount   1
            End If
        Next

        Call LockWindowUpdate(0)
        
        Dim strCaption  As String
        strCaption = "Displaying " & dwViewCount & " items"

        If strLibraryFilter <> "(None)" Then
            strCaption = strCaption & " in """ & cmbLibraryList.Text & """"
            If intCatID > 0 Then strCaption = strCaption & ", """ & cmbCategories.Text & """"
        Else
            If intCatID > 0 Then strCaption = strCaption & " in """ & cmbCategories.Text & """"
        End If

        lblInfo(2).Caption = strCaption & ":"
    End If
End Sub

Private Sub LoadAPIFile(strFile As String)
    If Dir$(strFile) = "" Then
        MsgBox "Selected file does not exist!"
        Exit Sub
    End If

    Dim intFH As Integer, intPos As Integer, intCommentPos As Integer, intQuotePos As Integer
    Dim intDLLIndex As Integer
    Dim strLine As String, strToken As String, strRest As String, strLibraries As String
    Dim blnAdvanceNext As Boolean
    Dim dwEntryIndex As Long
    Dim vDeclare

    dwEntryIndex = 0
    intDLLIndex = 1
    strLibraries = "|"
    intFH = FreeFile

    Open strFile For Input As #intFH
    ReDim APIEntries(100) As apiEntry
    ReDim DLLEntries(50) As String

    DLLEntries(0) = "(None)"

    frmMain.MousePointer = vbHourglass
    Do Until EOF(intFH)
        Line Input #1, strLine
        strLine = Trim(strLine)

        If Not (Left(strLine, 1) = "'" Or Left(strLine, 1) = "") Then
            intPos = InStr(strLine, " ")
            If intPos > 0 Then
                strToken = Left(strLine, intPos - 1)
                strRest = Right(strLine, Len(strLine) - intPos)
                intCommentPos = InStrRev(strRest, "'")

                If intCommentPos > 0 Then
                    intQuotePos = InStrRev(strRest, Chr(34))
                    If intCommentPos > intQuotePos Or intQuotePos = 0 Then
                        strRest = Left(strRest, intCommentPos - 1)
                    End If
                End If

                blnAdvanceNext = False
                Select Case LCase(strToken)
                    Case "const":
                        ' Const SHUTDOWN_NORETRY = &H1

                        With APIEntries(dwEntryIndex)
                            .DisplayName = strRest
                            .Code = strLine
                            .EntryType = 1
                        End With

                    Case "declare":
                        ' Declare Function CreateMutex Lib "kernel32" Alias "CreateMutexA" (lpMutexAttributes As SECURITY_ATTRIBUTES, ByVal bInitialOwner As Long, ByVal lpName As String) As Long

                        vDeclare = Split(strLine, " ", 6)
                        vDeclare(4) = Replace(LCase(UnQuote(vDeclare(4))), ".dll", "")
                        If InStr(strLibraries, "|" & vDeclare(4) & "|") = 0 Then
                            strLibraries = strLibraries & vDeclare(4) & "|"
                            DLLEntries(intDLLIndex) = vDeclare(4)

                            intDLLIndex = intDLLIndex   1
                            If intDLLIndex > UBound(DLLEntries) Then
                                ReDim Preserve DLLEntries(UBound(DLLEntries)   50) As String
                            End If
                        End If
                        
                        With APIEntries(dwEntryIndex)
                            .DisplayName = vDeclare(2)
                            .Library = vDeclare(4)
                            .Code = strLine
                            .EntryType = 2
                        End With

                    Case "type":
                        ' Type WIN32_FIND_DATA

                        With APIEntries(dwEntryIndex)
                            .DisplayName = strRest
                            .Code = strLine & vbCrLf
                            .EntryType = 3
                        End With

                    Case Else:
                        ' Continued code

                        If LCase(strLine) = "end type" Then blnAdvanceNext = True
                        APIEntries(dwEntryIndex).Code = APIEntries(dwEntryIndex).Code & IIf(blnAdvanceNext, "", Space$(4)) & Trim(strLine) & vbCrLf
                End Select
                
                If APIEntries(dwEntryIndex).EntryType <> 3 Or blnAdvanceNext Then
                    dwEntryIndex = dwEntryIndex   1
                    If dwEntryIndex > UBound(APIEntries) Then ReDim Preserve APIEntries(UBound(APIEntries)   100) As apiEntry
                End If
            End If
        End If
        
        DoEvents
    Loop

    ReDim Preserve APIEntries(dwEntryIndex - 1) As apiEntry
    Dim intIndex As Integer

    cmbLibraryList.Clear

    For intIndex = 0 To intDLLIndex - 1
        cmbLibraryList.AddItem DLLEntries(intIndex) & IIf(InStr(DLLEntries(intIndex), ".") = 0 And Left(DLLEntries(intIndex), 1) <> "(", ".dll", "")
        cmbLibraryList.ItemData(cmbLibraryList.NewIndex) = intIndex
    Next

    ReDim Preserve DLLEntries(intDLLIndex - 1) As String

    strLibraries = ""
    cmbLibraryList.ListIndex = 0
    frmMain.MousePointer = vbDefault
    APIFileLoaded = True
    
    Call cmbEntryType_Click

    Close #intFH
End Sub

Private Function UnQuote(ByVal strStr As String) As String
    If Left(strStr, 1) = Chr(34) And Right(strStr, 1) = Chr(34) Then
        strStr = Mid(strStr, 2, Len(strStr) - 2)
    End If

    UnQuote = strStr
End Function

Private Sub lstItems_DblClick()
    Dim dwIndex As Long
    Dim blnAddItem As Boolean
    Dim szPrefix As String, szText As String
    Dim vSplit As Variant
    
    Select Case cmbEntryType.ListIndex
        Case 0: szPrefix = "Const: "
        Case 1: szPrefix = "Declare: "
        Case 2: szPrefix = "Type: "
    End Select

    szText = lstItems.List(lstItems.ListIndex)
    If InStr(szText, " ") > 0 Then
        vSplit = Split(szText, " ", 5)
        szText = vSplit(IIf(LCase(vSplit(1)) = "declare", 2, 0))
    End If
    
    blnAddItem = True
    For dwIndex = 0 To lstSelectedItems.ListCount - 1
        If lstSelectedItems.List(dwIndex) = szPrefix & szText Then
            blnAddItem = False
            Exit For
        End If
    Next
    
    If blnAddItem Then
        lstSelectedItems.AddItem szPrefix & szText
        lstSelectedItems.ItemData(lstSelectedItems.NewIndex) = lstItems.ItemData(lstItems.ListIndex)
    End If

    cmdClear.Enabled = True
    cmdCopy.Enabled = True
    cmdInsert.Enabled = True
    cmdRemove.Enabled = True

    UpdateFullTextView
End Sub

Private Sub lstItems_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyReturn Then Call lstItems_DblClick
End Sub

Private Sub menu_showpopup_show_Click(Index As Integer)
    menu_showpopup_show(0).Checked = (Index = 0)
    menu_showpopup_show(1).Checked = (Index = 1)

    cmdShow.Caption = "Show [" & IIf(Index = 0, "Line", "Full") & "]"

    Select Case Index
        Case 0: lstSelectedItems.ZOrder
        Case 1: txtItemText.ZOrder
    End Select
End Sub

Private Sub txtSearch_Change()
    Dim dwIndex As Long, dwIdx As Long

    For dwIndex = ListSearchIndex To lstItems.ListCount - 1
        If LCase(Left(lstItems.List(dwIndex), Len(txtSearch.Text))) = LCase(txtSearch.Text) Then
            If dwIndex   9 < lstItems.ListCount - 1 Then dwIdx = dwIndex   9 Else dwIdx = dwIndex

            lstItems.ListIndex = dwIdx
            Exit For
        End If
    Next

    If dwIndex >= lstItems.ListCount Then Exit Sub

    ' Set search index (optimized searching)
    ListSearchIndex = dwIndex - 1
    lstItems.ListIndex = dwIndex
End Sub

Private Sub txtSearch_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyDown Or KeyCode = vbKeyUp Or KeyCode = vbKeyPageDown Or KeyCode = vbKeyPageUp Then
        Call SendMessage(lstItems.hWnd, WM_KEYDOWN, KeyCode, &O0)
        KeyCode = 0
    ElseIf KeyCode = vbKeyReturn Then
        Call lstItems_DblClick
    ElseIf KeyCode = vbKeyBack Then
        ' Reset search index
        ListSearchIndex = 0
    End If
End Sub

Private Sub UpdateFullTextView()
    Dim dwIndex As Long, dwCodeID As Long, dwCodeIdx As Long
    Dim szScope As String, szCodeView As String
    Dim intCommentPos As Integer, intQuotePos As Integer
    Dim vCode As Variant

    szScope = IIf(chkScope(0).Checked, "Public ", "Private ")
    txtItemText.Text = ""

    If lstSelectedItems.ListCount > -1 Then
        For dwIndex = 0 To lstSelectedItems.ListCount - 1
            dwCodeID = lstSelectedItems.ItemData(dwIndex)
            vCode = Split(APIEntries(dwCodeID).Code, vbCrLf)

            For dwCodeIdx = 0 To UBound(vCode)
                vCode(dwCodeIdx) = LTrimNL(RTrimNL(CStr(vCode(dwCodeIdx))))
                
                If chkNoComments.Checked Then
                    intCommentPos = InStrRev(vCode(dwCodeIdx), "'")

                    If intCommentPos > 0 Then
                        intQuotePos = InStrRev(vCode(dwCodeIdx), Chr(34))
                        If intCommentPos > intQuotePos Or intQuotePos = 0 Then
                            vCode(dwCodeIdx) = Left(vCode(dwCodeIdx), intCommentPos - 1)
                        End If
                    End If
                End If

                vCode(dwCodeIdx) = RTrim(vCode(dwCodeIdx))
            Next
            
            szCodeView = szCodeView & szScope & RTrimNL(Join(vCode, vbCrLf)) & vbCrLf & vbCrLf
        Next
    End If

    txtItemText.Text = szCodeView
    txtItemText.SelStart = Len(txtItemText.Text)
End Sub

Private Sub txtItemText_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    On Local Error Resume Next

    Dim szText As String, szPrefix As String, szScope As String
    Dim intPos As Integer
    Dim vSplit As Variant

    szScope = IIf(chkScope(0).Checked, "Public ", "Private ")
    szText = txtItemText.Text

    If szText > "" Then
        intPos = InStr(txtItemText.SelStart, szText, vbCrLf)
        intPos = IIf(intPos > 0, intPos, Len(txtItemText.Text))
        szText = RTrimNL(Left(szText, intPos   1))
        
        intPos = InStrRev(szText, szScope)
        szText = RTrimNL(Right(szText, Len(szText) - intPos   1))
        
        intPos = InStr(szText, vbCrLf)
        intPos = IIf(intPos > 0, intPos - 1, Len(szText))
        szText = Left(szText, intPos)

        vSplit = Split(szText, " ", 6)

        szText = vSplit(IIf(LCase(vSplit(1)) = "declare", 3, 2))
        szText = StrConv(vSplit(1), vbProperCase) & ": " & RTrimNL(szText)

        For intPos = 0 To lstSelectedItems.ListCount - 1
            If lstSelectedItems.List(intPos) = szText Then Exit For
        Next

        lstSelectedItems.ListIndex = intPos
    End If
End Sub

Private Function RTrimNL(szStr As String) As String
    Dim intPos As Integer

    If Len(szStr) > 0 Then
        For intPos = Len(szStr) To 1 Step -1
            If Asc(Mid(szStr, intPos, 1)) > 31 Then Exit For
        Next
    
        RTrimNL = IIf(intPos > 0, Left(szStr, intPos), szStr)
    Else
        RTrimNL = ""
    End If
End Function

Private Function LTrimNL(szStr As String) As String
    Dim intPos As Integer

    For intPos = 1 To Len(szStr)
        If Asc(Mid(szStr, intPos, 1)) > 31 Then
            Exit For
        End If
    Next

    
    LTrimNL = IIf(intPos > 1, Right(szStr, Len(szStr) - intPos   1), szStr)
End Function

标签: 浏览器 API VB6 浏览 vb

实例下载地址

VB6高级版API浏览器

不能下载?内容有错? 点击这里报错 + 投诉 + 提问

好例子网口号:伸出你的我的手 — 分享

网友评论

第 1 楼 罗雨 发表于: 2022-05-11 09:20 29
下载后,是一堆文件,怎么操作能你预览一样呢?求大神

支持(0) 盖楼(回复)

发表评论

(您的评论需要经过审核才能显示)

查看所有1条评论>>

小贴士

感谢您为本站写下的评论,您的评论对其它用户来说具有重要的参考价值,所以请认真填写。

  • 类似“顶”、“沙发”之类没有营养的文字,对勤劳贡献的楼主来说是令人沮丧的反馈信息。
  • 相信您也不想看到一排文字/表情墙,所以请不要反馈意义不大的重复字符,也请尽量不要纯表情的回复。
  • 提问之前请再仔细看一遍楼主的说明,或许是您遗漏了。
  • 请勿到处挖坑绊人、招贴广告。既占空间让人厌烦,又没人会搭理,于人于己都无利。

关于好例子网

本站旨在为广大IT学习爱好者提供一个非营利性互相学习交流分享平台。本站所有资源都可以被免费获取学习研究。本站资源来自网友分享,对搜索内容的合法性不具有预见性、识别性、控制性,仅供学习研究,请务必在下载后24小时内给予删除,不得用于其他任何用途,否则后果自负。基于互联网的特殊性,平台无法对用户传输的作品、信息、内容的权属或合法性、安全性、合规性、真实性、科学性、完整权、有效性等进行实质审查;无论平台是否已进行审查,用户均应自行承担因其传输的作品、信息、内容而可能或已经产生的侵权或权属纠纷等法律责任。本站所有资源不代表本站的观点或立场,基于网友分享,根据中国法律《信息网络传播权保护条例》第二十二与二十三条之规定,若资源存在侵权或相关问题请联系本站客服人员,点此联系我们。关于更多版权及免责申明参见 版权及免责申明

;
报警