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