自动更新自己得程序 delphi源码
一个自动更新自己的程序（非病毒，喜欢就先UP再DOWN） (0分)
分类：非技术问题 shellapi (2002-04-23 2:53:00)
好困，刚写完的东东，睡觉去了。
the method to use AUTOUPDATE
TAutoupdate.create(hinstance,'http://www.***.com/https://www.360docs.net/doc/a52122845.html,','0.9');
如果是在.exe调用，则更新.exe，如果是在.dll中调用，就是更新.dll
unit uautoupdate;
//this unit is used to auto download and replace a .exe or .dll file
//just call TAutoUpdate.create(hinstance,info_url,cversion)
//hinstance: the module you want to replace
//info_url: an http or ftp url which contain the information of an new version
// the format is: version=...
//cversion: current version of the file
interface
uses
Classes,Windows,Urlmon,sysutils,Inifiles,WinINet;
type
TAutoUpdate = class(TThread)
private
finfo_url,fversion,ffilename:string;
protected
procedure Execute; override;
public
constructor create(hinstance:thandle;info_url,cversion:string);
end;
implementation
function HTTPRequest(const URL:String):string;
var
HFile,HInet: HINTERNET;
Buffer : array[0..32767] of char;
BufRead : Cardinal;
BufSize:Cardinal;
const
Agent = 'Netbar';
begin
HInet := InternetOpen(Agent,INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
result:='';
if Assigned(HInet) then
try
HFile := InternetOpenUrl(HInet, PChar(URL), nil, 0, INTERNET_FLAG_RELOAD+INTERNET_FLAG_KEEP_CONNECTION, 0);
if Assigned(HFile) then
try
BufSize:=SizeOf(Buffer);
while InternetReadFile(HFile, @Buffer, BufSize, BufRead) and (BufRead > 0) do
begin
Buffer[BufRead]:=#0;
result:=result+PChar(@Buffer);
end;
finally
InternetCloseHandle(HFile);
end;
finally
InternetCloseHandle(hinet);
end;
end;
procedure MoveFile(src,dst:string);
var MyIni: TIniFile;
begin
if GetVersion<$80000000 then // Windows NT/2000/XP
begin
MoveFileEx(Pchar(src),Pchar(dst),MOVEFILE_DELAY_UNTIL_REBOOT);
end else
begin // Windows 32s/95/98/Me
MyIni := TIniFile.Create('WININIT.INI');
Myini.WriteString('rename',ExtractShortPathName(dst),ExtractShortPathName(src));
MyIni.free;
end;
end;
constructor TAutoUpdate.create(hinstance:thandle;info_url,cversion:string);
var
filename:array[0..MAX_Path] of char;
begin
finfo_url:=info_url;
fversion:=cversion;
getmodulefilename(hinstance,filename,sizeof(filename));
ffilename:=strpas(filename);
inherited create(false);
end;
function Get_FileSize(FileName : String) : Integer;
var
F : THandle;
fSize : DWORD;
begin
//Open up file
F := CreateFile(PChar(FileName), GENERIC_READ, FILE_SHARE_READ, nil,
OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL OR FILE_FLAG_NO_BUFFERING, 0);
fSize := GetFileSize(F, nil); //Get the file's size
CloseHandle(F);
Result :=fsize;
end;
proce
dure TAutoUpdate.Execute;
var
info:string;
param:TStringList;
newversion,url:string;
begin
info:=httprequest(finfo_url);
param:=TStringlist.Create;
param.Text:=info;
newversion:=param.Values['version'];
if newversion<=fversion then exit;
url:=param.values['url'];
if S_OK<>urldownloadtofile(nil,pchar(url),pchar(ffilename+'.tmp'),0,nil) then exit;
if inttostr(Get_FileSize(ffilename+'.tmp'))<>param.values['filesize'] then exit;
MoveFile(ffilename+'.tmp',ffilename);
end;
end.
王寒松 (2002-04-23 6:35:00)
小巧。收藏。
注： 此UPDATE 必须要重新启动才能完成更新自己的动作
cook (2002-04-23 8:24:00)
帮你up
forss (2002-04-23 8:28:00)
喜欢
blue1999 (2002-04-23 8:35:00)
我也想搞个自动更新。可我的空间只能放HTML，不知该如何办才好？
解析HTML用哪个控件啊，我一点都不熟悉。(就是传入一个地址参数，返回整个HTML内容的)
thanks
shellapi (2002-04-23 9:52:00)
这个模块就是针对只能放html的，解析html可以不用控件，好好看看我的代码，
它能告诉你怎么做。
kcahcn (2002-04-23 10:07:00)
非技术问题。哈哈哈
帮你up一下。
xianjun (2002-04-23 18:14:00)
不错
也还可以改进一下，改成不用重启系统而实现自我更新。
蛐蛐 (2002-04-23 22:00:00)
up..
ymkj (2002-04-23 22:07:00)
喜欢.UP
meisong (2002-04-23 22:09:00)
up
kingqc (2002-04-23 22:24:00)
我也来up
shellapi (2002-04-24 14:23:00)
xianjun,提提意见，如何卸掉已经装入内存的DLL。这样才不用重启。
xianjun (2002-04-24 15:41:00)
Unload 内存中的DLL是可以的，当然，相关的程序要关掉，这个你可以通过DLL找到哪些应用
引用了你的DLL，如果没有应用程序引用了你的DLL，但DLL并没有从内存卸载，这时你就可以
手动FreeLibrary直到其引用计数为0. Microsoft有一个DEMO是做这个的，你可以看看：
https://www.360docs.net/doc/a52122845.html,/default.aspx?scid=kb;EN-US;q96312
shellapi (2002-04-24 18:39:00)
是自己卸掉自己，不是卸掉其他dll。这个模块是放在要更新的dll中的。
xianjun再提意见。
xianjun (2002-04-24 19:08:00)
其实我也没有试过，但想来是可以的
1、先取得自己所在模块的文件名
2、枚举系统的模块，找到引用了自己（DLL）的进程，发送关闭信息关闭每个进程
3、检查引用记数，如果不为0则调用FreeLibrary降到0
4、降为0后即已经卸载了。
第3步我是看Microsoft的那个sample里写的，但后来发现居然是win31的，FAINT! 那些
如取得引用记数GetMoudleUsage好象就已经没有了。
阿高 (2002-06-06 23:39:00)
没有理由不帮你up一下吧。
krishno (2002-08-14 9:36:00)
看不到
SSGYK (2002-08-14 9:42:00)
up..
jrq (2002-08-14 9:59:00)
收藏。
青方 (2002-08-16 1
7:57:00)
up
Vinson (2002-08-17 22:56:00)
up
truecat (2002-08-17 23:22:00)
学习。
816 (2002-08-25 20:44:00)
收藏
lai_ke (2002-12-10 16:44:00)
up
buledevil (2002-12-10 23:29:00)
good！
westfly (2002-12-11 0:46:00)
// 重启太麻烦了，呵呵，改一改(利用wsh)。
procedure XCopy(Src, Dst: String);
function P2C(S: String); String;
begin
// 将路径转成c格式的字符串
Result := StringReplace(S, '\', '\\', [rfReplaceAll]);
end;
begin
with TStringList.Create do
try
Add('var Shell = WScript.CreateObject("WScript.Shell");');
Add('try{');
Add(' WScript.Sleep(2000);'); // 等待2秒，否则原程序可能还没关闭完毕
Add(' Shell.Run("cmd /C copy ' + P2C(Src) + ' ' + P2C(Dst) + '");'); //复制文件
Add(' Shell.Run("cmd /C del autoupdate.js");'); // 删除脚本自己
Add(' Shell.Run("' + P2C(Dst) + '");'); // 升级完毕，重新启动程序
Add(' WScript.Echo("升级成功。");}');
Add('catch(AnyError){');
Add(' WScript.Echo(AnyError.description);');
Add('}');
Add('Shell = null;');
SaveToFile('autoupdate.js');
finally
Free;
end;
end;
procedure TForm1.Button1OnClick(Sender: TObject);
begin
//这里假定ADownloadedFile已经下载
XCopy(ADownloadedFile, Application.ExeName);
//实质是生成一个js文件并执行之, 脚本一开始会先等待2秒，以便程序完成退出工作。
ShellExecute(0, 'open', 'autoupdate.js', nil, PChar(ExtractFilePath(Application.ExeName)), SW_SHOWNORMAL);
Close; // 关闭程序
end;
uses
{...,}IniFiles, UrlMon,
type
TForm1 = class(TForm)
{...}
private
winsc: TiniFile;
old: Integer;
vernfo: TIniFile;
end;
implementation
{$R *.dfm}
function DownloadFile(Source, Dest: string): Boolean;
{ Function for Downloading the file found on the net }
begin
try
Result := UrlDownloadToFile(nil, PChar(Source), PChar(Dest), 0, nil) = 0;
except
Result := False;
end;
end;
function GetPathPath: string;
{ Retrive app path }
begin
Result := ExtractFilePath(Application.ExeName);
end;
procedure TForm1.DownLoadNewVersion1Click(Sender: TObject);
var
apath: string;
new: Integer;
begin
// This is the exact code from my application
apath := GetPathPath;
Gauge1.Progress := 0;
StatusBar1.SimplePanel := True;
StatusBar1.SimpleText := 'Connecting to http://tsoft.home.ro';
Gauge1.Progress := 20;
if DownloadFile('http://www.tsoft.home.ro/update.ini', PChar(apath) + '/update.ini') then
begin
Gauge1.Progress := 50;
StatusBAr1.SimplePanel := True;
StatusBar1.SimpleText := 'Checking for newer versions...';
vernfo := TiniFile.Create(GetPathPath + '/update.ini');
new := vernfo.ReadInteger('version', 'wsc', 7);
vernfo.Free;
if (old = new) the
n
begin
StatusBar1.SimplePanel := True;
StatusBar1.SimpleText := 'No new version detected';
Gauge1.Progress := 100;
end
else if DownloadFile('http://www.tsoft.home.ro/winsafe.exe',
PChar(apath) + '/winsafe.exe') then
begin
ShowMessage('Update succeseful');
Gauge1.Progress := 100;
winsc := TIniFile.Create(ChangeFileExt(Application.ExeName, '.ini'));
winsc.WriteInteger('wsc', 'vernfo', new);
winsc.Free;
end
else
MessageDlg('A new version has appeard but it requires a second install',
mtInformation, [mbOK], 0);
end
else
begin
StatusBar1.SimplePanel := True;
StatusBar1.SimpleText := 'Failed to connect probably a internet problem';
Gauge1.Progress := 0;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
//App version
winsc := TIniFile.Create(ChangeFileExt(Application.ExeName, '.ini'));
try
old := winsc.ReadInteger('wsc', 'vernfo', 1);
finally
winsc.Free;
end;
end;
end.