更新的原代码，包括了CRACK功能。 (10千字)
hdy 2002.05.30最近使用录音功能，发现录好的PCM文件传出来后认仍然是PCM，用没有CRACK的程序可以正常转为WAVE文件，于是修改了此工具，下面是更新的原码。也许用破解的方法比编程更简单 ：）
'====================================================================
'= =
'= MPM => MP3 的工具 =
'= =
'=------------------------------------------------------------------=
'= =
'= hdy 2002.05.30 增加:Crack功能和对PCM文件的处理 =
'= hdy 2002.05.23 增加:删除原始文件和播放多媒体文件的功能 =
'= hdy 2002.04.01 创建 =
'= =
'====================================================================
Option Explicit
Private Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
Private Declare Function SHBrowseForFolder Lib "SHELL32.DLL" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long 'ITEMIDLIST
Private Declare Function SHGetPathFromIDList Lib "SHELL32.DLL" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Const BIF_RETURNONLYFSDIRS = &H1
Private Const BIF_DONTGOBELOWDOMAIN = &H2
Private Const BIF_STATUSTEXT = &H4
Private Const BIF_RETURNFSANCESTORS = &H8
Private Const BIF_BROWSEFORCOMPUTER = &H1000
Private Const BIF_BROWSEFORPRINTER = &H2000
Private Type WaveHead
'RIFF Wave Chunk
RiffChunkID As String * 4
RiffChunkSize As Long
WaveChunkID As String * 4
'Format Chunk
FmtChunkID As String * 4
FmtChunkSize As Long
wformattag As Integer
wchannels As Integer
dwsamplespersec As Long
dwavgbytespersec As Long
wblockalign As Integer
wbitspersample As Integer
cbsize As Integer
wpole As Integer
'Date Chunk
DateChunkID As String * 4
DateChunkSize As Long
End Type
Private Sub cmdHelp_Click()
Dim Str As String
Str = "此工具用于将MP3播放器内存储的MPM格式文件还原为MP3格式文件。" & vbCrLf & vbCrLf _
& "并破解mpm文件不能上传(双击提示栏): " & vbCrLf _
& "DM-N64.exe 文件 50 FF 15 A8 E0 45 00 => 50 90 90 90 90 90 90 " & vbCrLf _
& "MPMan-F60.exe 文件 50 FF 15 4C E4 45 00 => 50 90 90 90 90 90 90" & vbCrLf & vbCrLf _
& "此工具在MSC的 ""DM-N64"" 上通过测试。" & vbCrLf & vbCrLf _
& " ---- hdy 2002.05.30 mail:hdy@sina.com"
MsgBox Str, vbInformation, "帮助"
End Sub
Private Sub cmdRefresh_Click()
Dir1.Refresh
File1.Refresh
File2.Refresh
txtMsg = ""
End Sub
Private Sub Dir1_Change()
File1.Path = Dir1.Path
File2.Path = Dir1.Path
End Sub
Private Sub Drive1_Change()
On Error GoTo errh
Dir1.Path = Drive1.Drive
Drive1.Tag = Drive1.Tag
Exit Sub
errh:
Drive1.Drive = Drive1.Tag
End Sub
Private Sub File1_DblClick()
Dim filemp3() As Byte
Dim filempm() As Byte
Dim fh As WaveHead
Dim filepcm() As Byte
Dim filewave() As Byte
Dim OldFileName As String
Dim NewFileName As String
Dim FileLength As Long
Dim Position As Long
Dim i As Long, j As Long
Dim sTmp As String
On Error GoTo errh
Me.Enabled = False
Me.MousePointer = 11
'取得原始文件的绝对文件名
OldFileName = IIf(Right(File1.Path, 1) = "\", File1.Path & File1.FileName, File1.Path & "\" & File1.FileName)
Open OldFileName For Binary Access Read As #1
FileLength = LOF(1)
'转换MPM文件
If UCase(Right(OldFileName, 3)) = "MPM" Then
ReDim filempm(FileLength - 1) As Byte
ReDim filemp3(FileLength - 33) As Byte
'读取mpm文件
Get #1, , filempm
txtMsg = "转换 " & OldFileName & " ..."
txtMsg.Refresh
j = 512 * ((FileLength - 32) \ 512) '计算实际要进行转换的数据总数
For i = 0 To j - 1
'数据转换 (每512个字节作为一个转换单元)
Position = ((i Mod 512) \ 32) + 16 * ((i Mod 512) Mod 32) + 512 * (i \ 512)
filemp3(Position) = filempm(i) - 2 * (filempm(i) Mod 2) + 1
Next i
For i = j To FileLength - 32 - 1
'剩余的字节直接拷贝
filemp3(i) = filempm(i)
Next i
Close #1
NewFileName = Left(OldFileName, Len(OldFileName) - 4) & ".MP3"
Open NewFileName For Binary Access Write As #1
'写入mp3文件
Put #1, , filemp3
Close #1
End If
'转换PCM文件
If UCase(Right(OldFileName, 3)) = "PCM" Then
Dim wh As WaveHead '定义48字节的RIFF文件头
With wh
.RiffChunkID = "RIFF"
.RiffChunkSize = FileLength + 48 - 8 'wave文件总长减8
.WaveChunkID = "WAVE"
.FmtChunkID = "fmt "
.FmtChunkSize = &H14
.wformattag = &H350
.wchannels = &H1
.dwsamplespersec = 8000 '采样频率
.dwavgbytespersec = 4137
.wblockalign = &H1E
.wbitspersample = &H0
.cbsize = &H2
.wpole = &H3A
.DateChunkID = "data"
.DateChunkSize = FileLength 'wave文件总长减48
End With
ReDim filepcm(FileLength - 1) As Byte
ReDim filewave(FileLength + 47) As Byte
'读取PCM文件
Get #1, , filepcm
Select Case filepcm(2)
Case 1:
'MP模式
wh.dwsamplespersec = 8000 '采样频率
wh.dwavgbytespersec = 4137 '比特率
Case 2:
'SP模式
wh.dwsamplespersec = 16000 '采样频率
wh.dwavgbytespersec = 8275 '比特率
Case Else
txtMsg = "此PCM文件不能被还原为Wave文件."
Close #1
Me.MousePointer = 0
Me.Enabled = True
Exit Sub
End Select
Close #1
NewFileName = Left(OldFileName, Len(OldFileName) - 4) & ".WAV"
Open NewFileName For Binary Access Write As #1
'写入wav文件
Put #1, , wh
Put #1, , filepcm
Close #1
End If
txtMsg = "生成 " & NewFileName
'删除原始文件
If chkDelOld.Value = 1 Then
Kill OldFileName
File1.Refresh
End If
File2.Refresh
Me.MousePointer = 0
Me.Enabled = True
Exit Sub
errh:
Close #1
File1.Refresh
File2.Refresh
Me.MousePointer = 0
Me.Enabled = True
End Sub
Private Sub File2_DblClick()
Shell "rundll32.exe url.dll,FileProtocolHandler " & Dir1.Path & File2.FileName
End Sub
Private Sub Form_Load()
Drive1.Tag = Drive1.Drive
File1.Pattern = "*.mpm;*.pcm"
File1.ToolTipText = "双击进行文件格式转换"
File2.Pattern = "*.mp3;*.wav"
File2.ToolTipText = "双击进行播放"
txtMsg.ToolTipText = "双击进行文件Crack"
chkDelOld.Caption = "删除原始文件"
cmdHelp.Caption = "帮助"
cmdRefresh.Caption = "刷新"
End Sub
Private Sub txtMsg_DblClick()
'进行文件Crack
Dim szFileName As String
Dim FileLength As Long
Dim OldFileName As String
Dim NewFile(0 To 5) As Byte
On Error GoTo errh
szFileName = BrowseFolder(Me.hWnd, "指定要Crack的文件 ""DM-N64.exe"" 所在的目录:")
If szFileName = "" Then
txtMsg = "Crack被取消."
Exit Sub
End If
OldFileName = szFileName & "\DM-N64.exe"
FileLength = FileLen(OldFileName)
If FileLength = 684032 Or FileLength = 671744 Then
'分别为英文版和中文版
Open OldFileName For Binary Access Read As #1
Get #1, 115002, NewFile
If NewFile(0) = &HFF And NewFile(1) = &H15 And NewFile(2) = &HA8 _
And NewFile(3) = &HE0 And NewFile(4) = &H45 And NewFile(5) = &H0 Then
Else
Close #1
txtMsg = "DM-N64.exe 非原始文件."
Exit Sub
End If
Close #1
If chkDelOld.Value = 0 Then
'备份原文件
FileCopy OldFileName, OldFileName & ".bak"
End If
Open OldFileName For Binary Access Write As #1
NewFile(0) = &H90
NewFile(1) = &H90
NewFile(2) = &H90
NewFile(3) = &H90
NewFile(4) = &H90
NewFile(5) = &H90
Put #1, 115002, NewFile
txtMsg = "Crack DM-N64.exe 文件成功."
Close #1
Else
txtMsg = "DM-N64.exe 文件尺寸不对."
End If
txtMsg = txtMsg & IIf(chkDelOld.Value, "原文件已被删除.", "原文件已被备份.")
Exit Sub
errh:
Close #1
txtMsg = "未找到 DM-N64.exe 文件."
End Sub
Private Function Int2HexStr(IntNum As Long) As String
'将10进制整数变为16进制字符串
'输入: IntNum 十进制整数
'输出: 格式化的字符串,前面填充零(共8个字符)
Dim sTmp As String
sTmp = CStr(Hex(IntNum))
Int2HexStr = String(8 - Len(sTmp), "0") & sTmp
End Function
Private Function HexStr2Int(HexStr As String) As Integer
'将16进制字符串变为10进制整数
'输入: 格式化的字符串(2字符)
'输出: 十进制整数
Dim iTmp As Integer
Dim a As Integer
Dim b As Integer
a = Asc(Left(HexStr, 1))
a = IIf(a < 65, a - 48, a - 55)
b = Asc(Right(HexStr, 1))
b = IIf(b < 65, b - 48, b - 55)
HexStr2Int = a * 16 + b
End Function
'//
'// BrowseFolder Function
'//
'// Description:
'// Allows the user to interactively browse and select a folder found in the file system.
'//
'// Syntax:
'// StrVar = BrowseFolder(hWnd, StrVar)
'//
'// Example:
'// szFilename = BrowseFolder(Me.hWnd, "Browse for application folder:")
'//
Private Function BrowseFolder(hWnd As Long, szDialogTitle As String) As String
Dim x As Long, BI As BROWSEINFO, dwIList As Long, szPath As String, wPos As Integer
BI.hOwner = hWnd
BI.lpszTitle = szDialogTitle
BI.ulFlags = BIF_RETURNONLYFSDIRS
dwIList = SHBrowseForFolder(BI)
szPath = Space$(512)
x = SHGetPathFromIDList(ByVal dwIList, ByVal szPath)
If x Then
wPos = InStr(szPath, Chr(0))
BrowseFolder = Left$(szPath, wPos - 1)
Else
BrowseFolder = ""
End If
End Function
