unit1.pas

基于Internet的利用IIS实现系统的自动更新程序

//  This demo check application update information from website,
//  I put a TXT file in my homepage,
//  URL is http://www.DelphiBox.com/update.txt
//
//  The TXT file have his format like HTML:
{
;  update.txt File Format
;  First Application Update Information
  [update]
    <ver>1.79.9.25</ver>
    <url>http://delphibox.com/softm/3_update.zip</url>
    <date>2002-9-25</date>
  [/update]

;  Another Application Update Information
  [exelock]
    <ver>2.11.0.0</ver>
    <url>http://delphibox.com/softm/3_exelock.zip</url>
    <date>2002-9-25</date>
  [/exelock]

;  You can put more ...
}
//  This Application get TXT body use TNMHTTP Component and Analyse it,
//  According as Update Information to give a suggestion if download new file.
//
//  This is a gift for my friends at 2002.1.11 for new year.
//
//      -'`"_         -'`" \
//     /     \       /      "
//    /     /\\__   /  ___   \    ADDRESS:
//   |      | \  -"`.-(   \   |     143 mailbox XI'AN Science and Technology University
//   |      |  |     | \"  |  |   ZIP CODE:
//   |     /  /  "-"  \  \    |     710054
//    \___/  /  (o o)  \  (__/    NAME:
//         __| _     _ |__          ZHONG WAN
//        (      ( )      )       EMAIL:
//         \_\.-.___.-./_/          [e-mail]
//           __  | |  __          HOMEPAGE:
//          |  \.| |./  |           http://www.delphibox.com
//          | '#.   .#' |         OICQ:
//          |__/ '"" \__|           6036742
//        -/             \-
//
//
//  3:49 2002-2-14 in Xi'An China,Please look at DelphiBox.com
//  Compiled by Delphi6.0

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, Psock, NMHttp, ComCtrls, Buttons, ShellAPI;

type
  TSimpleVersion=record
    dwProductVersionMS: DWORD;
    dwProductVersionLS: DWORD;
  end;
  TUpdate=record      { Structure of update information }
    Name:String[63];
    Version:TSimpleVersion;
    Date:TDate;
    URL:ShortString;
  end;
  
  TForm1 = class(TForm)
    NMHTTP1: TNMHTTP;
    GroupBox2: TGroupBox;
    LabeledEdit1: TLabeledEdit;
    LabeledEdit2: TLabeledEdit;
    LabeledEdit3: TLabeledEdit;
    Button1: TButton;
    Button2: TButton;
    GroupBox1: TGroupBox;
    LabeledEdit4: TLabeledEdit;
    LabeledEdit5: TLabeledEdit;
    LabeledEdit6: TLabeledEdit;
    Button3: TButton;
    Memo1: TMemo;
    SpeedButton1: TSpeedButton;
    procedure Button1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure NMHTTP1Connect(Sender: TObject);
    procedure NMHTTP1ConnectionFailed(Sender: TObject);
    procedure NMHTTP1Disconnect(Sender: TObject);
    procedure NMHTTP1HostResolved(Sender: TComponent);
    procedure NMHTTP1Status(Sender: TComponent; Status: String);
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
  private
    Update_New, Update_Ori: TUpdate;
    function AnalyseUpdate(Body: String; var Update: TUpdate): Boolean;
    procedure DisplaySuggestion(b: Boolean);
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function GetBuildInfo(FName:string):TSimpleVersion;
var
  VerInfoSize: DWORD;
  VerInfo: Pointer;
  VerValueSize: DWORD;
  VerValue: PVSFixedFileInfo;
  Dummy: DWORD;
begin
  VerInfoSize := GetFileVersionInfoSize(PChar(FName), Dummy);
  GetMem(VerInfo, VerInfoSize);
  GetFileVersionInfo(PChar(ParamStr(0)), 0, VerInfoSize, VerInfo);
  VerQueryValue(VerInfo, '\', Pointer(VerValue), VerValueSize);
  with VerValue^ do
  begin
    Result.dwProductVersionMS := dwFileVersionMS;
    Result.dwProductVersionLS := dwFileVersionLS;
  end;
  FreeMem(VerInfo, VerInfoSize);
end;

function SeparateVerStr(s:String):TSimpleVersion;
const
  Separator = '.';
var
  p:WORD;
  v1,v2,v3,v4:WORD;
begin
  if Length(s)=0 then Exit;

  p:=pos(Separator, s);
  v1:=StrToInt(copy(s,1,p-1));
  Delete(s,1,p);
  p:=Pos(Separator,s);
  v2:=StrToInt(copy(s,1,p-1));
  Delete(s,1,p);
  p:=Pos(Separator,s);
  v3:=StrToInt(copy(s,1,p-1));
  Delete(s,1,p);
  v4:=StrToInt(s);

  Result.dwProductVersionMS:=v1*$10000+v2;
  Result.dwProductVersionLS:=v3*$10000+v4;
end;

function TForm1.AnalyseUpdate(Body:String;var Update:TUpdate):Boolean;
var
  TmpStr,Ver:String;
  function CenterStr(Src:String;Before,After:String):String;
  var
    Pos1,Pos2:WORD;
  begin
    Pos1:=Pos(Before,Src)+Length(Before);
    Pos2:=Pos(After,Src);
    Result:=Copy(Src,Pos1,Pos2-Pos1);
  end;
begin
  TmpStr:=CenterStr(Body,Format('[%s]',[LowerCase(Update_Ori.Name)]),Format('[/%s]',[LowerCase(Update_Ori.Name)]));
  if TmpStr='' then
    Result:=False else
  begin
    Ver:=CenterStr(TmpStr,'<ver>','</ver>');
    Update.Version:=SeparateVerStr(Ver);
    Update.Date:=StrToDate(CenterStr(TmpStr,'<date>','</date>'));
    Update.URL:=CenterStr(TmpStr,'<url>','</url>');
    Result:=True;
    Memo1.Lines.Add('Version:'+Ver);
    Memo1.Lines.Add('Date:'+DateToStr(Update.Date));
    Memo1.Lines.Add('URL:'+Update.URL);
  end;
end;

{ Compare tow versions whether need update, True stand for need }
function VersionCheck(OriVer,NewVer:TSimpleVersion):Boolean;
begin
  if (OriVer.dwProductVersionMS=NewVer.dwProductVersionMS) then
  begin
    Result:=OriVer.dwProductVersionLS<NewVer.dwProductVersionLS;
  end else
  begin
    Result:=OriVer.dwProductVersionMS<NewVer.dwProductVersionMS
  end;
end;

procedure TForm1.DisplaySuggestion(b:Boolean);
begin
  Memo1.Lines.Add('');
  Memo1.Lines.Add('Suggestion ...');
  if b then
  begin
    if VersionCheck(Update_Ori.Version,Update_New.Version) then
    begin
      Memo1.Lines.Add('Found New Version');
      Memo1.Lines.Add('Download New File');
    end else
      Memo1.Lines.Add('No New Version');
  end else
  begin
    Memo1.Lines.Add('Check Setup Try Again');
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Memo1.Clear;
  Memo1.Lines.Add('Begin Update ...');
{-------------------------------------------}
  NMHTTP1.InputFileMode := FALSE;
  NMHTTP1.OutputFileMode := FALSE;
  NMHTTP1.ReportLevel := Status_Basic;
  try
    NMHTTP1.Get(LabeledEdit5.Text);
    Memo1.Lines.Add('');
    Memo1.Lines.Add('Begin Analyse ...');
    if AnalyseUpdate(NMHTTP1.Body,Update_New) then
    begin
      LabeledEdit1.Text:=Format('%d.%d.%d.%d',[
        Update_New.Version.dwProductVersionMS shr 16,
        Update_New.Version.dwProductVersionMS and $FFFF,
        Update_New.Version.dwProductVersionLS shr 16,
        Update_New.Version.dwProductVersionLS and $FFFF
        ]);
      LabeledEdit2.Text:=Update_New.URL;
      LabeledEdit3.Text:=DateToStr(Update_New.Date);
      Memo1.Lines.Add('Analyse Success');
      DisplaySuggestion(True);
    end else
    begin
      Memo1.Lines.Add('Can''t Find Information');
      Memo1.Lines.Add('Analyse Failed');
      DisplaySuggestion(False);
    end;
  except
    DisplaySuggestion(False);
//    ShowMessage('Get Information Failed');
  end;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  Close;
end;

procedure TForm1.NMHTTP1Connect(Sender: TObject);
begin
  Memo1.Lines.Add('Connected');
end;

procedure TForm1.NMHTTP1ConnectionFailed(Sender: TObject);
begin
  Memo1.Lines.Add('Connection Failed');
end;

procedure TForm1.NMHTTP1Disconnect(Sender: TObject);
begin
  Memo1.Lines.Add('Disconnected');
end;

procedure TForm1.NMHTTP1HostResolved(Sender: TComponent);
begin
  Memo1.Lines.Add('Host Resolved');
end;

procedure TForm1.NMHTTP1Status(Sender: TComponent; Status: String);
begin
  Memo1.Lines.Add(Status);
  If NMHTTP1.ReplyNumber = 404 then
    Memo1.Lines.Add('Object Not Found');
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Update_Ori.Name:='Update';
  Update_Ori.Version:=GetBuildInfo(ParamStr(0));
  Update_Ori.Date:=FileDateToDateTime(FileAge(ParamStr(0)));
  Update_Ori.URL:='http://www.DelphiBox.com/update.txt';
//  Update_Ori.URL:='http://localhost/webs/delphibox/update.txt';
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  LabeledEdit4.Text:=Format('%d.%d.%d.%d',[
    Update_Ori.Version.dwProductVersionMS shr 16,
    Update_Ori.Version.dwProductVersionMS and $FFFF,
    Update_Ori.Version.dwProductVersionLS shr 16,
    Update_Ori.Version.dwProductVersionLS and $FFFF
    ]);
  LabeledEdit6.Text:=DateToStr(Update_Ori.Date);
  LabeledEdit5.Text:=Update_Ori.URL;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  aboutstr:string;
begin
  aboutstr:='Author: WanZhong'+#13+
            'Email  : [e-mail]'+#13+
            'URL    : www.DelphiBox.com';
  MessageBox(handle,PChar(aboutstr),'ABOUT',MB_OK);
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
var
  url:string;
begin
  if LabeledEdit2.Text<>'' then
  begin
    url:=LabeledEdit2.Text;
    ShellExecute(Handle,nil,PChar(url),nil,nil,SW_SHOWNORMAL);
  end;
end;

end.