unit1.pas

自动升级,配置简单,使用httpS_CXV

unit Unit1;

interface

uses
  {} filectrl, inifiles, {} Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ScktComp, ExtCtrls, Gauges, Buttons, ComCtrls, jpeg,
  WinSkinData;

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

type
  TForm1 = class(TForm)
    ClientSocket1: TClientSocket;
    Panel2: TPanel;
    Image1: TImage;
    Panel1: TPanel;
    Panel3: TPanel;
    g: TGauge;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    GroupBox1: TGroupBox;
    Memo1: TMemo;
    SkinData1: TSkinData;
    procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
    procedure ClientSocket1Connect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure BitBtn2Click(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    filename1: string; //本地文件名
    serfilename: string; //服务器端文件名
    serhost1: string; //服务器地址
    can_rec1: boolean; //是否可以接收
    stop1: boolean; //是否停止
    procedure getinfo;
    procedure downloads(frompath, topath: string);
  end;

var
  Form1: TForm1;
  pos1: longint; //上次下载到的位置

procedure msg(Atsh: string; b: integer);
implementation


{$R *.dfm}
procedure msg(Atsh: string; b: integer);
begin
  if b = 0 then //错误
    Application.MessageBox(Pchar(Atsh), '提示', MB_ICONERROR);
  if b = 1 then //疑问
    Application.MessageBox(Pchar(Atsh), '提示', MB_ICONWARNING);
end;
function app_path1: string;
begin
  result := extractfilepath(Application.ExeName);
end;


//接收一行数据//socket,超时，结束符
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;

procedure TForm1.ClientSocket1Read(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  Memo1.Lines.Add(Socket.ReceiveText);
end;

procedure TForm1.ClientSocket1Connect(Sender: TObject;
  Socket: TCustomWinSocket);
var
  url1: string;
begin
  {  url1:='';

    url1:=url1+'GET http://clq.51.net/textfile.zip 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+'Host: clq.51.net'+#13#10;
    url1:=url1+'Connection: Keep-Alive'+#13#10;
    url1:=url1+#13#10;
    ClientSocket1.Socket.SendText(url1);

   }
end;

procedure TForm1.BitBtn2Click(Sender: TObject);
begin
  self.stop1 := true;
  close;
end;

procedure TForm1.downloads(frompath, topath: string);
var
  url1: string;
  buf1: Tbuf_byte;
  rec1: longint;
  f1: file;

  cmd1: string; //这一行的内容
  reclen1, real_reclen1: longint; //服务器返回的长度;实际已经收到的长度
  value1: string; //标志们的值
  total_len1: longint; //数据总长

begin
  try
    // self.Memo1.Lines.Add('开始升级......');
     //self.filename1:='c:\temp1.dat';
    assignfile(f1, self.filename1);
    can_rec1 := false;
    self.stop1 := false;

    if FileExists(self.filename1) = true then begin
      reset(f1, 1);
      pos1 := filesize(f1);
    end
    else begin
      rewrite(f1, 1);
      pos1 := 0;
    end;

    seek(f1, pos1);


    ClientSocket1.Active := false;
    ClientSocket1.Host := get_host1(frompath);
    ClientSocket1.Port := 80;


    url1 := '';

    self.serfilename := get_file1(frompath);
    self.serhost1 := get_host1(frompath);

    // self.Memo1.Lines.Add('获得配置参数成功；');
     //取得文件长度以确定什么时候结束接收[通过"head"请求得到]

    ClientSocket1.Active := false;
    ClientSocket1.Active := true;
    url1 := '';

    url1 := url1 + 'HEAD /' + self.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: ' + self.serhost1 + #13#10;
    url1 := url1 + #13#10;

    ClientSocket1.Socket.SendText(url1);

    while ClientSocket1.Active = true do begin

      if self.stop1 = true then break;

      cmd1 := socket_rec_line1(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请求，以得到实际的文件数据

    ClientSocket1.Active := false;
    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 /' + self.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: ' + self.serhost1 + #13#10;
    //应该可以不要
    //url1:=url1+'Connection: Keep-Alive'+#13#10;
    url1 := url1 + #13#10;
    ClientSocket1.Socket.SendText(url1);

    while ClientSocket1.Active = true do begin

      if self.stop1 = true then break;

      cmd1 := socket_rec_line1(ClientSocket1.Socket, 60 * 1000);

      //是否可接收
      if pos(lowercase('Content-Range:'), lowercase(cmd1)) = 1 then begin
        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;

      //计算要接收的长度_end;

      //头信息收完了
      if cmd1 = #13#10 then break;
    end;

    real_reclen1 := 0;
    while ClientSocket1.Active = true do begin


      if self.stop1 = true then break;

      //不能接收则退出
      if can_rec1 = false then break;

      //如果文件当前的长度大于服务器标识的长度,则是出错了，不要写入文件中
      if filesize(f1) >= total_len1 then begin
        // showmessage('文件已经下载完毕了！');
        break;
      end;

      zeromemory(@buf1, sizeof(buf1));
      rec1 := ClientSocket1.Socket.ReceiveBuf(buf1, sizeof(buf1));

      //如果实际收到的长度大于服务器标识的长度,则是出错了，不要写入文件中
      if real_reclen1 >= reclen1 then begin
        // showmessage('文件已经下载完毕了！');
        break;

      end;
      //如果当前的长度大于服务器标识的长度,则是出错了，不要写入文件中
      if pos1 = reclen1 then begin
        //  showmessage('文件已经下载完毕了！');
        break;

      end;

      blockwrite(f1, buf1, rec1);

      real_reclen1 := real_reclen1 + rec1;

      // Label1.Caption := FormatFloat('#,##', real_reclen1) + '/' + FormatFloat('#,##', reclen1);

      // Label1.Caption := Label1.Caption + '->' + inttostr(trunc((real_reclen1 / reclen1) * 100)) + '%';
      g.Progress := trunc((real_reclen1 / reclen1) * 100);
      Application.ProcessMessages;



    end;

    closefile(f1);
    // showmessage('ok');

     //发送get请求，以得到实际的文件数据_end;

    ClientSocket1.Active := false;

  except
    closefile(f1);
    showmessage('discon...');
  end;

end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
  getinfo;
  close;
end;

procedure TForm1.getinfo;
var
  ini1: tinifile;
  //配置文件的下载路径
  configname,
    downloadname,
    tmpname,
    ExeName
    : string;
  f: file;
begin 
  self.Memo1.Lines.Add('开始更新......');
  self.Memo1.Lines.Add('正在分析配置信息;');
  ini1 := tinifile.Create(app_path1 + 'config.ini');

  configname := ini1.ReadString('configfile', 'filename', '');
  self.filename1 := ini1.ReadString('brjxc', 'temppath', 'c:\temp1.tmp');
  downloadname := ini1.ReadString('brjxc', 'filename', 'c:\temp1.tmp');
  ExeName := ini1.ReadString('brjxc', 'exename', '1.exe');
  tmpname := self.filename1;
  //pos1:=filesize(
  ini1.Free;
  //
  self.Memo1.Lines.Add('开始更新配置文件;');
  downloads(downloadname, tmpname);

  copyfile(Pchar(tmpname), Pchar(app_path1 + 'config.ini'), true);

  self.Memo1.Lines.Add('更新配置文件完成;');
  self.Memo1.Lines.Add('开始下载主程序;');

  deletefile(Pchar(tmpname));

  deletefile(Pchar(tmpname));
  deletefile(Pchar(app_path1 + 'tmp.tmp'));
  //
  assignfile(f, app_path1 + ExeName);
  // Rename(f, SaveDialog1.FileName);
  Rename(f, app_path1 + 'tmp.tmp');
  //
  downloads(downloadname, tmpname);
  copyfile(Pchar(tmpname), Pchar(app_path1 + ExeName), true);
  self.Memo1.Lines.Add('更新主程序完成!!');
  msg('软件升级成功,请重新启动软件!!', 1);
  close;
end;

end.