procedure TForm1.clipBtnClick(Sender: TObject); //复制到剪贴板
var
path,temp,downloadAddrTemp:string;
txtFile:Textfile;
begin
downloadAddrTemp:='';//初始化剪贴板缓存
clipboard.AsText:='';//清空剪贴板内容
path:=ExtractFilePath(Application.Exename)+'Download Path.txt';
AssignFile(txtFile,path);
Reset(txtFile); //打开读取txt
SetLength(temp,5); //初始化数组长度
while not eof(txtFile) do
begin
Readln(txtFile,temp);
downloadAddrTemp:=downloadAddrTemp+temp+#13#10;
end;
clipboard.AsText:=downloadAddrTemp; //下载地址复制到剪贴板
CloseFile(txtFile);
end;
//************************ 点击改名并分类按钮 *****************************************//
procedure TForm1.changNameBtnClick(Sender: TObject); //批量改名
var
path,downloadNametemp,artistNametemp,songNametemp,albumNametemp:string;
oldName,newName:string;
iniFile:TIniFile;
I,countI:Integer;
SearchRec:TSearchRec;
dirPath:string;
begin
if (downloaderSaveDir.Text = '') or (musicLibraryDir.Text = '') then
begin
ShowMessage('请确认下载保存目录和音乐库路径是否正确！');
Exit;
end;
path:=ExtractFilePath(Application.Exename)+'Download Info.ini';
iniFile:=Tinifile.Create(path);
countI:=iniFile.ReadInteger('已有','首歌',countI); //获取歌曲数目
for I := 0 to (countI-1) do
begin
downloadNametemp:=iniFile.ReadString('默认文件名',IntToStr(I),downloadNametemp);
if Pos(':',dlAlbumName) > 0 then
dlAlbumName:=StringReplace(dlAlbumName,':','-',[rfReplaceAll]);//防止命名有：
artistNametemp:=iniFile.ReadString('艺术家',IntToStr(I),artistNametemp);
songNametemp:=iniFile.ReadString('作曲名',IntToStr(I),songNametemp);
albumNametemp:=iniFile.ReadString('专辑名',IntToStr(I),albumNametemp);
if FindFirst(downloaderSaveDir.Text+'\'+downloadNametemp,faAnyFile,SearchRec) =0 then
begin //查找相同名字文件
repeat
newName:=downloaderSaveDir.Text+'\'+artistNametemp+' - '+songNametemp+RightStr(downloadNametemp,4);
RenameFile(downloaderSaveDir.Text+'\'+SearchRec.Name,newName); //文件改名
dirPath:=musicLibraryDir.Text+'\'+artistNametemp+'\'+albumNametemp;//在F盘下QQ音乐下载目录新建分类目录文件夹
//目录格式: 艺术家\专辑名\作曲名
ForceDirectories(dirPath);
//downloadAddr.Text:=dirPath; //调试用
MoveFile(PChar(newName),PChar(dirPath+RightStr(newName,Length(newName)-5))); //移动文件到新建目录
until(FindNext(SearchRec)<>0);
FindClose(SearchRec);
end;
end;
iniFile.Free;
end;
//************************ 点击清理记录按钮 *****************************************//
procedure TForm1.deleteBtnClick(Sender: TObject); //删除txt、ini文件
var
path:string;
txtFile:Textfile;
iniFile:TIniFile;
begin
path:=ExtractFilePath(Application.Exename)+'Download Path.txt';
DeleteFile(path);
path:=ExtractFilePath(Application.Exename)+'Download Info.ini';
DeleteFile(path);
end;
//******************* 凯撒移位函数，返回明码 *************************//
function TForm1.CaesarShifts(str: string; row: word): string; //凯撒移位,返回值为明码
var
arr1:array of char;
arr2:array of array of char;
len,n:Integer;
col,remainder,I,J:word;
begin
len:=Length(str); //字符串长度
SetLength(arr1,len); //初始化数组长度
for I := 0 to (len-1) do //字符串转数组
arr1[I]:=str[I+1];
DivMod(len,row,col,remainder);
if remainder <> 0 then //有余数，即没填满矩阵
begin
col:=col+1;
remainder:=word(col*row-len); //多出remainder个
end;
SetLength(arr2,row,col);
n:=0;
for I := 0 to (row-1) do
for J := 0 to (col-1) do
begin
if (I >= (row-remainder)) and (J >= (col-1)) then
begin
arr2[I,J]:=' ';
end
else
begin
arr2[I,J]:=arr1[n]; //矩阵赋值
inc(n);
end;
end;
n:=0;
for J := 0 to (col-1) do
for I := 0 to (row-1) do
begin
if n<len then
Result:=Result+arr2[I,J]; //数组转字符串
inc(n);
end;
Result:=URLDecode(Result);
Result:=StringReplace(Result,'^','0',[rfReplaceAll]); //替换^为0
end;
//******** 监视剪贴板，方便搜索地址栏完成自动粘贴，一条一条的复制粘贴很麻烦的 ************//
procedure TForm1.WMDrawClipBoard(var AMessage: TMessage); //监视剪贴板
begin
SendMessage(NextClipHwnd,AMessage.Msg,AMessage.WParam,AMessage.LParam);
//将WM_DRAWCLIPBOARD消息传递到下一个观察链中的窗口
if Clipboard.HasFormat(CF_TEXT) or Clipboard.HasFormat(CF_OEMTEXT) or Clipboard.HasFormat(CF_UNICODETEXT) then
begin
if Pos('www.xiami.com/song',Clipboard.AsText) > 0 then //过滤不是虾米音乐的内容
begin
if Clipboard.AsText = clipTemp then
ShowMessage('链接已复制粘贴！');
downloadAddr.Text:=Clipboard.AsText;
clipTemp:=Clipboard.AsText;
end;
end;
end;
//********************************************************************************//
//********************************************************************************//
运行效果：
由于迅雷有监视剪贴板的功能，所以很方便，点了下“粘到剪贴板”，新建任务窗口就呼出来了
//**********************************************************// 下面是解析专辑的代码：
//**********************************************************//
procedure TForm1.ResolveAlbum(albumUrl: string); //功能：解析专辑，保存信息
var
temp,songID:string;
i:Integer;
begin
temp:=GetWebPage(albumUrl); //获取URL源代码
while temp <> '' do
begin
i:=Pos('song_name',temp); //查找关键字 song_name
if i > 0 then
begin
Delete(temp,1,i); //删除前面比较过的字符串
songID:=Copy(temp,20,Pos('" title',temp)-20); //获取专辑中歌曲ID
ResolveSong('http://www.xiami.com'+songID); //获取专辑中该歌曲，并保存
end
else
break;
end;
end;
感觉UI做得越来越好了。
下面是解析专辑的代码：