untmain.pas

Delphi版天气预报-直接从网络上获取国内各大城市的天气

{如果有改进请发我一份谢谢了。
  [e-mail]}
unit untMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, HttpProt, StdCtrls, ComCtrls, ExtCtrls, RzTabs;

type
  TForm1 = class(TForm)
    HttpCli1: THttpCli;
    Panel1: TPanel;
    tvCity: TTreeView;
    RzPageControl1: TRzPageControl;
    TabSheet1: TRzTabSheet;
    TabSheet2: TRzTabSheet;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    Label11: TLabel;
    Label12: TLabel;
    Label13: TLabel;
    Label14: TLabel;
    Label15: TLabel;
    Label16: TLabel;
    Label17: TLabel;
    Label18: TLabel;
    Label19: TLabel;
    Label20: TLabel;
    Label21: TLabel;
    Label22: TLabel;
    Label23: TLabel;
    Label24: TLabel;
    Label25: TLabel;
    Label26: TLabel;
    procedure tvCityDblClick(Sender: TObject);
    procedure tvCityClick(Sender: TObject);
  private
    tmpUrl: string;
    nw: boolean;
  public
    { Public declarations }
  end;

var
  Form1             : TForm1;

implementation

{$R *.dfm}

function ddhtm(vs: string): string;
//将所有<>里的内容替换成空
var
  i                 : integer;
  bb                : boolean;
begin
  Result:= vs;
  for i:= 1 to Length(vs) do
  begin
    if (vs[i] = '<') and (vs[i + 1] <> '3') then bb:= true;
    if vs[i] = '>' then bb:= false;
    if bb then vs[i]:= ' ';
  end;
  vs:= StringReplace(vs, ' ', '', [rfReplaceAll]);
  vs:= StringReplace(vs, '	', '', [rfReplaceAll]);
  //vs:= StringReplace(vs, '>>', '>', [rfReplaceAll]);
  bb:= false;
  for i:= 1 to Length(vs) do
  begin
    if vs[i] = '>' then bb:= true;
    if vs[i + 1] <> '>' then bb:= false;
    if bb then vs[i]:= ' ';
  end;
  vs:= StringReplace(vs, ' ', '', [rfReplaceAll]);
  //vs:= StringReplace(vs, '>', ' ', [rfReplaceAll]);
  Result:= vs;
end;

function Htm2txt(vs: string): string;
var
  i                 : integer;
  bb                : boolean;
begin
  Result:= '';
  for i:= 1 to Length(vs) do
  begin
    if vs[i] = '>' then bb:= true;
    if vs[i] = '<' then bb:= false;
    if bb and (vs[i] <> '>') then Result:= Result + vs[i];
  end;
end;

procedure LoadMemoFromMemoryStream(Stream: TMemoryStream);
var
  p, q, r           : PChar;
  s, s2 {, s3}      : string;
  bb                : boolean;
  i, n              : integer;
  tmpStr            : string;           //临时变量
begin
  p:= Stream.Memory;
  q:= p + Stream.Size;                  // -1; fixed by Shay Horovitz
  r:= p;
  bb:= false;
  while (p <> nil) and (p < q) do
  begin
    while (p < q) and (p^ <> #13) and (p^ <> #10) do
      Inc(p);

    s:= Trim(Copy(StrPas(r), 1, p - r));
    if (Pos('<!--天气预报开始-->', s) > 0) or (Pos('<!--未来天气预报开始-->', s) > 0) then
      bb:= true;
    if (Pos('<!--天气预报结束-->', s) > 0) or (Pos('<!--未来天气预报结束-->', s) > 0) then
      bb:= false;

    if bb then
    begin
      s2:= Htm2txt(s);
      s2:= StringReplace(s2, '&nbsp;', '', [rfReplaceAll]);
      s2:= StringReplace(s2, '	', '', [rfReplaceAll]);

      s:= StringReplace(s, ' ', '', [rfReplaceAll]);
      s:= StringReplace(s, '&nbsp;', '', [rfReplaceAll]);
      if s2 <> '' then
      begin
        //s3:= s3 + Trim(s2);
        tmpStr:= tmpStr + Trim(s);
      end;
    end;

    if (p[0] = #13) and (p[1] = #10) then
      Inc(p, 2)
    else
      Inc(p);
    r:= p;
  end;


  tmpStr:= Trim(ddhtm(tmpStr)) + '>';
  Delete(tmpStr, 1, 1);                 //
  i:= Pos('>', tmpStr);
  n:= 0;
  while i > 0 do
  begin
    Inc(n);
    if Form1.nw then
    begin
      //国内天气
      case n of
        1: Form1.Label1.Caption:= Copy(tmpStr, 1, i - 1); //城市
        2: Form1.Label2.Caption:= Copy(tmpStr, 1, i - 1); //发布时间
        3: Form1.Label3.Caption:= Copy(tmpStr, 1, i - 1); //星期
        4: Form1.Label4.Caption:= Copy(tmpStr, 1, i - 1); //出
        5: Form1.Label5.Caption:= Copy(tmpStr, 1, i - 1); //落
        6: Form1.Label6.Caption:= Copy(tmpStr, 1, i - 1); //温度
        7: Form1.Label7.Caption:= Copy(tmpStr, 1, i - 1); //天气
        {未来天气}
        8: Form1.Label8.Caption:= Copy(tmpStr, 1, i - 1); //07月15日星期五
        9: Form1.Label9.Caption:= Copy(tmpStr, 1, i - 1); //07月16日星期六
        10: Form1.Label10.Caption:= Copy(tmpStr, 1, i - 1); //07月17日星期日
        11: Form1.Label11.Caption:= Copy(tmpStr, 1, i - 1); //天气
        12: Form1.Label12.Caption:= Copy(tmpStr, 1, i - 1); //天气
        13: Form1.Label13.Caption:= Copy(tmpStr, 1, i - 1); //天气
        14: Form1.Label14.Caption:= Copy(tmpStr, 1, i - 1); //天气
        15: Form1.Label15.Caption:= Copy(tmpStr, 1, i - 1); //风向
        16: Form1.Label16.Caption:= Copy(tmpStr, 1, i - 1); //风向
        17: Form1.Label17.Caption:= Copy(tmpStr, 1, i - 1); //风向
        18: Form1.Label18.Caption:= Copy(tmpStr, 1, i - 1); //风向
        19: Form1.Label19.Caption:= Copy(tmpStr, 1, i - 1); //风力
        20: Form1.Label20.Caption:= Copy(tmpStr, 1, i - 1); //风力
        21: Form1.Label21.Caption:= Copy(tmpStr, 1, i - 1); //风力
        22: Form1.Label22.Caption:= Copy(tmpStr, 1, i - 1); //风力
        23: Form1.Label23.Caption:= Copy(tmpStr, 1, i - 1); //温度
        24: Form1.Label24.Caption:= Copy(tmpStr, 1, i - 1); //温度
        25: Form1.Label25.Caption:= Copy(tmpStr, 1, i - 1); //温度
        26: Form1.Label26.Caption:= Copy(tmpStr, 1, i - 1); //温度
      end;
    end
    else
    begin
      //国外天气
      case n of
        1: Form1.Label1.Caption:= Copy(tmpStr, 1, i - 1); //城市
        2: Form1.Label2.Caption:= Copy(tmpStr, 1, i - 1); //发布时间
        3: Form1.Label3.Caption:= Copy(tmpStr, 1, i - 1); //星期
        4: Form1.Label6.Caption:= Copy(tmpStr, 1, i - 1); //温度
        5: Form1.Label7.Caption:= Copy(tmpStr, 1, i - 1); //天气
        {未来天气}
        6: Form1.Label8.Caption:= Copy(tmpStr, 1, i - 1); //07月15日星期五
        7: Form1.Label9.Caption:= Copy(tmpStr, 1, i - 1); //07月16日星期六
        8: Form1.Label11.Caption:= Copy(tmpStr, 1, i - 1); //天气
        9: Form1.Label12.Caption:= Copy(tmpStr, 1, i - 1); //天气
        10: Form1.Label13.Caption:= Copy(tmpStr, 1, i - 1); //天气
        11: Form1.Label15.Caption:= Copy(tmpStr, 1, i - 1); //风向
        12: Form1.Label16.Caption:= Copy(tmpStr, 1, i - 1); //风向
        13: Form1.Label17.Caption:= Copy(tmpStr, 1, i - 1); //风向
        14: Form1.Label19.Caption:= Copy(tmpStr, 1, i - 1); //风力
        15: Form1.Label20.Caption:= Copy(tmpStr, 1, i - 1); //风力
        16: Form1.Label21.Caption:= Copy(tmpStr, 1, i - 1); //风力
        17: Form1.Label23.Caption:= Copy(tmpStr, 1, i - 1); //温度
        18: Form1.Label24.Caption:= Copy(tmpStr, 1, i - 1); //温度
        19: Form1.Label25.Caption:= Copy(tmpStr, 1, i - 1); //温度
      end;
    end;
    Delete(tmpStr, 1, i);
    i:= Pos('>', tmpStr);
  end;
end;

procedure TForm1.tvCityDblClick(Sender: TObject);
var
  DataIn            : TMemoryStream;
  Buf               : string;
  i                 : integer;
begin
  //初始化显示
  Label1.Caption:= '';
  Label2.Caption:= '';
  Label3.Caption:= '';
  Label4.Caption:= '';
  Label5.Caption:= '';
  Label6.Caption:= '';
  Label7.Caption:= '';
  Label8.Caption:= '';
  Label9.Caption:= '';
  Label10.Caption:= '';
  Label11.Caption:= '';
  Label12.Caption:= '';
  Label13.Caption:= '';
  Label14.Caption:= '';
  Label15.Caption:= '';
  Label16.Caption:= '';
  Label17.Caption:= '';
  Label18.Caption:= '';
  Label19.Caption:= '';
  Label20.Caption:= '';
  Label21.Caption:= '';
  Label22.Caption:= '';
  Label23.Caption:= '';
  Label24.Caption:= '';
  Label25.Caption:= '';
  Label26.Caption:= '';
  tvCity.Enabled:= false;
  
  try
    DataIn:= TMemoryStream.Create;
    Buf:= 'city=' + tvCity.Selected.Text;

    HttpCli1.RcvdStream:= DataIn;

    HttpCli1.URL:= tmpUrl + Buf;

    try
      HttpCli1.Get;
    except
      Exit;
    end;

    {显示
    for I:= 0 to HttpCli1.RcvdHeader.Count - 1 do
      Memo2.Lines.Add('hdr>' + HttpCli1.RcvdHeader.Strings[I]);
    }
    LoadMemoFromMemoryStream(DataIn);
  finally
    DataIn.Free;
    tvCity.Enabled:= true;
  end;
end;

procedure TForm1.tvCityClick(Sender: TObject);
begin
  if tvCity.Selected.Text = '国内天气' then
  begin
    nw:= true;
    tmpUrl:= 'http://www.cma.gov.cn/netcenter_news/qxyb/city/index.php?';
  end;
  if tvCity.Selected.Text = '国外天气' then
  begin
    nw:= false;
    tmpUrl:= 'http://www.cma.gov.cn/netcenter_news/qxyb/foreign/index.php?';
  end;
end;

end.