unit_main.~pas

根据配置文件取的升级的Url地址自动下载文件升级程序

{-----------------------------------------------------------------------------
 Unit Name: Unit_main
 Author:    Tengy
 Purpose:   update from net's server
 History:   Modfied Net's product.
 support:   支持断点续传；下载日志；自动分析；
-----------------------------------------------------------------------------}
unit Unit_main;

interface

uses
  {}filectrl, Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, Gauges, Buttons, inifiles, shellapi, db,
  ImgList, ComCtrls, IdBaseComponent, IdComponent, IdTCPConnection,
  IdTCPClient, IdHTTP, ScktComp;

type
  Tbuf_char = array[0..4095] of char;
  Tbuf_byte = array[0..4095] of byte;

type
  TForm_Update = class(TForm)
    Image1: TImage;
    Notebook_step: TNotebook;
    Label1: TLabel;
    ListBox_servers: TListBox;
    GroupBox1: TGroupBox;
    Label2: TLabel;
    Edt_url: TEdit;
    Label3: TLabel;
    Gauge_process: TGauge;
    btn_pre: TButton;
    btn_next: TButton;
    ListView_files: TListView;
    ImageList: TImageList;
    HTTPFiles: TIdHTTP;
    Label4: TLabel;
    Memo1: TMemo;
    Button1: TButton;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure btn_nextClick(Sender: TObject);
    procedure Notebook_stepPageChanged(Sender: TObject);
    procedure btn_preClick(Sender: TObject);
    procedure ListBox_serversClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormActivate(Sender: TObject);

  private
    g_path: string;
    sys_id: string;
    AppIni: TIniFile;
    files: TStringList;
    function ExistNewFile: Boolean;
  public
    { Public declarations }
    ClientSocket1: TClientSocket;
    filename1: string;   //本地文件名
    serfilename: string; //服务器端文件名
    serhost1: string;    //服务器地址
    can_rec1: boolean;   //是否可以接收
    stop1: boolean;      //是否停止
    sj:boolean;          //是否所有文件均下载成功
  end;
var
  pos1: longint;        //上次下载到的位置
  Form_Update: TForm_Update;
implementation

{$R *.dfm}

procedure TForm_Update.FormCreate(Sender: TObject);
var
  servers: TStrings;
  i: integer;
begin
  self.sj:=true;
  ClientSocket1 := TClientSocket.create(application);
  ClientSocket1.ClientType := ctBlocking;
  files := TStringList.Create;
  Notebook_step.PageIndex := 0;
  ListBox_servers.Items.Clear;
  try
    //获取程序目录
    g_path := ExtractFilePath(application.ExeName);
    if copy(g_path, length(g_path), 1) <> '\' then g_path := g_path + '\';
    //创建下载需求变量INI文件
    AppIni := TIniFile.Create(g_path + 'GT.ini');
    //系统ID
    sys_id := AppIni.ReadString('GT', 'SubSys', '');
    //从ini文件中的update节点获取服务器 ，加入TSTRING控件里。
    servers := TStringList.Create;
    AppIni.ReadSectionValues('update', servers);
    for i := 0 to servers.Count - 1 do
    begin
      ListBox_servers.Items.Add(copy(servers[i], 1, pos('=', servers[i]) - 1));
      if i = 0 then
      begin
        Edt_url.Text := copy(servers[i], pos('=', servers[i]) + 1, length(servers[i]));
        ListBox_servers.Selected[0]:=true;
      end;
    end;
  finally
    AppIni.Free;
  end;

end;

function getfiledate(const filename2: string; var d: TDateTime): Boolean;
var
  DosFileTime: integer;//DOS文件时间
begin
  result := false;
  DosFileTime := FileAge(filename2);
  //返回-1表示文件不存在
  if DosFileTime <> -1 then
  begin
    //转化dos格式日期为delphi格式日期
    d := FileDateToDateTime(DosFileTime);
    result := true;
  end;
end;

function socket_rec_line1(socket1: TCustomWinSocket; timeout1: integer; crlf1: string = #13#10): string;
var
  buf1: Tbuf_char;
  r1: integer;
  ts1: TStringStream; //保存所有的数据
  FSocketStream: TWinSocketStream;
begin
  ts1 := TStringStream.Create('');
  FSocketStream := TWinSocketStream.create(Socket1, timeout1);
  //while true do//下面的一句更安全,不过对本程序好象没起作用
  while (socket1.Connected = true) do
  begin
    //确定是否可以接收数据
    //只能确定接收的超时，可见WaitForData的源码
    if not FSocketStream.WaitForData(timeout1) then break; //continue;
    //这一句是一定要有的，以免返回的数据不正确
    zeromemory(@buf1, sizeof(buf1));
    r1 := FsocketStream.Read(buf1, 1); //每次只读一个字符，以免读入了命令外的数据
    //读不出数据时也要跳出，要不会死循环
    if r1 = 0 then break; //test
    //用FsocketStream.Read能设置超时
    //r1:=socket1.ReceiveBuf(buf1,sizeof(buf1));
    ts1.Write(buf1, r1);
    //读到回车换行符了
    if pos(crlf1, ts1.DataString) <> 0 then
    begin
      break;
    end;
  end;
  result := ts1.DataString;
  //没有读到回车换行符,就表示有超时错，这时返回空字符串
  if pos(crlf1, result) = 0 then
  begin
    result := '';
  end;
  ts1.Free;
  FSocketStream.Free;
end;

function get_host1(in1: string): string;
begin
  in1 := trim(in1);
  if pos('http://', lowercase(in1)) = 1 then
  begin
    in1 := copy(in1, length('http://') + 1, length(in1));
  end;
  if pos('/', in1) <> 0 then
  begin
    in1 := copy(in1, 0, pos('/', in1) - 1);
  end;
  result := in1;
end;

function get_file1(in1: string): string;
begin
  in1 := trim(in1);
  if pos('http://', lowercase(in1)) = 1 then
  begin
    in1 := copy(in1, length('http://') + 1, length(in1));
  end;
  if pos('/', in1) <> 0 then
  begin
    in1 := copy(in1, pos('/', in1) + 1, length(in1));
  end;
  result := in1;
end;

function Download(var host1, file1: string): Boolean;
var
  url1: string;
  buf1: Tbuf_byte;
  rec1: longint;
  f1: file;
  cmd1: string;                   //这一行的内容
  reclen1, real_reclen1: longint; //服务器返回的长度;实际已经收到的长度
  value1: string;                 //标志们的值
  total_len1: longint;            //数据总长
begin
  try
    assignfile(f1, file1);
    Form_Update.can_rec1 := false;
    Form_update.stop1 := false;
    if FileExists(file1) = true then
    begin
      reset(f1, 1);
      pos1 := filesize(f1);
    end
    else
    begin
      rewrite(f1, 1);
      pos1 := 0;
    end;
    seek(f1, pos1);
    Form_Update.ClientSocket1.Active := false;
    Form_Update.ClientSocket1.Host := get_host1(host1);
    Form_Update.ClientSocket1.Port := 80;
    url1 := '';
    Form_Update.serfilename := get_file1(host1);
    Form_Update.serhost1 := get_host1(host1);
    //取得文件长度以确定什么时候结束接收[通过"head"请求得到]
    Form_Update.ClientSocket1.Active := false;
    Form_Update.ClientSocket1.Active := true;
    url1 := '';
    url1 := url1 + 'HEAD /' + Form_Update.serfilename + ' HTTP/1.1' + #13#10;
    //不使用缓存,我附加的
    //与以前的服务器兼容
    url1 := url1 + 'Pragma: no-cache' + #13#10;
    //新的
    url1 := url1 + 'Cache-Control: no-cache' + #13#10;
    //不使用缓存,我附加的_end;
    url1 := url1 + 'User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; .NET CLR 1.0.3705)' + #13#10;
    //下面这句必须要有
    //url1:=url1+'Host: clq.51.net'+#13#10;
    url1 := url1 + 'Host: ' + Form_Update.serhost1 + #13#10;
    url1 := url1 + #13#10;
    Form_Update.ClientSocket1.Socket.SendText(url1);
    while Form_Update.ClientSocket1.Active = true do
    begin
      if Form_Update.stop1 = true then break;
      cmd1 := socket_rec_line1(Form_Update.ClientSocket1.Socket, 60 * 1000);
      //计算文件的长度
      if pos(lowercase('Content-Length: '), lowercase(cmd1)) = 1 then
      begin
        value1 := copy(cmd1, length('Content-Length: ') + 1, length(cmd1));
        total_len1 := strtoint(trim(value1));
      end;
      //计算文件的长度_end;
      if cmd1 = #13#10 then break;
    end;
    //取得文件长度以确定什么时候结束接收_end;
    //发送get请求，以得到实际的文件数据
    Form_Update.clientsocket1.Active := false;
    Form_Update.clientsocket1.Active := true;
    url1 := '';
    //url1:=url1+'GET http://clq.51.net/textfile.zip HTTP/1.1'+#13#10;
    //url1:=url1+'GET /textfile.zip HTTP/1.1'+#13#10;
    url1 := url1 + 'GET /' + Form_Update.serfilename + ' HTTP/1.1' + #13#10;
    url1 := url1 + 'Accept: image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, */*' + #13#10;
    //应该可以不要url1:=url1+'Accept-Language: zh-cn'+#13#10;
    //应该可以不要url1:=url1+'Accept-Encoding: gzip, deflate'+#13#10;
    //不使用缓存,我附加的
    //与以前的服务器兼容
    //url1:=url1+'Pragma: no-cache'+#13#10;
    //新的
    //url1:=url1+'Cache-Control: no-cache'+#13#10;
    //不使用缓存,我附加的_end;
    url1 := url1 + 'User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; .NET CLR 1.0.3705)' + #13#10;
    //接受数据的范围,可选
    //url1:=url1+'RANGE: bytes=533200-'+#13#10;
    url1 := url1 + 'RANGE: bytes=' + inttostr(pos1) + '-' + #13#10;
    //下面这句必须要有
    //url1:=url1+'Host: clq.51.net'+#13#10;
    url1 := url1 + 'Host: ' + Form_Update.serhost1 + #13#10;
    //应该可以不要
    //url1:=url1+'Connection: Keep-Alive'+#13#10;
    url1 := url1 + #13#10;
    Form_Update.ClientSocket1.Socket.SendText(url1);
    while Form_Update.ClientSocket1.Active = true do
    begin
      if Form_Update.stop1 = true then break;
      cmd1 := socket_rec_line1(Form_Update.ClientSocket1.Socket, 60 * 1000);
      //是否可接收
      if pos(lowercase('Content-Range:'), lowercase(cmd1)) = 1 then
      begin
        Form_Update.can_rec1 := true;
      end;
      //是否可接收_end;
      //计算要接收的长度
      if pos(lowercase('Content-Length: '), lowercase(cmd1)) = 1 then
      begin
        value1 := copy(cmd1, length('Content-Length: ') + 1, length(cmd1));
        reclen1 := strtoint(trim(value1));
      end;