关于软件更新,如何从服务器上下载新版本的软件? 如软件名称为Main.exe,如何下载新版本的数据?不要用第三方控件。 解决方案 » 免费领取超大流量手机卡,每月29元包185G流量+100分钟通话, 中国电信官方发货 我用的是Delphi2007,有人吗,如何对软件自动更新? 可以把软件的功能模块写成dll,在软件运行的时候,以动态方式调用,这样,就可以在软件运行的任何时候,启动软件更新程序(更新程序最好是另外一个独立的exe程序)检查更新信息,并进行下载更新了。如果检测到需要更新主程序,如Main.exe,就通过更新程序,把Main.exe关闭,然后下载替换。网上流传一种让exe程序自己更新自己的说法,但是一直没有找到相关资料,那个应该是最好的,如果不行,就像我上面所说得那样迂回实现了 :) 服务器有一文件放版本号,如果当前软件版本号小于服务器版本号就下载更新我有一EXE,如要写信到ymkj#eyou.com,标题"在线更新程序" [email protected],这是你的邮箱吧,我发过了,谢谢。 ymkj,如果发不过来,可以QQ联系:120976153 做成一个EXE文件,定期检查是否有新版的就可以了.有则关闭应用程序,并下载 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 Form_Update: TForm_Update; pos1: longint; //上次下载到的位置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 + '\'; AppIni := TIniFile.Create(g_path + 'chis.ini'); sys_id := AppIni.ReadString('chis', 'SubSys', ''); 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 Edt_url.Text := copy(servers[i], pos('=', servers[i]) + 1, length(servers[i])); end; finally AppIni.Free; end;// self.filename1:=ini1.ReadString('file1','filename1','c:\temp1.dat');end;function getfiledate(const filename2: string; var d: TDateTime): Boolean;var DosFileTime: integer;begin result := false; DosFileTime := FileAge(filename2); if DosFileTime <> -1 then //返回-1表示文件不存在 begin 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; 做成一个EXE文件,定期检查是否有新版的就可以了.有则关闭应用程序,并下载[code=Delphi(Pascal)] 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 Form_Update: TForm_Update; pos1: longint; //上次下载到的位置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 + '\'; AppIni := TIniFile.Create(g_path + 'chis.ini'); sys_id := AppIni.ReadString('chis', 'SubSys', ''); 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 Edt_url.Text := copy(servers[i], pos('=', servers[i]) + 1, length(servers[i])); end; finally AppIni.Free; end;// self.filename1:=ini1.ReadString('file1','filename1','c:\temp1.dat');end;function getfiledate(const filename2: string; var d: TDateTime): Boolean;var DosFileTime: integer;begin result := false; DosFileTime := FileAge(filename2); if DosFileTime <> -1 then //返回-1表示文件不存在 begin 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;[/code] 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 //self.filename1:='c:\temp1.dat'; 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; //计算要接收的长度_end; //头信息收完了 if cmd1 = #13#10 then break; end; real_reclen1 := 0; while Form_Update.ClientSocket1.Active = true do begin if Form_Update.stop1 = true then break; //不能接收则退出 if Form_Update.can_rec1 = false then break; //如果文件当前的长度大于服务器标识的长度,则是出错了,不要写入文件中 if filesize(f1) >= total_len1 then begin //showmessage('文件已经下载完毕了!'); result := true; Form_Update.Memo1.Lines.Add(file1 + '文件下载完成' + #13#10); break; end; zeromemory(@buf1, sizeof(buf1)); rec1 := Form_Update.ClientSocket1.Socket.ReceiveBuf(buf1, sizeof(buf1)); //如果实际收到的长度大于服务器标识的长度,则是出错了,不要写入文件中 if real_reclen1 >= reclen1 then begin //showmessage('文件已经下载完毕了!'); result := true; Form_Update.Memo1.Lines.Add(Form_update.serfilename + '实际收到文件长度大于服务器标识长度,跳过下载' + #13#10); break; end; //如果当前的长度大于服务器标识的长度,则是出错了,不要写入文件中 if pos1 = reclen1 then begin //showmessage('文件已经下载完毕了!'); result := true; Form_Update.Memo1.Lines.Add(Form_update.serfilename + '当前长度大于服务器标识长度,跳过下载' + #13#10); break; end; blockwrite(f1, buf1, rec1); real_reclen1 := real_reclen1 + rec1; //显示下载进度 Form_Update.Label4.Caption := '共 ' + FormatFloat('#,##', reclen1) + ' 字节,已下载 ' + FormatFloat('#,##', real_reclen1) + ' 字节'; Form_Update.Gauge_process.MaxValue := reclen1; Form_Update.Gauge_process.Progress := real_reclen1; Form_update.Notebook_step.Refresh; application.ProcessMessages; end; closefile(f1); //发送get请求,以得到实际的文件数据_end; Form_Update.ClientSocket1.Active := false; except closefile(f1); //showmessage('连接失败...'); result := false; Form_Update.Memo1.lines.add(Form_update.serfilename + '服务器连接失败,取消下载' + #13#10); end;end; procedure TForm_Update.btn_nextClick(Sender: TObject);var i: integer; run_exe, host1, file1: string; Flist: TListItem; myblob: TStream; fd: Tdatetime; allget:boolean;begin if btn_next.Caption = '完成升级' then begin btn_next.Enabled := false; btn_next.Caption := '复制新文件..'; button2.Enabled := false; for i := 0 to files.Count - 1 do //复制文件更新 begin //备份一份文件出来到backup copyfile(pchar(g_path + files[i]), pchar(g_path + 'backup\' + files[i] + '.bak'), false); end; for i := 0 to files.Count - 1 do //从update复制新文件 begin copyfile(pchar(g_path + 'update\' + files[i]), pchar(g_path + files[i]), false); DeleteFile(pchar(g_path + 'update\' + files[i])); //删除update目录中的升级文件 end; try AppIni := TIniFile.Create(g_path + 'chis.ini'); run_exe := AppIni.ReadString('chis', 'exe', ''); if run_exe <> '' then shellexecute(handle, 'open', pchar(run_exe), nil, nil, sw_show); finally AppIni.Free; end; application.Terminate; exit; end; Notebook_step.PageIndex := Notebook_step.PageIndex + 1; Gauge_process.MaxValue := 100; Gauge_process.Progress := 0; ListView_files.Items.Clear; Flist := ListView_files.Items.Add; Flist.Caption := '分析文件升级信息...'; Flist.StateIndex := 0; Flist.ImageIndex := 0; if ExistNewFile then //如果存在升级信息 begin ListView_files.Items.Clear; Gauge_process.Progress := 0; for i := 0 to files.Count - 1 do begin Flist := ListView_files.Items.Add; //把待升级文件信息写入列表 Flist.Caption := files[i]; Flist.StateIndex := -1; Flist.ImageIndex := -1; end; //下载升级文件 btn_next.Enabled := false; btn_next.Caption := '正下载文件..'; button2.Enabled := true; try AppIni := TIniFile.Create(g_path + 'update\update.ini'); for i := 0 to files.Count - 1 do begin ListView_files.Items[i].StateIndex := 0; ListView_files.Items[i].ImageIndex := 0; listview_files.Items[i].SubItems.Add(appini.ReadString(files[i], 'datetime', '')); host1 := Edt_url.Text + files[i]; file1 := g_path + 'update\' + files[i]; memo1.Lines.Add('连接远程文件:' + host1 + #13#10); if getfiledate(files[i], fd) then begin if fd < strtodatetime(Appini.ReadString(files[i], 'datetime', '')) then begin listview_files.Items[i].SubItems.Append('需要升级'); if Download(host1, file1) then begin allget:=true; ListView_files.Items[i].StateIndex := 1; ListView_files.Items[i].ImageIndex := 1; end else begin allget:=false; ListView_files.Items[i].StateIndex := 2; ListView_files.Items[i].ImageIndex := 2; end; end else begin allget:=true; listview_files.Items[i].SubItems.Append('不需更新'); ListView_files.Items[i].StateIndex := 3; ListView_files.Items[i].ImageIndex := 3; memo1.Lines.Add(listview_files.Items[i].Caption+'文件不需要更新,跳过下载'+#13#10); end; end else begin listview_files.Items[i].SubItems.Append('需要创建'); if Download(host1, file1) then begin allget:=true; ListView_files.Items[i].StateIndex := 1; ListView_files.Items[i].ImageIndex := 1; end else begin allget:=false; ListView_files.Items[i].StateIndex := 2; ListView_files.Items[i].ImageIndex := 2; end; end; end; finally button2.Enabled := false; AppIni.Free; HTTPfiles.Disconnect; end; btn_next.Enabled := true; sj:=sj or allget; if (Notebook_step.PageIndex = Notebook_step.Pages.Count - 1) and sj then btn_next.Caption := '完成升级' else btn_next.Caption:='继续下载'; 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 else btn_pre.Enabled := true;end;procedure TForm_Update.btn_preClick(Sender: TObject);begin button2.Click; try HTTPFiles.Disconnect; except end; Notebook_step.PageIndex := Notebook_step.PageIndex - 1; btn_next.Caption := '下一步'; btn_next.Enabled := true;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 + '\chis.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; files.Free;end;function TForm_Update.ExistNewFile: Boolean;var i {, iFileHandle}: integer; {FileDateTime: TDateTime;} filestr: TStringList;begin result := false; filestr := TStringList.Create; //下载文件 files.Clear; try if copy(Edt_url.Text, length(Edt_url.Text), 1) <> '/' then Edt_url.Text := Edt_url.Text + '/'; filestr.Add(HTTPFiles.Get(Edt_url.Text + sys_id + '.htm')); filestr.SaveToFile(g_path + 'update\update.ini'); filestr.Free; except MessageBox(handle, '取得升级信息出错!', '错误提示', MB_OK + MB_ICONERROR); exit; end; files.Clear; try AppIni := TIniFile.Create(g_path + '\update\update.ini'); AppIni.ReadSections(files); {for i := 0 to files.Count - 1 do //逐个文件进行判断是否需要更新 try iFileHandle := FileOpen(g_path + files[i], fmOpenRead); FileDateTime := FileDateToDateTime(FileGetDate(iFileHandle)); FileClose(iFileHandle); listview_files.Items[i].SubItems.Add(appini.ReadString(files[i], 'datetime', '')); if FileDateTime < strtodatetime(Appini.ReadString(files[i], 'datetime', '')) then// begin// result := true;// break; listview_files.Items[i].SubItems.Add('是') else listview_files.Items[i].SubItems.Add('否');// end; except end;} finally AppIni.Free; end; result := true;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 if self.Height = 280 then self.Height := 438 else self.Height := 280;end;procedure TForm_Update.Button2Click(Sender: TObject);begin sj:=false; self.stop1 := true; memo1.Lines.Add('已中断下载;' + #13#10);end;procedure TForm_Update.FormActivate(Sender: TObject);begin self.Height := 280;end; ClientSocket1: TClientSocket;提示TClientSocket未声明,是不是第三方控件? hui717:你是不是用到许多第三方控件? update.ini和 chis.ini的内容是什么?Notebook_step中的内容呢? 软件能成功编译,可是运行时不行function TForm_Update.ExistNewFile: Boolean;try if copy(Edt_url.Text, length(Edt_url.Text), 1) <> '/' then Edt_url.Text := Edt_url.Text + '/'; filestr.Add(HTTPFiles.Get(Edt_url.Text + sys_id + '.htm')); //filestr.Add('http://127.0.0.1:9099'); filestr.SaveToFile(g_path + 'update\update.ini'); filestr.Free; except MessageBox(handle, '取得升级信息出错!', '错误提示', MB_OK + MB_ICONERROR); exit; end;点下一步时提示“取得升级信息出错” 字符串问题. 怎么设置TImageEnDBView播放gif动画?? fastreport分页问题 求成熟进销存源代码 模拟按键点击总是很慢,效果不好,不知什么原因。 时间的比较问题 SPCOMM串口通信问题 有一Sql-server数据库问题请指教.谢谢!! 有关MDI子窗口的问题 大家帮我提供有关Delphi网络编程方面的好的书籍。 delphi 存储过程中临时表的应用 关于多线程异步调用InternetOpenUrl过程中取消任务时的延时问题
网上流传一种让exe程序自己更新自己的说法,但是一直没有找到相关资料,那个应该是最好的,如果不行,就像我上面所说得那样迂回实现了 :)
我有一EXE,如要写信到ymkj#eyou.com,标题"在线更新程序"
可以QQ联系:120976153
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
Form_Update: TForm_Update;
pos1: longint; //上次下载到的位置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 + '\';
AppIni := TIniFile.Create(g_path + 'chis.ini');
sys_id := AppIni.ReadString('chis', 'SubSys', '');
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 Edt_url.Text := copy(servers[i], pos('=', servers[i]) + 1, length(servers[i]));
end;
finally
AppIni.Free;
end;// self.filename1:=ini1.ReadString('file1','filename1','c:\temp1.dat');
end;function getfiledate(const filename2: string; var d: TDateTime): Boolean;
var
DosFileTime: integer;
begin
result := false;
DosFileTime := FileAge(filename2);
if DosFileTime <> -1 then //返回-1表示文件不存在
begin
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;
做成一个EXE文件,定期检查是否有新版的就可以了.有则关闭应用程序,并下载
[code=Delphi(Pascal)]
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
Form_Update: TForm_Update;
pos1: longint; //上次下载到的位置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 + '\';
AppIni := TIniFile.Create(g_path + 'chis.ini');
sys_id := AppIni.ReadString('chis', 'SubSys', '');
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 Edt_url.Text := copy(servers[i], pos('=', servers[i]) + 1, length(servers[i]));
end;
finally
AppIni.Free;
end;// self.filename1:=ini1.ReadString('file1','filename1','c:\temp1.dat');
end;function getfiledate(const filename2: string; var d: TDateTime): Boolean;
var
DosFileTime: integer;
begin
result := false;
DosFileTime := FileAge(filename2);
if DosFileTime <> -1 then //返回-1表示文件不存在
begin
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;[/code]
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
//self.filename1:='c:\temp1.dat';
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;
//计算要接收的长度_end;
//头信息收完了
if cmd1 = #13#10 then break;
end;
real_reclen1 := 0;
while Form_Update.ClientSocket1.Active = true do
begin
if Form_Update.stop1 = true then break;
//不能接收则退出
if Form_Update.can_rec1 = false then break;
//如果文件当前的长度大于服务器标识的长度,则是出错了,不要写入文件中
if filesize(f1) >= total_len1 then
begin
//showmessage('文件已经下载完毕了!');
result := true;
Form_Update.Memo1.Lines.Add(file1 + '文件下载完成' + #13#10);
break;
end;
zeromemory(@buf1, sizeof(buf1));
rec1 := Form_Update.ClientSocket1.Socket.ReceiveBuf(buf1, sizeof(buf1));
//如果实际收到的长度大于服务器标识的长度,则是出错了,不要写入文件中
if real_reclen1 >= reclen1 then
begin
//showmessage('文件已经下载完毕了!');
result := true;
Form_Update.Memo1.Lines.Add(Form_update.serfilename + '实际收到文件长度大于服务器标识长度,跳过下载' + #13#10);
break;
end;
//如果当前的长度大于服务器标识的长度,则是出错了,不要写入文件中
if pos1 = reclen1 then
begin
//showmessage('文件已经下载完毕了!');
result := true;
Form_Update.Memo1.Lines.Add(Form_update.serfilename + '当前长度大于服务器标识长度,跳过下载' + #13#10);
break;
end;
blockwrite(f1, buf1, rec1);
real_reclen1 := real_reclen1 + rec1; //显示下载进度
Form_Update.Label4.Caption := '共 ' + FormatFloat('#,##', reclen1) + ' 字节,已下载 ' + FormatFloat('#,##', real_reclen1) + ' 字节';
Form_Update.Gauge_process.MaxValue := reclen1;
Form_Update.Gauge_process.Progress := real_reclen1;
Form_update.Notebook_step.Refresh;
application.ProcessMessages;
end;
closefile(f1);
//发送get请求,以得到实际的文件数据_end;
Form_Update.ClientSocket1.Active := false;
except
closefile(f1);
//showmessage('连接失败...');
result := false;
Form_Update.Memo1.lines.add(Form_update.serfilename + '服务器连接失败,取消下载' + #13#10);
end;
end;
procedure TForm_Update.btn_nextClick(Sender: TObject);
var i: integer;
run_exe, host1, file1: string;
Flist: TListItem;
myblob: TStream;
fd: Tdatetime;
allget:boolean;
begin
if btn_next.Caption = '完成升级' then
begin
btn_next.Enabled := false;
btn_next.Caption := '复制新文件..';
button2.Enabled := false;
for i := 0 to files.Count - 1 do //复制文件更新
begin
//备份一份文件出来到backup
copyfile(pchar(g_path + files[i]), pchar(g_path + 'backup\' + files[i] + '.bak'), false);
end;
for i := 0 to files.Count - 1 do //从update复制新文件
begin
copyfile(pchar(g_path + 'update\' + files[i]), pchar(g_path + files[i]), false);
DeleteFile(pchar(g_path + 'update\' + files[i])); //删除update目录中的升级文件
end;
try
AppIni := TIniFile.Create(g_path + 'chis.ini');
run_exe := AppIni.ReadString('chis', 'exe', '');
if run_exe <> '' then shellexecute(handle, 'open', pchar(run_exe), nil, nil, sw_show);
finally
AppIni.Free;
end;
application.Terminate;
exit;
end;
Notebook_step.PageIndex := Notebook_step.PageIndex + 1; Gauge_process.MaxValue := 100;
Gauge_process.Progress := 0;
ListView_files.Items.Clear;
Flist := ListView_files.Items.Add;
Flist.Caption := '分析文件升级信息...';
Flist.StateIndex := 0;
Flist.ImageIndex := 0; if ExistNewFile then //如果存在升级信息
begin
ListView_files.Items.Clear;
Gauge_process.Progress := 0;
for i := 0 to files.Count - 1 do
begin
Flist := ListView_files.Items.Add; //把待升级文件信息写入列表
Flist.Caption := files[i];
Flist.StateIndex := -1;
Flist.ImageIndex := -1;
end;
//下载升级文件
btn_next.Enabled := false;
btn_next.Caption := '正下载文件..';
button2.Enabled := true;
try
AppIni := TIniFile.Create(g_path + 'update\update.ini');
for i := 0 to files.Count - 1 do
begin
ListView_files.Items[i].StateIndex := 0;
ListView_files.Items[i].ImageIndex := 0;
listview_files.Items[i].SubItems.Add(appini.ReadString(files[i], 'datetime', ''));
host1 := Edt_url.Text + files[i];
file1 := g_path + 'update\' + files[i];
memo1.Lines.Add('连接远程文件:' + host1 + #13#10);
if getfiledate(files[i], fd) then
begin
if fd < strtodatetime(Appini.ReadString(files[i], 'datetime', '')) then
begin
listview_files.Items[i].SubItems.Append('需要升级');
if Download(host1, file1) then
begin
allget:=true;
ListView_files.Items[i].StateIndex := 1;
ListView_files.Items[i].ImageIndex := 1;
end
else
begin
allget:=false;
ListView_files.Items[i].StateIndex := 2;
ListView_files.Items[i].ImageIndex := 2;
end;
end
else
begin
allget:=true;
listview_files.Items[i].SubItems.Append('不需更新');
ListView_files.Items[i].StateIndex := 3;
ListView_files.Items[i].ImageIndex := 3;
memo1.Lines.Add(listview_files.Items[i].Caption+'文件不需要更新,跳过下载'+#13#10);
end;
end
else
begin
listview_files.Items[i].SubItems.Append('需要创建');
if Download(host1, file1) then
begin
allget:=true;
ListView_files.Items[i].StateIndex := 1;
ListView_files.Items[i].ImageIndex := 1;
end
else
begin
allget:=false;
ListView_files.Items[i].StateIndex := 2;
ListView_files.Items[i].ImageIndex := 2;
end;
end; end;
finally
button2.Enabled := false;
AppIni.Free;
HTTPfiles.Disconnect;
end;
btn_next.Enabled := true;
sj:=sj or allget;
if (Notebook_step.PageIndex = Notebook_step.Pages.Count - 1) and sj then btn_next.Caption := '完成升级' else btn_next.Caption:='继续下载';
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
else btn_pre.Enabled := true;
end;procedure TForm_Update.btn_preClick(Sender: TObject);
begin
button2.Click;
try
HTTPFiles.Disconnect;
except
end;
Notebook_step.PageIndex := Notebook_step.PageIndex - 1;
btn_next.Caption := '下一步';
btn_next.Enabled := true;
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 + '\chis.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;
files.Free;
end;function TForm_Update.ExistNewFile: Boolean;
var i {, iFileHandle}: integer;
{FileDateTime: TDateTime;}
filestr: TStringList;
begin
result := false;
filestr := TStringList.Create;
//下载文件
files.Clear;
try
if copy(Edt_url.Text, length(Edt_url.Text), 1) <> '/' then Edt_url.Text := Edt_url.Text + '/';
filestr.Add(HTTPFiles.Get(Edt_url.Text + sys_id + '.htm'));
filestr.SaveToFile(g_path + 'update\update.ini');
filestr.Free; except
MessageBox(handle, '取得升级信息出错!', '错误提示', MB_OK + MB_ICONERROR);
exit;
end;
files.Clear;
try
AppIni := TIniFile.Create(g_path + '\update\update.ini');
AppIni.ReadSections(files);
{for i := 0 to files.Count - 1 do //逐个文件进行判断是否需要更新
try
iFileHandle := FileOpen(g_path + files[i], fmOpenRead);
FileDateTime := FileDateToDateTime(FileGetDate(iFileHandle));
FileClose(iFileHandle);
listview_files.Items[i].SubItems.Add(appini.ReadString(files[i], 'datetime', ''));
if FileDateTime < strtodatetime(Appini.ReadString(files[i], 'datetime', '')) then
// begin
// result := true;
// break;
listview_files.Items[i].SubItems.Add('是')
else
listview_files.Items[i].SubItems.Add('否');
// end;
except
end;}
finally
AppIni.Free;
end;
result := true;
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
if self.Height = 280 then self.Height := 438 else self.Height := 280;
end;procedure TForm_Update.Button2Click(Sender: TObject);
begin
sj:=false;
self.stop1 := true;
memo1.Lines.Add('已中断下载;' + #13#10);
end;procedure TForm_Update.FormActivate(Sender: TObject);
begin
self.Height := 280;
end;
提示TClientSocket未声明,是不是第三方控件?
你是不是用到许多第三方控件?
function TForm_Update.ExistNewFile: Boolean;
try
if copy(Edt_url.Text, length(Edt_url.Text), 1) <> '/' then Edt_url.Text := Edt_url.Text + '/';
filestr.Add(HTTPFiles.Get(Edt_url.Text + sys_id + '.htm'));
//filestr.Add('http://127.0.0.1:9099');
filestr.SaveToFile(g_path + 'update\update.ini');
filestr.Free; except
MessageBox(handle, '取得升级信息出错!', '错误提示', MB_OK + MB_ICONERROR);
exit;
end;点下一步时提示“取得升级信息出错”