mainunit.pas

delphi开发的自动更新程序

unit MainUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, SUIProgressBar, StdCtrls, SUISkinForm, IdIntercept,
  IdLogBase, IdLogEvent, IdAntiFreezeBase, IdAntiFreeze, IdBaseComponent,
  IdComponent, IdTCPConnection, IdTCPClient, registry, IdFTP,
  SUIImagePanel, SUIGroupBox, SUIRadioGroup, ShellApi, SUIButton, Menus,
  SUIPopupMenu, ImgList, CoolTrayIcon, SUIDlg;

type
  TMainForm = class(TForm)
    Label1: TLabel;
    ProgressBar1: TsuiProgressBar;
    DocumentFTP: TIdFTP;
    IdAntiFreeze1: TIdAntiFreeze;
    IdLogEvent1: TIdLogEvent;
    Timer1: TTimer;
    ProgrameRadioGroup: TsuiRadioGroup;
    Label2: TLabel;
    Label3: TLabel;
    ProgramLabel: TLabel;
    ImageList1: TImageList;
    suiPopupMenu1: TsuiPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    CoolTrayIcon1: TCoolTrayIcon;
    Timer3: TTimer;
    suiMessageDialog1: TsuiMessageDialog;
    BackImage: TImage;
    suiMessageDialog2: TsuiMessageDialog;
    procedure Timer1Timer(Sender: TObject);
    procedure DocumentFTPWork(Sender: TObject; AWorkMode: TWorkMode;
      const AWorkCount: Integer);
    procedure DocumentFTPWorkEnd(Sender: TObject; AWorkMode: TWorkMode);
    procedure FormCreate(Sender: TObject);
    procedure DocumentFTPWorkBegin(Sender: TObject; AWorkMode: TWorkMode;
      const AWorkCountMax: Integer);
    procedure N4Click(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure Timer3Timer(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormResize(Sender: TObject);
  private
    
    ProjectSize:int64;
    ProjectFileStrings:TStrings;
    NewProjectDateTime:TDatetime;

    function IPAddressGet:string;
    function DownLoadCheck:boolean;
    procedure InitialSet;
    procedure DownLoadFile;

  public
    CDir,ProgrameName:string;
    procedure CreateParams(var Params : TCreateParams);Override;
  end;

var
  MainForm: TMainForm;

implementation

uses AboutUnit;

{$R *.dfm}

procedure TMainForm.CreateParams(var Params : TCreateParams);
begin
  inherited CreateParams(params);
  Params.WinClassName := 'MYWNDNAME';//任意给个名字
end;

function TMainForm.IPAddressGet:string;
var
  Reg:Tregistry;
  Str, KeyName:string;
begin
  Result:='127.0.0.1';
    try
    //创建注册表，有该键则读取，无则创建
    Reg:=Tregistry.Create ;
    Reg.RootKey :=hkey_local_machine;

    KeyName:='SOFTWARE\中国矿业大学信息与电气工程学院\'+ProgrameName+'(客户端)';
    if Reg.OpenKey(KeyName,true) then Result:=Reg.ReadString('IPAddress');
    reg.CloseKey ;
    finally
    reg.Free ;
    end;

end;

procedure TMainForm.InitialSet;
var
  Reg:Tregistry;
  KeyName:string;
begin
  case ProgrameRadioGroup.ItemIndex of
  0: ProgrameName:='兖矿集团科技管理信息系统';
  1: ProgrameName:='平煤集团电务厂管理信息系统';
  end;
  ProgramLabel.Caption:=ProgrameName;
  suiMessageDialog1.Caption:=ProgrameName+'－升级程序';
  suiMessageDialog2.Caption:=ProgrameName+'－升级程序';
  CoolTrayIcon1.Hint:=ProgrameName+'－升级程序';

  try
    //创建注册表，有该键则读取，无则创建
    Reg:=TRegistry.Create ;
    Reg.RootKey :=hkey_local_machine;
     KeyName:='SOFTWARE\中国矿业大学信息与电气工程学院\'+ProgrameName+'(客户端)';
     if Reg.OpenKey(KeyName,true) then try CDir:=Reg.ReadString('Path'); except end;
    reg.CloseKey ;
  finally
  reg.Free ;
  end;

  //SetWindowPos(Application.handle,HWND_TOPMOST,0,0,0,0,SWP_NOMOVE or SWP_NOSIZE);
  //SetWindowLong(Application.Handle,GWL_EXSTYLE,WS_EX_TOOLWINDOW);
  //self.Top:=Screen.Height+20;
  //self.Left:=Screen.Width-Self.Width;
  Repaint;
end;

procedure TMainForm.DownLoadFile;
var
Str:string;
MyStrings:TStringList;
i:integer;
begin
MainForm.Show;
try
  if not DocumentFTP.Connected then
  with DocumentFTP do
  try
    UserName:='newprojectprogram';
    Password:='cyftppassword';
    Host := IPAddressGet;
    Connect;

  finally end;
  if DocumentFTP.Connected then
  begin
    try

      DocumentFTP.Get(ProgrameName+'.exe',CDir+ProgrameName+'.exe', true, false);
      MyStrings:=TStringList.Create;
      MyStrings.Text:=DateTimetostr(NewProjectDateTime);
      MyStrings.SaveToFile(CDir+'更新日志.txt');
    finally MyStrings.Free; end;
      MyStrings.Free;

    try DocumentFTP.Disconnect; except end;
  end;
    ProgressBar1.Visible:=False;
except end;
try DocumentFTP.Disconnect; except end;
end;

function TMainForm.DownLoadCheck;
var
TempDir: array[0..255] of Char;
Str,DirStr:string;
MyStrings:TStringList;
mystream:tmemorystream;
MyDateTime:TDatetime;
begin

  Result:=False;
  GetTempPath(255, @TempDir);
  DirStr := StrPas(TempDir);
try
  if not DocumentFTP.Connected then
  with DocumentFTP do
  try
    UserName:='newprojectprogram';
    Password:='cyftppassword';
    Host := IPAddressGet;
    Connect;

  finally end;

  if DocumentFTP.Connected then
  begin
      try
          mystream:=tmemorystream.create;
          mystream.loadfromfile(CDir+'更新日志.txt');
          MyStrings:=TStringList.Create;
          MyStrings.LoadFromStream(mystream);
          MyDateTime:=StrToDateTime(MyStrings.Strings[0]);
        finally
          mystream.free;
          MyStrings.Free;
        end;


      try DocumentFTP.Get('更新日志.txt',DirStr+'\更新日志.txt', true, false); except end;
      try
          mystream:=tmemorystream.create;
          mystream.loadfromfile(DirStr+'\更新日志.txt');
          MyStrings:=TStringList.Create;
          MyStrings.LoadFromStream(mystream);
          NewProjectDateTime:=StrToDateTime(MyStrings.Strings[0]);
          label1.Caption:=MyStrings.Text;
          //ProjectFileStrings.Text:=MyStrings.Text;
        finally
          mystream.free;
          MyStrings.Free;
        end;
      try DocumentFTP.Disconnect; except end;
    if NewProjectDateTime>MyDateTime then Result:=True;
  end;
except end;
try DocumentFTP.Disconnect; except end;
  
end;

procedure TMainForm.Timer1Timer(Sender: TObject);
begin
if DownLoadCheck=true then
begin
  Timer1.Enabled:=False;
  if suiMessageDialog1.ShowModal<>mrok then
     begin Timer1.Enabled:=True; exit; end;
  N1.Click;
  Timer1.Enabled:=True;
end;
end;

procedure TMainForm.DocumentFTPWork(Sender: TObject; AWorkMode: TWorkMode;
  const AWorkCount: Integer);
begin
  try
    ProgressBar1.Visible:=True;
    ProgressBar1.Position := Round(AWorkCount/ProjectSize*100);
  except end;
end;

procedure TMainForm.DocumentFTPWorkEnd(Sender: TObject;
  AWorkMode: TWorkMode);
begin
  ProgressBar1.Position := 0;
end;

procedure TMainForm.FormCreate(Sender: TObject);
var
  rgn:HRGN;
begin
  InitialSet;
  rgn:=CreateRoundRectRgn(0,0,Backimage.width,Backimage.height,30,30);
  SetWindowRgn(Handle, rgn, True);
  SetWindowLong(Handle,GWL_EXSTYLE,GetWindowLong(Handle,GWL_EXSTYLE) and (not WS_EX_APPWINDOW) or WS_EX_TOOLWINDOW);
end;

procedure TMainForm.DocumentFTPWorkBegin(Sender: TObject;
  AWorkMode: TWorkMode; const AWorkCountMax: Integer);
begin
try ProjectSize :=DocumentFTP.Size(ProgrameName+'.exe'); except end;//
end;

procedure TMainForm.N4Click(Sender: TObject);
begin
  if suiMessageDialog2.ShowModal=mrok then close;
end;

procedure TMainForm.N1Click(Sender: TObject);
begin
  if FindWindow(nil,Pchar(ProgrameName))>0 then showmessage('系统正在运行，请关闭后重试')
     else
  begin
    if DownLoadCheck=true then DownLoadFile else
       begin showmessage('您的系统已经是最新程序'); exit; end;
     showmessage('系统升级结束');
     Application.Minimize;

  end;
end;

procedure TMainForm.Timer3Timer(Sender: TObject);
begin
Application.Minimize;
Timer3.Enabled:=False;
end;

procedure TMainForm.N3Click(Sender: TObject);
begin
AboutForm.ShowModal;
end;

procedure TMainForm.FormShow(Sender: TObject);
begin
repaint;
end;

procedure TMainForm.FormResize(Sender: TObject);
begin
repaint;
end;

end.