用ASP实现对MP3曲目信息的操作

先简单说一下MP3的ID3 标记,因为主要是操作这个玩意。

MP3最开始的时候没有我们今天看到的那样,有歌手、年代,专集等等信息。只有一些简单的参数如yes/no来表示是不是privated或者copyrighted等信息,这样对MP3的相关工作带来了很多不便,1996年的时候有个老外提出来在每个MP3后面追加一段数据,用以存放上述的那些信息,后来就发展成为id3 v1 据我所知的现在已经到1.1了,具体的还是自己去查一下吧。

用metadata来引入DLL

<!–METADATA TYPE="typelib"
      UUID="00000205-0000-0010-8000-00AA006D2EA4"
     NAME="ADODB Type Library"
–>

<%
  Function ConvertBin(Binary)
  ‘This function converts a binary byte into an ASCII byte.
    for i = 1 to LenB(Binary)
      strChar = chr(AscB(MidB(Binary,i,1)))
      ConvertBin = ConvertBin & strChar
    Next
  End Function

dim objStream
  dim strTag, strSongName, strArtist, strAlbum, strYear, _
      strComment, strGenre, strFile

‘Specify the folder to iterate through, displaying all the MP3s
  Const folder = "C:mp3s"

‘Grab the folder information

Dim objFSO, objFolder, objFile
  Set objFSO = Server.CreateObject("Scripting.FileSYstemObject")
  Set objFolder = objFSO.GetFolder(folder)

‘Create the Stream object
  set objStream = Server.CreateObject("ADODB.Stream")
  objStream.Type = adTypeBinary

‘Loop through the files in the folder
  For Each objFile in objFolder.Files
    ‘Open the stream
    objStream.Open
    objStream.LoadFromFile objFile.Path

‘Read the last 128 bytes
    objStream.Position =  objStream.size – 128

‘Read the ID3 v1 tag info
    strTag = ConvertBin(objStream.Read(3))
    if ucase(strTag) = "TAG" then
      strSongName = ConvertBin(objStream.Read(30))
      strArtist = ConvertBin(objStream.Read(30))
      strAlbum = ConvertBin(objStream.Read(30))
      strYear = ConvertBin(objStream.Read(4))
      strComment = ConvertBin(objStream.Read(30))
    end if

‘Display the results
    response.write "<table><tr><td colspan=2><h3>" & _
                   "ID3 Tag info for:</td></tr><tr>" & _
                   "<td colspan=2>" & objFile.Name & "</td></tr>"
    response.write "<tr><td><b>Artist: </b></td>" & _
                   "<td>" & strArtist & "</td></tr>"
    response.write "<tr><td><b>Track: </b></td>" & _
                   "<td>" & strSongName  & "</td></tr>"
    response.write "<tr><td><b>Album: </b></td>" & _
                   <td>" & strAlbum & "</td></tr>"
    response.write "<tr><td><b>Year: </b></td>" & _
                   "<td>" & strYear & "</td></tr>"
    response.write "<tr><td><b>Comment: </b>" & _
                   "</td><td>" & strComment & "</td></tr>"
    response.write "</table>"

objStream.Close

Response.Write "<p><hr><p>"
  Next

Set objStream = Nothing    ‘Clean up…
%>
 

修改了一下:

<!–METADATA TYPE="typelib"
UUID="00000205-0000-0010-8000-00AA006D2EA4"
NAME="ADODB Type Library"
–>

<%
Response.Buffer = false
Function ConvertBin(Binary)
‘This function converts a binary byte into an ASCII byte.
for i = 1 to LenB(Binary)
strChar = chr(AscB(MidB(Binary,i,1)))
ConvertBin = ConvertBin & strChar
Next
End Function

dim objStream
dim strTag, strSongName, strArtist, strAlbum, strYear, _
strComment, strGenre, strFile

‘Specify the folder to iterate through, displaying all the MP3s
Const folder = "F:\MUSIC"

‘Grab the folder information

Dim objFSO, objFolder, objFile
Set objFSO = Server.CreateObject("Scripting.FileSYstemObject")
Set objFolder = objFSO.GetFolder(folder)

‘Create the Stream object
set objStream = Server.CreateObject("ADODB.Stream")
objStream.Type = adTypeBinary

‘Loop through the files in the folder
For Each objFile in objFolder.Files
if lcase(objFSO.GetExtensionName(objFile)) = "mp3" then
Response.Write objFile.Type
‘Open the stream
objStream.Open
objStream.LoadFromFile objFile.Path

‘Read the last 128 bytes
objStream.Position = objStream.Size – 128

‘Read the ID3 v1 tag info
strTag = ConvertBin(objStream.Read(3))
if ucase(strTag) = "TAG" then
strSongName = ConvertBin(objStream.Read(30))
strArtist = ConvertBin(objStream.Read(30))
strAlbum = ConvertBin(objStream.Read(30))
strYear = ConvertBin(objStream.Read(4))
strComment = ConvertBin(objStream.Read(30))
end if

‘Display the results
response.write "<table><tr><td colspan=2><h3>" & _
"ID3 Tag info for:</td></tr><tr>" & _
"<td colspan=2>" & objFile.Name & "</td></tr>"
response.write "<tr><td><b>Artist: </b></td>" & _
"<td>" & strArtist & "</td></tr>"
response.write "<tr><td><b>Track: </b></td>" & _
"<td>" & strSongName & "</td></tr>"
response.write "<tr><td><b>Album: </b></td>" & _
"<td>" & strAlbum & "</td></tr>"
response.write "<tr><td><b>Year: </b></td>" & _
"<td>" & strYear & "</td></tr>"
response.write "<tr><td><b>Comment: </b>" & _
"</td><td>" & strComment & "</td></tr>"
response.write "</table>"

objStream.Close

Response.Write "<p><hr><p>"

end if
Next

Set objStream = Nothing ‘Clean up…
%>

— EOF —

ASP+FSO实现的服务器目录名和文件名罗列脚本

闲着的时候写了这个东东:^_^

打包下载:
listpath.zip

下面是源代码:

<%
Response.Buffer = False
Server.ScriptTimeOut = 360000000
On error Resume next
%>
<html>
<head>
<title>::. 风动网目录文件罗列脚本 .::</title>
<style type="text/css">
Body {font-size: 12px; font-family: "verdana", "arial", "helvetica", "sans-serif"}
a {color: #000000; text-decoration: none}
</STYLE>
</head>
<body>
<div align="center">
<form align="center" action="?" method="post" ID="Form1">
<fieldset style="width: 350px;">
<legend align="center" onclick="showOrHide(‘syspanel’);" style="cursor: hand;" title="点击[显示/隐藏]此框"><b><big>风动网目录文件罗列脚本</big></b></legend>
<div id="syspanel">
目录: <input type="text" name="ListPath" size="40"
title="这里指服务器上的目录, 可以是盘符或路径." ID="Text1"><br>
类型: <input type="text" name="FileType" size="40"
title="你所要罗列文件的类型,
如[.exe .rar],中间可用任意字符隔开
不填即列所有类型文件." ID="Text2"><br>
层数: <input type="text" name="Depth" size="40"
title="你所要罗列目录的层数, 不填即列所有层数." ID="Text3"><br>
<span id="param1ctrl" style="display: none;">路径: <input type="text" name="LogPath" size="40"
title="目录清单文件保存的路径, 也是指服务器上的." ID="Text4"><br></span>
参数: <input type="checkbox" name="Param" value="file" checked
title="是否罗列出文件." ID="Checkbox1"> 列文件
<input type="checkbox" name="Param1" value="txtlog" onclick="display(‘param1ctrl’,’Param1′);"
title="是否生成目录清单文件." ID="Checkbox2"> 生成txt
<input type="checkbox" name="Param2" value="scrout" checked
title="是否在浏览器窗口中输出." ID="Checkbox3"> 屏幕输出<br>  
<input type="checkbox" name="Param3" value="fsout" checked
title="是否显示文件大小." ID="Checkbox2"> 显示文件大小
<input type="checkbox" name="Param4" value="fenout" checked
title="是否显示文件扩展名." ID="Checkbox2"> 显示文件扩展名<br><br>
<input type="submit" value="     开   始   罗   列     " title="罗列过程中按空格可以控制屏幕滚动" ID="Submit1" NAME="Submit1">
</div>
</fieldset>
</form>
</div>
<script language="JavaScript">
<!–
window.status = " ** 风动网目录文件罗列脚本 ** ";
function showOrHide(id) {
if (getObjectById(id).style.display=="none")
  {getObjectById(id).style.display=’block’;}
else
  {getObjectById(id).style.display=’none’;}
}
function display(id,ctrl) {
  if (getObjectById(ctrl).checked==true)
   {getObjectById(id).style.display=’block’;}
  else
   {getObjectById(id).style.display=’none’;}
}
function displayObject(id,flag) {
  if (flag==true)
   {getObjectById(id).style.display=’block’;}
  else
   {getObjectById(id).style.display=’none’;}
}
function getObjectById(id) {
     return document.getElementById(id);
}
//–>
</script>
<%
Dim ListPath, Depth, CurDepth
ListPath = Replace(Request.Form("ListPath"), "/", "\")
If Not ListPath = Empty Then
%>
<script language="JavaScript">
<!–
window.status = "服务器正在罗列,请稍候 … (按空格可以控制屏幕滚动)"
Timer = window.setInterval("window.scroll(0, document.body.scrollHeight);", 50);
var Timer;
var stopScroll;
 
function document.onkeydown() {
  if (event.keyCode == 32) {
   if (stopScroll == false) {
    winScroll();
    stopScroll = true;
   }
   else {
    window.clearInterval(Timer);
    stopScroll = false;
   }
  }
}
function winScroll(){
  Timer = window.setInterval("window.scroll(0, document.body.scrollHeight);", 100);
}
function document.onstop(){
  window.status = "罗列中断!"
  window.setTimeout("window.clearInterval(Timer);", 1000);
}
//–>
</script>
<%
  If Right(ListPath, 1) <> "\" Then ListPath = ListPath & "\"
  If Not Request.Form("Depth") = "" Then Depth = Int(Request.Form("Depth"))
  FileType = LCase(Request.Form("FileType"))
  Param = Request.Form("Param")
  Param1 = Request.Form("Param1")
  Param2 = Request.Form("Param2")
  Param3 = Request.Form("Param3")
  Param4 = Request.Form("Param4")

Set ListParentObject = Server.CreateObject("Scripting.FileSystemObject")
  If Len(ListPath) <= 4 Then
   If ListParentObject.DriveExists(ListPath) Then
    Set ListDriveObject = ListParentObject.GetDrive(ListPath)
    If ListDriveObject.IsReady = True Then
     Set ListPathObject = ListDriveObject.RootFolder
    Else
     errmsg = "<br>对不起,当前驱动器未准备就绪!"
     ErrOccur(errmsg)
     Response.End
    End If
   Else
    errmsg = "<br>对不起,当前驱动器不存在!"
    ErrOccur(errmsg)
    Response.End
   End If
  Else
   If ListParentObject.FolderExists(ListPath) Then
    Set ListPathObject = ListParentObject.GetFolder(ListPath)
   Else
   
    errmsg = "<br>对不起,当前路径不存在!"
    ErrOccur(errmsg)
    Response.End
   End If
 
  End If
  If Param1 = "txtlog" Then
   Dim LogPath
   LogPath = Replace(Request.Form("LogPath"), "/", "\")
   Set FSO = Server.CreateObject("Scripting.FileSystemObject")
   If (FSO.FolderExists(LogPath)) Then
  
    If (Right(LogPath, 1) <> "\") Then LogPath = LogPath & "\"
    Set FO = FSO.CreateTextFile(LogPath & Replace(Replace(ListPath, "\", "-"), ":", "-") & ".txt")
   Else
    Response.Write "<font color=""red"">输入路径不存在, 日志文件将被保存在与该脚本相同的目录下.</font><br><br>"
    Set FO = FSO.CreateTextFile(Server.MapPath(Replace(Replace(ListPath, "\", "-"), ":", "-") & ".txt"))
   End If
  End If
  Response.Write "<font color=""brown"">▊</font> 目录 "
  Response.Write "<font color=""green"">▊</font> 文件<br><br>"
  Response.Write "<b><font color=""red"">[" & ListPath & "]</font></b><br>"
  If Param1 = "txtlog" Then FO.Write(ListPath) & VbCrLf
  Call ListAllPath(ListPath, "0", False)
  Response.Write "<br><br><b><font color=""red"">罗列完毕!</font></b>"
%>
 
<script language="JavaScript">
<!–
window.status = "罗列完毕!"
window.setTimeout("window.clearInterval(Timer);", 1000);
//–>
</script>
<%
  If Param1 = "txtlog" Then
 
   Set FO = Nothing
   Set FSO = Nothing
  End If
End If
%>
</body>
</html>
<%

Function ListAllPath(byval CurPath, byval Symbol, byval LastFolder)

Dim CurFolderIndex
  CurFolderIndex = 0
  CurDepth = CurDepth + 1
  If LastFolder = True Then
 
   Symbol = Symbol & "1"
  Else
 
   Symbol = Symbol & "2"
  End If
 
  If Depth <> "" Then
 
   If CurDepth >= Depth + 1 Then Exit Function
  End If
  If Len(ListPath) <= 4 Then
   Set ListDriveObject = ListParentObject.GetDrive(CurPath)
   Set ListPathObject = ListDriveObject.RootFolder
  Else
   Set ListPathObject = ListParentObject.GetFolder(CurPath)
  End If
  If InStr(Param, "file") > 0 Then Call ListAllFile(CurPath, Symbol, LastFolder)
  TotalFolderNum = ListPathObject.SubFolders.Count
  For Each ListPath In ListPathObject.SubFolders
   CurFolderIndex = CurFolderIndex + 1
   If ListPath.Attributes <> 22 Then
    If ListPath.Size <= 1024 Then
     PathSize = 1
    Else
     PathSize = FormatNumber(ListPath.Size/1024,0)
    End If
    StrTemp = Nums2Symbols(Mid(Symbol, 3))
    If Param2 = "scrout" Then Response.Write StrTemp
    If Param1 = "txtlog" Then FO.Write(StrTemp)
    If CurFolderIndex = TotalFolderNum Then
     If Param2 = "scrout" Then Response.Write("└─")
     If Param1 = "txtlog" Then FO.Write("└─")
     LastFolder1 = True
    Else
   
     If Param2 = "scrout" Then Response.Write("├─")
     If Param1 = "txtlog" Then FO.Write("├─")
     LastFolder1 = False
    End If
    If Param2 = "scrout" Then
   Response.Write("<font color=""brown"">" & ListPath.Name)
   If Param3 = "fsout" Then Response.Write(" " & PathSize & "KB")
   Response.Write("</font><br>")
End If
    If Param1 = "txtlog" Then
   FO.Write(ListPath.Name)
   If Param3 = "fsout" Then FO.Write(" " & PathSize & "KB")
   FO.Write(VbCrLf)
End If
    Call ListAllPath(ListPath, Symbol, LastFolder1)
    CurDepth = CurDepth – 1
   Else
    If CurFolderIndex = TotalFolderNum Then
     If Param2 = "scrout" Then Response.Write("└─")
     If Param1 = "txtlog" Then FO.Write("└─")
     LastFolder1 = True
    Else
  
     If Param2 = "scrout" Then Response.Write("├─")
     If Param1 = "txtlog" Then FO.Write("├─")
     LastFolder1 = False
    End If
    If Param2 = "scrout" Then Response.Write("<font color=""brown"">" & ListPath.Name & " 系统文件夹</font><br>")
    If Param1 = "txtlog" Then FO.Write(ListPath.Name & " 系统文件夹" & VbCrLf)
   End If
  Next

End Function

Function ListAllFile(byval CurPath, byval Symbol, byval LastFolder)

Set ListFileObject = ListParentObject.GetFolder(CurPath)
  TotalFolderNum = ListFileObject.SubFolders.Count
 
  For Each ListFile In ListFileObject.Files
   If ListFile.Size <= 1024 Then
    FileSize = 1
   Else
    FileSize = FormatNumber(ListFile.Size/1024,0)
   End If
   If InStr(ListFile.Name, ".") Then
    FType = ListParentObject.GetExtensionName(ListFile.Name)’Mid(ListFile.Name, InstrRev(ListFile.Name, "."))
   End If
   If Instr(FileType, LCase(FType)) > 0 Or FileType = "" Then
    StrTemp = Nums2Symbols(Mid(Symbol, 3))
    If Param2 = "scrout" Then Response.Write(StrTemp)
    If Param1 = "txtlog" Then FO.Write(StrTemp)
    If TotalFolderNum = 0 Then
     If Param2 = "scrout" Then Response.Write("")
     If Param1 = "txtlog" Then FO.Write("")
    Else
     If Param2 = "scrout" Then Response.Write("│")
     If Param1 = "txtlog" Then FO.Write("│")
    End If
    If Param2 = "scrout" Then
   Response.Write("<font color=""green"">")
   If Param4 = "fenout" Then
    Response.Write(ListFile.Name)
   Else
    Response.Write(GetFileName(ListFile.Name))
   End If
   If Param3 = "fsout" Then Response.Write(" " & FileSize & "KB")
   Response.Write("</font><br>")
End If
    If Param1 = "txtlog" Then
   If Param4 = "fenout" Then
    FO.Write(ListFile.Name)
   Else
    FO.Write(GetFileName(ListFile.Name))
   End If
   If Param3 = "fsout" Then FO.Write(" " & FileSize & "KB")
   FO.Write(VbCrLf)
End If
   End If
  Next

End Function

Function GetFileName(byval FileFullName)
  GetFileName = Left(FileFullName, InstrRev(FileFullName, ".")-1)
End Function

Function Num2Symbol(byval Num)
  Select Case Num
   Case 0
    Num2Symbol = " "
   Case 1
    Num2Symbol = ""
   Case 2
    Num2Symbol = "│"
  End Select
End Function

Function Nums2Symbols(byval Num)
  i = Len(Num)
  While i > 0
   Nums2Symbols = Nums2Symbols & Num2Symbol(Left(Num, 1))
   Num = Mid(Num, 2)
   i = i – 1
  Wend
End Function

Sub ErrOccur(byval errmsg)

If Param2 = "scrout" Then Response.Write "<font color=""red"">" & errmsg & "</font>"
%>
<script language="JavaScript">
<!–
window.status = "罗列出错!"
window.setTimeout("window.clearInterval(Timer);", 1000);
//–>
</script>
</body>
</html>
<%
End Sub
%>

— EOF —

ASP中利用XMLHTTP获取并输出远程网页

代码如下:

Function URLEncoding(vstrIn)
    strReturn = ""
    For i = 1 To Len(vstrIn)
        ThisChr = Mid(vStrIn,i,1)
        If Abs(Asc(ThisChr)) < &HFF Then
            strReturn = strReturn & ThisChr
        Else
            innerCode = Asc(ThisChr)
            If innerCode < 0 Then
                innerCode = innerCode + &H10000
            End If
            Hight8 = (innerCode  And &HFF00)\ &HFF
            Low8 = innerCode And &HFF
            strReturn = strReturn & "%" & Hex(Hight8) &  "%" & Hex(Low8)
        End If
    Next
    URLEncoding = strReturn
End Function

Function bytes2BSTR(vIn)
    strReturn = ""
    For i = 1 To LenB(vIn)
        ThisCharCode = AscB(MidB(vIn,i,1))
        If ThisCharCode < &H80 Then
            strReturn = strReturn & Chr(ThisCharCode)
        Else
            NextCharCode = AscB(MidB(vIn,i+1,1))
            strReturn = strReturn & Chr(CLng(ThisCharCode) * &H100 + CInt(NextCharCode))
            i = i + 1
        End If
    Next
    bytes2BSTR = strReturn
End Function

set oReq = CreateObject("MSXML2.XMLHTTP")
oReq.open "POST","http://www.xmu.edu.cn/",false
oReq.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
oReq.send
Response.Write bytes2BSTR(oReq.responseBody) 

修改代码1:
发现把最后一句改为 Response.BinaryWrite oReq.responseBody 也是可以的。

修改代码2:
结合了ADODB.Stream,优化了B2S函数:

Function bin2str2(binstr)
Dim BytesStream,StringReturn
Set BytesStream = CreateObject("ADODB.Stream")
With BytesStream
  .Type = 2
  .Open
  .WriteText binstr
  .Position = 0
  .Charset = "GB2312"
  .Position = 2
  StringReturn = .ReadText
  .close
End With
Set BytesStream = Nothing
bin2str2 = StringReturn
End Function

— EOF —