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做得越來越好了。
下面是解析專輯的代碼：