
// OnlineUpdate By Moonlight.
//   http://home.att.ne.jp/blue/moonlight/index.html
//   E-Mail: monlight@tkb.att.ne.jp

unit MainWin;

interface

{$WARN UNIT_PLATFORM OFF}
{$WARN SYMBOL_PLATFORM OFF}

uses
  Windows, SysUtils, Forms, ShellAPI,
  _CZip_Tools, _m_Tools,_netconst,_HTTPSocket, _SimpleDialog,
  Classes, Controls,StdCtrls, ExtCtrls, Graphics, ComCtrls;

const WM_CLOSE=$0010;

type
  TMain = class(TForm)
    StartupTimer: TTimer;
    ProcessTimer: TTimer;
    InfoLst: TListBox;
    Label1: TLabel;
    Label2: TLabel;
    BGFillImg: TImage;
    TitleImg: TImage;
    goHPShape: TShape;
    goHPLbl: TLabel;
    UpdateShape: TShape;
    UpdateLbl: TLabel;
    CloseShape: TShape;
    CloseLbl: TLabel;
    BGRightImg: TImage;
    CanvasImg: TImage;
    SharpShape: TShape;
    SharpLbl: TLabel;
    DownloadPrgBar: TProgressBar;
    InfoHedLbl: TLabel;
    InfoAppLbl: TLabel;
    InfoVerLbl: TLabel;
    DownloadTimer: TTimer;
    InfoImg: TImage;
    ChangeText: TMemo;
    procedure StartupTimerTimer(Sender: TObject);
    procedure ProcessTimerTimer(Sender: TObject);
    procedure InfoLstDblClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure goHPLblClick(Sender: TObject);
    procedure CloseLblClick(Sender: TObject);
    procedure UpdateLblClick(Sender: TObject);
    procedure SharpLblClick(Sender: TObject);
  private
    { Private 宣言 }
    procedure WriteLog(x:string);
    procedure InitProcess(mes:string);
    function ProcessRun1_GetNewUPD:boolean;
    function ProcessRun2_AnalizeNewUPD:boolean;
    function ProcessRun3_GetNewArchive:boolean;
    function ProcessRun4_CheckArchive:boolean;
    function ProcessRun5_FileCopy:boolean;
    function ProcessRun6_Stop:boolean;
  public
    { Public 宣言 }
    ProcessNo:integer;
    OldUPD,NewUPD:TUPD;
    StartDir:string;
    WinLeft,WinTop:integer;
    UpdateCheckOnly:boolean;
    HTTPSocket:THTTPSocket;
    NeedFile:TNeedFile;
    procedure onNetworkProgressStart(msg:string);
    procedure onNetworkProgressRefresh(RefStatus,RefProgress:boolean;Status:string;Size,Pos:integer);
    procedure onNetworkProgressEnd;
    procedure InfoChange(InfoNo:integer;msg:string);
    procedure ChangeBtnEnabled(var TargetLbl:TLabel;var TargetShape:TShape;mode:boolean);
    procedure SetChangeText(msg:string;Visible:boolean);
  end;

const BtnEnabledColor=$000000;
const BtnDisabledColor=$a0a0a0;

const InfoApplication=0;
const InfoOldVer=1;
const InfoNewVer=2;
const InfoUPDURL=3;
const InfoArchiveURL=4;
const InfoArchiveSize=5;
const InfoHPURL=6;
const InfoNull=7;
const InfoStatus=8;

var
  Main: TMain;

implementation

{$R *.dfm}

procedure TMain.WriteLog(x:string);
var
  Filename:string;
  T:TextFile;
begin
  if UpdateCheckOnly=True then exit;

  Filename:=ExtractFilePath(Application.ExeName)+'OnlineUpdate.log';
  AssignFile(T,Filename);
  if FileExists(Filename)=False then
    Rewrite(T)
    else
    Append(T);
  Writeln(T,FormatDateTime('c',now)+':'+x);
  Flush(T);
  CloseFile(T);
end;

procedure TMain.FormCreate(Sender: TObject);
var
  mx,my:integer;
  StartDir,ExeFilename,InstansFilename:string;
  param:string;
begin
  param:=ParamStr(1);

  if param='-UpdateCheckOnly' then begin
    UpdateCheckOnly:=True;
    end else begin
    UpdateCheckOnly:=False;
  end;

  WriteLog('');
  WriteLog('StartApplication.');

  StartDir:=ExtractFilePath(Application.ExeName);
  ExeFilename:=Application.ExeName;

  if param<>'-DirectBoot' then begin
    InstansFilename:=StartDir+'OnlineUpdate_Instans.exe';
    if lowercase(ExtractFilename(ExeFilename))<>'onlineupdate_instans.exe' then begin
      WriteLog('Boot OnlineUpdate.exe. ChangeProcess.');
      Main.Left:=-Main.Width;
      Main.Top:=-Main.Height;

      if FileExists(ExeFilename)=False then begin
        WriteLog('not ExistFile. ['+ExtractFilename(ExeFilename)+']');
        end else begin
        DeleteFile(InstansFilename);
        if FileExists(InstansFilename)=True then begin
          WriteLog('ApplicationReady.');
          ShowMessage('OnlineUpdate.exe','オンラインアップデートは既に起動しています。');
          end else begin
          WriteLog('ApplicationCopy to ['+ExtractFilename(InstansFilename)+']');
          CopyFile(pchar(ExeFilename),pchar(InstansFilename),False);
          WriteLog('boot ['+ExtractFilename(InstansFilename)+']');
          ShellExecute(0,'open',PChar(InstansFilename),pchar(param), nil,SW_SHOW);
        end;
      end;

      Application.Terminate;
      exit;
    end;
  end;

  Main.Left:=(Screen.Width-Main.Width) div 2;
  Main.Top:=(Screen.Height-Main.Height) div 2;
  Main.ClientHeight:=ChangeText.Top+ChangeText.Height+8;

  if UpdateCheckOnly=True then begin
    WinLeft:=Main.Left;
    WinTop:=Main.Top;
    Main.Left:=-Main.Left;
    Main.Top:=-Main.Width;
  end;

  with CanvasImg do begin
    Top:=0;
    Left:=0;
    Width:=Main.Width;
    Height:=Main.Height;
    Picture.Bitmap.PixelFormat:=pf24bit;
    Picture.Bitmap.Width:=Width;
    Picture.Bitmap.Height:=Height;
    Canvas.FillRect(Rect(0,0,Width,Height));
  end;

  with CanvasImg do begin
    for my:=0 to (Height div 60)+1 do begin
      for mx:=0 to (Width div 60)+1 do begin
        BitBlt(Canvas.Handle,mx*60,my*60,BGFillImg.Width,BGFillImg.Height,BGFillImg.Canvas.Handle,0,0,SRCCOPY);
      end;
      BitBlt(Canvas.Handle,Width-120,my*60,BGRightImg.Width,BGRightImg.Height,BGRightImg.Canvas.Handle,0,0,SRCCOPY);
    end;
  end;

  CanvasImg.Refresh;

  with goHPLbl do
    Top:=Top+(24-Height) div 2;
  with UpdateLbl do
    Top:=Top+(24-Height) div 2;
  with CloseLbl do
    Top:=Top+(24-Height) div 2;
  with SharpLbl do
    Top:=Top+(24-Height) div 2;

  ChangeBtnEnabled(goHPLbl,goHPShape,True);
  ChangeBtnEnabled(UpdateLbl,UpdateShape,False);
  ChangeBtnEnabled(CloseLbl,CloseShape,True);
  ChangeBtnEnabled(SharpLbl,SharpShape,True);

  Main.ClientHeight:=InfoLst.Top;

  HTTPSocket:=THTTPSocket.Create;
  HTTPSocket.Startup(False,15,onNetworkProgressStart,onNetworkProgressRefresh,onNetworkProgressEnd);

  StartupTimer.Enabled:=True;

  WriteLog('ApplicationCreated.');
end;

procedure TMain.ChangeBtnEnabled(var TargetLbl:TLabel;var TargetShape:TShape;mode:boolean);
begin
  if mode=True then begin
    TargetLbl.Font.Color:=BtnEnabledColor;
    TargetShape.Pen.Color:=BtnEnabledColor;
    end else begin
    TargetLbl.Font.Color:=BtnDisabledColor;
    TargetShape.Pen.Color:=BtnDisabledColor;
  end;
end;

procedure TMain.StartupTimerTimer(Sender: TObject);
var
  res:integer;
  SearchRec:TSearchRec;
begin
  StartupTimer.Enabled:=False;

  if UpdateCheckOnly=True then begin
    Main.Visible:=False;
  end;

  StartDir:=ExtractFilePath(Application.ExeName);

  res:=FindFirst(StartDir+'*.upd', (faReadOnly or faHidden or faSysFile or faArchive), SearchRec);
  FindClose(SearchRec);

  if res<>0 then begin
    WriteLog('UpdateInfomation not exists in LocalDrive.');
    if UpdateCheckOnly=False then ShowMessage('OnlineUpdate.exe','アップデート情報ファイルが見つかりませんでした。');
    Application.Terminate;
    exit;
  end;

  WriteLog('UpdateInfomationLoading... ['+SearchRec.Name+']');
  LoadUPDfromFile(OldUPD,StartDir+SearchRec.Name);
  WriteLog('UpdateInfomationLoaded.');

  WriteLog('UpdateInfomationRewriting...');

  InfoLst.Clear;
  InfoLst.DoubleBuffered:=True;

  InfoChange(InfoApplication,OldUPD.Application);
  InfoChange(InfoOldVer,format('%4.3f',[OldUPD.Version]));
  InfoChange(InfoNewVer,'不明');
  InfoChange(InfoUPDURL,OldUPD.UpdateURL);
  InfoChange(InfoArchiveURL,OldUPD.ArchiveURL);
  InfoChange(InfoArchiveSize,'不明');
  InfoChange(InfoHPURL,OldUPD.HomePageURL);
  InfoChange(InfoNull,'');
  InfoChange(InfoStatus,'新しいバージョンを探しています…');

  InitProcess('');

  WriteLog('RewritedUpdateInfomation.');

  ProcessTimer.Enabled:=True;
end;

procedure TMain.InfoChange(InfoNo:integer;msg:string);
var
  srcmes:string;
begin
  case InfoNo of
    InfoApplication: srcmes:='対象アプリケーション';
    InfoOldVer:      srcmes:='現在のバージョン';
    InfoNewVer:      srcmes:='新しいバージョン';
    InfoUPDURL:      srcmes:='情報ファイルURL';
    InfoArchiveURL:  srcmes:='アーカイブURL';
    InfoArchiveSize: srcmes:='アーカイブサイズ';
    InfoHPURL:       srcmes:='ホームページURL';
    InfoNull:        srcmes:='';
    InfoStatus:      srcmes:='状態：';
  end;

  if InfoNo>=InfoNull then begin
    InfoLst.Items[InfoNo]:=srcmes+msg;
    end else begin
    InfoLst.Items[InfoNo]:=srcmes+StringOfChar(' ',20-Length(srcmes))+' : '+msg;
  end;

  if InfoNo=InfoStatus then begin
    with InfoImg do begin
      BitBlt(Canvas.Handle,0,0,Width,Height,CanvasImg.Canvas.Handle,Left,Top,SRCCOPY);
      with Canvas.Font do begin
        Name:='Terminal';
        Size:=14;
      end;
      Canvas.Brush.Style:=bsClear;
      Canvas.TextOut(0,0,msg);
    end;
  end;

  InfoLst.Refresh;
end;

procedure TMain.InitProcess(mes:string);
begin
  WriteLog('ProcessInitialize.');

  ProcessNo:=0;
  ProcessTimer.Enabled:=False;
  ChangeBtnEnabled(UpdateLbl,UpdateShape,False);

  if mes<>'' then begin
    WriteLog('ProcessInitializeError. '+mes);
    if UpdateCheckOnly=False then ShowMessage('OnlineUpdate.exe',mes+CRLF+CRLF+'しばらくしてから再試行するか、ネットワークを再起動して下さい。'+CRLF+'それでも回復しない場合は、お手数ですがHP上からアップデートして下さい。');
    HTTPSocket.Free;
    Application.Terminate;
  end;
end;

procedure TMain.ProcessTimerTimer(Sender: TObject);
var
  Result:boolean;
begin
  if HTTPSocket.NetworkResult=ResultNowProcess then exit;
  if HTTPSocket.NetworkResult=ResultUserWait then exit;

  ProcessTimer.Enabled:=False;

  case HTTPSocket.NetworkResult of
    ResultFileSizeMismatch: begin
      WriteLog('NetworkError. ResultFileSizeMismatch.');
      InitProcess('ファイルサイズ異常により続行できません。');
      exit;
    end;
    ResultFlleCheckSumMismatch: begin
      WriteLog('NetworkError. ResultFlleCheckSumMismatch.');
      InitProcess('ファイルチェックサム異常により続行できません。');
      exit;
    end;
    ResultFileTransferError: begin
      WriteLog('NetworkError. ResultFileTransferError.');
      InitProcess('ファイル転送が異常終了しました。続行できません。');
      exit;
    end;
    ResultTimeout:begin
      WriteLog('NetworkError. ResultTimeout.');
      InitProcess('ネットワークが規定時間内に応答しませんでした。');
      exit;
    end;
    Result404Error:begin
      WriteLog('NetworkError. Result404Error.');
      InitProcess('ネットワーク上のファイルが見つかりませんでした。');
      exit;
    end;
    ResultSocketError: begin
      WriteLog('NetworkError. ResultSocketError.');
      InitProcess('ソケットが無効です。ネットワーク接続を確認して下さい。');
      exit;
    end;
    ResultNetworkError: begin
      WriteLog('NetworkError. ResultNetworkError.');
      InitProcess('ネットワークエラーにより続行できません。'+CRLF+'NetworkStatus:('+inttostr(HTTPSocket.NetworkErrorCode)+')'+HTTPSocket.NetworkErrorMessage);
      exit;
    end;
  end;

  inc(ProcessNo);

  WriteLog('ProcessNo.'+IntToStr(ProcessNo)+' Start.');
  case ProcessNo of
    1: Result:=ProcessRun1_GetNewUPD;
    2: Result:=ProcessRun2_AnalizeNewUPD;
    3: Result:=ProcessRun3_GetNewArchive;
    4: Result:=ProcessRun4_CheckArchive;
    5: Result:=ProcessRun5_FileCopy;
    6: Result:=ProcessRun6_Stop;
    else
    WriteLog('ProcessNo.'+IntToStr(ProcessNo)+' IlligalFunctionCall.');
    if UpdateCheckOnly=False then ShowMessage('OnlineUpdate.exe','規定外の関数が呼ばれました。'+CRLF+'アップデーターを再起動して下さい。'+CRLF+'プロセス番号:'+inttostr(ProcessNo));
    HTTPSocket.Free;
    Application.Terminate;
    Result:=False;
  end;

  ProcessTimer.Enabled:=Result;
end;

function TMain.ProcessRun1_GetNewUPD:boolean;
begin
  with NeedFile do begin
    Port:=OldUPD.Port;
    Host:=OldUPD.Host;
    URL:=OldUPD.UpdateURL;
    UserAgent:=OldUPD.UserAgent;
    WriteFileSize:=0;
    WriteFileCheckSum:=0;
    WriteFilename:='';
  end;
  WriteLog('GetHTTPFile.');
  HTTPSocket.SetNeedFile(NeedFile);
  HTTPSocket.GetHTTPFile('');

  Result:=True;
end;

function TMain.ProcessRun2_AnalizeNewUPD:boolean;
begin
  WriteLog('LoadUPDfromBuffer.');

  LoadUPDfromBuffer(NewUPD,HTTPSocket.Buffer,HTTPSocket.BufferCount);

  WriteLog('AnalizeNewUPD.');

  InfoChange(InfoNewVer,format('%4.3f',[NewUPD.Version]));
  InfoChange(InfoUPDURL,NewUPD.UpdateURL);
  InfoChange(InfoArchiveURL,NewUPD.ArchiveURL);
  InfoChange(InfoArchiveSize,IntToStr(NewUPD.FileSize));
  InfoChange(InfoHPURL,NewUPD.HomePageURL);

  if OldUPD.Application<>NewUPD.Application then begin
    ChangeBtnEnabled(UpdateLbl,UpdateShape,False);
    InfoChange(InfoStatus,'オンラインアップデートが無効になっています。'+CRLF+'ホームページ状の情報を参照して下さい。');
    end else begin
    ChangeBtnEnabled(UpdateLbl,UpdateShape,True);
    if OldUPD.Version>=NewUPD.Version then begin
      InfoChange(InfoStatus,'新しいバージョンは見つかりませんでした。');
      SetChangeText(NewUPD.UpdateText,False);
      end else begin
      InfoChange(InfoStatus,'新しいバージョンが見つかりました。更新をお勧めします。');
      InfoHedLbl.Visible:=True;
      InfoAppLbl.Caption:=NewUPD.Application;
      InfoAppLbl.Visible:=True;
      InfoVerLbl.Caption:=format('ver %4.3f から ver %4.3f に更新',[OldUPD.Version,NewUPD.Version]);
      InfoVerLbl.Visible:=True;
      SetChangeText(NewUPD.UpdateText,True);
    end;
  end;

  if UpdateCheckOnly=True then begin
    if OldUPD.Application<>NewUPD.Application then begin
      WriteLog('Invalid ApplicationName.');
      HTTPSocket.Free;
      Application.Terminate;
      Result:=False;
      exit;
      end else begin
      if OldUPD.Version>=NewUPD.Version then begin
        WriteLog('not found NewVersion.');
        HTTPSocket.Free;
        Application.Terminate;
        Result:=False;
        exit;
        end else begin
        Main.Left:=WinLeft;
        Main.Top:=WinTop;
        Main.Visible:=True;
        Main.Refresh;
      end;
    end;
  end;

  WriteLog('end of AnalizeNewUPD.');

  UpdateCheckOnly:=False;

  HTTPSocket.NetworkResult:=ResultUserWait;
  Result:=True;
end;

function TMain.ProcessRun3_GetNewArchive:boolean;
var
  Wnd:hwnd;
begin
  InfoHedLbl.Visible:=False;
  InfoAppLbl.Visible:=False;
  InfoVerLbl.Visible:=False;

  WriteLog('Check and Exit HostApplication.');

  if NewUPD.WindowTitle<>'' then begin
    Wnd:=FindWindow(pchar(NewUPD.WindowClass),pchar(NewUPD.WindowTitle));
    while (Wnd<>0) do begin
      if MessageDlgisOK('OnlineUpdate.exe',NewUPD.WindowTitle+'が起動中です。'+CRLF+'OKボタンを押すと、'+NewUPD.WindowTitle+'を終了させて続行します。',MB_Warrning)=False then begin
        InitProcess('アップデートを中断しました。'+NewUPD.WindowTitle+'を終了してから再試行して下さい。');
        Result:=False;
        exit;
      end;
      Wnd:=FindWindow(pchar(NewUPD.WindowClass),pchar(NewUPD.WindowTitle));
      if Wnd<>0 then begin
        PostMessage(Wnd,WM_CLOSE,0,0);
        Sleep(500);
        Wnd:=FindWindow(pchar(NewUPD.WindowClass),pchar(NewUPD.WindowTitle));
        if Wnd<>0 then begin
          Sleep(500);
          Wnd:=FindWindow(pchar(NewUPD.WindowClass),pchar(NewUPD.WindowTitle));
          if Wnd<>0 then begin
            Sleep(500);
            Wnd:=FindWindow(pchar(NewUPD.WindowClass),pchar(NewUPD.WindowTitle));
            if Wnd<>0 then begin
              Sleep(500);
              Wnd:=FindWindow(pchar(NewUPD.WindowClass),pchar(NewUPD.WindowTitle));
            end;
          end;
        end;
        if Wnd=0 then Sleep(1000);
      end;
    end;
    WriteLog('Exit.');
  end;

  WriteLog('Checked.');

  InfoChange(InfoStatus,'新しいバージョンをダウンロードしています…');

  with NeedFile do begin
    Port:=NewUPD.Port;
    if FileExists(StartDir+'NetworkDebugEnabled.dat')=False then begin
      Host:=NewUPD.Host;
      end else begin
      Host:='Saga';
    end;
    URL:=MChangeFileExt(NewUPD.ArchiveURL,'.czip');
    UserAgent:=NewUPD.UserAgent;
    WriteFileSize:=NewUPD.FileSize;
    WriteFileCheckSum:=NewUPD.FileCheckSum;
    WriteFilename:=MChangeFileExt(StartDir+NewUPD.Filename,'.czip');
  end;
  WriteLog('DownloadNewVersionCZip. ['+NeedFile.URL+']');
  HTTPSocket.SetNeedFile(NeedFile);
  HTTPSocket.GetHTTPFile('');
  WriteLog('DownLoad Complite.');

  DownloadTimer.Enabled:=True;
  DownloadPrgBar.Position:=0;
  DownloadPrgBar.Visible:=True;

  Result:=True;
end;

function TMain.ProcessRun4_CheckArchive:boolean;
var
  res:integer;
begin
  DownloadTimer.Enabled:=False;
  DownloadPrgBar.Visible:=False;

  // 展開先の確認
  WriteLog('Check LocalExtractFolder.');
  InfoChange(InfoStatus,'展開先フォルダを確認しています…');
  if DirectoryExists(StartDir+NewUPD.BasePath+'\')=True then begin
    if MessageDlgisOK('OnlineUpdate.exe','一時展開フォルダが残っています。削除してもいいですか？'+CRLF+'['+StartDir+NewUPD.BasePath+'\]',MB_Warrning)=False then begin
      InitProcess('アップデートを中断しました。フォルダを削除してから再試行して下さい。');
      Result:=False;
      exit;
    end;
    DeleteFolder(StartDir+NewUPD.BasePath+'\');
  end;

  WriteLog('OverrideCheck DownloadCZip.');
  InfoChange(InfoStatus,'アーカイブの解凍先を確認しています…');
  res:=CZipOverrideCheck(NeedFile.WriteFilename,StartDir);
  if res<>CZipDecompressSuccess then begin
    case res of
      CZipDecompressFileSizeError: begin
        WriteLog('ExtractError. CZipDecompressFileSizeError.');
        ShowMessage('OnlineUpdate.exe','ファイルサイズが異常です。');
      end;
      CZipDecompressCRCError: begin
        WriteLog('ExtractError. CZipDecompressCRCError.');
        ShowMessage('OnlineUpdate.exe','ファイルCRCが異常です。');
      end;
      CZipDecompressDecompressError: begin
        WriteLog('ExtractError. CZipDecompressDecompressError.');
        ShowMessage('OnlineUpdate.exe','解凍エラーです。');
      end;
      CZipDecompressAttrError: begin
        WriteLog('ExtractError. CZipDecompressAttrError.');
        ShowMessage('OnlineUpdate.exe','MDXWinが正常に終了しなかったか、他のプロセスが使用中の可能性があります。'+CRLF+'確実な方法の一例として、Windowsを再起動後、MDXWinを起動せずに直接OnlineUpdate.exeを起動してみて下さい。'+CRLF+'それでも改善しない場合はお手数ですが、MoonlightまでOnlineUpdate.logを添付メールして頂けるとありがたいです。');
      end;
      else begin
        WriteLog('ExtractError. CZipDecompress InvalidError.[code:'+IntToStr(res)+']');
        ShowMessage('OnlineUpdate.exe','未定義エラー');
      end;
    end;
    Result:=False;
    exit;
  end;

  WriteLog('Extract DownloadCZip.');
  InfoChange(InfoStatus,'ダウンロードしたアーカイブを解凍しています…');
  res:=CZipDecompress(NeedFile.WriteFilename,StartDir+NewUPD.BasePath+'\');
  if res<>CZipDecompressSuccess then begin
    case res of
      CZipDecompressFileSizeError: begin
        WriteLog('ExtractError. CZipDecompressFileSizeError.');
        ShowMessage('OnlineUpdate.exe','ファイルサイズが異常です。');
      end;
      CZipDecompressCRCError: begin
        WriteLog('ExtractError. CZipDecompressCRCError.');
        ShowMessage('OnlineUpdate.exe','ファイルCRCが異常です。');
      end;
      CZipDecompressDecompressError: begin
        WriteLog('ExtractError. CZipDecompressDecompressError.');
        ShowMessage('OnlineUpdate.exe','解凍エラーです。');
      end;
      CZipDecompressAttrError: begin
        WriteLog('ExtractError. CZipDecompressAttrError.');
        ShowMessage('OnlineUpdate.exe','MDXWinが正常に終了しなかったか、他のプロセスが使用中の可能性があります。'+CRLF+'確実な方法の一例として、Windowsを再起動後、MDXWinを起動せずに直接OnlineUpdate.exeを起動してみて下さい。'+CRLF+'それでも改善しない場合はお手数ですが、MoonlightまでOnlineUpdate.logを添付メールして頂けるとありがたいです。');
      end;
      CZipDecompressWriteError: begin
        WriteLog('ExtractError. CZipDecompressWriteError.');
        ShowMessage('OnlineUpdate.exe','書き込みに失敗しました。');
      end;
      else begin
        WriteLog('ExtractError. CZipDecompress InvalidError.[code:'+IntToStr(res)+']');
        ShowMessage('OnlineUpdate.exe','未定義エラー');
      end;
    end;
    Result:=False;
    exit;
  end;

  WriteLog('Extract Complite.');

  Result:=True;
end;

function TMain.ProcessRun5_FileCopy:boolean;
begin
  WriteLog('RealFileCopy.');

  InfoChange(InfoStatus,'ファイルをコピーしています…');

  CopyFolder(StartDir+NewUPD.BasePath+'\',StartDir);
  DeleteFolder(StartDir+NewUPD.BasePath+'\');

  UpdateLbl.Caption:='起動';
  ChangeBtnEnabled(UpdateLbl,UpdateShape,True);

  WriteLog('RealFileCopied.');

  Result:=True;
end;

function TMain.ProcessRun6_Stop:boolean;
begin
  WriteLog('OnlineUpdateComplite.');

  InfoChange(InfoStatus,'アップデートが完了しました。');
  Main.ClientHeight:=InfoLst.Top;
  Result:=False;
end;

procedure TMain.InfoLstDblClick(Sender: TObject);
begin
  if InfoLst.ItemIndex=InfoHPURL then goHPLblClick(Sender);
end;

procedure TMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  if HTTPSocket.NetworkResult=ResultNowProcess then begin
    WriteLog('UserClick UpdateClose.');
    if MessageDlgisOK('OnlineUpdate.exe','アップデート処理中です。強制中断してもよろしいですか？',MB_Warrning)=False then begin
      CanClose:=False;
      exit;
    end;
  end;

  WriteLog('OnlineUpdate Terminate.');

  Main.Visible:=True;
  Application.ProcessMessages;
  HTTPSocket.Free;

  WriteLog('OnlineUpdate Terminated.');

  CanClose:=True;
end;

procedure TMain.goHPLblClick(Sender: TObject);
var
  URL:string;
begin
  URL:=OldUPD.HomePageURL;
  WriteLog('UserClick OpenHomePage. ['+URL+']');
  ShellExecute(0,'open',PChar(URL),nil, nil,SW_SHOW);
end;

procedure TMain.CloseLblClick(Sender: TObject);
begin
  Main.Close;
end;

procedure TMain.UpdateLblClick(Sender: TObject);
var
  Filename:string;
begin
  if UpdateLbl.Font.Color<>BtnEnabledColor then exit;

  if UpdateLbl.Caption='起動' then begin
    Filename:=ExtractFilePath(Application.ExeName)+'MDXWin.exe';
    ShellExecute(0,'open',PChar(Filename),pchar(''), nil,SW_SHOW);
    Main.Close;
    end else begin
    HTTPSocket.NetworkResult:=ResultSuccess;
    ChangeBtnEnabled(UpdateLbl,UpdateShape,False);
  end;
end;

procedure TMain.SharpLblClick(Sender: TObject);
begin
  if Main.ClientHeight=InfoLst.Top then
    Main.ClientHeight:=ChangeText.Top+ChangeText.Height+8
    else
    Main.ClientHeight:=InfoLst.Top;
end;

procedure TMain.onNetworkProgressStart(msg:string);
begin
  exit;
end;

procedure TMain.onNetworkProgressRefresh(RefStatus,RefProgress:boolean;Status:string;Size,Pos:integer);
begin
  if RefStatus=True then begin
    InfoChange(InfoStatus,Status);
    Application.ProcessMessages;
  end;

  if RefProgress=True then begin
    if DownloadPrgBar.Max<>Size then begin
      DownloadPrgBar.Min:=0;
      DownloadPrgBar.Position:=0;
      DownloadPrgBar.Max:=Size;
    end;
    DownloadPrgBar.Position:=Pos;
  end;
end;

procedure TMain.onNetworkProgressEnd;
begin
  exit;
end;

procedure TMain.SetChangeText(msg:string;Visible:boolean);
var
  dst:string;
begin
  dst:=CRLF;

  while (ansipos('\',msg)<>0) do begin
    dst:=dst+copy(msg,1,ansipos('\',msg)-1)+CRLF;
    msg:=copy(msg,ansipos('\',msg)+1,Length(msg));
  end;
  dst:=dst+msg+CRLF;

  ChangeText.Text:=dst;

  if Visible=True then begin
    Main.ClientHeight:=ChangeText.Top+ChangeText.Height+8;
  end;
end;

end.
