2024年1月11日发(作者：)
VB 制作 可输出函数DLL（标准DLL）
无需注册，只要放在程序同目录内就可以调用，非常方便。
其实可用的方法有很多种，下面介绍的这个是我用到现在最可靠的的，里面的,和，因为时间长了记不得是那个作者的了，忘作者见谅。
第一步、准备工作
1、编译新的,和。
‘************新的**********************************
新的程序
建立新工程，不需要窗体，只要一个模块放上下面的main过程，工程属性里面 启动对象Sub main
Public Sub Main()
On Error Resume Next
Dim strCmd As String, strPath As String
Dim oFS As New stemObject
Dim ts As TextStream
strCmd = Command
strPath =
Set ts = TextFile(strPath & "")
ine "Beginning execution at " & Date & " " & Time()
lankLines 1
ine "Command line parameters to c2 call:"
ine " " & strCmd
lankLines 1
ine "Calling C2 compiler"
Shell " " & strCmd
If <> 0 Then
ine "Error in calling "
End If
lankLines 1
ine "Returned from c2 compiler call"
End Sub
编译成，不要直接覆盖，放在其他地方备用。
‘************新的**********************************
‘************新的**********************************
新的程序
建立新工程，不需要窗体，只要一个模块放上下面的main过程，工程属性里面 启动对象Sub main
Option Explicit
Public Sub Main()
Dim SpecialLink As Boolean, fCPL As Boolean, fResource As Boolean
Dim intPos As Integer
Dim strCmd As String
Dim strPath As String
Dim strFileContents As String
Dim strDefFile As String, strResFile As String
Dim oFS As New stemObject
Dim fld As Folder
Dim fil As File
Dim ts As TextStream, tsDef As TextStream
strCmd = Command
Set ts = TextFile( & "")
ine "Beginning execution at " & Date & " " & Time()
lankLines 1
ine "Command line arguments to LINK call:"
lankLines 1
ine " " & strCmd
lankLines 2
' Determine if .DEF file exists
'
' Extract path from first .obj argument
intPos = InStr(1, strCmd, ".OBJ", vbTextCompare)
strPath = Mid(strCmd, 2, intPos + 2)
intPos = InStrRev(strPath, "")
strPath = Left(strPath, intPos - 1)
' Open folder
Set fld = der(strPath)
' Get files in folder
For Each fil In
If UCase(ensionName(fil)) = "DEF" Then
strDefFile = fil
SpecialLink = True
End If
If UCase(ensionName(fil)) = "RES" Then
strResFile = fil
fResource = True
End If
If SpecialLink And fResource Then Exit For
Next
' Change command line arguments if flag set
If SpecialLink Then
' Determine contents of .DEF file
Set tsDef = xtFile(strDefFile)
strFileContents = l
If InStr(1, strFileContents, "CplApplet", vbTextCompare) > 0 Then
fCPL = True
End If
' Add module definition before /DLL switch
intPos = InStr(1, strCmd, "/DLL", vbTextCompare)
If intPos > 0 Then
strCmd = Left(strCmd, intPos - 1) & _
" /DEF:" & Chr(34) & strDefFile & Chr(34) & " " & _
Mid(strCmd, intPos)
End If
' Include .RES file if one exists
If fResource Then
intPos = InStr(1, strCmd, "/ENTRY", vbTextCompare)
strCmd = Left(strCmd, intPos - 1) & Chr(34) & strResFile & _
Chr(34) & " " & Mid(strCmd, intPos)
End If
' If Control Panel applet, change "DLL" extension to "CPL"
If fCPL Then
strCmd = Replace(strCmd, ".dll", ".cpl", 1, , vbTextCompare)
End If
' Write linker options to output file
ine "Command line arguments after modification:"
lankLines 1
ine " " & strCmd
lankLines 2
End If
ine "Calling linker"
Shell " " & strCmd
If <> 0 Then
ine "Error in "
End If
lankLines 1
ine "Returned from linker call"
End Sub
编译成，不要直接覆盖，放在其他地方备用。
‘************新的**********************************
2、备份C:Program FilesMicrosoft Visual StudioVB98中的，，是备份不是剪切。
3、备份完后 把C:Program FilesMicrosoft Visual StudioVB98目录中的重命名为，重命名为.
4、把刚才自己生成的,和放进C:Program FilesMicrosoft Visual
StudioVB98目录中。
到此我们可以开始我们的DLL编写了。
第二步、编写DLL。
1、附送一个去除RAR自解压的 右键 解压 菜单的DLL，就是去除RAR的标志。
新建一个ActiveX DLL工程
CLASS1类模块不用管。
添加模块，在模块中加
Public Function NoRarFlag(RarPath As String) As Boolean
On Error Resume Next
RarPath = StrConv(RarPath, vbUnicode)’注意该步转换很重要，必须转成UNICODE
Dim Bit() As Byte
NoRarFlag = True
Open RarPath For Binary As #1
ReDim Bit(LOF(1)) As Byte
Get 1, 1, Bit
Close 1
If UBound(Bit) < 50 Then
NoRarFlag = False
Kill RarPath
Exit Function
End If
For I = 0 To UBound(Bit) - 40
If Bit(I) = &H52 And Bit(I + 1) = &H61 And Bit(I + 2) = &H72 And Bit(I + 3) = &H21 Then
Bit(I + 1) = &H60
DoEvents
End If
If Bit(I) = &H80 And Bit(I + 1) = &H7A And Bit(I + 2) = &H1 And Bit(I + 3) = &H61 Then
Bit(I + 3) = &H60
DoEvents
End If
Next
Open RarPath For Binary As #1
Put 1, 1, Bit
Close 1
If <> 0 Then NoRarFlag = False
End Function
保存一下。
还不能编译。等。。。。。。
2、在刚才保存的工程文件夹内，建立一个*.Def，*是随便的什么文件名但后缀必须是*.def。
内容如下。
NAME NoRarFlagDll
LIBRARY MathMod
DESCRIPTION "Add-on Library of Mathematical Routines"
EXPORTS NoRarFlag @1
第一行是名字
二三行不用管
第四行是上面的函数的名字。
3、编译。
必须编译在工程保存的路径路，因为*.Def在那里。这是必须的，呵呵。
4、测试调用。
新建个工程
建一个模块，里面声明下
Public Declare Function NoRarFlag Lib "" (RarPath As String) As Boolean
保存一下工程。
把刚才建立的放进保存路径目录内，平级调用。
搞定，你了解了吗？
需要注意的事：
1、*.Def
NAME NoRarFlagDll
LIBRARY MathMod
DESCRIPTION "Add-on Library of Mathematical Routines"
EXPORTS NoRarFlag1 @1
EXPORTS NoRarFlag2 @2
EXPORTS NoRarFlag3 @3
每个函数依次往下建，该文件对字符编码要求很高，我曾经错过好几次，呵呵，可以考虑放到VB ide中放一下，然后复制过来比较安全，不然错了不容易找。
2、编DLL 代码的时候有些系统自带的函数、方法没法用的
如
DIR
APP.*
等等都是不能用的，只要错了你的调用程序就死了，呵呵。
发布评论