VB6调用DLL的问题（解决问题立即结贴）

Question

Declare Function test1 Lib "1.dll" (ByVal handle As Long) As Long请问如何调取.exe主程序同目录下的1.dll，并且确保调取的1.dll就是和当前运行的exe是同一目录，不会因为目录优先顺序的原因被劫持。
程序所在的安装目录是不固定的，调用时直接写明固定路径的方法是不行的，而此时app.path又用不了。

Answer 1

返回可执行文件所在的目录?
看到网上有人用GetMoudleFileName获得的,不过我没写过.

Answer 2

先搜索目标exe的绝对路径，再按照此路径调用

Answer 3

遇到不带路径调用dll或者外部文件时，系统会先检查应用程序旁边的，其次是c:\windows\system32下的，再其次是c:\windows下的，之后就是按照系统环境变量PATH里面设置的目录一个个找，都找不到才会提示错误。这样看来劫持是不可能的，因为windows系统的规定，最优先调用exe旁边的。所以有些病毒就利用这点在每个exe文件旁边都复制一个和系统某个dll名字相同的文件（这个文件对exe作用不是很大比如语言包管理什么的，例如lpk.dll），这样双击exe后就会调用这些dll。

Answer 4

补充：windows貌似已经考虑到这种问题，所以在提供了一个设置方法，为了保证系统dll文件不被上述下三滥的手段劫持所以在注册表某处设置了一个项目，保证你指定的dll在无论什么情况下都优先调用system32下的。具体方法：
开始菜单-----运行 输入：“regedit.exe”（双引号去掉），调出“注册表编辑器”。依次展开至分支“HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Session Manager\KnownDLLs”，可以看到子项“KnownDLLs”分支下有多个系统动态链接库程序，比如上述举的lpk.dll病毒的例子，那么可以在这里新建一个项目命名为lpk.dll即可。

Answer 5

刚才写了一个测试的:
Option Explicit
Private Declare Function GetModuleFileName Lib "kernel32" Alias "GetModuleFileNameA" (ByVal hModule As Long, ByVal lpFileName As String, ByVal nSize As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Const GWL_HINSTANCE = (-6)Private Sub Command1_Click()
    Dim h As Long, d As Long
    Dim s As String * 256
    s = String(256, " ")
    h = FindWindow(vbNullString, "测试")
    
    If h <> 0 Then
        d = GetWindowLong(h, GWL_HINSTANCE)
        GetModuleFileName d, s, 255
        Debug.Print Replace(Trim(s), Chr(0), "")
    End If
End Sub

Answer 6

多谢各位的解答。这个方法在早期版本的xp上是不被支持的
默认的搜索顺序在不同操作系统下是不一样的
哪位高手还有没有更好的办法？实现的目标就是要保证当前执行的exe调用到的DLL是正确的，不会被用各种方法换成山寨版的。

Answer 7

早期版本xp是什么？sp1？你以为人家会为了用你的软件去卸载win7、win8什么的去费劲找个早期版本的啊，现在主流的都是xp sp2吧，没有你说的问题，估计你也只是猜想。

Answer 8

我觉得楼主的思路有些问题，既然是动态链接库，为什么非得要固定在安装目录下？这有违DLL的初衷。把它放置到system32目录下（安装时放置），什么程序都到哪儿去调用很好啊，windows下，绝大多数Dll都是这样的调用方式。简单方便且不会出问题。

Answer 9

这个在系统里面貌似是这个顺序，还不能设置、更改这个顺序。
至于不支持，默认的搜索顺序在不同操作系统下是不一样，只有在 系统环境变量  可以改一部分顺序。一般，需要调用外部dll时，在大多数时候，还是放在注册表注册一下，到工程里引用一下比较好。

Answer 10

放到exe程序旁边是为了方便做绿色免安装包程序，好像qq什么的就是这样的，初衷是为了让用户将整个安装目录复制到任何地方都可以直接双击qq.exe使用。

Answer 11

好吧，既然你也说搜索顺序取决于操作系统，那么就算是吧，不过不管怎么变至少最优先的肯定还是exe文件旁边的吧。
关于劫持什么的可以参考下面的文章：
http://baike.baidu.com/view/3515992.htm“由于输入表中只包含DLL名而没有它的路径名，因此加载程序必须在磁盘上搜索DLL文件。首先会尝试从当前程序所在的目录加载DLL，如果没找到，则在Windows系统目录中查找，最后是在环境变量中列出的各个目录下查找。”
里面也没提到搜索顺序因操作系统而异。

Answer 12

就是说在任何情况下，应用程序exe所在的目录都是最优先的，只要这个文件夹里有被调用的dll文件，就不会调用其它位置的同名dll？

Answer 13

那在exe中调用一个dll后，能否有什么办法在exe中用代码获取到这个dll的加载文件夹位置呢？

Answer 14

vb程序是完全可以的，以前看到个高手写的代码，可以列出某个进程当前所调用的所有model的路径。
随便搜下，很多的。
http://www.baidu.com/s?tn=baiduhome_pg&bs=vb%B5%C3%B5%BD%BD%F8%B3%CC%D2%FD%D3%C3%B5%C4dll&f=8&rsv_bp=1&rsv_spt=1&wd=vb%B5%C3%B5%BD%BD%F8%B3%CC+%CA%B9%D3%C3%B5%C4dll&inputT=2073
http://www.baidu.com/s?wd=vb%E5%BE%97%E5%88%B0%E8%BF%9B%E7%A8%8B+%E5%8A%A0%E8%BD%BD%E7%9A%84dll&rsv_spt=1&issp=1&rsv_bp=0&ie=utf-8&tn=baiduhome_pg由于不能访问外网，复制几个链接自己看吧：
http://it.china-b.com/cxsj/vb/20090608/57493_1.html
http://topic.csdn.net/t/20060403/15/4659633.html

Answer 15

可以动态调用API。  就是不申明 动态调用  这样前面就可以+一些判断 
 判断是否在同一个目录 什么的 都可以解决了。···  至于相关的资料你自己去查查看吧。
  你可以搜索下关键字： 动态调用API

Answer 16

你不申明API  然后动态调用就可以了 如果申明API  如果目录中没有的话就会报错 动态调用就不会了
  
 你先获取.exe的目录 然后判断是否纯在dll 如果存在 然后再动态调用它
下面是一个动态调用的例子：
申明：我复制来的    原帖地址：http://topic.csdn.net/u/20100326/18/8f87567c-a66e-4f91-b36f-164b30429672.html
'********************************************************************************  
'  
'Name.......... APIClass  
'File.......... APIClass.cls  
'Version....... 1.0.0  
'Dependencies.. kernel32.DLL  
'Author........ Supermanking  
'Date.......... Apr, 17nd 2008  
'UpdateURL..... http://bbs.rljy.com/?m=vbAPIClass  
'  
'Copyright (c) 2008 bywww.rljy.com  
'Liuzhou city, China  
'  
'********************************************************************************  
Option Explicit  
'==============================================================================  
'数据类型定义  
'==============================================================================  
Private Type VariableBuffer  
VariableParameter() As Byte  
End Type  
'==============================================================================  
'API 函数声明  
'==============================================================================  
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long  
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long  
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long  
Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long  
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpDest As Any, lpSource As Any, ByVal cBytes As Long)  
'==============================================================================  
'成员定义  
'==============================================================================  
'类中的全局变量  
Private m_opIndex As Long  
Private m_OpCode() As Byte  
'********************************************************************************  
'** 作 者 ： 人类(Supermanking)  
'** 函 数 名 ： ExecuteAPI  
'** 输 入 ： LIBPath(String) - 刷新的目标窗口句柄，可为0  
'** ： APIScript(String) - 场景图像的宽度  
'** 返 回 ： (Long) - 返回零表示失败，非零表示成功  
'** 功能描述 ： 动态执行类库里的API函数  
'** 创建日期 ： 2008-04-17  
'** 修 改 人 ：  
'** 修改日期 ：  
'** 版 本 ： Version 1.0.0  
'********************************************************************************  
Public Function ExecuteAPI(LibPath As String, APIScript As String) As Long  
Dim hProcAddress As Long, hModule As Long, X As Long, Y As Long  
Dim RetLong As Long, FunctionName As String, FunctionParameter As String  
Dim LongCount As Long, StringInfo As String, StrByteArray() As VariableBuffer  
Dim StringSize As Long, ByteArray() As Byte, IsHaveParameter As Boolean  
Dim ParameterArray() As String, OutputArray() As Long  
StringSize = 0  
ReDim StrByteArray(StringSize)  
'识别函数名称  
RetLong = InStr(1, APIScript, " ", vbTextCompare)  
If RetLong = 0 Then  
'没有参数的函数  
FunctionName = APIScript  
IsHaveParameter = False  
Else  
'带参数的函数  
FunctionName = Left(APIScript, RetLong - 1)  
IsHaveParameter = True  '识别函数参数  
FunctionParameter = Right(APIScript, Len(APIScript) - RetLong)  '分析函数参数  
ParameterArray = Split(FunctionParameter, ",")  '初始化函数内存大小  
ReDim OutputArray(UBound(ParameterArray))  '格式化函数参数  
For X = 0 To UBound(ParameterArray)  
If IsNumeric(Trim(ParameterArray(X))) = True Then  
LongCount = CLng(Trim(ParameterArray(X)))  
OutputArray(X) = LongCount  
Else  
StringInfo = Mid(Trim(ParameterArray(X)), 2, Len(ParameterArray(X)) - 3)  
If Len(StringInfo) = 0 Then  
OutputArray(X) = CLng(VarPtr(Null))  
Else  
ReDim Preserve StrByteArray(StringSize)  
ByteArray = StrConv(StringInfo, vbFromUnicode)  
ReDim Preserve StrByteArray(StringSize).VariableParameter(UBound(ByteArray) + 1)  
CopyMemory StrByteArray(StringSize).VariableParameter(0), ByteArray(0), UBound(ByteArray) + 1  
OutputArray(X) = CLng(VarPtr(StrByteArray(StringSize).VariableParameter(0)))  
StringSize = StringSize + 1  
End If  
End If  
Next X  
ReDim m_OpCode(400 + 6 * UBound(OutputArray)) '保留用来写m_OpCode  
End If  '读取API库  
hModule = LoadLibrary(ByVal LibPath)  
If hModule = 0 Then  
ExecuteAPI = 0 'Library 读取失败  
Exit Function  
End If  '取得函数地址  
hProcAddress = GetProcAddress(hModule, ByVal FunctionName)  
If hProcAddress = 0 Then  
ExecuteAPI = 0 '函数读取失败  
FreeLibrary hModule  
Exit Function  
End If  If IsHaveParameter = True Then  
'带参数的情况在此执行  
ExecuteAPI = CallWindowProc(GetCodeStart(hProcAddress, OutputArray), 0, 1, 2, 3)  
Else  
'不带参数的情况在此执行  
ExecuteAPI = CallWindowProc(hProcAddress, 0, 1, 2, 3)  
End If  '释放库空间  
FreeLibrary hModule  
End Function  Private Function GetCodeStart(ByVal lngProc As Long, arrParams() As Long) As Long  
Dim lngIndex As Long, lngCodeStart As Long  
lngCodeStart = (VarPtr(m_OpCode(0)) Or &HF) + 1  
m_opIndex = lngCodeStart - VarPtr(m_OpCode(0))  
For lngIndex = 0 To m_opIndex - 1  
m_OpCode(lngIndex) = &HCC  
Next lngIndex  
For lngIndex = UBound(arrParams) To 0 Step -1  
AddByteToCode &H68  
AddLongToCode arrParams(lngIndex)  
Next lngIndex  
AddByteToCode &HE8  
AddLongToCode lngProc - VarPtr(m_OpCode(m_opIndex)) - 4  
AddByteToCode &HC2  
AddByteToCode &H10  
AddByteToCode &H0  
GetCodeStart = lngCodeStart  
End Function  Private Sub AddLongToCode(lData As Long)  
CopyMemory m_OpCode(m_opIndex), lData, 4  
m_opIndex = m_opIndex + 4  
End Sub  Private Sub AddIntToCode(iData As Integer)  
CopyMemory m_OpCode(m_opIndex), iData, 2  
m_opIndex = m_opIndex + 2  
End Sub  Private Sub AddByteToCode(bData As Byte)  
m_OpCode(m_opIndex) = bData  
m_opIndex = m_opIndex + 1  
End Sub

Answer 17

你可以把你的“正宗版本”打包到某个资源文件中，比如DAT，然后运行前先从包里解出来覆盖到各位置一遍，再进入正式的程序运行。

Answer 18

我这里有一个动态调用API的类，Supermanking写的，很方便。只需要输入DLL路径，然后将要调用的函数及参数以逗号相隔输入即可，如下：APIScript = "MessageBoxA 0, ""这是动态调用API函数显示的MSGBOX内容，下面将要在作面画一笔。"", ""API信息提示"", 0"
API.ExecuteAPI "C:\WINDOWS\system32\user32.dll", APIScript
这样的话你就可以使用App.Path了。整个工程：[类模块源码] 动态调用API函数