delphi编写的软件如何在局域网内自动更新?

Question

是一个数据库管理软件,只有一个文件,就是 .exe 文件,公司局域网.
要升级时,跑到每个部门,复制一次.
我不想开什么http,ftp服务,
我想将最新的程序放在电脑PC1的 D:/new/ 目录下,设为共享,在数据库上做个新版本记号,然后其它电脑启动程序时,发现有新版本,就从 电脑PC1的 D:/new/ 目录下 复制新的程序过来.这种做法可以吗?还有更好的做法吗?

Answer 1

unit u_main;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, IdBaseComponent, IdComponent,
  IdTCPConnection, IdTCPClient, IdFTP, ComCtrls, ExtCtrls,IniFiles,
   ShellApi,Math;type
  TFrMain = class(TForm)
    idftp2: TIdFTP;
    btnUpgrade: TBitBtn;
    btnExit: TBitBtn;
    pnl1: TPanel;
    lblVer: TLabel;
    lbl1: TLabel;
    lv1: TListView;
    mmo1: TMemo;
    pb1: TProgressBar;
    procedure btnUpgradeClick(Sender: TObject);
    procedure btnExitClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure idftp2Work(Sender: TObject; AWorkMode: TWorkMode;
      const AWorkCount: Integer);
  private
    AppPath,HostIp,User,UserPwd,DownLoadPath:string;
    HostPort,pIdx:Integer;
    procedure ReadIni;      //读取FTP配置文件
    procedure FtpConnection;   //连接FTP
    procedure FtpDisConnection;  //断开FTP
    procedure DownloadFiles(Source,Target: string);   //下载文件
    procedure DownLoadFilesList(Ver:string);   //下载文件列表
    procedure DonwLoadVerInfo;   //下载版本信息
    function  DetectVer:string;  //检测版本
    procedure ReadPEVer;         //读取当前程序版本
    function  GetFileSize(filename:string):string;    //获取文件的大小
    procedure StartDownload;       //开始下载
    procedure writever;           //保存更新后的版本号
    procedure AfterRun;           //下载后完成运行
    procedure AddShowInfo(act:string);    //显示详细 操作
    procedure BtState;              //按钮状态
    procedure PrgShow(Pos,Max:Integer); //进度条
    procedure WriteError(Err:string);
    { Private declarations }
  public
    { Public declarations }
  end;var
  FrMain: TFrMain;
const
  VerFile='DVerInfo.dat';
  DFileList='FList.dat';
implementation
{$R *.dfm}{ TFrMain }procedure TFrMain.FtpConnection;
begin
  FtpDisConnection;
  try
    with idftp2 do
    begin
      Host:=HostIp;
      Port:=HostPort;
      Username:=User;
      Password:=UserPwd;
      Connect();
    end
  except
    on E:Exception do
      begin
        WriteError(e.Message);
        ShowMessage('Connection Error!');
        Application.Terminate;
      end;  
  end;  
end;procedure TFrMain.FtpDisConnection;
begin
  idftp2.Disconnect;
end;procedure TFrMain.btnUpgradeClick(Sender: TObject);
begin
  StartDownload;
end;procedure TFrMain.btnExitClick(Sender: TObject);
begin
  Close;
end;procedure TFrMain.DonwLoadVerInfo;
begin
  AddShowInfo('verify the Version,please wait...');
  try
    DownloadFiles(VerFile,DownLoadPath+VerFile);
  except
    on E:Exception do
      begin
        WriteError(e.Message);
        ShowMessage('Failed:download version.');
      end;  
  end;  
end;procedure TFrMain.ReadIni;
var
  Ini:TIniFile;
begin
  Ini:=TIniFile.Create(AppPath+'\ftpSvr.ini');
  try
    HostIp:=Ini.ReadString('Ftpinfo','HostIp','');
    HostPort:=Ini.ReadInteger('Ftpinfo','HostPort',0);
    User:=Ini.ReadString('Ftpinfo','User','');
    UserPwd:=Ini.ReadString('Ftpinfo','UserPwd','');
    DownLoadPath:=Ini.ReadString('Ftpinfo','DownLoadPath','');
  finally
    Ini.Free;
  end;  
end;procedure TFrMain.FormCreate(Sender: TObject);
begin
  AppPath:=ExtractFilePath(Application.ExeName);
  ReadPEVer;
  ReadIni;
  Application.Title:=Caption;
end;procedure TFrMain.ReadPEVer;
var
  VerData:TStringList;
  Vertxt:string;
begin
  Vertxt:=AppPath+'\Ver.txt';
  if not FileExists(Vertxt) then
     begin
       ShowMessage('Failed:Read the version.');
       Close;
     end;
  VerData:=TStringList.Create;
  try
    VerData.LoadFromFile(Vertxt);
    lblVer.Caption:=VerData.Strings[0];
  finally
    VerData.Free;
  end;
end;procedure TFrMain.DownloadFiles(Source,Target: string);
begin
  try
   try
    FtpConnection;
    idftp2.ChangeDir('/');
    idftp2.ChangeDirUp;
    idftp2.Get(Source,Target,True);
   except
     on E:Exception do
        WriteError(e.Message);
   end;
  finally
   FtpDisConnection;
  end; 
end;function TFrMain.DetectVer: string;
var
  DataList:TStringList;
begin
  if not FileExists(DownLoadPath+VerFile) then
    begin
//     ShowMessage('');
     Exit;
    end;
  DataList:=TStringList.Create;
  try
    DataList.LoadFromFile(DownLoadPath+VerFile);
    Result:=DataList.Values[lblVer.Caption]
  finally
    DataList.Free;
  end;
end;procedure TFrMain.DownLoadFilesList(Ver:string);
begin
  try
    AddShowInfo('Downloading file list.');
    DownloadFiles(Ver+'\'+DFileList,DownLoadPath+DFileList);
    AddShowInfo('OK:Downloading file list.');
  except
     on E:Exception do
        WriteError(e.Message);
    
  end;
end;procedure TFrMain.StartDownload;
var
  Ver,SourceFilename,TargerFilename,AfterRp:string;
  DataList:TStringList;
  Idx,FileCount:Integer;
begin
  lv1.Clear;
  mmo1.Clear;
  DonwLoadVerInfo;
  Ver:=Trim(DetectVer);
  if Ver='' then
    begin
     if not DeleteFile(AppPath+DownLoadPath+VerFile) then
         ShowMessage('VerFile is not exsist.')
     else
         ShowMessage('No update.');
     Close;
     Exit;
    end;
  AddShowInfo('Old Version:'+lblVer.Caption+',New Version:'+Ver);
  DownLoadFilesList(Ver);     //下载对应版本的文件列表
  DataList:=TStringList.Create;
  AddShowInfo('Download files,please wait...');
  try
    BtState;
    DataList.LoadFromFile(AppPath+DownLoadPath+DFileList);
    FileCount:=StrToInt(DataList.Values['FileCount']);
    AfterRp:=DataList.Values['AfterRun'];
    pb1.Position:=0;
    FtpConnection;
    for Idx:=0 to FileCount-1 do
     begin
        SourceFilename:=DataList.Values['File'+InttoStr(Idx)];
        TargerFilename:=DownLoadPath+SourceFilename;
        pIdx:=Idx;
        if AfterRp<>SourceFilename then
        begin
         with lv1 do
          begin
           Items.Add;
           Items.Item[Idx].Caption:=SourceFilename;
           Items.Item[Idx].SubItems.Add(GetFileSize(Ver+'\'+SourceFilename));
           Items.Item[Idx].SubItems.Add('Downloading...');
           PrgShow(Idx+1,FileCount);
           Application.ProcessMessages;
          end;
         end; 
        try
          idftp2.Get(Ver+'\'+SourceFilename,TargerFilename,True);
         if AfterRp<>SourceFilename then
            lv1.Items.Item[Idx].SubItems.Strings[1]:='OK';
          Application.ProcessMessages;
        except
          lv1.Items.Item[Idx].SubItems.Strings[1]:='Failed';
        end;  
     end;
    writever;
    AddShowInfo('OK:Download files.');
    AfterRun; 
  finally
    DataList.Free;
    FtpDisConnection;
    BtState;
  end;
end;procedure TFrMain.writever;
var
  DataList:TStringList;
  Ver:string;
begin
  if not idftp2.Connected then Exit;
  DataList:=TStringList.Create;
  Ver:=DetectVer;
  try
    DataList.LoadFromFile(AppPath+'Ver.txt');
    DataList.Clear;
    DataList.Add(Ver);
    DataList.SaveToFile(AppPath+'Ver.txt');
    lblVer.Caption:=Ver;
  finally
    DataList.Free;
  end;
end;procedure TFrMain.AfterRun;
var
  DataList:TStringList;
  strExe:string;
begin
  DataList:=TStringList.Create;
  try
    DataList.LoadFromFile(AppPath+DownLoadPath+DFileList);
    strExe:=Downloadpath+DataList.Values['AfterRun'];
    ShellExecute(Handle,'',PChar(strExe),'','',SW_NORMAL);
    Close;
  finally
    DataList.Free;
  end;
end;
function TFrMain.GetFileSize(filename:string): string;
var
  size1:Double;
begin
  size1:=idftp2.Size(filename)/1024;
  Result:=VarToStr(size1);
end;procedure TFrMain.idftp2Work(Sender: TObject; AWorkMode: TWorkMode;
  const AWorkCount: Integer);
begin
  lv1.Items.Item[pIdx].SubItems.Strings[1]:=
     VarToStr(AWorkCount/1024);
     Application.ProcessMessages;
end;procedure TFrMain.AddShowInfo(act: string);
begin
  mmo1.Lines.Add('Time:'+DateTimeToStr(Now)+',operation:'+act);
  Application.ProcessMessages;
end;procedure TFrMain.BtState;
begin
  btnUpgrade.Enabled:=not btnUpgrade.Enabled;
  btnExit.Enabled:=not btnExit.Enabled;
end;procedure TFrMain.PrgShow(Pos, Max: Integer);
begin
    pb1.Position:=Floor(Pos*100/Max);
    Application.ProcessMessages;
end;procedure TFrMain.WriteError(Err: string);
var
  MyFile:TextFile;
  ErrFile:string;
begin
  ErrFile:=AppPath+'err.log';
  try
   AssignFile(MyFile,ErrFile);
   if FileExists(ErrFile) then
      Append(MyFile)
   else
      Rewrite(MyFile);
   writeln(MyFile,'Time:'+DateTimeToStr(Now)+',ErrorMsg:'+err);   
  finally
   CloseFile(MyFile);
  end;
end;end.

Answer 2

以上的代码是我利用IIS中的FTP服务器来搭建的，当然，你也可以利用其他的工具，
我还有个网络硬盘的例子：我存在：http://jschenhao.ys168.com