原作者：eleqian 请尊重作者成果。转载请注明原作者！
窗体主文件form1.frm内容如下：
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form Form1
BorderStyle = 1 'Fixed Single
Caption = "UnMRP by ele前 初始版本"
ClientHeight = 4995
ClientLeft = 45
ClientTop = 435
ClientWidth = 10275
Icon = "Form1.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 333
ScaleMode = 3 'Pixel
ScaleWidth = 685
StartUpPosition = 2 '屏幕中心
Begin VB.CommandButton cmd_CopyBmp
Caption = "复制"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Left = 8925
TabIndex = 8
Top = 2925
Width = 1170
End
Begin VB.CommandButton cmd_SaveBmp
Caption = "另存为"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Left = 8925
TabIndex = 7
Top = 3465
Width = 1170
End
Begin VB.PictureBox Picture0
AutoRedraw = -1 'True
BackColor = &H00FFFFFF&
BorderStyle = 0 'None
Height = 4800
Left = 5250
OLEDropMode = 1 'Manual
ScaleHeight = 320
ScaleMode = 3 'Pixel
ScaleWidth = 240
TabIndex = 4
Top = 120
Width = 3600
Begin VB.PictureBox Pic_bmp
AutoRedraw = -1 'True
BackColor = &H80000018&
BorderStyle = 0 'None
Height = 1800
Left = 1050
OLEDropMode = 1 'Manual
ScaleHeight = 120
ScaleMode = 3 'Pixel
ScaleWidth = 113
TabIndex = 5
Top = 1470
Width = 1695
End
End
Begin VB.CommandButton Command2
Caption = "打开MRP"
Height = 525
Left = 3990
TabIndex = 3
Top = 225
Width = 1065
End
Begin VB.ListBox List1
Height = 2040
Left = 8925
TabIndex = 2
Top = 135
Width = 1275
End
Begin VB.CheckBox Check1
BackColor = &H80000004&
Caption = "限制X≦240"
Height = 240
Left = 8925
MaskColor = &H8000000F&
TabIndex = 1
Top = 2295
Value = 1 'Checked
Width = 1170
End
Begin VB.TextBox Text1
Height = 2010
Left = 105
Locked = -1 'True
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 0
Top = 120
Width = 3795
End
Begin MSComDlg.CommonDialog CommonDialog1
Left = 4410
Top = 990
_ExtentX = 847
_ExtentY = 847
_Version = 393216
CancelError = -1 'True
End
Begin MSComctlLib.ListView ListView1
Height = 2745
Left = 105
TabIndex = 6
Top = 2205
Width = 5055
_ExtentX = 8916
_ExtentY = 4842
View = 3
LabelEdit = 1
Sorted = -1 'True
LabelWrap = 0 'False
HideSelection = 0 'False
AllowReorder = -1 'True
Checkboxes = -1 'True
FullRowSelect = -1 'True
_Version = 393217
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
NumItems = 4
BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Text = "模块名"
Object.Width = 3528
EndProperty
BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Alignment = 1
SubItemIndex = 1
Text = "类型"
Object.Width = 1059
EndProperty
BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Alignment = 1
SubItemIndex = 2
Text = "地址偏移"
Object.Width = 1764
EndProperty
BeginProperty ColumnHeader(4) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Alignment = 1
SubItemIndex = 3
Text = "大小(B)"
Object.Width = 1764
EndProperty
End
Begin VB.Menu RMenu
Caption = "RMenu"
Visible = 0 'False
Begin VB.Menu CheckAll
Caption = "全选"
End
Begin VB.Menu CheckSame
Caption = "选择同类型"
End
Begin VB.Menu fg1
Caption = "-"
End
Begin VB.Menu Extract
Caption = "开始提取"
End
Begin VB.Menu fg
Caption = "-"
End
Begin VB.Menu UnGzip
Caption = "自动Gzip解压"
End
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim ClickIndex As Integer '单击项目
Dim IsMove As Boolean, MX As Single, MY As Single '用于Picture的移动
'将图像复制到剪切板
Private Sub cmd_CopyBmp_Click()
Clipboard.Clear
Clipboard.SetData Pic_bmp.Image, vbCFDIB
Me.Caption = "UnMrp 图像已复制到剪切板"
End Sub
'图像另存为
Private Sub cmd_SaveBmp_Click()
On Error Resume Next
With CommonDialog1
.DialogTitle = "图像另存为"
.Filter = "BMP位图文件(*.bmp)|*.bmp|所有文件|*"
.FileName = bmpFile
.Flags = 6
.ShowSave
End With
If Err.Number = cdlCancel Then Err.Clear: Exit Sub
SavePicture Pic_bmp.Image, CommonDialog1.FileName
Me.Caption = "UnMrp 图像已保存为：" & CommonDialog1.FileName
End Sub
'全选
Private Sub CheckAll_Click()
Dim i As Integer
CheckAll.Checked = Not CheckAll.Checked
With ListView1
For i = 1 To .ListItems.Count
.ListItems(i).Checked = CheckAll.Checked
Next
End With
End Sub
'选择同类型
Private Sub CheckSame_Click()
Dim i As Integer
Dim CK As String
With ListView1
CK = .ListItems(ClickIndex).ListSubItems(1)
For i = 1 To .ListItems.Count
If .ListItems(i).ListSubItems(1) = CK Then .ListItems(i).Checked = True
Next
End With
End Sub
'打开MRP对话框
Private Sub Command2_Click()
On Error Resume Next
With CommonDialog1
.DialogTitle = "请选择MRP文件"
.Filter = "MRP文件(*.mrp)|*.mrp|所有文件|*"
.InitDir = App.Path
.Flags = 4
.ShowOpen
End With
If Err.Number = cdlCancel Then Err.Clear: Exit Sub
mrpFile = CommonDialog1.FileName
Text1.Text = InfoText(ReadInfo(mrpFile))
Call ListMods(mrpFile, ReadInfo(mrpFile))
End Sub
'提取选定资源文件
Private Sub Extract_Click()
Dim i As Integer
SavePath = BrowseForFolder("请选择用来保存提取出的模块文件的文件夹", Me.hWnd)
If SavePath = "" Then Exit Sub
For i = 1 To ListView1.ListItems.Count
With ListView1.ListItems(i)
If .Checked Then
Me.Caption = "UnMrp 正在提取... " & .Text
ExtractOne mrpFile, SavePath & "\" & .Text & ".gz", .ListSubItems(2), .ListSubItems(3)
If UnGzip.Checked Then Shell "gzip.exe -df " & SavePath & "\" & .Text & ".gz", vbHide
DoEvents
End If
End With
Next
Me.Caption = "UnMrp 提取完成！保存在" & SavePath
End Sub
'初始化
Private Sub Form_Load()
If Command <> "" Then
mrpFile = Replace(Command, Chr(34), "")
Text1.Text = InfoText(ReadInfo(mrpFile))
Call ListMods(mrpFile, ReadInfo(mrpFile))
End If
Call UnGzip_Click
Pic_bmp.BackColor = RGB(255, 255, 255)
'SetWindowPos Me.hWnd, -1, 0, 0, 0, 0, 3 '窗体置顶
End Sub
Private Sub Form_Unload(Cancel As Integer)
If Dir(bmpFile) <> "" And bmpFile <> "" Then Kill (bmpFile) '删除临时文件
End
End Sub
'排序指定列
Private Sub ListView1_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
Dim i As Integer
With ListView1
If .SortKey = ColumnHeader.Index - 1 Then
.SortOrder = 1 - .SortOrder
Else
.SortOrder = 0
.SortKey = ColumnHeader.Index - 1
End If
If ColumnHeader.Index = 4 Then '按数值大小排列
For i = 1 To .ListItems.Count
.ListItems(i).ListSubItems(3).Text = Format(.ListItems(i).ListSubItems(3).Text, "00000000")
Next
.Sorted = True
For i = 1 To .ListItems.Count
.ListItems(i).ListSubItems(3).Text = Val(.ListItems(i).ListSubItems(3).Text)
Next
End If
End With
End Sub
'取消全选
Private Sub ListView1_ItemCheck(ByVal Item As MSComctlLib.ListItem)
If CheckAll.Checked Then CheckAll.Checked = False
End Sub
'保存单击项目
Private Sub ListView1_ItemClick(ByVal Item As MSComctlLib.ListItem)
ClickIndex = Item.Index
End Sub
'右键菜单 & 预览图片
Private Sub ListView1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then
Me.PopupMenu RMenu
ElseIf Button = 1 Then
If ListView1.ListItems(ClickIndex).ListSubItems(1) = "bmp" And UnGzip.Checked Then
If ClickIndex > 0 Then Call Preview(ClickIndex)
End If
End If
End Sub
'自动解压选项
Private Sub UnGzip_Click()
Dim PID As Long
UnGzip.Checked = Not UnGzip.Checked
On Error Resume Next
PID = Shell("gzip.exe", vbHide)
If PID = 0 Or Err.Number = 53 Then
Me.Caption = "UnMRP Gzip.exe不存在或有错误"
UnGzip.Checked = False
End If
End Sub
'图片拖动
Private Sub Pic_bmp_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
IsMove = True
MX = X: MY = Y
End Sub
Private Sub Pic_bmp_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If IsMove Then
Pic_bmp.Left = Pic_bmp.Left + X - MX
Pic_bmp.Top = Pic_bmp.Top + Y - MY
End If
End Sub
Private Sub Pic_bmp_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
IsMove = False
End Sub
'选择一种BMP分辨率
Private Sub List1_Click()
Dim bmpX As Long, bmpY As Long
bmpX = List1.ItemData(List1.ListIndex)
bmpY = Round((FileLen(bmpFile) / 2) / bmpX)
DrawPic bmpFile, bmpX, bmpY
End Sub
模块：函数和过程Module2.bas
Attribute VB_Name = "声明"
Option Explicit
'窗口置顶API
Public Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
'控制解压过程
Public Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Public Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Public Const PROCESS_QUERY_INFOMATION = &H400
Public Const STILL_ALIVE = &H103
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'Mrp格式定义 by ele前 QQ:1003082820 E-Mail:[email protected]
'以下定义为作者自己总结得来，难免有错误
'如需使用此定义请保留作者信息
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Public Type MRPFILEINFO 'MRP文件信息结构
mHeader As Long '文件头(MRPG) &H4750524D
mInfoSize As Long '文件信息+模块列表大小 不包括前8字节(mHeader和mInfoSize)
mFileSize As Long '文件总大小
mInfoBegin As Long '模块信息偏移(通常为240)
mIntName As String * 12 '内部文件名 以Null结尾
mProName As String * 24 '应用名称 以Null结尾
mCode0 As String * 16 'SDK授权编码 (猜测)(正版只有前9位且在HEX范围,其余应该是被乱修改的)
mCode1 As Long '编码1 应用编号 (部分MRP的被倒序,疑被错误修改)
mCode2 As Long '编码2 版本编号 (同上)
mCode3 As Long '编码3 ?(通常为7)
mCode4 As Long '编码4 编译器版本(猜测)(通常为10002)
mCode5(3) As Byte '编码5
mComp As String * 40 '出品公司、版权等 以Null结尾
mDesc As String * 64 '应用描述 以Null结尾
mCode6(3) As Byte '编码6 =编码1倒序
mCode7(3) As Byte '编码7 =编码2倒序
mCode8(3) As Byte '少数MRP下面有数据
mCode9(3) As Byte
mCode10(3) As Byte
End Type
'Public Type MRPFILELIST 'MRP文件内容列表结构
' aNameLen As Long '文件名长度
' aName As String * aNameLen '文件名 以Null结尾
' aFileAddr As Long '文件开始地址
' aFileLen As Long '文件长度
' aOther As Long 'Null
'End Type
'Public Type MRPFILERES 'MRP文件内容结构
' aNameLen As Long '文件名长度
' aName As String * aNameLen '文件名 以Null结尾
' aFileLen As Long '文件长度
' aOther As Long 'Null
' aFile(aFileLen - 1) As Byte 'gzip文件
'End Type
Public mrpFile As String
Public SavePath As String
Public bmpFile As String
模块：浏览文件夹（SHBrowseForFolder.bas）
Attribute VB_Name = "浏览文件夹"
Option Explicit
Public Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Public Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Public Type BROWSEINFO
hOwner As Long '父窗口句柄
pidlRoot As Long '最上层文件，可为0
pszDisplayName As String '返回的文件夹(带一个Null字符)
lpszTitle As String '对话框标题(以vbNullChar结尾)
ulFlaga As Long '浏览标志
lpfn As Long '回调函数地址，可为Null
lParam As Long '若有回调函数，设置它的值
iImage As Long '保存所选文件夹映像索引的缓冲区
End Type
Public Const BIF_RETURNONLYFSDIRS = &H1 '仅允许浏览文件系统
Public Const BIF_DONTGOBELOWDOMAIN = &H2 '强制停留在网上邻居中
Public Const BIF_STATUSTEST = &H4 '显示状态栏
Public Const BIF_RETURNFSANCESTORS = &H8 '返回文件系统祖先？
Public Const BIF_EDITBOX = &H10 '显示输入框（需IE4）
Public Const BIF_VALIDATE = &H20 '若输入非法文件名就返回BFFM_VALIDATEFAILED给回调函数
Public Const BIF_USENEWUI = &H40 '使用新界面（>Win2k）
Public Const BIF_BROWSEFORCOMPUTER = &H1000 '允许浏览计算机
Public Const BIF_BROWSEFORPINTER = &H2000 '允许打开打印机文件夹
Public Const BIF_BROWSEINCLUDEFILES = &H4000 '允许浏览文件（需IE4）
Public Function BrowseForFolder(Optional Title As String, Optional hWnd As Long) As String '浏览文件夹
Dim bi As BROWSEINFO
Dim pidl As Long
Dim Folder As String
Folder = String(255, vbNullChar)
With bi
.hOwner = hWnd
.ulFlaga = BIF_RETURNONLYFSDIRS Or BIF_USENEWUI 'Or BIF_EDITBOX
.pidlRoot = 0
.lpszTitle = IIf(Title <> "", Title, "选择文件夹") & vbNullChar
End With
pidl = SHBrowseForFolder(bi)
If SHGetPathFromIDList(ByVal pidl, ByVal Folder) Then
BrowseForFolder = Left(Folder, InStr(Folder, vbNullChar) - 1)
Else
BrowseForFolder = ""
End If
End Function
模块：声明（module1.bas）
Attribute VB_Name = "声明"
Option Explicit
'窗口置顶API
Public Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
'控制解压过程
Public Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Public Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Public Const PROCESS_QUERY_INFOMATION = &H400
Public Const STILL_ALIVE = &H103
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'Mrp格式定义 by ele前 QQ:1003082820 E-Mail:[email protected]
'以下定义为作者自己总结得来，难免有错误
'如需使用此定义请保留作者信息
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Public Type MRPFILEINFO 'MRP文件信息结构
mHeader As Long '文件头(MRPG) &H4750524D
mInfoSize As Long '文件信息+模块列表大小 不包括前8字节(mHeader和mInfoSize)
mFileSize As Long '文件总大小
mInfoBegin As Long '模块信息偏移(通常为240)
mIntName As String * 12 '内部文件名 以Null结尾
mProName As String * 24 '应用名称 以Null结尾
mCode0 As String * 16 'SDK授权编码 (猜测)(正版只有前9位且在HEX范围,其余应该是被乱修改的)
mCode1 As Long '编码1 应用编号 (部分MRP的被倒序,疑被错误修改)
mCode2 As Long '编码2 版本编号 (同上)
mCode3 As Long '编码3 ?(通常为7)
mCode4 As Long '编码4 编译器版本(猜测)(通常为10002)
mCode5(3) As Byte '编码5
mComp As String * 40 '出品公司、版权等 以Null结尾
mDesc As String * 64 '应用描述 以Null结尾
mCode6(3) As Byte '编码6 =编码1倒序
mCode7(3) As Byte '编码7 =编码2倒序
mCode8(3) As Byte '少数MRP下面有数据
mCode9(3) As Byte
mCode10(3) As Byte
End Type
'Public Type MRPFILELIST 'MRP文件内容列表结构
' aNameLen As Long '文件名长度
' aName As String * aNameLen '文件名 以Null结尾
' aFileAddr As Long '文件开始地址
' aFileLen As Long '文件长度
' aOther As Long 'Null
'End Type
'Public Type MRPFILERES 'MRP文件内容结构
' aNameLen As Long '文件名长度
' aName As String * aNameLen '文件名 以Null结尾
' aFileLen As Long '文件长度
' aOther As Long 'Null
' aFile(aFileLen - 1) As Byte 'gzip文件
'End Type
Public mrpFile As String
Public SavePath As String
Public bmpFile As String
尊重版权，转载请注明原作者eleqian
