Delphi 从网上下载HTML、图片文件

最新推荐文章于 2023-12-03 12:41:32 发布

原创最新推荐文章于 2023-12-03 12:41:32 发布 · 2k 阅读

1 ·

CC 4.0 BY-SA版权

文章标签：

#delphi #html #download #database #integer #string

Delphi 专栏收录该内容

33 篇文章

订阅专栏

这个博客介绍了如何使用Delphi程序从网上下载HTML页面，获取基金价格信息，并将这些信息更新到数据库中。同时，程序还展示了如何下载基金的历史净值图和当日预测图，保存为本地GIF文件。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

procedure TFm_FundUpdPri.Btn_UpdClick(Sender: TObject); var FundUrl, myHtml, myFNO, myFNM, myStr1, myStr2, myStr3, myPRI, myPRD, sqlstr, FundPic: string; myPOS: integer; mystrm: TMemoryStream; myD1, myD2: boolean; begin inherited; if (not CBox_1.Checked) and (not CBox_2.Checked) and (not CBox_3.Checked) then exit; Tbutton(sender).Enabled := false; CBox_1.Enabled := false; CBox_2.Enabled := false; CBox_3.Enabled := false; RBtn_1.Enabled := false; RBtn_2.Enabled := false; try // memo1.Lines.Clear; myD1 := false; F_SEQ := 0; myLog('Download the Fund Price. '); if CBox_1.Checked then begin myD1 := true; FundUrl := 'http://finance.sina.com.cn/fund/fund_ranks/open/netvalue_ranks0_0.html'; try myHtml := IdHTTP1.Get(FundUrl); except myD1 := false; myLog('Error: Can Not Download Data'); // exit; end; end; myLog('Open the Fund DataBase'); if RBtn_1.Checked then sqlstr := ' AND (T11_QTY>0)' else sqlstr := ''; Dm.ADODS_b.Close; Dm.ADODS_b.CommandText := 'Select T11_FNO,T11_FNM,T11_QTY from T11_FUND where ' + PWR_SQL + sqlstr; Dm.ADODS_b.Open; Dm.ADODS_b.First; while not Dm.ADODS_b.Eof do begin myFNO := Dm.ADODS_b.fieldbyname('T11_FNO').AsString; myFNM := Dm.ADODS_b.fieldbyname('T11_FNM').AsString; myLog('*** ' + myFNO + ' ' + myFNM + ' ***'); if myD1 then begin myPOS := pos(myFNO, myHtml); if myPOS > 0 then begin myStr1 := ' '; myStr2 := ' '; myStr3 := ' '; myPRI := ' '; myPRD := ' '; try myStr1 := copy(myHtml, myPOS, 550); //1 myStr2 := myStr1; myPOS := pos('</td>', myStr2); mystr3 := copy(myStr2, myPOS + 6, 550); //2 myStr2 := myStr3; myPOS := pos('</td>', myStr2); mystr3 := copy(myStr2, myPOS + 6, 550); //3 myStr2 := myStr3; myPOS := pos('</td>', myStr2); mystr3 := copy(myStr2, myPOS + 6, 550); //4 myStr2 := myStr3; myPOS := pos('</td>', myStr2); if myPOS > 6 then myPRI := copy(myStr2, myPOS - 6, 6) else myPRI := '0'; //error mystr3 := copy(myStr2, myPOS + 6, 550); //5 myStr2 := myStr3; myPOS := pos('</td>', myStr2); mystr3 := copy(myStr2, myPOS + 6, 550); //6 myStr2 := myStr3; myPOS := pos('</td>', myStr2); mystr3 := copy(myStr2, myPOS + 6, 550); //7 myStr2 := myStr3; myPOS := pos('</td>', myStr2); mystr3 := copy(myStr2, myPOS + 6, 550); //8 myStr2 := myStr3; myPOS := pos('</td>', myStr2); mystr3 := copy(myStr2, myPOS + 6, 550); //9 myStr2 := myStr3; myPOS := pos('</td>', myStr2); mystr3 := copy(myStr2, myPOS + 6, 550); //10 myStr2 := myStr3; myPOS := pos('</td>', myStr2); if myPOS > 10 then myPRD := copy(myStr2, myPOS - 10, 10) else myPRD := '1900-02-01'; //error myLog(' Price: ' + myPRI + ' ' + myPRD); except myLog('Error detected, please check!' + #10#13 + myFNO + ' ' + myFNM + ' ' + myPRI + ' ' + myPRD); exit; end; if myPRI <> '0' then begin //Update Database sqlstr := 'Update T11_FUND set ' + ' T11_PRI=' + myPRI + ',T11_PRD=#' + myPRD + '#' + ' where ' + PWR_SQL + ' and (T11_FNO = ''' + myFNO + ''' )'; DM.pub_sqlren(sqlstr, 1); end; end else begin myLog('Not Existed!'); end; end; //Download Picture //历史净值图 if CBox_2.Checked then begin FundUrl := 'http://image.sinajs.cn/newchart/v5/fund/nav/b/' + myFNO + '.gif'; FundPic := App_Path + 'Image/Fund_' + myFNO + 'A.gif'; mystrm := TMemoryStream.Create; myD2 := true; try try IdHTTP1.Get(FundUrl, mystrm); except myLog('Error: Can Not Download Picture A'); myD2 := false; end; if myD2 then begin if FileExists(FundPic) then DeleteFile(FundPic); mystrm.SaveToFile(FundPic); myLog(' Picture A has been saved. '); end; finally mystrm.Free; end; end; //当日预测图 if CBox_3.Checked then begin FundUrl := 'http://image.sinajs.cn/newchart/v5/fundpre/min/' + myFNO + '.gif'; FundPic := App_Path + 'Image/Fund_' + myFNO + 'B.gif'; mystrm := TMemoryStream.Create; myD2 := true; try try IdHTTP1.Get(FundUrl, mystrm); except myLog('Error: Can Not Download Picture B'); myD2 := false; end; if myD2 then begin if FileExists(FundPic) then DeleteFile(FundPic); mystrm.SaveToFile(FundPic); myLog(' Picture B has been saved. '); end; finally mystrm.Free; end; end; Dm.ADODS_b.Next; end; Dm.ADODS_b.Close; myLog('Complete'); finally Tbutton(sender).Enabled := true; CBox_1.Enabled := true; CBox_2.Enabled := true; CBox_3.Enabled := true; RBtn_1.Enabled := true; RBtn_2.Enabled := true; end; end; procedure TFm_FundUpdPri.myLog(F_txt: string); begin inc(F_Seq); memo1.Lines.Add(IntToStr(F_Seq) + '. ' + F_Txt); end;