这是vb的世界，这是程序源代码的海洋，我借此与众多朋友共同交流编程思想，编程技巧，望我能够在帮助大家的同时，得到大家的恩惠。魔灵圣域欢迎大家的到来。
批量生成资源文件工具
2008-05-16 13:16:36 / 个人分类：VB 类别
'**************************************************************************
'**模 块 名：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
'**模 块 名：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
(2008-05-16 11:04:12, Size: 453 kB, Downloads: 6)
相关阅读:
- 让精灵说话的驱动和查看器，外加示例程序 (icecept, 2008-4-12)
- 制作试用软件 (icecept, 2008-4-13)
- VB DoEvents用法 (petercaida, 2008-4-16)
- 从资源文件中释放五个文本文件到不同地方 (icecept, 2008-4-22)
- 一个利用vb资源文件制作的MP3播放器 (icecept, 2008-4-25)
- 锁定电脑，只运行许可的Windows应用程序 (icecept, 2008-4-30)
- 选择文件夹 (icecept, 2008-5-02)
- 企业商品管理 (icecept, 2008-5-06)
- InitCommonControls (petercaida, 2008-5-07)
论坛模式 推荐 收藏 等级(5) 编辑 管理 查看(577) 评论(12)
TAG: 批量生成资源文件工具 资源文件 VB RES
-
yangzn
发布于2008-06-17 10:26:36
-
个人认为：
'DestinationFile = File1.Path & "\" & "A" & i + 1 & "." & Combo1.Text '改为下面一句应更好了
DestinationFile = File1.Path & "\" & "A" & i + 1 & File1.FileName
这样便知道，被编进源文件的资源号，都对应哪些文件（文件是有意义的），而不是被生生变成一些无意义的文件名。
-
icecept
发布于2008-06-16 14:22:02
-
If InStr(Dir1.Path, Chr(32)) Then
MsgBox "路径中不能含有空格，此文件未编译!请把此程序放到没有空格的文件夹中运行", vbOKOnly Or vbInformation, "提示"
Exit Sub
End If
上面已有说明，且路径中不能是长路径名，且不支持中文文件名。dos 命令的局限性
[ 本帖最后由 icecept 于 2008-6-16 15:43 编辑 ]
-
zzi617发布于2008-06-16 13:26:06
-
谢谢楼主，正在使用，提一点意见：
Name SourceFile As DestinationFile
如果在重复运行后，因为没有判断文件名是否已存在，会造成出错，
因你已使用了On Error Resume Next，所以便无提醒，
ShellWait CheckFilePath(App.Path) & "RC.EXE /r RES.rc", vbHide
编译时，我首先都在中文文件夹中，始终无法成功，原本想转到ＤＯＳ手动操作，结果移到英文文件夹编译则成功，所以可能需要再检查看看，是否有错．
以上是我用你的源码运行时发现的错误，不知是否因我的操作或理解有误或水平原因造成的，谨此提出
再次谢谢！
-
icecept
发布于2008-06-13 18:28:21
-
此程序是借用RC.EXE来编译rc文件为res文件，照此推断，exe文件也可以做到用程序的方法来编译。这个程序回过头来看，给了我一个不错的借鉴。
-
DreamonII
发布于2008-05-16 19:55:42
-
嗯啦~~
谢谢sgz888的鼓励哦~~
加油加油~~
-
sgz888
发布于2008-05-16 19:48:06
-
这么快就梦想成真了，恭喜啊，真是想不到这么快啊。
-
DreamonII
发布于2008-05-16 19:44:16
-
谢谢谢谢~~
嘿嘿~
多多支持哦~~~
-
icecept
发布于2008-05-16 19:40:44
-
恭喜DreamonII 成为版主
-
ctzl8发布于2008-05-16 18:42:37
-
学习了。
-
DreamonII
发布于2008-05-16 18:33:28
-
终于又有分可送了~~
偶级别不够,一次只能加这么多了~~ 嘿嘿~~
-
sgz888
发布于2008-05-16 11:08:09
-
看到源码了，一定要好好研究啊。谢谢
-
DreamonII
发布于2008-05-16 11:07:55
-
晕啊~~
我今天的评分用光了~~
好东东啊
晚些一定补上~~~~
