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, url : 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                             url := downResult.Values[ 'n_url' ];
 133                             newgiko := StrToInt(current[3]) < StrToInt(newest[3]);
 134                         end else begin
 135                             url := downResult.Values[ 'url' ];
 136                             newgiko := ( StrToInt(current[1]) < StrToInt(newest[1]) ) or
 137                                         ( (StrToInt(current[1]) = StrToInt(newest[1]))) and
 138                                             ((StrToInt(current[2]) < StrToInt(newest[2])) );
 139                         end;
 140                         if (newgiko) then begin
 141                             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',
 142                                 MB_YESNO or MB_ICONWARNING or MB_DEFBUTTON2) = ID_YES then begin
 143                                 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);
 144                                 DonwloadUpdate(Trim(url));
 145                                 Result := True;
 146                             end;
 147                         end else begin
 148                             ResultMemo.Lines.Add('\8d¡\82Ì\83M\83R\83i\83r\82ª\8dÅ\90V\82Å\82·\81B');
 149                         end;
 150                     end else begin
 151                         ResultMemo.Lines.Add('\8d¡\82Ì\83M\83R\83i\83r\82ª\8dÅ\90V\82Å\82·\81B');
 152                     end;
 153                 except
 154                     on E: Exception do begin
 155                         ResultMemo.Lines.Add(E.Message);
 156                         {$IFDEF DEBUG}
 157                         Writeln(IdHTTP.ResponseText);
 158                         {$ENDIF}
 159                     end;
 160                 end;
 161             finally
 162                 current.free;
 163                 newest.free;
 164                 downResult.Free;
 165                 IdAntiFreeze.Active := false;
 166             end;
 167         finally
 168             ResStream.Clear;
 169             ResStream.Free;
 170         end;
 171     finally
 172         UpdateButton.Enabled := True;
 173         Screen.Cursor := crDefault;
 174     end;
 175
 176 end;
 177
 178 //! \83A\83b\83v\83f\81[\83g\83_\83E\83\93\83\8d\81[\83h
 179 procedure TUpdateCheckForm.DonwloadUpdate(url: String);
 180 var
 181     filename : String;
 182     fileStrem: TFileStream;
 183 begin
 184     filename := GetDownloadFilePath(Copy(url, LastDelimiter('/', url) + 1,  Length(url)));
 185     fileStrem := TFileStream.Create(filename, fmCreate);
 186     try
 187         IdHTTP.Get(url, fileStrem);
 188         ResultMemo.Lines.Add(
 189             IdHttp.ResponseText + '(' + IntToStr(IdHttp.ResponseCode) + ')');
 190         FExecPath := filename;
 191         FExecArgs := '/SP- /silent /noicons "/dir=' + GikoSys.GetAppDir + '"';
 192         if CreateShortCut(
 193             execPath, execArgs, GetDesktopDir) then begin
 194             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');
 195             // 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');
 196         end else begin
 197             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');
 198         end;
 199
 200     finally
 201         fileStrem.Free;
 202     end;
 203 end;
 204 //! \83_\83E\83\93\83\8d\81[\83h\82µ\82½\83t\83@\83C\83\8b\82Ì\95Û\91¶\83p\83X
 205 function  TUpdateCheckForm.GetDownloadFilePath(FileName: String): String;
 206 var
 207     TempPath: array[0..MAX_PATH] of Char;
 208 begin
 209     GetTempPath(MAX_PATH, TempPath);
 210     Result := IncludeTrailingPathDelimiter(TempPath) + FileName;
 211 end;
 212
 213
 214 //! \83f\83X\83N\83g\83b\83v\82Ì\83p\83X\82ð\8eæ\93¾\82·\82é\8aÖ\90\94
 215 function  TUpdateCheckForm.GetDesktopDir:string;
 216 var
 217     DeskTopPath: array[0..MAX_PATH] of Char;
 218     pidl: PItemIDList;
 219 begin
 220     SHGetSpecialFolderLocation(Application.Handle, CSIDL_DESKTOP, pidl);
 221     SHGetPathFromIDList(pidl, DesktopPath);
 222     Result := DesktopPath;
 223 end;
 224
 225 //! \83V\83\87\81[\83g\83J\83b\83g\82ð\8dì\90¬\82·\82é\8aÖ\90\94
 226 function  TUpdateCheckForm.CreateShortCut(FileName, Argment, SavePath :string):boolean;
 227 //FileName\81c\83V\83\87\81[\83g\83J\83b\83g\82ð\8dì\90¬\82·\82é\83t\83@\83C\83\8b\96¼
 228 //SavePath\81c.lnk\83t\83@\83C\83\8b\82ð\8dì\90¬\82·\82é\83f\83B\83\8c\83N\83g\83\8a
 229 var
 230     SL :IShelllink;
 231     PF :IPersistFile;
 232     wFileName :WideString;
 233 begin
 234     Result :=false;
 235     //IUnKnown\83I\83u\83W\83F\83N\83g\82ð\8dì\90¬\82µ\82Ä\81AIShellLink\82É\83L\83\83\83X\83g
 236     SL :=CreateComObject(CLSID_ShellLink) as IShellLink;
 237     //IPersistFile \82É\83L\83\83\83X\83g
 238     PF :=SL as IPersistFile;
 239
 240     if (SL.SetPath(PChar(FileName)) <> NOERROR) then begin
 241         Exit;
 242     end;
 243     if (SL.SetWorkingDirectory(PChar(ExtractFilePath(FileName)))
 244                                    <> NOERROR ) then begin
 245         Exit;
 246     end;
 247     if (SL.SetArguments(PChar(Argment)) <> NOERROR) then begin
 248         Exit;
 249     end;
 250     if (SL.SetDescription(PChar('\83M\83R\83i\83r\8dX\90V')) <> NOERROR) then begin
 251         Exit;
 252     end;
 253
 254     //IPersistFile\82ÌSave\83\81\83\\83b\83h\82É\82ÍPWChar\8c^\82Ì\83p\83\89\83\81\81[\83^\82ª\95K\97v
 255     wFileName :=SavePath +'\\83M\83R\83i\83r\8dX\90V.lnk';
 256     //\83V\83\87\81[\83g\83J\83b\83g\82ð\8dì\90¬
 257     if (PF.Save(PWChar(wFileName),True) <> NOERROR) then begin
 258         Exit;
 259     end;
 260     Result :=true;
 261 end;
 262
 263 //! Form\83R\83\93\83X\83g\83\89\83N\83^
 264 procedure TUpdateCheckForm.FormCreate(Sender: TObject);
 265 begin
 266     ResultMemo.Lines.Clear;
 267     FExecPath := '';
 268     FExecArgs := '';
 269     FAllowshutdown := False;
 270 end;
 271
 272 end.