首页 /编程语言和算法/VB6/ASP
 VB6 文件写入资源,懒得写例子,直接给.bas
2024年11月19日 17:33

新建模块 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


 
全部回复(0)
首页 | 电脑版 |