软件自动升级问题!(100)

谁给一个好用点的软件自动升级的代码,软件每次启动的时候就检查有没有新版本,有就执行更新,已经有了http网络空间存放更新文件和版本信息.

自己写吧，不难。

function TForm1.doRunProcess(Path: string): boolean;var StartUpInfo: tSTARTUPINFO; ProcessInfo: PROCESS_INFORMATION;begin FillChar(StartUpInfo, SizeOf(StartUpInfo), 00); StartUpInfo.dwFlags := STARTF_USESHOWWINDOW; StartUpInfo.wShowWindow := sw_show; result := Boolean(CreateProcess(nil, PChar(Path), nil, nil, False, 0, nil, nil, StartupInfo, ProcessInfo)); tmr1.Enabled := True;end;procedure TForm1.doClient(Client_Path, flag: string);begin Fupdate.Visible := false; if LowerCase(flag) = 'section' then begin if not doRunProcess(Client_Path) then ErrMsg(DecodeString(RunWrg), DecodeString(wrg)); end else if LowerCase(flag) = 'station' then begin if not doRunProcess(Client_Path) then ErrMsg(DecodeString(RunWrg), DecodeString(wrg)); end;end;procedure TForm1.doLocalClient(Client_Path, flag: string);begin Fupdate.Visible := false; if LowerCase(flag) = 'section' then begin if not doRunProcess(Client_Path) then ErrMsg(DecodeString(RunWrg), DecodeString(wrg)); end else if LowerCase(flag) = 'station' then begin if not doRunProcess(Client_Path) then ErrMsg(DecodeString(RunWrg), DecodeString(wrg)); end; Application.Terminate;end;function GetOnlineStatus: Boolean;var ConTypes: Integer;begin ConTypes := INTERNET_CONNECTION_MODEM + INTERNET_CONNECTION_LAN + INTERNET_CONNECTION_PROXY; if (InternetGetConnectedState(@ConTypes, 0) = False) then Result := False else Result := True;end;procedure TForm1.IdHTTP1WorkEnd(Sender: TObject; AWorkMode: TWorkMode);begin IdHTTP1.Disconnect;end;function TForm1.GetVaule(RootList: TStrings; SubStr: string): Integer;var i, Flag: Integer;begin Flag := 0; for i := 0 to RootList.Count - 1 do begin if RootList = SubStr then Flag := 1; end; Result := Flag;end;procedure TForm1.FileComp();var UrlXML, LocalXML: IXMLDocument; UrlNode, LocalNode: IXMLNode; i, j: integer; TempList: TStringList;begin TempList := TStringList.Create; UrlXML := TXMLDocument.Create(fUpdateUrl); UrlXML.Active; UrlNode := UrlXML.DocumentElement; LocalXML := TXMLDocument.Create(fLocalUrl); for i := 0 to UrlNode.ChildNodes.Count - 1 do begin UrlNode := UrlXML.DocumentElement; UrlNode := UrlNode.ChildNodes.Nodes; LocalXML.Active; LocalNode := LocalXML.DocumentElement; for j := 0 to LocalNode.ChildNodes.Count - 1 do begin LocalNode := LocalXML.DocumentElement; LocalNode := LocalNode.ChildNodes.Nodes[j]; TempList.Add(LocalNode.NodeValue); if UrlNode.NodeValue = LocalNode.NodeValue then begin if StrToDate(UrlNode.Attributes['date']) > StrToDate(LocalNode.Attributes['date']) then fUrlList.Add(UrlNode.NodeValue); end; end; if GetVaule(TempList, UrlNode.NodeValue) = 0 then fUrlList.Add(UrlNode.NodeValue); end; TempList.Free; LocalXML := nil; UrlXML := nil;end;procedure TForm1.selfupdate;var MyStream: TMemoryStream; UrlPath: string; SavePath: string; i: Integer; Count: Integer;begin if not GetOnlineStatus then begin Fupdate.Visible := False; MessageBox(Handle, '计算机没有连接到网络不能进行在线升级!', '错误提示', MB_OK + MB_ICONERROR); Application.Terminate; end else begin UrlPath := 'http://' + fsvrIP + '/update/'; SavePath := ExtractFilePath(Application.ExeName); FileComp(); if fUrlList.Count < 1 then begin if LowerCase(f_flag) = 'section' then doLocalClient('d:/client/section/HCGL.exe', f_flag) else if LowerCase(f_flag) = 'station' then doLocalClient('d:/client/station/HCGL.exe', f_flag); end else begin IdHTTP1.HandleRedirects := true; IdAntiFreeze1.OnlyWhenIdle := False; MyStream := TMemoryStream.Create; Count := 1; for i := 0 to fUrlList.Count - 1 do begin try IdHTTP1.Get(UrlPath + fUrlList, MyStream); except Fupdate.Visible := false; WarnMsg('软件在线升级错误，请检查网络是否连通。', DecodeString(warn)); MyStream.Free; Application.Terminate; end; MyStream.SaveToFile(SavePath + fUrlList); FDownFinish := True; MyStream.Clear; Count := Count + 1; end; try IdHttp1.Get(fUpdateUrl, MyStream); MyStream.SaveToFile(fLocalUrl); except MyStream.Free; end; FDownFinish := false; MyStream.Free; end; end;end;procedure TForm1.FormCreate(Sender: TObject);begin Fupdate := TFupdate.Create(self); Fupdate.Show; Form1.Visible := false; if not IsSet then begin createfm(Tfrm_setParas, frm_setParas); InfoMsg(DecodeString(peizhiOK), DecodeString(titleCaption)); Application.Terminate; end else begin fConfig := ChangeFileExt(ParamStr(0), '.dat'); with TIniFile.Create(fConfig) do try fsvrIP := ReadString('Server', 'SvrIP', '127.0.0.1'); f_flag := ReadString('Option', 'CFlag', 'unknown'); finally free; end; if fsvrIP = '127.0.0.1' then begin InfoMsg(DecodeString(FileTitleWrong), DecodeString(titleCaption)); Exit; end; if LowerCase(f_flag) = 'section' then fUpdateUrl := 'http://' + fsvrIP + '/update/ver_section.xml' else if LowerCase(f_flag) = 'station' then fUpdateUrl := 'http://' + fsvrIP + '/update/ver_station.xml' else if LowerCase(f_flag) = 'unknown' then begin InfoMsg(DecodeString(FileTitleWrong), DecodeString(titleCaption)); Close; end; fLocalUrl := ExtractFilePath(Application.ExeName) + 'ver.xml'; FDownFinish := false; fURLList := TStringList.Create; selfupdate; end;end;procedure TForm1.IdHTTP1Status(ASender: TObject; const AStatus: TIdStatus; const AStatusText: string);const StateText: array[TIdStatus] of string = ( '解析地址...', '正在连接...', '已连接', '正在断开连接...', '连接已断开', '接收...', '接收...', '接收...', '接收...');var i: Byte;begin if (StateText[AStatus] = '连接已断开') and (FDownFinish) then begin for i := 0 to fURlList.Count - 1 do begin if LowerCase(ExtractFileExt(fURlList)) = '.exe' then doClient(ExtractFilePath(Application.ExeName) + fURlList, f_flag); end; end;end;procedure TForm1.FormDestroy(Sender: TObject);begin fUrlList.Free;end;procedure TForm1.tmr1Timer(Sender: TObject);begin inherited; findrar;end;

虽然不好但 能用，生产中就这个代码。

我以前写了一个自动升级的程序，你可以在上面修改一下http://www.delphibbs.com/keylife/iblog_show.asp?xid=30904

用控件 AutoUpgrader 有源码，你可以搜一下。

我以前有写过，可以HTTP和FTP更新的软件，可以自动去选择的。我在CSDN里有发过。可以去下载。

多人接受答案了。