维护过音乐站点的朋友都只道，要实现确保音乐站点在线播放MP3音乐必须为每首Mp3建一个.m3u音乐列表文件，当网友点击音乐时先下载m3u音乐列表文件，然后播放器根据m3u文件指向的Mp3文件地址就可以实现在线播放。如果音乐站点要实现查询、统计功能就必须用到数据库，把每首歌的信息记录入数据库。
如果，一个站点有5000首Mp3音乐（一般远大于这个数目），维护文件夹、创建列表文件、添加到数据库这一过程的劳动量可想而知。而且人工管理可能搞得非常混乱，没有规律。那么我们能否通过程序实现自动化呢？下面就是一个可以在1分钟只把5000首音乐添加到站点上的程序，有了它您会发现维护一个音乐站点真是太轻松了，无论你有多少音乐都会在极短的时间之内全部输入到数据库进行网上在线播放。本程序用Delphi5.0＋Win2000Server 编程调试通过。
主要功能：您指定一个音乐（本例以Mp3文件为例，读者可以根据具体情况修改）文件夹，其下一层文件夹为歌手的名字。再指定把本地绝对路径的一部分替换为URL部分，以及您的数据库（本例以Access数据库为例）文件地址。（建图<2.>图<4.>）。本程序会把您指定文件夹下的字文件夹取汉语拼音首字母为文件夹名建一个对应的文件夹(以方有的浏览器设置不支持中文URL，所以在网上用拼音更好)，并把该文件夹下的Mp3文件建一个对应的m3u文件放在该对应文件夹下。下面让我们逐步创建此程序。
首先，建一个主窗口SearchDir，来选择音乐所在文件夹，在主窗口加入如下控件：
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Buttons, StdCtrls, Menus, Db, ADODB;
type
TForm1 = class(TForm)
openpath: TEdit;
okb: TButton;
Label1: TLabel;
searchspb: TSpeedButton;
Op1: TOpenDialog;
sd: TSaveDialog;
MainMenu1: TMainMenu;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
N5: TMenuItem;
N6: TMenuItem;
N7: TMenuItem;
N8: TMenuItem;
ADOConnection1: TADOConnection;
ADOQuery1: TADOQuery;
procedure searchspbClick(Sender: TObject);
procedure okbClick(Sender: TObject);
procedure N5Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
SearchDir: TForm1;
dir:string;
implementation
uses replace;
{$R *.DFM}
procedure readfiles(var str:string;filename:string);//读取文件文本内容。本程序中用来读取歌手性别。
var tem:string;
f:text;
begin
try
assignfile(f,filename);
reset(f);
while not eof(f) do
begin
readln(f,tem);
str:=str+tem;
end;
except
showmessage('读文件:'+filename+' 时出错，请检查是否存在此文件！');
end;
end;
procedure strreplace(var str:string;substr,str2:string);//进行字符串替换函数。
var ind,i:integer;
begin
//查找匹配时不区分大小写，全部转变为小写字母在进行匹配。
substr:=lowercase(substr);
str:=lowercase(str);
str2:=lowercase(str2);
ind:=pos(substr,str);
if ind<>0 then
begin
i:=length(substr);
delete(str,ind,i);
insert(str2,str,ind);
end;
end;
function GetPYCode(HanStr: String) : String;//提取汉字的汉语拼音首字母函数。
const
PRCCodePage=936;
VowelPos: array['`'..'{'] of Integer = ($0000,$B0A1,$b0c5,$b2c1,$b4ee,
$b6ea,$b7a2,$b8c1,$b9fe,$0000,$bbf7,$bfa8,
$c0ac,$c2e8,$c4c3,$c5b6,$c5be,$c6da,$c8bb,
$c8f6,$cbfa,$0000,$0000,$cdda,$cef4,$d1b9,
$d4d1,$FFFF);
var
sVol : string;
Vowels : String;
i:Char;
HanziCode:Word;
lps,p1,p2:Pointer;
begin
sVol := HanStr;
GetMem(lps,Length(sVol)+1);
StrPCopy(lps,sVol);
p1:=lps;
p2:=CharNextEx(PRCCodePage,p1,0);
Repeat
if Abs(Longint(p2)-Longint(p1))=2 then
begin
HanziCode:=Word(p1^);
HanziCode:=swap(HanziCode);
for i:='`' to '{' do
begin
if VowelPos[i]>HanziCode then
begin
if i='a' then
Vowels:=Vowels+i
else if i='j' then //因为汉语内没有以“I”开头的拼音，遇到这种情况就是遇到了“H”
Vowels:=Vowels+'h'
else if i='w' then // 没有以“U、V”开头的拼音，遇到这种情况就是遇到了“T”
Vowels:=Vowels+'t'
else
Vowels:=Vowels+Chr(Ord(i)-1);
break;
end;
end;
end
else begin
Vowels:=Vowels+PChar(p1)^; //非汉字不转换
end;
p1:=p2;
p2:=CharNextEx(PRCCodePage,p1,0);
Until p1=p2;
Result:=Vowels;
//Result:=UpperCase(Vowels);
FreeMem(lps);
end;
procedure searchmp3(const dirs:string);//搜索指定文件夹下的Mp3文件。
var m3uurl,sqlstr,singer,sex,dbpath,dir1,dir2,url,filenames,fnames,fnames2:string;
bool,po:integer;
f:tsearchrec;
m3u:text;
boo:boolean;
begin
dir1:=dirs+'\*.mp3';
dir2:=dirs;
bool:=findfirst(dir1,faanyfile,f);
while (bool=0) do
begin
fnames:=f.name ;
sex:='';
url:=dirs+'\'+fnames;
//路径替换，
strreplace(fnames,'.mp3','.m3u');
fnames2:=fnames;
{if not(fileexists(filenames)) then
begin
showmessage('对不起，没有创建m3u文件夹！');
exit;
end; }
readfiles(sex,dirs+'\sex.txt');//读歌手的性别
{本例中，歌手的性别保存在音乐所在文件夹下的sex.txt文件中}
filenames:=dirs+'\'+fnames;
strreplace(filenames,dir,'');//删除绝对路径中在主窗口选择文件夹时所填入的文件夹。
filenames:=dir+getpycode(filenames);//把路径中汉字转变为其首字母。
if replaceform.org<>'' then//如果需要进行路径替换则替换
strreplace(url,replaceform.org,replaceform.news);
m3uurl:=filenames;
strreplace(m3uurl,replaceform.org,'');
assignfile(m3u,filenames);
rewrite(m3u);
writeln(m3u,url); //向音乐列表(m3u)文件中写入Mp3文件的路径（如果进行了路径替换，写进去的为Mp3文件的URL）
closefile(m3u);
//以下进行数据库连接！！
if replaceform.links<>'' then//判断是否指定了数据库文件。
begin
if SearchDir.Adoconnection1.connected=false then//判断是否已经与数据库连接了。
Begin //如果没有则连接数据库
dbpath:='Provider=Microsoft.Jet.OLEDB.4.0;Data Source='+ replaceform.links;
dbpath:=dbpath+';Persist Security Info=False';
SearchDir .Adoconnection1.connectionstring:=dbpath;
SearchDir.Adoconnection1.connected:=true;
end;
SearchDir.ADOQuery1.Close;
SearchDir.ADOQuery1.SQL.clear;
strreplace(fnames,'.m3u','');//除去文件后缀名作为歌名。
GetPYCode(m3uurl);
//以下截取第一层子文件夹名作为歌手名字。
strreplace(dir2,dir+'\','');
po:=pos('\',dir2);
delete(dir2,po,length(dir2)-po+1);
singer:=dir2;
if length(singer)=0 then singer:=' ';
sqlstr:='select * from songs where url='''+m3uurl+'''';//检索数据库看这首歌是否已经保存到数据库中（由于有可能出现同名音乐，所以这儿以音乐地址是否相同作为判断依据）
SearchDir.ADOquery1.SQL.Add(sqlstr);
SearchDir.ADOQuery1.open;
boo:=not(SearchDir.ADOQuery1.Eof);
if boo then
begin
if not(replaceform.overwrite.checked=true) then //判断是否选中覆盖重复音乐
begin
if replaceform.ignore.checked<>true then //判断是否选中忽略重复音乐
//如果即没有选中覆盖也没有选中忽略，则显示警告对话框，并退出。
showmessage('数据库中已经有:'+fnames+' 本程序将放弃向数据库输入！');
exit;
end;
end;
SearchDir.ADOQuery1.Close;
SearchDir.ADOQuery1.SQL.clear;
if (replaceform.overwrite.checked=true)and boo then //如果数据库中有重复，并且选中覆盖，则对重复音乐进行覆盖。
sqlstr:='update songs set sex='''+sex+''',songs='''+fnames+''',url='''+m3uurl+''',singer='''+singer+''' where url='''+m3uurl+''''
else //否则忽略重复，直接作为新的音乐插入数据库中。
sqlstr:='insert into songs(songs,sex,url,singer)values('''+fnames+''','''+sex+''','''+m3uurl+''',+'''+singer+''')';
SearchDir.ADOquery1.SQL.Add(sqlstr);
SearchDir.ADOQuery1.ExecSQL;
end;
bool:=findnext(f);
end;
findclose(f)
end;
procedure searchdir(const dirs:string); //搜索指定文件夹下的子文件夹。
var dir1,dir2,dir3,dirname,filename:string;
bool:integer;
f:tsearchrec;
dirlist:tstringlist;
//bool:boolean;
begin
dirlist:=tstringlist.Create;
dir2:=dirs;
dir1:=dirs+'\*';
searchmp3(dir2); //查找当前文件夹下的Mp3 文件。
bool:=findfirst(dir1,16,f);
while (bool=0) or (dirlist.Count>0)do
begin
if bool<>0 then
begin
dir1:=dirlist.Strings[dirlist.count-1];
searchdir(dir+dir1); //利用递归遍历指定文件夹下的所有子文件夹。
dirlist.Delete(dirlist.count-1);
end
else
begin
if (f.name<>'.')and(f.name<>'..')and((f.Attr and faDirectory)=f.Attr) then //判断找到的文件是否是文件夹。
//如果是文件夹则：
begin
dir3:=dir2+'\'+f.name;
strreplace(dir3,dir,'' );
dirlist.Add(dir3);
filename:=f.name;
//下面把以汉字命名的文件夹取汉字首字母组成字符串，并以此字符串为名建一个文件夹
dirname:=dir2+'\'+getpycode(filename);
strreplace(dirname,dir,'');
if not fileexists(dir+getpycode(dirname)) then
CreateDirectory(pchar(dir+getpycode(dirname)),nil);//创建文件夹
end;
bool:=findnext(f);
end;
end;
findclose(f)
end;
procedure TForm1.searchspbClick(Sender: TObject); //选择文件夹
begin
if op1.Execute then
begin
openpath.Text:=op1.FileName;
end;
end;
procedure TForm1.okbClick(Sender: TObject); //点击确定按钮时触发
//var filelist:tstringlist;
begin
dir:=openpath.Text;
if dir<>'' then //判断是否指定文件夹。
begin
try
searchdir(dir);
except
showmessage('出现错误！请检查输入的文件夹及文件名是否正确！');
end
end
else
showmessage('请选择文件夹及文件');
end;
procedure TForm1.N5Click(Sender: TObject);
begin
replaceform.ShowModal; //打开选项窗口
end;
end.
下面我们来创建选项窗口：
首先加入一个新的Form，命名为：replaceform，在replaceform中加入下列一些控件：
unit replace;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Buttons;
type
TForm2 = class(TForm)
opath: TEdit;
replacepath: TEdit;
removp: TButton;
GroupBox1: TGroupBox;
Label1: TLabel;
Label2: TLabel;
GroupBox2: TGroupBox;
dbpath: TEdit;
Label3: TLabel;
SpeedButton1: TSpeedButton;
Open1: TOpenDialog;
removlink: TButton;
closeb: TButton;
GroupBox3: TGroupBox;
overwrite: TRadioButton;
ignore: TRadioButton;
RadioButton1: TRadioButton;
procedure closebClick(Sender: TObject);
procedure removpClick(Sender: TObject);
procedure removlinkClick(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
private
{ Private declarations }
public
links,org,news:string;
{ Public declarations }
end;
var
Replaceform: TForm2;
implementation
{$R *.DFM}
uses m3u1;
procedure TForm2.closebClick(Sender: TObject);
begin
if opath.Text<>'' then //判断路径替换栏，原始路径输入框是否为空。如果不为空则进行替换。
begin
org:=opath.Text;
news:=replacepath.Text;
end;
if (dbpath.Text<>'') then //判断是否指定文件。
links:=dbpath.Text;
close;
end;
procedure TForm2.removpClick(Sender: TObject); // 取消路径替换
begin
org:='';
news:='';
close;
end;
procedure TForm2.removlinkClick(Sender: TObject); //取消数据库连接
begin
links:='';
close;
end;
procedure TForm2.SpeedButton1Click(Sender: TObject); //指定数据库文件
begin
if open1.Execute then
dbpath.Text:=open1.FileName;
end;
end.
到此为止本程序已经基本完成。下面让我们以一个具体的例子来看一看此程序的功能：
假设本例中音乐放在E:\oldmusic\ 文件夹下面，数据库文件为 E:\oldmusic\songs.mdb。存储音乐信息的表名为：songs；表中字段分别为：ID，songs，url，singer，sex等。且本文件夹下有文件：E:\oldmusic\齐秦\爱情宣言\ 和文件夹 ：E:\oldmusic\齐秦\命运的深渊\ 两个文件夹，在文件夹E:\oldmusic\爱情宣言\ 下面有 爱情宣言.mp3 和 别对我寄望太多.mp3 两首歌，在E:\oldmusic\命运的深渊\ 文件夹下面有 命运的深渊.MP3 一首；路径替换，数据库文件设置如上图 “选项“窗口所设置。则本程序运行后结果为：在E:\oldmusic\ 文件夹下建文件夹 ：E:\oldmusic\qi\ 在E:\oldmusic\qi\ 下建：E:\oldmusic\qi\aqxy\ , E:\oldmusic\mydsy\ 两个文件夹。在E:\oldmusic\qi\aqxy\ 生成aqxy.m3u bdwjwtd.m3u 文件，在E:\oldmusic\mydsy\ 下建 mydsy.m3u 文件。aqxy.m3u 文件内容为：http://herald.seu.edu.cn/html/mp3/oldmusic/齐秦/爱情宣言/爱情宣言.mp3 其他文件类似。爱情宣言.mp3插入到数据库中，Id 字段为自增字段，songs字段为：爱情宣言 url字段为：qi\aqxy\aqxy.m3u ，singer字段为：齐秦 ，sex字段内容为：E:\oldmusic\爱情宣言\ 文件夹下 sex.txt（此文件必须有）文件内的内容。
本文章为转载内容，我们尊重原作者对文章享有的著作权。如有内容错误或侵权问题，欢迎原作者联系我们进行内容更正或删除文章。
