VB改变名称列表高度1.0 绿色版【附源码】

VB的下拉列表框很短，用起来很不爽有木有？这里，小编给大家带来一款小工具，可以加长VB命名列表框，主要是利用OllyDBG跟踪改了它，附源码。需要的朋友可以下载试试哦！

VB6加长命名列表框工具怎么用

VB改变名称列表高度使用说明

下载解压后，可以直接运行此软件，选择VB6的目录，点击【开始更换即可】

注意：软件上的相关备份事宜也说的很清楚，到时候要还原就按照说明来做就OK了。

VB加长名称：

NameListWndClass

0x0FBAC4B1

0x0011BAA7  20

offset 0x11BAB1

原：83C704

新：6BFF04

offset 0x11BAA4

旧：0F AF 7D F8

新：6b ff 1c 90

下面是源代码内容：

Option Explicit

Private Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long

Private Declare Function PathFileExists Lib "shlwapi.dll" Alias "PathFileExistsA" (ByVal pszPath As String) As Long

Private VBA6Path As String

Private Sub Form_Load()

        App.TaskVisible = False

        'On Error Resume Next

        Dim VBPath As String

        VBPath = GetSetting(App.Title, "Set", "VBInstallPath")

        If VBPath = "" Then VBPath = "C:\Program Files\Microsoft Visual Studio\VB98"

        VBA6Path = VBPath & "\VBA6.DLL"

        txtPath.Text = VBPath

        UpdateStatus

End Sub

Private Sub cmdOk_Click(Index As Integer)

        'On Error Resume Next

        Dim strPath     As String

        Dim strPathSrc  As String

        Dim VerNumber   As String

        strPath = txtPath.Text

        If FileExist(strPath & "\VBA6.DLL") = False Then

                MsgBox "指定目录无效，找不到VBA6.DLL。", vbExclamation

                Exit Sub

        End If

        SaveSetting App.Title, "Set", "VBInstallPath", strPath

        If Right(strPath, 1) <> "\" Then strPath = strPath & "\"

        strPath = strPath & "VBA6.DLL"

        strPathSrc = strPath & ".bak"

        VBA6Path = strPath

        'Debug.Print VerNumber

        If IsVersionError Then

                MsgBox "不支持此版本。请确定是否是VB6简体中文版/企业版，以及VBA6版本是否为6.0.0.8169", vbExclamation

                Exit Sub

        End If

        If Index = 0 Then

                '换

                If FileExist(strPathSrc) = False Then

                        CopyFile strPath, strPathSrc, False

                End If

                If ModifyNameList = False Then

                        MsgBox "修改失败，如果VB正在运行请先退出，否则确定是否有权限改写目标文件。", vbExclamation

                Else

                        MsgBox "成功更改NameList高度。", vbInformation

                End If

        Else

                '还原

                If ModifyNameList(True) Then

                        MsgBox "取消成功。", vbInformation

                Else

                        MsgBox "取消失败，请确认VB没有运行，否则请直接还原文件。", vbExclamation

                End If

        End If

        UpdateStatus

End Sub

Sub UpdateStatus()

        If IsModified Then

                cmdOk(0).Enabled = False

                cmdOk(1).Enabled = True

        Else

                cmdOk(0).Enabled = True

                cmdOk(1).Enabled = False

        End If

End Sub

Private Function FileExist(strPath As String) As Boolean

        On Error Resume Next

        If PathFileExists(strPath) Then

                FileExist = ((GetAttr(strPath) And vbDirectory) = 0)

        End If

End Function

Private Function ModifyNameList(Optional ByVal bRestore As Boolean) As Boolean

        On Error GoTo ErrCatch

        Dim bytFile(0 To 3) As Byte

        If bRestore = False Then

                bytFile(0) = &H6B 'IMUL EDI,EDI,0x1C (EDI=14是Listbox行高，1440x900下我们设置成28行。)

                bytFile(1) = &HFF

                bytFile(2) = &H1C

                bytFile(3) = &H90 'NOP

        Else

                bytFile(0) = &HF  'IMUL EDI,[EBP-0x8] (Height=14x7+4)

                bytFile(1) = &HAF

                bytFile(2) = &H7D

                bytFile(3) = &HF8

        End If

        Open VBA6Path For Binary As #1

                Put #1, &H11BAA4 + 1, bytFile

        Close #1

        ModifyNameList = True

        Exit Function

ErrCatch:

        Close

End Function

Private Function IsModified() As Boolean

        On Error GoTo ErrCatch

        If FileExist(VBA6Path) = False Then IsModified = False: Exit Function

        Dim curValue As Long

        Dim oldValue As Long

        oldValue = &HF87DAF0F

        Open VBA6Path For Binary Access Read As #1

                Get #1, &H11BAA4 + 1, curValue

        Close #1

        IsModified = (curValue <> oldValue)

        Exit Function

ErrCatch:

        Close

End Function

Private Function IsVersionError() As Boolean

        On Error Resume Next

        Dim curValue As Long

        'Debug.Print VBA6Path

        Open VBA6Path For Binary Access Read As #1

                Get #1, &H11BAA4 + 1, curValue

        Close #1

        IsVersionError = (curValue <> &HF87DAF0F And curValue <> &H901CFF6B)

End Function