{* * This application launches the dmdirc java-based installer. * * DMDirc - Open Source IRC Client * Copyright (c) 2006-2008 Chris Smith, Shane Mc Cormack, Gregory Holmes * * Permission is hereby granted, free of charge, to any person obtaining a copy * of this software and associated documentation files (the "Software"), to deal * in the Software without restriction, including without limitation the rights * to use, copy, modify, merge, publish, distribute, sublicense, and/or sell * copies of the Software, and to permit persons to whom the Software is * furnished to do so, subject to the following conditions: * * The above copyright notice and this permission notice shall be included in * all copies or substantial portions of the Software. * * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, * OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE * SOFTWARE. *} program Setup; {$R most.res} {$IFDEF FPC} {$MODE Delphi} {$ENDIF} // Use this instead of {$APPTYPE XXX} // APP_XXX is the same as {$APPTYPE XXX} // Defaults to console // This is a work-around for a bug in FPC Cross Compiling to windows in delphi // mode (IsConsole is always true) {$DEFINE APP_GUI} // This block actually does the work for the above work-around {$IFDEF APP_GUI} {$APPTYPE GUI} {$ELSE} {$IFDEF APP_FS} {$APPTYPE FS} {$ELSE} {$IFDEF APP_TOOL} {$DEFINE APP_CONSOLE} {$APPTYPE TOOL} {$ELSE} {$DEFINE APP_CONSOLE} {$APPTYPE CONSOLE} {$ENDIF} {$ENDIF} {$ENDIF} // If this is defined, lazarus-specific code (gui progress bar) will be compiled // without it, a wget console window will be used for progress instead. // This is automatically set by the build script when lazarus is detected in /usr/lib/lazarus // You can forcibly define or undefine it here. // {$DEFINE LAZARUS} // {$UNDEF LAZARUS} uses {$IFDEF LAZARUS}Interfaces, Forms, ComCtrls, Buttons, Messages, Controls, StdCtrls, {$ENDIF} Vista, Windows, SysUtils, classes, registry, strutils {$IFNDEF FPC},masks{$ENDIF}; {$IFDEF LAZARUS} type TProgressForm = class(TForm) ProgressBar: TProgressBar; CancelButton: TButton; CaptionLabel: TLabel; constructor Create(AOwner: TComponent); override; private procedure onButtonClick(Sender: TObject); public procedure setProgress(value: integer); end; {$ENDIF} const {$I SetupConsts.inc} // This is also part of the above work-around. {$IFDEF APP_CONSOLE} IsConsole: boolean = true; {$ELSE} IsConsole: boolean = false; {$ENDIF} var {$IFDEF LAZARUS} form: TProgressForm; {$ENDIF} terminateDownload: boolean = false; {$IFDEF LAZARUS} constructor TProgressForm.Create(AOwner: TComponent); begin inherited; self.Width := 500; self.Height := 80; self.Position := poScreenCenter; self.BorderStyle := bsSingle; CaptionLabel := TLabel.create(self); CaptionLabel.Parent := self; CaptionLabel.Width := 490; CaptionLabel.Height := 15; CaptionLabel.Top := 5; CaptionLabel.Left := 5; CaptionLabel.Caption := 'Downloading JRE - 0%'; ProgressBar := TProgressBar.create(self); ProgressBar.Parent := self; ProgressBar.Width := 490; ProgressBar.Height := 20; ProgressBar.Top := CaptionLabel.Top+CaptionLabel.Height+5; ProgressBar.Left := 5; ProgressBar.Visible := true; ProgressBar.Max := 100; ProgressBar.Position := 0; CancelButton := TButton.create(self); CancelButton.Parent := self; CancelButton.Width := 80; CancelButton.Height := 25; CancelButton.Top := ProgressBar.Top+ProgressBar.Height+5; CancelButton.Left := Round((self.Width/2) - (CancelButton.Width/2)); CancelButton.Visible := true; CancelButton.Caption := 'Cancel'; CancelButton.onClick := self.onButtonClick; self.Caption := pChar('DMDirc Setup'); Application.Title := self.Caption; SetVistaFonts(self); end; procedure TProgressForm.onButtonClick(Sender: TObject); begin terminateDownload := true; end; procedure TProgressForm.setProgress(value: integer); begin ProgressBar.Position := value; CaptionLabel.Caption := pchar('Downloading JRE - '+inttostr(value)+'%'); self.Caption := pChar('DMDirc Setup - '+CaptionLabel.Caption); Application.Title := self.Caption; end; {$ENDIF} function askQuestion(Question: String): boolean; begin Result := TaskDialog(0, 'DMDirc Setup', 'Question', Question, TD_ICON_QUESTION, TD_BUTTON_YES + TD_BUTTON_NO) = mrYes; end; procedure showError(ErrorMessage: String; addFooter: boolean = true; includeDescInXP: boolean = true); begin if IsConsole then begin writeln(''); writeln('-----------------------------------------------------------------------'); writeln('Sorry, setup is unable to continue.!'); writeln('-----------------------------------------------------------------------'); writeln('Reason:'); writeln('----------'); writeln(ErrorMessage); if addFooter then begin writeln('-----------------------------------------------------------------------'); writeln('If you feel this is incorrect, or you require some further assistance,'); writeln('please feel free to contact us.'); end; writeln('-----------------------------------------------------------------------'); readln; end else begin if addFooter then begin ErrorMessage := ErrorMessage+#13#10; ErrorMessage := ErrorMessage+#13#10+'If you feel this is incorrect, or you require some further assistance,'; if not IsWindowsVista then ErrorMessage := ErrorMessage+#13#10; ErrorMessage := ErrorMessage+'please feel free to contact us.'; end; TaskDialog(0, 'DMDirc Setup', 'Sorry, setup is unable to continue.', ErrorMessage, TD_ICON_ERROR, TD_BUTTON_OK, includeDescInXP, false); end; end; procedure showmessage(message: String; context:String = 'Information'); begin if IsConsole then begin writeln(''); writeln('-----------------------------------------------------------------------'); writeln(context+':'); writeln('-----------------------------------------------------------------------'); writeln(message); writeln('-----------------------------------------------------------------------'); readln; end else begin TaskDialog(0, 'DMDirc Setup', context, message, TD_ICON_INFORMATION, TD_BUTTON_OK); end; end; // Run an application and don't wait for it to finish. function Launch(sProgramToRun: String; hide: boolean = false): TProcessInformation; var StartupInfo: TStartupInfo; begin FillChar(StartupInfo, SizeOf(TStartupInfo), 0); with StartupInfo do begin cb := SizeOf(TStartupInfo); dwFlags := STARTF_USESHOWWINDOW; if hide then wShowWindow := SW_HIDE else wShowWindow := SW_SHOWNORMAL; end; CreateProcess(nil, PChar(sProgramToRun), nil, nil, False, NORMAL_PRIORITY_CLASS, nil, nil, StartupInfo, Result); end; // Run an application and wait for it to finish. function ExecAndWait(sProgramToRun: String; hide: boolean = false): Longword; var ProcessInfo: TProcessInformation; begin ProcessInfo := Launch(sProgramToRun, hide); getExitCodeProcess(ProcessInfo.hProcess, Result); while Result=STILL_ACTIVE do begin sleep(1000); GetExitCodeProcess(ProcessInfo.hProcess, Result); end; end; procedure dowriteln(line: String); begin if IsConsole then writeln(line); end; procedure dowrite(line: String); begin if IsConsole then write(line); end; function GetFileSizeByName(name: String): Integer; var hand: THandle; begin hand := 0; Result := 0; if FileExists(name) then begin try hand := CreateFile(PChar(name), GENERIC_READ, FILE_SHARE_WRITE or FILE_SHARE_READ, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0); Result := GetFileSize(hand, nil); finally try if (hand <> 0) then CloseHandle(hand); except Result := -1; end; end; end; end; function DoMatch(Input: String; Wildcard: String): boolean; begin {$ifdef FPC} Result := IsWild(Input,Wildcard,True); {$else} Result := MatchesMask(Input,Wildcard); {$endif} end; {$IFNDEF VER150} function AnsiMidStr(Source: String; Start: Integer; Count: Integer): String; begin // Not perfectly accurate, but does the job Result := Copy(Source, Start, Count); end; {$ENDIF} function downloadJRE(message: String = 'Would you like to download the java JRE?'): boolean; var ProcessInfo: TProcessInformation; processResult: Longword; url: String; dir: String; line: String; f: TextFile; bits: TStringList; match: boolean; {$IFDEF LAZARUS} wantedsize: double; currentsize: double; {$ENDIF} begin dir := IncludeTrailingPathDelimiter(ExtractFileDir(paramstr(0))); url := 'http://www.dmdirc.com/getjava/windows/all'; Result := false; ExecAndWait('wget.exe -o '+dir+'wgetoutput --spider '+url, true); AssignFile(f, dir+'wgetoutput'); Reset(f); line := ''; match := false; while not Eof(f) do begin ReadLn(f, line); match := DoMatch(line,'Length:*'); if match then break; end; if match then begin bits := TStringList.create; try bits.Clear; bits.Delimiter := ' '; bits.DelimitedText := line; {$IFDEF LAZARUS} try wantedsize := strtoint(StringReplace(bits[1], ',', '', [rfReplaceAll])) except wantedsize := 0; end; {$ENDIF} if askQuestion(message+' (Download Size: '+AnsiMidStr(bits[2], 2, length(bits[2])-2)+')') then begin {$IFDEF LAZARUS} ProcessInfo := Launch('wget.exe '+url+' -O jre.exe', true); form.show(); if wantedsize <= 0 then begin form.setProgress(50); end; {$ELSE} ProcessInfo := Launch('wget.exe '+url+' -O jre.exe'); {$ENDIF} getExitCodeProcess(ProcessInfo.hProcess, processResult); while (processResult=STILL_ACTIVE) and (not terminateDownload) do begin // Update progress bar. {$IFDEF LAZARUS} if wantedsize > 0 then begin currentsize := GetFileSizeByName('jre.exe'); if (currentsize > 0) then form.setProgress(Round((currentsize/wantedsize)*100)); end; Application.ProcessMessages; {$ENDIF} sleep(10); GetExitCodeProcess(ProcessInfo.hProcess, processResult); end; {$IFDEF LAZARUS}form.hide();{$ENDIF} if (terminateDownload) then begin Result := false; {$IFDEF LAZARUS} TerminateProcess(ProcessInfo.hProcess, 0); showError('JRE Download was aborted', false); {$ENDIF} end else Result := processResult = 0; if not Result then begin if not terminateDownload then begin showError('JRE Download Failed', false); end else begin // If the download was cancelled by the form, this error will already // have been given. {$IFNDEF LAZARUS} showError('JRE Download was aborted', false); {$ENDIF} end; end; end; finally bits.free; end; end; end; function installJRE(isUpgrade: boolean): boolean; var question: String; needDownload: boolean; canContinue: boolean; begin Result := false; needDownload := not FileExists(IncludeTrailingPathDelimiter(ExtractFileDir(paramstr(0)))+'jre.exe'); if needDownload then begin if not isUpgrade then question := 'Java was not detected on your machine. Would you like to download and install it now?' else question := 'The version of java detected on your machine is not compatible with DMDirc. Would you like to download and install a compatible version now?'; end else begin if not isUpgrade then question := 'Java was not detected on your machine. Would you like to install it now?' else question := 'The version of java detected on your machine is not compatible with DMDirc. Would you like to install a compatible version now?'; end; canContinue := true; if (needDownload) then begin canContinue := downloadJRE(question); end; if canContinue then begin // Final result of this function is the return value of installing java. if needDownload or askQuestion(question) then begin showmessage('The Java installer will now run. Please follow the instructions given. '+#13#10+'The DMDirc installation will continue afterwards.'); Result := (ExecAndWait('jre.exe') = 0); end; end end; var errorMessage: String; javaCommand: String = 'javaw.exe'; params: String = ''; dir: String = ''; Reg: TRegistry; result: Integer; begin {$IFDEF LAZARUS} Application.Initialize; Application.CreateForm(TProgressForm, form); {$ENDIF} if IsConsole then begin writeln('-----------------------------------------------------------------------'); writeln('Welcome to the DMDirc installer.'); writeln('-----------------------------------------------------------------------'); writeln('This will install DMDirc on your computer.'); writeln(''); writeln('Please wait whilst the GUI part of the installer loads...'); writeln('-----------------------------------------------------------------------'); // end // else begin // errorMessage := 'This will install DMDirc on your computer, please click OK to continue, or Cancel to abort.'; // if (MessageBox(0, PChar(errorMessage), 'DMDirc Installer', MB_OKCANCEL + MB_ICONINFORMATION) <> IDOK) then begin // exit; // end; end; errorMessage := ''; dowrite('Checking for DMDirc.jar.. '); if FileExists('DMDirc.jar') then begin dowriteln('Success!'); dowrite('Checking for JVM.. '); if (ExecAndWait(javaCommand+' -version') <> 0) then begin dowriteln('Failed!'); if not installJRE(false) then begin showError('DMDirc setup can not continue without java. Please install java and try again', false, false); exit; end; end else begin if IsConsole then begin writeln('Success!'); write('Starting installer.. '); javaCommand := 'java.exe'; end; end; Reg := TRegistry.Create; Reg.RootKey := HKEY_LOCAL_MACHINE; if Reg.OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\DMDirc', false) then begin dir := Reg.ReadString('InstallDir'); if (dir <> '') then begin params := params+' --directory "'+dir+'"'; end; end; Reg.CloseKey; Reg.Free; if (ReleaseNumber <> '') then begin params := params+' --release '+ReleaseNumber; end; // Check if the installer runs if (ExecAndWait(javaCommand+' -cp DMDirc.jar com.dmdirc.installer.Main --help') <> 0) then begin dowriteln('Failed!'); if not installJRE(true) then begin showError('Sorry, DMDirc setup can not continue without an updated version of java.', false, false); exit; end else begin // Try again now that java is installed. result := ExecAndWait(javaCommand+' -cp DMDirc.jar com.dmdirc.installer.Main '+params); end; end else begin // Java is the right version, run the installer result := ExecAndWait(javaCommand+' -cp DMDirc.jar com.dmdirc.installer.Main '+params); end; if result = 0 then dowriteln('Installation completed.') else dowriteln('Installation did not complete.') end else begin dowriteln('Failed!'); errorMessage := errorMessage+'DMDirc.jar was not found.'; errorMessage := errorMessage+#13#10; errorMessage := errorMessage+#13#10+'This is likely because of a corrupt installer build.'; errorMessage := errorMessage+#13#10+'Please check http://www.dmdirc.com/ for an updated build.'; showError(errorMessage); end; if IsConsole then begin writeln(''); writeln('-----------------------------------------------------------------------'); writeln('Installation Completed. Thank you for choosing DMDirc'); writeln('-----------------------------------------------------------------------'); end; end.