unit_main.pas

来自「用DELPHI编写的在线升级程序.在我实际的共享软件中已经应用.程序一模一样.直」· PAS 代码 · 共 604 行 · 第 1/2 页

        Flist.StateIndex:=-1;
        Flist.ImageIndex:=-1;
      end;

      //下载升级文件
      lblDisplay.Caption:='正在下载最新资料...';
      //下载程序更新文件
      for i:=0 to HTTPFileList.Count-1 do
      try
        Gauge_process.MaxValue:=2000;
        Gauge_process.Progress:=1;
        ListView_files.Items[i].StateIndex:=0;
        ListView_files.Items[i].ImageIndex:=0;
        try
          HTTPFiles.InputFileMode := true;
          HTTPFiles.OutputFileMode := FALSE;
          HTTPFiles.ReportLevel := Status_Basic;
          HTTPFiles.Body:=g_path+'update/'+HTTPFileList.Strings[i];
          HTTPFiles.Get(Edt_url.Text+HTTPFileList.Strings[i]);
        except
          //下载文件失败
          ListView_files.Items[i].StateIndex:=2;
          ListView_files.Items[i].ImageIndex:=2;
        end;
        ListView_files.Items[i].StateIndex:=1;
        ListView_files.Items[i].ImageIndex:=1;
      except
      end;
    end;
    Gauge_process.Progress:=Gauge_process.MaxValue;
    btn_next.Enabled:=true;
    if Notebook_step.PageIndex=1 then
      btn_next.Caption:='完成升级';
  end
  else
  begin //没有文件更新 或者没连接网络
   if noConnected then
   begin
     Notebook_step.PageIndex:=2;
     Memo1.Lines.Add(#13#10+'谢谢您使用在线升级！'+#13#10);
     Memo1.Lines.add('取得升级信息出错！'+#13#10);
     Memo1.Lines.add('您可能没有连接到互联网上，请检查您的网络！'+#13#10);
     memo1.Lines.Add('或者您输入的升级服务器错误，请检查！');
     memo1.Font.Color:=clRed;
     btn_Next.Visible:=false;
   end
   else
   begin
     Notebook_step.PageIndex:=2;
     Memo1.Lines.Add(#13#10+'谢谢您使用在线升级！'+#13#10);
     Memo1.Lines.add('没有文件更新！'+#13#10);
     Memo1.Lines.add('您现在已经是最新版本！');
     btn_Next.Visible:=false;
   end;
  end;

end;

procedure TForm_Update.Notebook_stepPageChanged(Sender: TObject);
begin
  if Notebook_step.PageIndex=0 then
  begin
     //btn_pre.Enabled:=false;
     btn_next.Caption:='下一步';
     btn_next.Enabled:=true;
  end;
end;

procedure TForm_Update.ListBox_serversClick(Sender: TObject);
var i:integer;
begin
  Edt_url.Text:='';
  for i:=0 to ListBox_servers.Items.Count-1 do
    if ListBox_servers.Selected[i] then
    begin
      try
        AppIni := TIniFile.Create(g_path+'\Update.ini');
        edt_url.Text:=AppIni.ReadString('update',ListBox_servers.Items[i],'http://');
      finally
        AppIni.free;
      end;
    end;
end;

procedure TForm_Update.FormShow(Sender: TObject);
begin
  btn_next.SetFocus;
end;

procedure TForm_Update.FormClose(Sender: TObject;var Action: TCloseAction);
begin
  try
    HTTPFiles.Disconnect;
  except
  end;
  ProgramList.free;
  BmpList.Free;
  HTTPFileList.Free;
end;

function TForm_Update.ExistNewFile:boolean;
var
  UpdateInfoFile:string;
begin
   Result:=False;
   UpdateInfoFile:=g_path+'update/Amyupdate.xml';
   if not DirectoryExists(g_path+'update') then
     Createdir(g_path+'update');
   try
     HTTPFiles.InputFileMode := true;
     HTTPFiles.OutputFileMode := FALSE;
     HTTPFiles.ReportLevel := Status_Basic;
     HTTPFiles.Body:=UpdateInfoFile;
     if copy(Edt_url.Text,length(edt_url.Text),1)<>'/' then
       Edt_url.Text:=Edt_url.Text+'/';
     HTTPFiles.Get(Edt_url.Text+'AmyUpdate.xml');
   except
      noConnected:=True;
      //MessageBox(handle,'取得升级信息出错！','错误提示',MB_OK+MB_ICONERROR);
      exit;
   end;
   if XMLParse(UpdateInfoFile,ProgramList,BmpList,HttpFileList) then
     Result:=True;
end;

procedure TForm_Update.HTTPFilesPacketRecvd(Sender: TObject);
begin
   Gauge_process.Progress:=Gauge_process.Progress+1;
   if Gauge_process.Progress>=Gauge_process.MaxValue then Gauge_process.Progress:=Gauge_process.MaxValue-1000;
end;

procedure TForm_Update.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
  CanClose:=true;
  if HTTPFiles.Connected then
  begin
    if MessageBox(handle,'正在下载文件，要退出吗？','信息提示',MB_YESNO+MB_ICONQUESTION)=ID_YES then
      CanClose:=true
    else
      CanClose:=false;
  end;
  
  if btn_next.Caption='完成升级' then
  begin
    if MessageBox(handle,'文件下载已经完成，但并没有更新文件，要退出吗？','信息提示',MB_YESNO+MB_ICONQUESTION)=ID_YES then
      CanClose:=true
    else
      CanClose:=false;
  end;
end;

procedure TForm_Update.Button1Click(Sender: TObject);
begin
  close;
end;

procedure TForm_Update.DeleteRunProgram(FileName:string); //杀掉其他程序
var
  BatchFile: TextFile;
  BatchFileName: string;
  ProcessInfo: TProcessInformation;
  StartUpInfo: TStartupInfo;
begin
  BatchFileName := g_path + 'del.bat';
  AssignFile(BatchFile, BatchFileName);
  Rewrite(BatchFile);
  Writeln(BatchFile, ':try');
  Writeln(BatchFile, 'del ' + g_path + FileName);
  Writeln(BatchFile,
  'if exist "' + g_path + FileName + '"' + ' goto try');
  Writeln(BatchFile, ':trymove');
  writeln(BatchFile,'move '+ g_path+'update\'+FileName+' '+g_path);
  Writeln(BatchFile,
  'if  not exist "' + g_path + FileName + '"' + ' goto trymove');
  Writeln(BatchFile, 'del "' + BatchFileName + '"');
  Writeln(BatchFile, 'cls');
  CloseFile(BatchFile);
  FillChar(StartUpInfo, SizeOf(StartUpInfo), $00);
  StartUpInfo.dwFlags := STARTF_USESHOWWINDOW;
  StartUpInfo.wShowWindow := SW_HIDE;
  if CreateProcess(nil, PChar(BatchFileName), nil, nil,
  False, IDLE_PRIORITY_CLASS, nil, nil, StartUpInfo,
  ProcessInfo) then
  begin
    CloseHandle(ProcessInfo.hThread);
    CloseHandle(ProcessInfo.hProcess);
  end;
end;

//解析XML格式的升级文件
function TForm_Update.XMLParse(UpdateFile:String; var ProgramFileList,BmpFileList,HttpFileList:TStrings):boolean;
var
  //XMLDocument : TXMLDocument;
  Root : IXMLNode; //指向XML根结点
  Child_Node : IXMLNode; //指向消息的子结点
  UpdatePackage_Node : IXMLNode; //指向各版本的升级包结点
  Files_Node:IXMLNode;//最终的文件结点
  ProgramOldVer:String;//程序包的旧版本
  HttpFilesOldVer:String;//资料包的旧版本
  VerReg:TRegistry;  //注册表信息
  iCounts:integer;
begin
  Result:=False;
  try
  //读入XML文件，代码如下：
  XMLDocument.LoadFromFile(UpdateFile);
  Root := XMLDocument.DocumentElement; //取XML文件的根结点
  if(trim(Root.NodeName)<>'AmyUpdate') then //如果不是有效文件，则退出
    Exit;
  except
    exit;
  end;
  //根据注册表获得原程序版本，如果出错，则缺省为5.0
  try
    VerReg:=TRegistry.Create;
    VerReg.RootKey:=HKEY_LOCAL_MACHINE;
    if VerReg.OpenKey('Software\AmySoft\Ver', False) then
    begin
      ProgramOldVer:=VerReg.ReadString('ProgramVer');
      HTTPFilesOldVer:=VerReg.ReadString('HTTPFileVer');
    end;
  finally
    VerReg.Free;
  end;
  if ProgramOldVer='' then
    ProgramOldVer:='5.0';
  if HTTPFilesOldVer='' then
    HTTPFilesOldVer:='5.0';

  UpdatePackage_Node:= Root.ChildNodes.First; //取XML文件的最新升级包结点
  //判断程序包是否需要更新
  if UpdatePackage_Node<>nil then
  begin
    //如果是程序升级包，则判断是否要更新程序文件
    if (UpdatePackage_Node.NodeName = 'ProgramFiles') then
    begin
      ProgramNewVer:=UpdatePackage_Node.Attributes['Ver'];//取得升级包的更新版本

      //判断是否应该更新，如果需要更新则取文件列表
      if Strtofloat(ProgramNewVer)>StrtoFloat(ProgramOldVer) then
      begin
        Child_Node:=UpdatePackage_Node.ChildNodes.First;  //获得Files文件子结点
        //iCounts:=Child_Node.Attributes['Counts'];

        Files_Node := Child_Node.ChildNodes.First;
        while (Files_Node<>nil) do //循环取Files的各个子各点
        begin
          ProgramFileList.Add(Files_Node.text);
          Files_Node := Files_Node.NextSibling; //顺序取下一个文件子结点信息
        end;
      end;
      UpdatePackage_Node:=UpdatePackage_Node.NextSibling; //下一个包就是资料包了,这步必须的
    end;
  end;

  //设置最新更新资料库
  if (UpdatePackage_Node<>nil) then
     HTTPFilesNewVer:=UpdatePackage_Node.Attributes['Ver'];
  //资料升级包，判断是否要更新资料库
  while UpdatePackage_Node<>nil do
  begin
    //HTTPFilesNewVer:=UpdatePackage_Node.Attributes['Ver'];//取得升级包的更新版本
    
    //如果不是更新的版本，则文件下面的升级包都不用判断了（为了加快速度）
    if StrToFloat(UpdatePackage_Node.Attributes['Ver'])<=StrToFloat(HTTPFilesOldVer) then
      break;

    //更新的版本，则加入文件列表中
    Child_Node:=UpdatePackage_Node.ChildNodes.First;  //获得子结点
    while Child_Node<>nil do
    begin
      if Child_Node.NodeName ='Bmps' then   //获得图片列表
      begin
        Files_Node := Child_Node.ChildNodes.First;
        while (Files_Node<>nil) do //循环取Files的各个子各点
        begin
          BmpFileList.Add(Files_Node.text);
          Files_Node := Files_Node.NextSibling; //顺序取下一个文件子结点信息
        end;
      end;
      if Child_Node.NodeName ='Files' then   //获得HTTP文件列表
      begin
        Files_Node := Child_Node.ChildNodes.First;
        while (Files_Node<>nil) do //循环取Files的各个子各点
        begin
          HTTPFileList.Add(Files_Node.text);
          Files_Node := Files_Node.NextSibling; //顺序取下一个文件子结点信息
        end;
      end;
      Child_Node:=Child_Node.NextSibling;
    end;
    //下一升级包的判断
    UpdatePackage_Node:=UpdatePackage_Node.NextSibling;
  end;
  //如果列表不为空，则有文件要更新
  if (ProgramFileList.Count>0) or (BmpFileList.Count>0) or (HttpFileList.Count>0) then
    Result:=True;
end;

end.