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     procedure UpdateButtonClick(Sender: TObject);
  19     procedure FormCreate(Sender: TObject);
  20   private
  21     { Private \90é\8c¾ }
  22     function  GetDesktopDir:string;
  23     function  GetDownloadFilePath(FileName: String): String;
  24     function  CreateShortCut(FileName, Argment, SavePath :string):boolean;
  25     procedure DonwloadUpdate(url: String);
  26   public
  27     { Public \90é\8c¾ }
  28   end;
  29
  30 var
  31   UpdateCheckForm: TUpdateCheckForm;
  32
  33 implementation
  34 uses
  35     GikoSystem, NewBoard, Giko, IniFiles, MojuUtils, GikoDataModule,
  36     ActiveX, ComObj, ShlObj;
  37
  38 {$R *.dfm}
  39
  40 procedure TUpdateCheckForm.UpdateButtonClick(Sender: TObject);
  41 const
  42         CHECK_URL = 'http://gikonavi.sourceforge.jp/updater/latest.txt';
  43 var
  44     value : string;
  45         ResStream: TMemoryStream;
  46     downResult, current, newest: TStringList;
  47 begin
  48     ResultMemo.Lines.Clear;
  49     Screen.Cursor := crHourGlass;
  50     UpdateButton.Enabled := False;
  51
  52     try
  53         ResStream := TMemoryStream.Create;
  54         try
  55             TNewBoardDialog.InitHTTPClient(IdHTTP);
  56             IdHTTP.Request.Referer := '';
  57             IdHTTP.Request.AcceptEncoding := 'gzip';
  58
  59             IdHTTP.Request.CacheControl := 'no-cache';
  60             IdHTTP.Request.CustomHeaders.Add('Pragma: no-cache');
  61             IdHTTP.HandleRedirects := true;
  62             downResult := TStringList.Create;
  63             newest     := TStringList.Create;
  64             current    := TStringList.Create;
  65             IdAntiFreeze.Active := true;
  66             try
  67                 try
  68                     ResStream.Clear;
  69                     IdHTTP.Get(CHECK_URL, ResStream);
  70                     value := GikoSys.GzipDecompress(ResStream,
  71                             IdHTTP.Response.ContentEncoding);
  72                     downResult.Text := value;
  73                     newest.Text := MojuUtils.CustomStringReplace(downResult.Values[ 'version' ],
  74                                         '.', #10, false);
  75                     current.Text := MojuUtils.CustomStringReplace(GikoSys.Version,
  76                                         '.', #10, false);
  77                     if newest.Count >= 2 then begin
  78                         if ( StrToInt(current[1]) < StrToInt(newest[1]) ) or
  79                            ( (StrToInt(current[1]) = StrToInt(newest[1]))) and
  80                            ((StrToInt(current[2]) < StrToInt(newest[2])) ) then begin
  81                             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' ]);
  82
  83                             DonwloadUpdate(Trim(downResult.Values[ 'url' ]));
  84                         end else begin
  85                             ResultMemo.Lines.Add('\8d¡\82Ì\83M\83R\83i\83r\82ª\8dÅ\90V\82Å\82·\81B');
  86                         end;
  87                     end else begin
  88                         ResultMemo.Lines.Add('\8d¡\82Ì\83M\83R\83i\83r\82ª\8dÅ\90V\82Å\82·\81B');
  89                     end;
  90                 except
  91                     on E: Exception do begin
  92                         ResultMemo.Lines.Add(E.Message);
  93                         {$IFDEF DEBUG}
  94                         Writeln(IdHTTP.ResponseText);
  95                         {$ENDIF}
  96                     end;
  97                 end;
  98             finally
  99                 current.free;
 100                 newest.free;
 101                 downResult.Free;
 102                 IdAntiFreeze.Active := false;
 103             end;
 104         finally
 105             ResStream.Clear;
 106             ResStream.Free;
 107         end;
 108     finally
 109         UpdateButton.Enabled := True;
 110         Screen.Cursor := crDefault;
 111     end;
 112
 113 end;
 114
 115 //! \83A\83b\83v\83f\81[\83g\83_\83E\83\93\83\8d\81[\83h
 116 procedure TUpdateCheckForm.DonwloadUpdate(url: String);
 117 var
 118     filename : String;
 119     fileStrem: TFileStream;
 120 begin
 121     filename := GetDownloadFilePath(Copy(url, LastDelimiter('/', url) + 1,  Length(url)));
 122     fileStrem := TFileStream.Create(filename, fmCreate);
 123     try
 124         IdHTTP.Get(url, fileStrem);
 125         ResultMemo.Lines.Add(
 126             IdHttp.ResponseText + '(' + IntToStr(IdHttp.ResponseCode) + ')');
 127         if CreateShortCut(
 128             filename,
 129             '/SP- /silent /noicons "/dir=' + GikoSys.GetAppDir + '"'
 130             , GetDesktopDir) then begin
 131             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');
 132             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');
 133         end else begin
 134             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');
 135         end;
 136
 137     finally
 138         fileStrem.Free;
 139     end;
 140 end;
 141 //! \83_\83E\83\93\83\8d\81[\83h\82µ\82½\83t\83@\83C\83\8b\82Ì\95Û\91¶\83p\83X
 142 function  TUpdateCheckForm.GetDownloadFilePath(FileName: String): String;
 143 var
 144     TempPath: array[0..MAX_PATH] of Char;
 145 begin
 146     GetTempPath(MAX_PATH, TempPath);
 147     Result := IncludeTrailingPathDelimiter(TempPath) + FileName;
 148 end;
 149
 150
 151 //! \83f\83X\83N\83g\83b\83v\82Ì\83p\83X\82ð\8eæ\93¾\82·\82é\8aÖ\90\94
 152 function  TUpdateCheckForm.GetDesktopDir:string;
 153 var
 154     DeskTopPath: array[0..MAX_PATH] of Char;
 155     pidl: PItemIDList;
 156 begin
 157     SHGetSpecialFolderLocation(Application.Handle, CSIDL_DESKTOP, pidl);
 158     SHGetPathFromIDList(pidl, DesktopPath);
 159     Result := DesktopPath;
 160 end;
 161
 162 //! \83V\83\87\81[\83g\83J\83b\83g\82ð\8dì\90¬\82·\82é\8aÖ\90\94
 163 function  TUpdateCheckForm.CreateShortCut(FileName, Argment, SavePath :string):boolean;
 164 //FileName\81c\83V\83\87\81[\83g\83J\83b\83g\82ð\8dì\90¬\82·\82é\83t\83@\83C\83\8b\96¼
 165 //SavePath\81c.lnk\83t\83@\83C\83\8b\82ð\8dì\90¬\82·\82é\83f\83B\83\8c\83N\83g\83\8a
 166 var
 167     SL :IShelllink;
 168     PF :IPersistFile;
 169     wFileName :WideString;
 170 begin
 171     Result :=false;
 172     //IUnKnown\83I\83u\83W\83F\83N\83g\82ð\8dì\90¬\82µ\82Ä\81AIShellLink\82É\83L\83\83\83X\83g
 173     SL :=CreateComObject(CLSID_ShellLink) as IShellLink;
 174     //IPersistFile \82É\83L\83\83\83X\83g
 175     PF :=SL as IPersistFile;
 176
 177     if (SL.SetPath(PChar(FileName)) <> NOERROR) then begin
 178         Exit;
 179     end;
 180     if (SL.SetWorkingDirectory(PChar(ExtractFilePath(FileName)))
 181                                    <> NOERROR ) then begin
 182         Exit;
 183     end;
 184     if (SL.SetArguments(PChar(Argment)) <> NOERROR) then begin
 185         Exit;
 186     end;
 187     if (SL.SetDescription(PChar('\83M\83R\83i\83r\8dX\90V')) <> NOERROR) then begin
 188         Exit;
 189     end;
 190
 191     //IPersistFile\82ÌSave\83\81\83\\83b\83h\82É\82ÍPWChar\8c^\82Ì\83p\83\89\83\81\81[\83^\82ª\95K\97v
 192     wFileName :=SavePath +'\\83M\83R\83i\83r\8dX\90V.lnk';
 193     //\83V\83\87\81[\83g\83J\83b\83g\82ð\8dì\90¬
 194     if (PF.Save(PWChar(wFileName),True) <> NOERROR) then begin
 195         Exit;
 196     end;
 197     Result :=true;
 198 end;
 199
 200 //! Form\83R\83\93\83X\83g\83\89\83N\83^
 201 procedure TUpdateCheckForm.FormCreate(Sender: TObject);
 202 begin
 203     ResultMemo.Lines.Clear;
 204 end;
 205
 206 end.