UpdateCheck.pas

   1 unit UpdateCheck;
   2
   3 interface
   4
   5 uses
   6   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
   7   Dialogs, IdAntiFreezeBase, IdAntiFreeze, IdBaseComponent, IdComponent,
   8   IdTCPConnection, IdTCPClient, IdHTTP, StdCtrls, ExtCtrls;
   9
  10 type
  11   TUpdateCheckForm = class(TForm)
  12     Panel1: TPanel;
  13     Panel2: TPanel;
  14     ResultMemo: TMemo;
  15     UpdateButton: TButton;
  16     IdHTTP: TIdHTTP;
  17     IdAntiFreeze: TIdAntiFreeze;
  18     NightBuildCheckButton: TButton;
  19     procedure UpdateButtonClick(Sender: TObject);
  20     procedure FormCreate(Sender: TObject);
  21     procedure NightBuildCheckButtonClick(Sender: TObject);
  22   private
  23     { Private \90é\8c¾ }
  24     FExecPath : string;
  25     FExecArgs : string;
  26     FAllowshutdown : Boolean;
  27     function  GetDesktopDir:string;
  28     function  GetDownloadFilePath(FileName: String): String;
  29     function  CreateShortCut(FileName, Argment, SavePath :string):boolean;
  30     procedure DonwloadUpdate(url: String);
  31     function CheckUpdate(nightbuild :Boolean): Boolean;
  32   public
  33     { Public \90é\8c¾ }
  34     property ExecPath :String read FExecPath;
  35     property ExecArgs :String read FExecArgs;
  36     property Allowshutdown :Boolean read FAllowshutdown;
  37   end;
  38
  39 var
  40   UpdateCheckForm: TUpdateCheckForm;
  41
  42 implementation
  43 uses
  44     GikoSystem, NewBoard, Giko, IniFiles, MojuUtils, GikoDataModule,
  45     ActiveX, ComObj, ShlObj, GikoUtil;
  46
  47 {$R *.dfm}
  48 //! \90³\8bK\94Å
  49 procedure TUpdateCheckForm.UpdateButtonClick(Sender: TObject);
  50 begin
  51     if CheckUpdate(false) then begin
  52         if GikoUtil.MsgBox(Handle, '\8dX\90V\82ª\82 \82é\82½\82ß\83M\83R\83i\83r\82ð\8dÄ\8bN\93®\82µ\82Ü\82·\82©\81H', '\8fI\97¹\8am\94F',
  53             MB_YESNO or MB_ICONWARNING or MB_DEFBUTTON2) = ID_YES then begin
  54             FAllowshutdown := True;
  55             close;
  56         end;
  57     end;
  58 end;
  59 //! \90l\92\8c\94Å
  60 procedure TUpdateCheckForm.NightBuildCheckButtonClick(Sender: TObject);
  61 begin
  62     if GikoUtil.MsgBox(Handle, '\90³\8e®\83\8a\83\8a\81[\83X\94Å\82Å\82Í\82 \82è\82Ü\82¹\82ñ\82ª\82æ\82ë\82µ\82¢\82Å\82·\82©\81H', '\8dX\90V\8am\94F',
  63         MB_YESNO or MB_ICONWARNING or MB_DEFBUTTON2) = ID_YES then begin
  64         if CheckUpdate(true) then begin
  65             if GikoUtil.MsgBox(Handle, '\8dX\90V\82ª\82 \82é\82½\82ß\83M\83R\83i\83r\82ð\8dÄ\8bN\93®\82µ\82Ü\82·\82©\81H', '\8fI\97¹\8am\94F',
  66                 MB_YESNO or MB_ICONWARNING or MB_DEFBUTTON2) = ID_YES then begin
  67                 FAllowshutdown := True;
  68                 close;
  69             end;
  70         end;
  71     end;
  72 end;
  73
  74 //! \83A\83b\83v\83f\81[\83g\91Î\8fÛ\8am\94F
  75 function TUpdateCheckForm.CheckUpdate(nightbuild :Boolean): Boolean;
  76 const
  77 {$IFDEF DEBUG}
  78         CHECK_URL = 'http://gikonavi.sourceforge.jp/updater/debug.txt';
  79 {$ELSE}
  80         CHECK_URL = 'http://gikonavi.sourceforge.jp/updater/latest.txt';
  81 {$ENDIF}
  82 var
  83     value : string;
  84         ResStream: TMemoryStream;
  85     downResult, current, newest: TStringList;
  86     newgiko: Boolean;
  87 begin
  88     Result := false;
  89     FExecPath := '';
  90     FExecArgs := '';
  91     FAllowshutdown := False;
  92     ResultMemo.Lines.Clear;
  93     Screen.Cursor := crHourGlass;
  94     UpdateButton.Enabled := False;
  95
  96     try
  97         ResStream := TMemoryStream.Create;
  98         try
  99             TNewBoardDialog.InitHTTPClient(IdHTTP);
 100             IdHTTP.Request.Referer := '';
 101             IdHTTP.Request.AcceptEncoding := 'gzip';
 102
 103             IdHTTP.Request.CacheControl := 'no-cache';
 104             IdHTTP.Request.CustomHeaders.Add('Pragma: no-cache');
 105             IdHTTP.HandleRedirects := true;
 106             downResult := TStringList.Create;
 107             newest     := TStringList.Create;
 108             current    := TStringList.Create;
 109             IdAntiFreeze.Active := true;
 110             try
 111                 try
 112                     ResStream.Clear;
 113                     IdHTTP.Get(CHECK_URL, ResStream);
 114                     value := GikoSys.GzipDecompress(ResStream,
 115                             IdHTTP.Response.ContentEncoding);
 116                     downResult.Text := value;
 117                     if (nightbuild) then  begin
 118                         ResultMemo.Lines.Add('\8dÅ\90V\82Ìnight build\82Í\81A' + downResult.Values[ 'n_version' ]);
 119                         newest.Text := MojuUtils.CustomStringReplace(downResult.Values[ 'n_version' ],
 120                                         '.', #10, false);
 121                     end else begin
 122                         ResultMemo.Lines.Add('\8dÅ\90V\82Ì\83M\83R\83i\83r\82Í\81A' +  downResult.Values[ 'version' ]);
 123                         newest.Text := MojuUtils.CustomStringReplace(downResult.Values[ 'version' ],
 124                                         '.', #10, false);
 125                     end;
 126                     current.Text := MojuUtils.CustomStringReplace(GikoSys.Version,
 127                                         '.', #10, false);
 128                     if newest.Count >= 2 then begin
 129                         newgiko := false;
 130                         // night build\82Í\81A\83r\83\8b\83h\94Ô\8d\86\82¾\82¯\82Å\94»\92è\82·\82é
 131                         if (nightbuild) then begin
 132                             newgiko := StrToInt(current[3]) < StrToInt(newest[3]);
 133                         end else begin
 134                             newgiko := ( StrToInt(current[1]) < StrToInt(newest[1]) ) or
 135                                         ( (StrToInt(current[1]) = StrToInt(newest[1]))) and
 136                                             ((StrToInt(current[2]) < StrToInt(newest[2])) );
 137                         end;
 138                         if (newgiko) then begin
 139                             if GikoUtil.MsgBox(Handle, '\90V\82µ\82¢\83M\83R\83i\83r\82ª\82 \82è\82Ü\82·\81B\83_\83E\83\93\83\8d\81[\83h\82µ\82Ü\82·\82©\81H', '\8dX\90V\8am\94F',
 140                                 MB_YESNO or MB_ICONWARNING or MB_DEFBUTTON2) = ID_YES then begin
 141
 142                                 ResultMemo.Lines.Add('\90V\82µ\82¢\83M\83R\83i\83r\82ª\82 \82è\82Ü\82·\81B\83_\83E\83\93\83\8d\81[\83h\82ð\8aJ\8en\82µ\82Ü\82·\81B' + downResult.Values[ 'url' ]);
 143                                 DonwloadUpdate(Trim(downResult.Values[ 'url' ]));
 144                                 Result := True;
 145                             end;
 146                         end else begin
 147                             ResultMemo.Lines.Add('\8d¡\82Ì\83M\83R\83i\83r\82ª\8dÅ\90V\82Å\82·\81B');
 148                         end;
 149                     end else begin
 150                         ResultMemo.Lines.Add('\8d¡\82Ì\83M\83R\83i\83r\82ª\8dÅ\90V\82Å\82·\81B');
 151                     end;
 152                 except
 153                     on E: Exception do begin
 154                         ResultMemo.Lines.Add(E.Message);
 155                         {$IFDEF DEBUG}
 156                         Writeln(IdHTTP.ResponseText);
 157                         {$ENDIF}
 158                     end;
 159                 end;
 160             finally
 161                 current.free;
 162                 newest.free;
 163                 downResult.Free;
 164                 IdAntiFreeze.Active := false;
 165             end;
 166         finally
 167             ResStream.Clear;
 168             ResStream.Free;
 169         end;
 170     finally
 171         UpdateButton.Enabled := True;
 172         Screen.Cursor := crDefault;
 173     end;
 174
 175 end;
 176
 177 //! \83A\83b\83v\83f\81[\83g\83_\83E\83\93\83\8d\81[\83h
 178 procedure TUpdateCheckForm.DonwloadUpdate(url: String);
 179 var
 180     filename : String;
 181     fileStrem: TFileStream;
 182 begin
 183     filename := GetDownloadFilePath(Copy(url, LastDelimiter('/', url) + 1,  Length(url)));
 184     fileStrem := TFileStream.Create(filename, fmCreate);
 185     try
 186         IdHTTP.Get(url, fileStrem);
 187         ResultMemo.Lines.Add(
 188             IdHttp.ResponseText + '(' + IntToStr(IdHttp.ResponseCode) + ')');
 189         FExecPath := filename;
 190         FExecArgs := '/SP- /silent /noicons "/dir=' + GikoSys.GetAppDir + '"';
 191         if CreateShortCut(
 192             execPath, execArgs, GetDesktopDir) then begin
 193             ResultMemo.Lines.Add('\83f\83X\83N\83g\83b\83v\82É"\83M\83R\83i\83r\8dX\90V"\83V\83\87\81[\83g\83J\83b\83g\82ð\8dì\90¬\82µ\82Ü\82µ\82½\81B');
 194             // ResultMemo.Lines.Add('\83M\83R\83i\83r\82ð\8fI\97¹\82µ\82Ä\81A"\83M\83R\83i\83r\8dX\90V"\83V\83\87\81[\83g\83J\83b\83g\82ð\83_\83u\83\8b\83N\83\8a\83b\83N\82µ\82Ä\82\82¾\82³\82¢\81B');
 195         end else begin
 196             ResultMemo.Lines.Add('\83f\83X\83N\83g\83b\83v\82É\83V\83\87\81[\83g\83J\83b\83g\82ð\8dì\90¬\82Å\82«\82Ü\82¹\82ñ\82Å\82µ\82½\81B');
 197         end;
 198
 199     finally
 200         fileStrem.Free;
 201     end;
 202 end;
 203 //! \83_\83E\83\93\83\8d\81[\83h\82µ\82½\83t\83@\83C\83\8b\82Ì\95Û\91¶\83p\83X
 204 function  TUpdateCheckForm.GetDownloadFilePath(FileName: String): String;
 205 var
 206     TempPath: array[0..MAX_PATH] of Char;
 207 begin
 208     GetTempPath(MAX_PATH, TempPath);
 209     Result := IncludeTrailingPathDelimiter(TempPath) + FileName;
 210 end;
 211
 212
 213 //! \83f\83X\83N\83g\83b\83v\82Ì\83p\83X\82ð\8eæ\93¾\82·\82é\8aÖ\90\94
 214 function  TUpdateCheckForm.GetDesktopDir:string;
 215 var
 216     DeskTopPath: array[0..MAX_PATH] of Char;
 217     pidl: PItemIDList;
 218 begin
 219     SHGetSpecialFolderLocation(Application.Handle, CSIDL_DESKTOP, pidl);
 220     SHGetPathFromIDList(pidl, DesktopPath);
 221     Result := DesktopPath;
 222 end;
 223
 224 //! \83V\83\87\81[\83g\83J\83b\83g\82ð\8dì\90¬\82·\82é\8aÖ\90\94
 225 function  TUpdateCheckForm.CreateShortCut(FileName, Argment, SavePath :string):boolean;
 226 //FileName\81c\83V\83\87\81[\83g\83J\83b\83g\82ð\8dì\90¬\82·\82é\83t\83@\83C\83\8b\96¼
 227 //SavePath\81c.lnk\83t\83@\83C\83\8b\82ð\8dì\90¬\82·\82é\83f\83B\83\8c\83N\83g\83\8a
 228 var
 229     SL :IShelllink;
 230     PF :IPersistFile;
 231     wFileName :WideString;
 232 begin
 233     Result :=false;
 234     //IUnKnown\83I\83u\83W\83F\83N\83g\82ð\8dì\90¬\82µ\82Ä\81AIShellLink\82É\83L\83\83\83X\83g
 235     SL :=CreateComObject(CLSID_ShellLink) as IShellLink;
 236     //IPersistFile \82É\83L\83\83\83X\83g
 237     PF :=SL as IPersistFile;
 238
 239     if (SL.SetPath(PChar(FileName)) <> NOERROR) then begin
 240         Exit;
 241     end;
 242     if (SL.SetWorkingDirectory(PChar(ExtractFilePath(FileName)))
 243                                    <> NOERROR ) then begin
 244         Exit;
 245     end;
 246     if (SL.SetArguments(PChar(Argment)) <> NOERROR) then begin
 247         Exit;
 248     end;
 249     if (SL.SetDescription(PChar('\83M\83R\83i\83r\8dX\90V')) <> NOERROR) then begin
 250         Exit;
 251     end;
 252
 253     //IPersistFile\82ÌSave\83\81\83\\83b\83h\82É\82ÍPWChar\8c^\82Ì\83p\83\89\83\81\81[\83^\82ª\95K\97v
 254     wFileName :=SavePath +'\\83M\83R\83i\83r\8dX\90V.lnk';
 255     //\83V\83\87\81[\83g\83J\83b\83g\82ð\8dì\90¬
 256     if (PF.Save(PWChar(wFileName),True) <> NOERROR) then begin
 257         Exit;
 258     end;
 259     Result :=true;
 260 end;
 261
 262 //! Form\83R\83\93\83X\83g\83\89\83N\83^
 263 procedure TUpdateCheckForm.FormCreate(Sender: TObject);
 264 begin
 265     ResultMemo.Lines.Clear;
 266     FExecPath := '';
 267     FExecArgs := '';
 268     FAllowshutdown := False;
 269 end;
 270
 271 end.