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 {$ELSE}
  83         CHECK_URL = 'http://gikonavi.sourceforge.jp/updater/latest.txt';
  84 {$ENDIF}
  85 var
  86     value, url : string;
  87         ResStream: TMemoryStream;
  88     downResult, current, newest: TStringList;
  89     newgiko: Boolean;
  90 begin
  91     Result := false;
  92     FExecPath := '';
  93     FExecArgs := '';
  94     FAllowshutdown := False;
  95     ResultMemo.Lines.Clear;
  96     Screen.Cursor := crHourGlass;
  97     UpdateButton.Enabled := False;
  98     NightBuildCheckButton.Enabled := False;
  99
 100     try
 101         ResStream := TMemoryStream.Create;
 102         try
 103             TNewBoardDialog.InitHTTPClient(IdHTTP);
 104             IdHTTP.Request.Referer := '';
 105             IdHTTP.Request.AcceptEncoding := 'gzip';
 106
 107             IdHTTP.Request.CacheControl := 'no-cache';
 108             IdHTTP.Request.CustomHeaders.Add('Pragma: no-cache');
 109             IdHTTP.ReadTimeout := 0;
 110             IdHTTP.HandleRedirects := true;
 111             downResult := TStringList.Create;
 112             newest     := TStringList.Create;
 113             current    := TStringList.Create;
 114             IdAntiFreeze.Active := true;
 115             try
 116                 try
 117                     ResStream.Clear;
 118                     FCanceled := False;
 119                     CancelBitBtn.Enabled := True;
 120                     IdHTTP.Get(CHECK_URL, ResStream);
 121                     CancelBitBtn.Enabled := False;
 122                     if (FCanceled) then begin
 123                         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');
 124                     end;
 125                     value := GikoSys.GzipDecompress(ResStream,
 126                             IdHTTP.Response.ContentEncoding);
 127                     downResult.Text := value;
 128                     if (nightbuild) then  begin
 129                         ResultMemo.Lines.Add('\8dÅ\90V\82Ìnight build\82Í\81A' + downResult.Values[ 'n_version' ]);
 130                         newest.Text := MojuUtils.CustomStringReplace(downResult.Values[ 'n_version' ],
 131                                         '.', #10, false);
 132                     end else begin
 133                         ResultMemo.Lines.Add('\8dÅ\90V\82Ì\83M\83R\83i\83r\82Í\81A' +  downResult.Values[ 'version' ]);
 134                         newest.Text := MojuUtils.CustomStringReplace(downResult.Values[ 'version' ],
 135                                         '.', #10, false);
 136                     end;
 137                     current.Text := MojuUtils.CustomStringReplace(GikoSys.Version,
 138                                         '.', #10, false);
 139                     if newest.Count >= 2 then begin
 140                         newgiko := false;
 141                         // night build\82Í\81A\83r\83\8b\83h\94Ô\8d\86\82¾\82¯\82Å\94»\92è\82·\82é
 142                         if (nightbuild) then begin
 143                             url := downResult.Values[ 'n_url' ];
 144                             newgiko := StrToInt(current[3]) < StrToInt(newest[3]);
 145                         end else begin
 146                             url := downResult.Values[ 'url' ];
 147                             newgiko := ( StrToInt(current[1]) < StrToInt(newest[1]) ) or
 148                                         ( (StrToInt(current[1]) = StrToInt(newest[1]))) and
 149                                             ((StrToInt(current[2]) < StrToInt(newest[2])) );
 150                         end;
 151                         if (newgiko) then begin
 152                             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',
 153                                 MB_YESNO or MB_ICONWARNING or MB_DEFBUTTON2) = ID_YES then begin
 154                                 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);
 155                                 DonwloadUpdate(Trim(url));
 156                                 Result := True;
 157                             end;
 158                         end else begin
 159                             ResultMemo.Lines.Add('\8d¡\82Ì\83M\83R\83i\83r\82ª\8dÅ\90V\82Å\82·\81B');
 160                         end;
 161                     end else begin
 162                         ResultMemo.Lines.Add('\8d¡\82Ì\83M\83R\83i\83r\82ª\8dÅ\90V\82Å\82·\81B');
 163                     end;
 164                 except
 165                     on E: Exception do begin
 166                         ResultMemo.Lines.Add(E.Message);
 167                         {$IFDEF DEBUG}
 168                         Writeln(IdHTTP.ResponseText);
 169                         {$ENDIF}
 170                     end;
 171                 end;
 172             finally
 173                 current.free;
 174                 newest.free;
 175                 downResult.Free;
 176                 IdAntiFreeze.Active := false;
 177             end;
 178         finally
 179             ResStream.Clear;
 180             ResStream.Free;
 181         end;
 182     finally
 183         NightBuildCheckButton.Enabled := True;
 184         UpdateButton.Enabled := True;
 185         Screen.Cursor := crDefault;
 186     end;
 187
 188 end;
 189
 190 //! \83A\83b\83v\83f\81[\83g\83_\83E\83\93\83\8d\81[\83h
 191 procedure TUpdateCheckForm.DonwloadUpdate(url: String);
 192 var
 193     filename : String;
 194     fileStrem: TFileStream;
 195 begin
 196     filename := GetDownloadFilePath(Copy(url, LastDelimiter('/', url) + 1,  Length(url)));
 197     fileStrem := TFileStream.Create(filename, fmCreate);
 198     try
 199         CancelBitBtn.Enabled := True;
 200         IdHTTP.Get(url, fileStrem);
 201         CancelBitBtn.Enabled := False;
 202         if (FCanceled) then begin
 203             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');
 204         end;
 205         ResultMemo.Lines.Add(
 206             IdHttp.ResponseText + '(' + IntToStr(IdHttp.ResponseCode) + ')');
 207         FExecPath := filename;
 208         FExecArgs := '/SP- /silent /noicons "/dir=' + GikoSys.GetAppDir + '"';
 209         if CreateShortCut(
 210             execPath, execArgs, GetDesktopDir) then begin
 211             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');
 212             // 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');
 213         end else begin
 214             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');
 215         end;
 216
 217     finally
 218         fileStrem.Free;
 219     end;
 220 end;
 221 //! \83_\83E\83\93\83\8d\81[\83h\82µ\82½\83t\83@\83C\83\8b\82Ì\95Û\91¶\83p\83X
 222 function  TUpdateCheckForm.GetDownloadFilePath(FileName: String): String;
 223 var
 224     TempPath: array[0..MAX_PATH] of Char;
 225 begin
 226     GetTempPath(MAX_PATH, TempPath);
 227     Result := IncludeTrailingPathDelimiter(TempPath) + FileName;
 228 end;
 229
 230
 231 //! \83f\83X\83N\83g\83b\83v\82Ì\83p\83X\82ð\8eæ\93¾\82·\82é\8aÖ\90\94
 232 function  TUpdateCheckForm.GetDesktopDir:string;
 233 var
 234     DeskTopPath: array[0..MAX_PATH] of Char;
 235     pidl: PItemIDList;
 236 begin
 237     SHGetSpecialFolderLocation(Application.Handle, CSIDL_DESKTOP, pidl);
 238     SHGetPathFromIDList(pidl, DesktopPath);
 239     Result := DesktopPath;
 240 end;
 241
 242 //! \83V\83\87\81[\83g\83J\83b\83g\82ð\8dì\90¬\82·\82é\8aÖ\90\94
 243 function  TUpdateCheckForm.CreateShortCut(FileName, Argment, SavePath :string):boolean;
 244 //FileName\81c\83V\83\87\81[\83g\83J\83b\83g\82ð\8dì\90¬\82·\82é\83t\83@\83C\83\8b\96¼
 245 //SavePath\81c.lnk\83t\83@\83C\83\8b\82ð\8dì\90¬\82·\82é\83f\83B\83\8c\83N\83g\83\8a
 246 var
 247     SL :IShelllink;
 248     PF :IPersistFile;
 249     wFileName :WideString;
 250 begin
 251     Result :=false;
 252     //IUnKnown\83I\83u\83W\83F\83N\83g\82ð\8dì\90¬\82µ\82Ä\81AIShellLink\82É\83L\83\83\83X\83g
 253     SL :=CreateComObject(CLSID_ShellLink) as IShellLink;
 254     //IPersistFile \82É\83L\83\83\83X\83g
 255     PF :=SL as IPersistFile;
 256
 257     if (SL.SetPath(PChar(FileName)) <> NOERROR) then begin
 258         Exit;
 259     end;
 260     if (SL.SetWorkingDirectory(PChar(ExtractFilePath(FileName)))
 261                                    <> NOERROR ) then begin
 262         Exit;
 263     end;
 264     if (SL.SetArguments(PChar(Argment)) <> NOERROR) then begin
 265         Exit;
 266     end;
 267     if (SL.SetDescription(PChar('\83M\83R\83i\83r\8dX\90V')) <> NOERROR) then begin
 268         Exit;
 269     end;
 270
 271     //IPersistFile\82ÌSave\83\81\83\\83b\83h\82É\82ÍPWChar\8c^\82Ì\83p\83\89\83\81\81[\83^\82ª\95K\97v
 272     wFileName :=SavePath +'\\83M\83R\83i\83r\8dX\90V.lnk';
 273     //\83V\83\87\81[\83g\83J\83b\83g\82ð\8dì\90¬
 274     if (PF.Save(PWChar(wFileName),True) <> NOERROR) then begin
 275         Exit;
 276     end;
 277     Result :=true;
 278 end;
 279
 280 //! Form\83R\83\93\83X\83g\83\89\83N\83^
 281 procedure TUpdateCheckForm.FormCreate(Sender: TObject);
 282 begin
 283     ResultMemo.Lines.Clear;
 284     FExecPath := '';
 285     FExecArgs := '';
 286     FAllowshutdown := False;
 287 end;
 288 //! \83L\83\83\83\93\83Z\83\8b\83{\83^\83\93\89\9f\89º
 289 procedure TUpdateCheckForm.CancelBitBtnClick(Sender: TObject);
 290 begin
 291     CancelBitBtn.Enabled := False;
 292     FCanceled := True;
 293     if IdHTTP.Connected then begin
 294         IdHTTP.Disconnect;
 295     end;
 296 end;
 297
 298 end.