VBGood网站全文搜索 Google

搜索VBGood全站网页(全文搜索)

VB爱好者乐园(VBGood)

 找回密码
 立即注册
搜索
楼主: icecept

[经验技巧] 资源文件精解示例

[复制链接]
 楼主| 发表于 2008-4-22 08:38:55 | 显示全部楼层
资源文件中释放五个文本文件到不同地方

Option Explicit
'此函数是释放资源文件中的其它文件
Private Sub ResShiFang(ResID As Integer, vDataFileName As String)
    Dim DataFile() As Byte
    DataFile = LoadResData(ResID, "TXT")  '从资源文件读入文件内容
    Open vDataFileName For Binary As #1  '建立数据文件,以二进制方式打开
    Put #1, , DataFile
    Close #1    '写完后关闭文件
End Sub
Private Sub Command1_Click(Index As Integer)
    Select Case Index
        Case 0
        ResShiFang 101, "C:\1.txt"
        Shell "c:\windows\explorer.exe /e, C:\", vbNormalFocus
        Case 1
        ResShiFang 102, "D:\2.txt"
        Shell "c:\windows\explorer.exe /e, D:\", vbNormalFocus
        Case 2
        ResShiFang 103, "C:\Program Files\3.txt"
        Shell "c:\windows\explorer.exe /e, C:\Program Files", vbNormalFocus
        Case 3
        If Dir("D:\Test", vbDirectory) = vbNullString Then
            MkDir "D:\Test"
        End If
        ResShiFang 104, "D:\Test\4.txt"
        Shell "c:\windows\explorer.exe /e, D:\Test", vbNormalFocus
        Case 4
        If Dir("C:\Test", vbDirectory) = vbNullString Then
            MkDir "C:\Test"
        End If
        ResShiFang 105, "C:\Test\5.txt"
        Shell "c:\windows\explorer.exe /e, C:\Test", vbNormalFocus
    End Select
End Sub



附件: 释放文本文件到不同文件夹.rar
回复 支持 反对

使用道具 举报

 楼主| 发表于 2008-4-22 08:40:27 | 显示全部楼层
附图:



图片附件: 1.JPG (2008-4-22 08:37, 34.37 K)



图片附件: 2.JPG (2008-4-22 08:37, 19.5 K)



图片附件: 3.JPG (2008-4-22 08:37, 18.26 K)



图片附件: 4.JPG (2008-4-22 08:37, 17.45 K)

回复 支持 反对

使用道具 举报

 楼主| 发表于 2008-4-25 19:16:31 | 显示全部楼层
一个利用vb资源文件制作的MP3播放器

'**************************************************************************
'**模 块 名:利用vb资源文件制作的MP3播放器 - form1
'**说    明:魔灵圣域 版权所有2008 - 2009(C)
'**创 建 人:郭卫(魔灵)
'**日    期:2008-04-24 03:50:39
'**修 改 人:郭卫
'**日    期:
'**描    述:郭卫制作
'**版    本:V1.0.0    http://icecept.blog.sohu.com
'*************************************************************************

Option Explicit
Private Sub Command1_Click(Index As Integer)
    Select Case Index
        Case 0: PlayMp3 101, "笑傲江湖.mp3"
        Case 1: PlayMp3 102, "真爱一世情.mp3"
        Case 2: PlayMp3 103, "遇见到是我的缘.mp3"
        Case 3: PlayMp3 104, "漫步人生路.mp3"
        Case 4: PlayMp3 105, "亲爱的朋友.mp3"
        Case 5: PlayMp3 106, "孤星独吟.mp3"
        Case 6: PlayMp3 107, "百万个吻.mp3"
        Case 7: PlayMp3 108, "回梦游仙.mp3"
        Case 8: PlayMp3 109, "吻和泪.mp3"
        Case 9: PlayMp3 110, "迟来的爱.MP3"
        Case 10: PlayMp3 111, "久别的人.mp3"
        Case 11: End
        Case 12: MMControl1.Command = "pause"
        Case 13: MMControl1.Command = "close"
    End Select
End Sub
Sub PlayMp3(RESid As Integer, Mp3Name As String)
    If Dir(Environ("temp") & "\" & Mp3Name) = vbNullString Then
        ResShiFang RESid, Environ("temp") & "\" & Mp3Name
    End If
    MMControl1.Command = "close"
    MMControl1.Notify = False
    MMControl1.Wait = True
    MMControl1.FileName = Environ("temp") & "\" & Mp3Name
    MMControl1.Command = "open"
    MMControl1.Notify = True
    MMControl1.Wait = False
    MMControl1.Command = "play"
End Sub
Private Sub ResShiFang(RESid As Integer, vDataFileName As String)
    Dim DataFile() As Byte
    DataFile = LoadResData(RESid, "MP3") '从资源文件读入文件内容
    Open vDataFileName For Binary As #1  '建立数据文件,以二进制方式打开
    Put #1, , DataFile
    Close #1    '写完后关闭文件
End Sub
Private Sub Form_Unload(Cancel As Integer)
     MMControl1.Command = "close"
End Sub


附件: 演奏音乐.part01.rar
附件: 演奏音乐.part02.rar
附件: 演奏音乐.part03.rar

附件: 演奏音乐.part04.rar
附件: 演奏音乐.part05.rar
附件: 演奏音乐.part06.rar

附件: 演奏音乐.part07.rar
附件: 演奏音乐.part08.rar
附件: 演奏音乐.part09.rar
附件: 演奏音乐.part10.rar
附件: 演奏音乐.part11.rar
附件: 演奏音乐.part12.rar
附件: 演奏音乐.part13.rar
附件: 演奏音乐.part14.rar

附件: 演奏音乐.part15.rar
附件: 演奏音乐.part16.rar
附件: 演奏音乐.part17.rar
附件: 演奏音乐.part18.rar
附件: 演奏音乐.part19.rar
附件: 演奏音乐.part20.rar

附件: 演奏音乐.part21.rar  
附件: 演奏音乐.part22.rar
附件: 演奏音乐.part23.rar


图片附件: QQ截图未命名.jpg   

  

评分

参与人数 1威望 +3 收起 理由
vbgo + 3 精品文章

查看全部评分

回复 支持 反对

使用道具 举报

发表于 2008-5-7 12:49:34 | 显示全部楼层
先收藏,以后看得懂了再学习.
回复 支持 反对

使用道具 举报

 楼主| 发表于 2008-5-7 13:36:31 | 显示全部楼层
一个月前 sgz888 (沈) 说想要一个可以一次加入上千资源的软件,我经过对vb和资源文件的分析,得出了一个结论,那就是vb可以编写出一次加入1000个资源的软件,我现在已经做出了用程序实现一次加入1000张图片、1000个图标、1000首wav音乐,我现在要做的就是把程序做的更美观一些。

以下只是设想,能否实现还有待实验:

再一个设想就是我想让vb在运行期间把产生的资源反复利用,也就是说让资源文件支持读写操作。这要用到rc脚本,再者就是在程序中把资源文件与exe文件结合在一起。

[ 本帖最后由 icecept 于 2008-5-7 14:17 编辑 ]
回复 支持 反对

使用道具 举报

 楼主| 发表于 2008-5-12 01:36:22 | 显示全部楼层

读取资源中的文本文件

Option Explicit
Private Sub Form_Load()
    Dim bArr() As Byte, S As String
    bArr = LoadResData(101, "TextFile")
    S = StrConv(bArr, vbUnicode)
    Text1.Text = S
End Sub

附件: 读取资源中的文本文件.rar

评分

参与人数 1威望 +7 收起 理由
hovidelphic + 7 ok

查看全部评分

回复 支持 反对

使用道具 举报

发表于 2008-5-12 17:00:14 | 显示全部楼层
不错的好帖,支持一个拉
回复 支持 反对

使用道具 举报

发表于 2008-5-17 14:23:24 | 显示全部楼层
很全,支持一下
回复 支持 反对

使用道具 举报

 楼主| 发表于 2008-5-17 23:22:40 | 显示全部楼层

批量生成资源文件工具

'**************************************************************************
'**模 块 名:RES批量生成 - frmRES
'**说    明:魔灵圣域 版权所有2008 - 2009(C)
'**创 建 人:郭卫(魔灵)
'**日    期:2008-05-16 01:33:59
'**修 改 人:郭卫
'**日    期:
'**描    述:郭卫制作
'**版    本:V1.0.2    http://icecept.blog.sohu.com
'*************************************************************************
Option Explicit
'让shell等待的API及参数
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredaccess&, ByVal bInherithandle&, ByVal dwProcessid&) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpexitcode As Long) As Long
Private Const STILL_ACTIVE = &H103
Private Const PROCESS_QUERY_INFORMATION = &H400
Private Sub Form_Load()    '选择默认路径
    Dir1.Path = App.Path
    File1.Path = Dir1.Path
    File1.Pattern = "*.bmp"
    Text2.Text = File1.Path
End Sub
Private Sub Combo1_Change()
    File1.Pattern = "*" & "." & Combo1.Text
End Sub
Private Sub Combo1_Click()
    File1.Pattern = "*" & "." & Combo1.Text
End Sub
Private Sub Drive1_Change()    '选择驱动器
    Dir1.Path = Drive1.Drive
End Sub
Private Sub Dir1_Change()    '选择文件夹
    File1.Pattern = "*" & "." & Combo1.Text
    File1.Path = Dir1.Path
    Text2.Text = File1.Path
End Sub
Private Sub Command1_Click()
    On Error Resume Next
    If InStr(Dir1.Path, Chr(32)) Then
        MsgBox "路径中不能含有空格,此文件未编译!请把此程序放到没有空格的文件夹中运行", vbOKOnly Or vbInformation, "提示"
        Exit Sub
    End If
    Dim DestinationFile As String, SourceFile As String, i As Long
    Dim RES As String, FileStyle As String
    Open CheckFilePath(App.Path) & "RES.rc" For Output As #1
    Print #1, vbNullString;
    Close #1
    If File1.ListCount > 0 Then
        For i = 0 To File1.ListCount - 1
            File1.ListIndex = i
            SourceFile = File1.Path & "\" & File1.FileName
            Select Case Combo1.Text
                Case "bmp"
                FileStyle = "BITMAP"
                Case "txt"
                FileStyle = "TEXTFILE"
                Case "ico"
                FileStyle = "ICON"
                Case "cur"
                FileStyle = "CURSOR"
                Case "wav"
                FileStyle = "WAVE"
            End Select
            DestinationFile = File1.Path & "\" & "A" & i + 1 & "." & Combo1.Text
            Name SourceFile As DestinationFile
            Open CheckFilePath(App.Path) & "RES.rc" For Append As #1
            Print #1, 100 + i + 1 & Space(2) & FileStyle & Space(2) & DestinationFile
            Close #1
        Next i
        File1.Refresh
        ShellWait CheckFilePath(App.Path) & "RC.EXE /r RES.rc", vbHide
    End If
    Kill CheckFilePath(App.Path) & "RES.rc"
End Sub
Private Sub Command2_Click()
    Unload Me
End Sub
Function CheckFilePath(ByVal Path As String) As String
    '检查文件是否在根目录下
    If Right(Path, 1) <> "\" Then
        CheckFilePath = Path & "\"
    Else
        CheckFilePath = Path
    End If
End Function
'让shell等待的函数
Public Sub ShellWait(cCommandLine As String, Optional WindowsStyle As VbAppWinStyle)
    Dim hShell As Long
    Dim hProc As Long
    Dim lExit As Long
    If Not IsMissing(WindowsStyle) Then WindowsStyle = vbNormalFocus
    hShell = Shell(cCommandLine, WindowsStyle)
    hProc = OpenProcess(PROCESS_QUERY_INFORMATION, False, hShell)
    Do
        GetExitCodeProcess hProc, lExit
        DoEvents
    Loop While lExit = STILL_ACTIVE
End Sub
Private Sub mnuabout_Click()
    Dim about As String
    about = "作者:郭卫,昵称:魔灵。喜欢用Visual Basic编程序的平面设计师,从中学时代就酷爱编程,"
    about = about & "从Gwbasic到Visual Basic,创作了不少的作品。并且我还特别喜"
    about = about & "欢平面设计,熟练使用photoshop和coreldraw,并创作了不少的作品."
    about = about & "作品有记事薄(类似于写字板)、华容道(20局的游戏)、企业商品"
    about = about & "管理、程序自动保存、整点报时、可产生关联的flash播放器、资源文件批量生成工具等一批软件,"
    about = about & "如果大家对我的程序感兴趣,请与我联系." & vbCrLf & "QQ:543375508"
    about = about & vbCrLf & "E-mail:icecept@163.com"
    about = about & vbCrLf & "魔灵圣域之情感世界 http://icecept.blog.sohu.com"
    MsgBox about, vbOKOnly Or vbInformation, "作者信息"
End Sub
Private Sub mnutishi_Click()
    MsgBox "本程序为了加快资源生成速度,会批量更改文件夹中文件的名称" & vbCrLf & "请备份此文件夹中的文件.", vbOKOnly Or vbInformation, "提示"
End Sub



附件: 批量生成资源文件.rar

[ 本帖最后由 icecept 于 2008-5-17 23:25 编辑 ]

评分

参与人数 1威望 +10 收起 理由
DreamonII + 10 精品文章

查看全部评分

回复 支持 反对

使用道具 举报

发表于 2008-5-18 10:52:04 | 显示全部楼层
精辟!收藏学习!
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

文字版|手机版|小黑屋|VBGood  

GMT+8, 2019-11-13 08:28

VB爱好者乐园(VBGood)
快速回复 返回顶部 返回列表