automain.pas

自动升级程序的程序

{
 *************************************************************
 **自动更新程序用了Delphi自带的TIdFTP控件来实现,比较简单    **
 **读取XML文件也是用Delphi自带的TXMLDocument控件
 **本程序代码可以自由使用,但所造成的后果不负责.
 **如果直接在本程序上修改,请修改后发一个新的给我.
 **邮箱:[e-mail]
 **2009.02.24
 *************************************************************
}
unit AutoMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ComCtrls, IdBaseComponent, IdComponent,
  IdTCPConnection, IdTCPClient, IdExplicitTLSClientServerBase, IdFTP, FileCtrl, inifiles,
  xmldom, XMLIntf, msxmldom, XMLDoc, ShellAPI;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    BitBtn1: TBitBtn;
    ProgressBar1: TProgressBar;
    IdFTP1: TIdFTP;
    XMLDocument1: TXMLDocument;
    procedure BitBtn1Click(Sender: TObject);
    procedure IdFTP1Work(ASender: TObject; AWorkMode: TWorkMode;
      AWorkCount: Integer);
    procedure IdFTP1WorkBegin(ASender: TObject; AWorkMode: TWorkMode;
      AWorkCountMax: Integer);
    procedure IdFTP1WorkEnd(ASender: TObject; AWorkMode: TWorkMode);
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
    FHost, FPath, FMainFile, FServerDir: String;
    FBytesToTransfer: LongWord;
    procedure GetIni;
    procedure FTPConnect;
    procedure FTPGetData;
    procedure ReadXml;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation
const
  IniName = 'AutoUpdate.ini';           //更新程序的配置文件
  FtpUser = 'ftp';                     //FTP服务器用户名
  FtpPass = 'gxjsxy.cn';               //FTP服务器密码
  UpFilstList = 'UpFileList.xml';      //要更新的文件列表

{$R *.dfm}

{ TForm1 }

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
  //更新结束后执行主程序
  if FMainFile <> '' then
    ShellExecute(Handle, nil,  pchar(FPath + FMainFile), nil, nil, SW_SHOWNORMAL);
  Close;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FPath:=ExtractFilePath(Application.ExeName);
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  FTPConnect;
  Application.ProcessMessages;
end;

procedure TForm1.FTPConnect;
begin
  GetIni;
  if not IdFtp1.Connected then
  begin
    with IdFtp1 do
    begin
      try
        UserName := FtpUser;
        PassWord := FtpPass;
        Host := FHost;
        Connect;
        FTPGetData;
      except
        Application.MessageBox('与服务器连接失败','提示');
      end;

      if Connected then
      begin
        //self.chagedir(sender);
      end;
    end;
  end;
end;

procedure TForm1.FTPGetData;
var FName1, FName2, aurl: String;
    FileSt: TFileStream;
    Node: IXMLNode;
    i: Integer;
  procedure UpdateFile;
  begin
    if not FileExists(FName2) then //文件不存在时
    begin
      FileSt := TFileStream.Create(FName2, fmCreate); //必须建立文件
      try
        FileSt.Position := FileSt.Size;
        IdFTP1.Get(FName1, FileSt, false);
      finally
        FileSt.Free;
      end;
    end else
    begin
      IdFTP1.Get(FName1, FName2, True); //这里直接覆盖,续传另外处理
    end;
  end;
begin
  IdFtp1.ChangeDir(FServerDir);
  //首选下载要更新的文件列表
  FName1 := UpFilstList;
  FName2 := FPath + UpFilstList;
  FBytesToTransfer := IdFTP1.Size(FName1);
  UpdateFile;
  //根据要更新的文件列表来更新文件，文件列表为XML格式
  try
    XMLDocument1.LoadFromFile(FPath + UpFilstList);
    XMLDocument1.Active := True;
    Node := XMLDocument1.ChildNodes['FileLists'];
    for i := 0 to Node.ChildNodes.Count - 1 do
    begin
      if Node.ChildNodes[i].NodeName = 'FileNode' then
      begin
        FName1 := Node.ChildNodes[i].ChildNodes['FileName'].Text;
        FName2 := FPath + FName1;
        Label1.Caption := '正在下载：' + FName1;
        Label1.Refresh;
        UpdateFile;
        Application.ProcessMessages;
      end;
    end;
  finally
    BitBtn1Click(nil);
  end;
  //Application.MessageBox('更新结束','提示');
end;

procedure TForm1.GetIni;
var iniFile: Tinifile;
begin
  try
   iniFile := TIniFile.Create(FPath + IniName);
   FHost := iniFile.ReadString('Server', 'Host', '');
   FMainFile := iniFile.ReadString('Server', 'MainFile', '');
   FServerDir := iniFile.ReadString('Server', 'Dir', '');
   if FServerDir <> '' then FServerDir := '/' + FServerDir;
   iniFile.WriteInteger('Server', 'updatetype', 0);
  finally
    iniFile.free;
  end;
end;

procedure TForm1.IdFTP1Work(ASender: TObject; AWorkMode: TWorkMode;
  AWorkCount: Integer);
begin
  case AWorkMode of
    wmRead: begin
       ProgressBar1.Position := AWorkCount;
    end;
    wmWrite: begin

    end;
  end;
end;

procedure TForm1.IdFTP1WorkBegin(ASender: TObject; AWorkMode: TWorkMode;
  AWorkCountMax: Integer);
begin
  case AWorkMode of
    wmRead: begin
      ProgressBar1.Min := 0;
      ProgressBar1.Max := AWorkCountMax;
      ProgressBar1.Max := FBytesToTransfer;

      //Edit1.Text := IntToStr(AWorkCountMax);
    end;
    wmWrite: begin

    end;
  end;
end;

procedure TForm1.IdFTP1WorkEnd(ASender: TObject; AWorkMode: TWorkMode);
begin
  //ProgressBar1.Min := 0;
  //ProgressBar1.Max := 
end;

procedure TForm1.ReadXml;
var
  Node: IXMLNode;
  i: Integer;
begin
  XMLDocument1.LoadFromFile(FPath + UpFilstList);
  //XMLDocument1.
  Node := XMLDocument1.ChildNodes['FileLists'];
  for i := 0 to Node.ChildNodes.Count - 1 do
  begin
    if Node.ChildNodes[i].NodeName = 'FileNode' then
    begin
      ShowMessage(Node.ChildNodes[i].ChildNodes['FileName'].Text);
    end;
  end;
end;

end.