新建模块 mod.bas,代码:
'WriteRes 资源地址, 文件地址, "CUSTOM", "103"
Public Declare Function BeginUpdateResource Lib "kernel32" Alias "BeginUpdateResourceA" (ByVal pFileName As String, ByVal bDeleteExistingResources As Boolean) As Long
Public Declare Function UpdateResource Lib "kernel32" Alias "UpdateResourceA" (ByVal hUpdate As Long, ByVal lpType As Any, ByVal lpName As Any, ByVal wLanguage As Long, lpData As Any, ByVal cbData As Long) As Long
Public Declare Function EndUpdateResource Lib "kernel32" Alias "EndUpdateResourceA" (ByVal hUpdate As Long, ByVal fDiscard As Boolean) As Long
Public Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Public Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
Public Function WriteRes(ByVal ResFileName As String, ByVal WriteFileName As String, ByVal ResType As String, ByVal ResID As Long) As Boolean
Dim VbArrayRes() As Byte '写入内容
Dim hUpdate As Long '被写入的目标文件路径
Dim ret As Long '资源句柄
Dim ResTypeX As String
ResTypeX = StrConv(ResType, vbUpperCase) '将资源标识符
hUpdate = BeginUpdateResource(WriteFileName, False) '打开要写入的目标文件
ReDim VbArrayRes(FileLen(ResFileName) - 1) '计算资源文件大小
Open ResFileName For Binary As #1 '获取资源文件内容
Get #1, , VbArrayRes
Close #1
ret = UpdateResource(hUpdate, ResTypeX, ResID, 0, VbArrayRes(0), UBound(VbArrayRes) + 1) '添加资源
If ret <> 0 Then
WriteRes = True
End If
Text4 = Text4 + 1
ret = EndUpdateResource(hUpdate, False)
End Function
Public Function 写入字符(ByVal 文件路径 As String, 写入内容() As Byte, Optional 资源标识 As String = "CUSTOM", Optional 编号 As Long = 101) As Boolean
Dim 文件句柄 As Long
Dim 资源句柄 As Long
Dim ResTypeX As String
ResTypeX = StrConv(资源标识, vbUpperCase) '资源标识符
文件句柄 = BeginUpdateResource(文件路径, False) '打开要写入的目标文件
资源句柄 = UpdateResource(文件句柄, ResTypeX, 编号, 2052, 写入内容(0), UBound(写入内容) + 1) '添加资源
If 资源句柄 <> 0 Then 写入字符 = True
资源句柄 = EndUpdateResource(文件句柄, False)
End Function
Public Function 保存INI(ByVal A As String, ByVal B As String) As String
Dim success As Long
success = WritePrivateProfileString("设置", A, B, App.path & "\配置.ini")
End Function
Public Function 读取INI(ByVal A As String) As String
Dim ret As Long
Dim buff As String
buff = String(255, 0)
ret = GetPrivateProfileString("设置", A, "", buff, 256, App.path & "\配置.ini")
读取INI = buff
End Function
Public Function DU(ByVal txt As String) As String
Dim s As String
Open txt For Binary As #1
s = Space(LOF(1))
Get #1, , s
Close #1
DU = s
End Function