晕这也能交高手
那我也是了
我的程序是从www.sogua.com搜索歌曲
把搜索到的数据保存到本地数据库中，我现在有10万多首歌曲的连接，5万多首LRC歌词
这其实不难
贴上部分代码
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, winsock,
StdCtrls, ScktComp, ExtCtrls, OleCtrls, SHDocVw, Grids, DB, ADODB,
ComCtrls, ProgressBead;
const
//自定义windows消息
WM_CLIENT_READ = WM_USER + 103;
WM_CLIENT_READCLOSE = WM_USER + 105;
port = 80;
CRLF = #$0D#$0A;
type
TForm1 = class(TForm)
Panel1: TPanel;
Button2: TButton;
Splitter1: TSplitter;
GroupBox3: TGroupBox;
dl: TCheckBox;
ip: TEdit;
port: TEdit;
Label1: TLabel;
Label2: TLabel;
Button3: TButton;
Button4: TButton;
Button5: TButton;
Button6: TButton;
Button1: TButton;
Button7: TButton;
Button8: TButton;
Ekey: TEdit;
Label4: TLabel;
Cmp3: TCheckBox;
Crm: TCheckBox;
Cwma: TCheckBox;
Casf: TCheckBox;
Button9: TButton;
Label3: TLabel;
Label5: TLabel;
SaveDialog1: TSaveDialog;
Button10: TButton;
Button11: TButton;
ADOConnection1: TADOConnection;
usQuery: TADOQuery;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
pgc1: TPageControl;
ts1: TTabSheet;
StringGrid1: TStringGrid;
ts2: TTabSheet;
ts3: TTabSheet;
spl1: TSplitter;
mmo1: TMemo;
mmo2: TMemo;
ts4: TTabSheet;
soulist: TMemo;
pnl1: TPanel;
procedure FormClose(Sender: TObject;
var Action: TCloseAction);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button7Click(Sender: TObject);
procedure Button8Click(Sender: TObject);
procedure Button9Click(Sender: TObject);
procedure Button11Click(Sender: TObject);
procedure Button10Click(Sender: TObject);
procedure StringGrid1DblClick(Sender: TObject);
private
{ Private declarations }
s: TSocket;
addr: TSockAddr;
FSockAddrIn: TSockAddrIn;
FProgressBead: TProgressBead;
procedure ReadData(var Message: TMessage);
message WM_CLIENT_READ;
procedure ClientReadClose(var Message: TMessage);
message WM_CLIENT_READCLOSE;
functiondo
wnload(url: string): boolean;
functiondo
wnmb(): boolean;
function savetodatabase(): boolean;
function clearmeno(): boolean;
public
{ Public declarations }
end;
var
Form1: TForm1;
firstrciv: integer;
recivstr: string;
recivok: boolean;
starttime: Ttime;
songcount: integer;
staute: integer;
do
wnindex: integer;
do
wnstop: boolean;
do
wnsize: integer;
savefile: string;
oldstatue: integer;
implementation
{$R *.DFM}
procedure TForm1.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
CloseSocket(s);
do
wnstop := false;
end;
procedure TForm1.ReadData(var Message: TMessage);
procedure pIncBlueIndex(var nIndex: Integer;
mBeadValue: TBeadValue);
begin
if nIndex < 0 then
Exit;
if nIndex > 0 then
FProgressBead[nIndex - 1] := mBeadValue;
if nIndex > 1 then
FProgressBead[nIndex - 2] := mBeadValue;
//Inc(nIndex);
//while (nIndex < FProgressBead.BeadCount) and
// (FProgressBead[nIndex] <> bvGray)do
// Inc(nIndex, cOffset);
if nIndex < FProgressBead.BeadCount then
FProgressBead[nIndex] := bvRed
else
nIndex := -1;
end;
var
buffer: array[1..100000] of char;
buffer2: array[1..10000] of char;
len: integer;
flen: integer;
Event: word;
value: string;
i, j: integer;
tmpstr: string;
Target: TFileStream;
uf1: file;
filelength, FIndexBlue: integer;
begin
flen := sizeof(FSockAddrIn);
Event := WSAGetSelectEvent(Message.LParam);
if Event = FD_READ then
begin
starttime := time;
len := recvfrom(s, buffer, sizeof(buffer), 0, FSockAddrIn, flen);
if firstrciv = 0 then
//如果是第一个包,分析http head
begin
i := 0;
while i <= len - 4do
begin
if (buffer
= #13) and (buffer[i + 1] = #10) and (buffer[i + 2] = #13) and (buffer[i + 3] = #10) then
break;
inc(i);
end;
value := copy(buffer, 1, i);
mmo1.Lines.add(value);
//head
//检查是否正确应答
if copy(value, pos('HTTP/', value) + 9, 3) <> '200' then
begin
recivok := false;
mmo1.Lines.Add('连接错误.');
exit;
end;
//取长度
tmpstr := copy(value, pos('Content-Length: ', value) + 16, length(value) - 15);
tmpstr := copy(tmpstr, 1, pos(#13, tmpstr) - 1);
label5.Caption := tmpstr;
try
filelength := strtoint(trim(tmpstr));
filelength := round(filelength / 10240);
finally
end;
//显示下载进度 tmpstr
FProgressBead.begin
Update;
for I := 1 to filelengthdo
FProgressBead.Append(bvGray);
FIndexBlue := 0;
FProgressBead[FIndexBlue] := bvRed;
FProgressBead.EndUpdate;
//body
for j := i + 4 to lendo
buffer2[j - i - 3] := buffer[j];
if staute = 3 then
//文件下载
begin
if not FileExists(savefile) then
//文件不存在
begin
assignfile(uf1, savefile);
Rewrite(uf1, 1);
try
BlockWrite(uf1, buffer2, len - i - 3, j);
finally
closefile(uf1);
end;
end
else
begin
Target := TFileStream.Create(savefile, fmOpenWrite or fmShareExclusive);
try
Target.Seek(0, soFromEnd);
//往尾部添加资源
Target.WriteBuffer(buffer2, len - i - 3);
finally
Target.Free;
end;
end;
end
else
begin
value := copy(buffer, i + 4, len - i - 3);
recivstr := recivstr + value;
end;
do
wnsize :=do
wnsize + len - i - 3;
end
else
begin
if staute = 3 then
//文件下载
begin
Target := TFileStream.Create(savefile, fmOpenWrite or fmShareExclusive);
try
Target.Seek(0, soFromEnd);
//往尾部添加资源
Target.WriteBuffer(buffer, len);
finally
Target.Free;
end;
end
else
begin
value := copy(buffer, 1, len);
recivstr := recivstr + value;
end;
do
wnsize :=do
wnsize + len;
end;
label3.Caption := inttostr(downsize);
FIndexBlue := round(downsize / 10240);
pIncBlueIndex(FIndexBlue, bvBlue);
inc(firstrciv);
end;
end;
procedure TForm1.ClientReadClose(var Message: TMessage);
begin
case Message.LParam of
FD_READ: ReadData(Message);
FD_CLOSE:
begin
mmo1.Lines.add('已关闭连接.');
FProgressBead.begin
Update;
FProgressBead.Clear;
FProgressBead.EndUpdate;
//Memo2.Lines.Text := recivstr;
mmo2.Lines.Clear;
mmo2.Lines.Add(recivstr);
recivok := false;
//分析数据
if staute = 1 then
//列表下载
button3.Click
else
if staute = 2 then
//目标地址下载
Button5.Click;
end;
end;
end;
function GetHostAddress(const hostname: string): u_long;
var
pHostAddr: PHostEnt;
type
T = ^u_long;
begin
pHostAddr := gethostbyname(PCHAR(hostname));
if (pHostAddr = nil) then
begin
result := 0;
end
else
begin
result := T(pHostAddr^.h_addr^)^;
end;
end;
function TForm1.download(url: string): boolean;
var
TempWSAData: TWSAData;
ulHostAddress: u_long;
in_: TInAddr;
ToSend: string;
Hour, Min, Sec, MSec: Word;
len: integer;
SR: TSearchRec;
begin
mmo1.Lines.Clear;
starttime := time;
Result := false;
firstrciv := 0;
songcount := 0;
recivstr := '';
recivok := true;
do
wnsize := 0;
label3.Caption := inttostr(downsize);
label5.Caption := '0';
// 初始化SOCKET dll
if WSAStartup($101, TempWSAData) = 1 then
begin
mmo1.Lines.Add('Socket版本错误.');
recivok := false;
exit;
end;
s := Socket(AF_INET, SOCK_STREAM, 0);
//tcp通讯
//Socket创建失败
if (s = INVALID_SOCKET) then
begin
mmo1.Lines.Add('Socket创建失败[' + inttostr(WSAGetLastError()) + ']');
CloseSocket(s);
recivok := false;
exit;
end;
if dl.Checked then
begin
mmo1.Lines.Add('正在连接代理服务器 ' + ip.text + ':' + port.text);
ulHostAddress := inet_addr(pchar(ip.text));
ifdo
wnstop = false then
begin
recivok := false;
mmo1.Lines.Add('用户取消.');
exit;
end;
end
else
begin
mmo1.Lines.Add('正在连接 ' + url + ':80');
ifdo
wnstop = false then
begin
recivok := false;
mmo1.Lines.Add('用户取消.');
exit;
end;
//判断ip地址的格式
if pos('/', url) <> 0 then
ulHostAddress := GetHostAddress(copy(url, 1, pos('/', url) - 1))
else
ulHostAddress := GetHostAddress(url);
in_.S_addr := ulHostAddress;
//edit2.Text := inet_ntoa(in_);
mmo1.Lines.Add('正在连接 ' + url + ' [IP=' + inet_ntoa(in_) + ':80' + ']');
ifdo
wnstop = false then
begin
recivok := false;
mmo1.Lines.Add('用户取消.');
exit;
end;
end;
//发送方SockAddr绑定
addr.sin_family := AF_INET;
addr.sin_addr.S_addr := ulHostAddress;
addr.sin_port := htons(80);
if connect(s, addr, sizeof(addr)) <> 0 then
begin
mmo1.Lines.Add('连接失败.');
recivok := false;
exit;
end;
ifdo
wnstop = false then
begin
recivok := false;
mmo1.Lines.Add('用户取消.');
exit;
end;
mmo1.Lines.Add('已连接.');
WSAAsyncSelect(s, Form1.Handle, WM_CLIENT_READCLOSE, FD_CLOSE xor FD_READ);
if dl.Checked then
ToSend := 'get http://' + url + ' HTTP/1.1' + CRLF
else
ToSend := 'GET /' + copy(url, pos('/', url) + 1, length(url) - pos('/', url)) + ' HTTP/1.1' + CRLF;
ToSend := ToSend + 'Accept: */*' + CRLF;
ToSend := ToSend + 'Accept-Language: en' + CRLF;
ToSend := ToSend + 'Accept-Encoding: gzip' + CRLF;
ToSend := ToSend + 'User-Agent: Mozilla/4.7 [fr] (AmstradOS;
I)' + CRLF;
//如果是下载文件,判断文件是否存在,存在则续传Range: bytes=7206-
//savefile
if FileExists(savefile) then
begin
FindFirst(savefile, faAnyFile, SR);
ToSend := ToSend + 'Range: bytes=' + inttostr(SR.Size) + '-' + CRLF;
end;
if pos('/', url) <> 0 then
ToSend := ToSend + 'Host: ' + copy(url, 1, pos('/', url) - 1) + CRLF
else
ToSend := ToSend + 'Host: ' + url + CRLF;
if dl.Checked then
ToSend := ToSend + 'Proxy-Connection: Close' + CRLF
else
ToSend := ToSend + 'Connection: Close' + CRLF;
mmo1.Lines.Add(ToSend);
ifdo
wnstop = false then
begin
recivok := false;
mmo1.Lines.Add('用户取消.');
exit;
end;
ToSend := ToSend + CRLF + CRLF;
len := sendto(s, ToSend[1], Length(ToSend), 0, FSockAddrIn, sizeof(FSockAddrIn));
if (WSAGetLastError() <> WSAEWOULDBLOCK) and (WSAGetLastError() <> 0) then
begin
mmo1.Lines.Add('Socket错误[' + inttostr(WSAGetLastError()) + ']');
recivok := false;
exit;
end;
if (len = SOCKET_ERROR) or (len <> Length(ToSend)) then
begin
mmo1.Lines.Add('发送请求失败');
recivok := false;
exit;
end;
//循环等待收到数据或者超时
ifdo
wnstop = false then
begin
recivok := false;
mmo1.Lines.Add('用户取消.');
exit;
end;
while recivokdo
begin
Application.ProcessMessages;
DecodeTime((time - starttime), Hour, Min, Sec, MSec);
Application.ProcessMessages;
if (Sec + Min * 60 + Hour * 60 * 60) > 60 then
begin
recivok := false;
mmo1.Lines.Add('连接超时.');
end;
ifdo
wnstop = false then
begin
recivok := false;
mmo1.Lines.Add('用户取消.');
end;
Application.ProcessMessages;
end;
CloseSocket(s);
Result := not recivok;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
i: integer;
url: string;
tmpint: integer;
begin
if Ekey.Text = '' then
begin
mmo1.Lines.Add('请输入搜索歌曲或歌手名');
end;
mmo1.Lines.Clear;
mmo2.Lines.Clear;
staute := 1;
do
wnstop := true;
url := 'search.sogua.com/search/search.asp?key=' + Ekey.Text;
if cmp3.Checked then
url := url + '&fmp3=1';
if crm.Checked then
url := url + '&frm=1';
if cwma.Checked then
url := url + '&fwma=1';
if casf.Checked then
url := url + '&fasf=1';
do
wnload(url);
if songcount > 30 then
begin
tmpint := songcount div 30;
if (songcount mod 30) > 0 then
tmpint := tmpint + 1;
for i := 2 to tmpintdo
//有余数要加1
begin
do
wnload(url + '&page=' + inttostr(i));
ifdo
wnstop = false then
break;
end;
end;
Button4.Click;
end;
procedure TForm1.Button3Click(Sender: TObject);
var
p: integer;
tmpstr: string;
tmpstr2, tmpstr3: string;
tmpcount: string;
begin
tmpstr := mmo2.Lines.Text;
//得到总共条数
tmpstr := copy(tmpstr, pos('共找到', tmpstr) + 6, length(tmpstr) - pos('共找到', tmpstr) - 6);
tmpstr := copy(tmpstr, pos('<font color=#FF7100>', tmpstr) + 20, length(tmpstr) - pos('<font color=#FF7100>', tmpstr) - 20);
tmpcount := copy(tmpstr, 1, pos('</font>', tmpstr) - 1);
songcount := 0;
try
songcount := strtoint(Trim(tmpcount));
except
end;
tmpstr := mmo2.Lines.Text;
p := pos('检测时间', tmpstr);
tmpstr := copy(tmpstr, p, length(tmpstr) - p);
//
p := pos('</tr>', tmpstr);
tmpstr := copy(tmpstr, p + 4, length(tmpstr) - p - 5);
p := pos('</tr>', tmpstr);
tmpstr := copy(tmpstr, p + 4, length(tmpstr) - p - 5);
while p > 0do
begin
StringGrid1.RowCount := StringGrid1.RowCount + 1;
tmpstr2 := copy(tmpstr, 1, pos('</tr>', tmpstr) - 1);
tmpstr2 := copy(tmpstr2, pos('<td width="30"', tmpstr2) + 14, length(tmpstr2) - pos('<td width="30"', tmpstr2) - 13);
//id
StringGrid1.Cells[0, StringGrid1.RowCount - 2] := copy(tmpstr2, pos('>', tmpstr2) + 1, pos('</td>', tmpstr2) - pos('>', tmpstr2) - 1);
tmpstr2 := copy(tmpstr2, pos('<td align=left width="355"', tmpstr2) + 26, length(tmpstr2) - pos('<td align=left width="355"', tmpstr2) - 25);
tmpstr3 := copy(tmpstr2, 1, pos('</td>', tmpstr2) - 1);
//歌名 源地址 StringGrid1.Cells[1, 0] := '歌曲名称';
tmpstr3 := copy(tmpstr3, pos('href="', tmpstr3) + 6, length(tmpstr3) - pos('href="', tmpstr3) - 6);
StringGrid1.Cells[8, StringGrid1.RowCount - 2] := copy(tmpstr3, 1, pos('"', tmpstr3) - 1);
tmpstr3 := copy(tmpstr3, pos('>', tmpstr3) + 1, length(tmpstr3) - pos('>', tmpstr3));
StringGrid1.Cells[1, StringGrid1.RowCount - 2] := copy(tmpstr3, 1, pos('<', tmpstr3) - 1);
tmpstr2 := copy(tmpstr2, pos('<td', tmpstr2) + 3, length(tmpstr2) - pos('<td', tmpstr2) - 2);
// 大小
tmpstr2 := copy(tmpstr2, pos('>', tmpstr2) + 1, length(tmpstr2) - pos('>', tmpstr2));
StringGrid1.Cells[2, StringGrid1.RowCount - 2] := copy(tmpstr2, 1, pos('</td>', tmpstr2) - 1);
//tmpstr2 := copy(tmpstr2, pos('43">', tmpstr2) + 4, length(tmpstr2) - pos('43">', tmpstr2) - 4);
tmpstr2 := copy(tmpstr2, pos('<td', tmpstr2) + 3, length(tmpstr2) - pos('<td', tmpstr2));
//格式
tmpstr2 := copy(tmpstr2, pos('>', tmpstr2) + 1, length(tmpstr2) - pos('>', tmpstr2));
StringGrid1.Cells[3, StringGrid1.RowCount - 2] := copy(tmpstr2, 1, pos('</td>', tmpstr2) - 1);
//tmpstr2 := copy(tmpstr2, pos('36">', tmpstr2) + 4, length(tmpstr2) - pos('36">', tmpstr2) - 4);
tmpstr2 := copy(tmpstr2, pos('<td', tmpstr2) + 3, length(tmpstr2) - pos('<td', tmpstr2));
//协议
tmpstr2 := copy(tmpstr2, pos('>', tmpstr2) + 1, length(tmpstr2) - pos('>', tmpstr2));
StringGrid1.Cells[4, StringGrid1.RowCount - 2] := copy(tmpstr2, 1, pos('</td>', tmpstr2) - 1);
//tmpstr2 := copy(tmpstr2, pos('45">', tmpstr2) + 4, length(tmpstr2) - pos('45">', tmpstr2) - 4);
tmpstr2 := copy(tmpstr2, pos('<td', tmpstr2) + 3, length(tmpstr2) - pos('<td', tmpstr2));
//响应
tmpstr2 := copy(tmpstr2, pos('>', tmpstr2) + 1, length(tmpstr2) - pos('>', tmpstr2));
StringGrid1.Cells[5, StringGrid1.RowCount - 2] := copy(tmpstr2, 1, pos('</td>', tmpstr2) - 1);
//tmpstr2 := copy(tmpstr2, pos('49">', tmpstr2) + 4, length(tmpstr2) - pos('49">', tmpstr2) - 4);
tmpstr2 := copy(tmpstr2, pos('<td', tmpstr2) + 3, length(tmpstr2) - pos('<td', tmpstr2));
// 连通率
tmpstr2 := copy(tmpstr2, pos('>', tmpstr2) + 1, length(tmpstr2) - pos('>', tmpstr2));
StringGrid1.Cells[6, StringGrid1.RowCount - 2] := copy(tmpstr2, 1, pos('</td>', tmpstr2) - 1);
//tmpstr2 := copy(tmpstr2, pos('90">', tmpstr2) + 4, length(tmpstr2) - pos('90">', tmpstr2) - 4);
tmpstr2 := copy(tmpstr2, pos('<td width="92"', tmpstr2) + 14, length(tmpstr2) - pos('<td width="92"', tmpstr2));
//最后检测时间
tmpstr2 := copy(tmpstr2, pos('>', tmpstr2) + 1, length(tmpstr2) - pos('>', tmpstr2) - 1);
StringGrid1.Cells[7, StringGrid1.RowCount - 2] := copy(tmpstr2, 1, pos('<', tmpstr2) - 1);
p := pos('<tr bgcolor=#EEEEEE', tmpstr);
tmpstr := copy(tmpstr, p + 14, length(tmpstr) - p - 14);
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
StringGrid1.Cells[0, 0] := 'ID';
StringGrid1.Cells[1, 0] := '歌曲名称';
StringGrid1.Cells[2, 0] := '大小';
StringGrid1.Cells[3, 0] := '格式';
StringGrid1.Cells[4, 0] := '协议';
StringGrid1.Cells[5, 0] := '响应';
StringGrid1.Cells[6, 0] := '连通率';
StringGrid1.Cells[7, 0] := '最后检测时间';
StringGrid1.Cells[8, 0] := '源地址';
StringGrid1.Cells[9, 0] := '目标地址';
FProgressBead := TProgressBead.Create(Self);
FProgressBead.Align := alClient;
FProgressBead.Parent := pnl1;
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
staute := 2;
do
wnstop := true;
fordo
wnindex := 1 to StringGrid1.RowCount - 2do
begin
if StringGrid1.Cells[9,do
wnindex] = '' then
do
wnload('search.sogua.com/search/' + StringGrid1.Cells[8,do
wnindex]);
//暂停0.1秒 防止1秒内访问10次以上
Application.ProcessMessages;
sleep(100);
Application.ProcessMessages;
ifdo
wnstop = false then
break;
end;
end;
function TForm1.downmb(): boolean;
begin
staute := 2;
do
wnstop := true;
fordo
wnindex := 1 to StringGrid1.RowCount - 2do
begin
if StringGrid1.Cells[9,do
wnindex] = '' then
do
wnload('search.sogua.com/search/' + StringGrid1.Cells[8,do
wnindex]);
//暂停0.1秒 防止1秒内访问10次以上
Application.ProcessMessages;
sleep(100);
Application.ProcessMessages;
ifdo
wnstop = false then
break;
end;
result := true;
end;
procedure TForm1.Button5Click(Sender: TObject);
var
tmpstr: string;
begin
tmpstr := mmo2.Lines.Text;
tmpstr := copy(tmpstr, pos('信息：', tmpstr) + 6, length(tmpstr) - pos('信息：', tmpstr) - 6);
tmpstr := copy(tmpstr, pos('href="', tmpstr) + 6, length(tmpstr) - pos('href="', tmpstr) - 6);
StringGrid1.Cells[9,do
wnindex] := copy(tmpstr, 1, pos('"', tmpstr) - 1);
end;
procedure TForm1.Button6Click(Sender: TObject);
begin
do
wnstop := false;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
i: integer;
begin
mmo2.Lines.Clear;
mmo2.Lines.Add('#EXTM3U');
for i := 1 to StringGrid1.RowCount - 2do
begin
if StringGrid1.Cells[9, i] <> '' then
begin
mmo2.Lines.Add('#EXTINF:-1,' + StringGrid1.Cells[1, i]);
mmo2.Lines.Add(StringGrid1.Cells[9, i]);
end;
end;
mmo2.Lines.SaveToFile('m3u/' + Ekey.text + '.m3u');
mmo2.Lines.Clear;
end;
procedure TForm1.Button7Click(Sender: TObject);
var
i: integer;
begin
mmo2.Lines.Clear;
mmo2.Lines.Add('<html><head><title>搜歌器</title></head><body><center><font color=red size=5>搜歌搜歌,搜尽天下歌曲</font></center><br><A href=http://www.efisc.net target=_top>鼎盛软件工作室 盛小青 羊年新奉献</A><br><br>' + Ekey.text + '<hr>');
for i := 1 to StringGrid1.RowCount - 2do
begin
if StringGrid1.Cells[9, i] <> '' then
begin
mmo2.Lines.Add('<a href=' + StringGrid1.Cells[9, i] + '>');
mmo2.Lines.Add(StringGrid1.Cells[1, i] + '</a><br>');
end;
end;
mmo2.Lines.Add('</body></html>');
mmo2.Lines.SaveToFile('web/' + Ekey.text + '.htm');
mmo2.Lines.Clear;
end;
procedure TForm1.Button8Click(Sender: TObject);
var
i, j: integer;
begin
mmo1.Lines.Clear;
mmo2.Lines.Clear;
for i := 1 to StringGrid1.RowCount - 2do
for j := 0 to StringGrid1.ColCount - 1do
StringGrid1.Cells[j, i] := '';
StringGrid1.RowCount := 2;
end;
function TForm1.clearmeno(): boolean;
var
i, j: integer;
begin
mmo1.Lines.Clear;
mmo2.Lines.Clear;
for i := 1 to StringGrid1.RowCount - 2do
for j := 0 to StringGrid1.ColCount - 1do
StringGrid1.Cells[j, i] := '';
StringGrid1.RowCount := 2;
result := true;
end;
procedure TForm1.Button9Click(Sender: TObject);
begin
SaveDialog1.FileName := StringGrid1.Cells[1, StringGrid1.Row];
if SaveDialog1.Execute then
begin
staute := 3;
do
wnstop := true;
savefile := SaveDialog1.FileName;
if StringGrid1.Cells[9, StringGrid1.Row] <> '' then
do
wnload(copy(StringGrid1.Cells[9, StringGrid1.Row], 8, length(StringGrid1.Cells[9, StringGrid1.Row]) - 7));
end;
savefile := '';
end;
procedure TForm1.Button11Click(Sender: TObject);
var
url: string;
tmpint, i, x: integer;
begin
do
wnstop := true;
for x := 0 to soulist.Lines.Count - 1do
begin
mmo1.Lines.Clear;
mmo2.Lines.Clear;
staute := 1;
do
wnstop := true;
url := 'search.sogua.com/search/search.asp?key=' + soulist.Lines.Strings[x];
label6.Caption := soulist.Lines.Strings[x];
if cmp3.Checked then
url := url + '&fmp3=1';
if crm.Checked then
url := url + '&frm=1';
if cwma.Checked then
url := url + '&fwma=1';
if casf.Checked then
url := url + '&fasf=1';
songcount := 0;
do
wnload(url);
ifdo
wnstop = false then
break;
if songcount > 30 then
begin
tmpint := songcount div 30;
if (songcount mod 30) > 0 then
tmpint := tmpint + 1;
for i := 2 to tmpintdo
//有余数要加1
begin
do
wnload(url + '&page=' + inttostr(i));
ifdo
wnstop = false then
break;
end;
end;
ifdo
wnstop = false then
break;
do
wnmb;
//下载目标
ifdo
wnstop = false then
break;
savetodatabase;
//保存到数据库
clearmeno;
//清空
soulist.Lines.Strings[x] := '';
end;
end;
function TForm1.savetodatabase(): boolean;
var
i, y: integer;
begin
y := 0;
for i := 1 to StringGrid1.RowCount - 2do
begin
if (StringGrid1.Cells[1, i] <> '') and
(pos('<', StringGrid1.Cells[1, i]) = 0) and (pos('>', StringGrid1.Cells[1, i]) = 0) and
(pos('<', StringGrid1.Cells[2, i]) = 0) and (pos('>', StringGrid1.Cells[2, i]) = 0) and
(pos('<', StringGrid1.Cells[3, i]) = 0) and (pos('>', StringGrid1.Cells[3, i]) = 0) and
(pos('<', StringGrid1.Cells[4, i]) = 0) and (pos('>', StringGrid1.Cells[4, i]) = 0) and
(pos('<', StringGrid1.Cells[5, i]) = 0) and (pos('>', StringGrid1.Cells[5, i]) = 0) and
(pos('<', StringGrid1.Cells[6, i]) = 0) and (pos('>', StringGrid1.Cells[6, i]) = 0) and
(pos('<', StringGrid1.Cells[7, i]) = 0) and (pos('>', StringGrid1.Cells[7, i]) = 0) and
(pos('<', StringGrid1.Cells[8, i]) = 0) and (pos('>', StringGrid1.Cells[8, i]) = 0) then
begin
if usQuery.Active then
usQuery.Close;
usQuery.SQL.Clear;
usQuery.sql.Add('insert into SongList (SongName,SongSize,SongType,SongProtole,SongTime,SongConnect,SongLast,SongSouce,SongAddress) values ("' +
StringReplace(StringReplace(StringGrid1.Cells[1, i], '"', '“', [rfReplaceAll]), chr(39), '‘', [rfReplaceAll]) + '","' +
StringReplace(StringReplace(StringGrid1.Cells[2, i], '"', '“', [rfReplaceAll]), chr(39), '‘', [rfReplaceAll]) + '","' +
StringReplace(StringReplace(StringGrid1.Cells[3, i], '"', '“', [rfReplaceAll]), chr(39), '‘', [rfReplaceAll]) + '","' +
StringReplace(StringReplace(StringGrid1.Cells[4, i], '"', '“', [rfReplaceAll]), chr(39), '‘', [rfReplaceAll]) + '","' +
StringReplace(StringReplace(StringGrid1.Cells[5, i], '"', '“', [rfReplaceAll]), chr(39), '‘', [rfReplaceAll]) + '","' +
StringReplace(StringReplace(StringGrid1.Cells[6, i], '"', '“', [rfReplaceAll]), chr(39), '‘', [rfReplaceAll]) + '","' +
StringReplace(StringReplace(StringGrid1.Cells[7, i], '"', '“', [rfReplaceAll]), chr(39), '‘', [rfReplaceAll]) + '","' +
StringReplace(StringReplace(StringGrid1.Cells[8, i], '"', '“', [rfReplaceAll]), chr(39), '‘', [rfReplaceAll]) + '","' +
StringReplace(StringReplace(StringGrid1.Cells[9, i], '"', '“', [rfReplaceAll]), chr(39), '‘', [rfReplaceAll]) + '")');
usQuery.ExecSQL;
y := y + 1;
end;
end;
label7.Caption := label6.Caption + '已保存' + inttostr
+ '条';
result := true;
end;
procedure TForm1.Button10Click(Sender: TObject);
var
i: integer;
begin
for i := 1 to StringGrid1.RowCount - 2do
begin
if usQuery.Active then
usQuery.Close;
usQuery.SQL.Clear;
usQuery.sql.Add('insert into SongList (SongName,SongSize,SongType,SongProtole,SongTime,SongConnect,SongLast,SongSouce,SongAddress) values ("' +
StringReplace(StringReplace(StringGrid1.Cells[1, i], '"', '', [rfReplaceAll]), chr(39), '', [rfReplaceAll]) + '","' + StringGrid1.Cells[2, i] + '","' + StringGrid1.Cells[3, i] + '","' + StringGrid1.Cells[4, i] + '","' + StringGrid1.Cells[5, i] + '","' + StringGrid1.Cells[6, i] + '","' + StringGrid1.Cells[7, i] + '","' + StringGrid1.Cells[8, i] + '","' + StringGrid1.Cells[9, i] + '")');
usQuery.ExecSQL;
end;
end;
