123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469 |
- {*
- * This application launches the dmdirc java-based installer.
- *
- * DMDirc - Open Source IRC Client
- * Copyright (c) 2006-2010 Chris Smith, Shane Mc Cormack, Gregory Holmes,
- * Michael Nixon
- *
- * 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.
- *}
-
- (* Current DMDirc windows setup flow:
- *
- * 1) Outer wrapper EXE that extracts a 7zip SFX to windows temp dir
- * 2) 7zip SFX unpacks
- * 3) Wrapper EXE starts Setup.exe (this program)
- * 4) Setup checks for existence of the JRE and offers to download/install it
- * 5) Setup starts the java portion of the DMDirc installer
- *)
- program Setup;
-
- // Resource file - icon, versioninfo, manifest
- {$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}
-
- { ----------------------------------------------------------------------------
- Debugging specific compiler directives
- ---------------------------------------------------------------------------- }
-
- // If defined the JRE will always be downloaded as if it didn't exist. Used for
- // testing the JRE download dialog.
- // {$DEFINE FORCEJREDOWNLOAD}
-
- uses
- kol, shared, Vista, Windows, SysUtils, classes, registry;
-
- const
- // SetupConsts holds build information for this release
- {$I SetupConsts.inc}
- // This is also part of the above IsConsole workaround.
- {$IFDEF APP_CONSOLE}
- IsConsole: boolean = true;
- {$ELSE}
- IsConsole: boolean = false;
- {$ENDIF}
-
- var
- { --------------------------------------------------------------------------
- KOL form objects
- -------------------------------------------------------------------------- }
- frmmain: pcontrol;
- progressbar, btncancel: pcontrol;
- label1, label2, label3, label4, labelurl, labelspeed, labelprogress: pcontrol;
-
- { --------------------------------------------------------------------------
- Other globals
- -------------------------------------------------------------------------- }
- terminateDownload: boolean = false;
-
- procedure InitCommonControls; stdcall; External 'comctl32.dll' name 'InitCommonControls';
-
- { ----------------------------------------------------------------------------
- Main form: Cancel button clicked event
- ---------------------------------------------------------------------------- }
- procedure btnCancel_Click(Dummy: Pointer; Sender: PControl);
- begin
- terminateDownload := true;
- end;
-
- { ----------------------------------------------------------------------------
- Main form: Set progress percentage to <value> and display in label <msg>
- ---------------------------------------------------------------------------- }
- procedure setProgress(value: integer; msg: string);
- begin
- ProgressBar.progress := value;
- labelprogress.Caption := msg;
- applet.processmessages;
- end;
-
- { ----------------------------------------------------------------------------
- Initialise KOL and create the main window
- ---------------------------------------------------------------------------- }
- procedure CreateMainWindow;
- var
- screenw, screenh: longint;
- iconhandle: thandle;
- begin
- { This call is required for common control 6 DLL to be correctly imported.
- Without it strange things happen on windows XP }
- InitCommonControls;
-
- { Load the icon to assign to our window }
- iconhandle := LoadIcon(hInstance, 'icon.ico');
-
- { We need the screen size to centre the window later }
- screenw := GetSystemMetrics(SM_CXSCREEN);
- screenh := GetSystemMetrics(SM_CYSCREEN);
-
- { KOL programs ideally need an Applet created }
- Applet := NewApplet('DMDirc Setup');
- Applet.Visible := true;
-
- Applet.Icon := iconhandle;
-
- { Create main form and set sane defaults. If we don't set the font here then
- all child objects will have a rubbish font as a holdover from Windows 3.1! }
- frmmain := NewForm(Applet, 'DMDirc Setup').SetClientSize(400, 184);
- frmmain.CreateVisible := True;
- frmmain.CanResize := False;
- frmmain.Style := frmmain.style and (not WS_MAXIMIZEBOX);
- frmmain.Font.FontName := 'Ms Sans Serif';
- frmmain.Font.FontHeight := 8;
- frmmain.SetPosition((screenw div 2) - (frmmain.Width div 2), (screenh div 2) - (frmmain.height div 2));
-
- frmmain.Icon := iconhandle;
-
- progressbar := NewProgressBar(frmmain).SetPosition(16, 114);
- progressbar.SetSize(frmmain.clientWidth - (progressbar.Left * 2), 16);
- progressbar.MaxProgress := 100;
- progressbar.Progress := 0;
- progressbar.Visible := true;
-
- btncancel := NewButton(frmmain, 'Cancel').SetPosition(progressbar.Left +
- progressbar.width - 60, progressbar.Top + progressbar.Height + 14);
- btncancel.SetSize(60, 24);
-
- label1 := NewLabel(frmmain, 'Downloading Java Runtime Environment').SetPosition(16, 16);
- label1.SetSize(frmmain.ClientWidth - 32, 16);
- label1.Font.FontStyle := [fsBold];
-
- label2 := NewLabel(frmmain, 'Address:').SetPosition(16, label1.top + 28);
- label2.SetSize(frmmain.ClientWidth - 32, 16);
-
- label3 := NewLabel(frmmain, 'Speed:').SetPosition(16, label2.top + 20);
- label3.SetSize(frmmain.ClientWidth - 32, 16);
-
- label4 := NewLabel(frmmain, 'Progress:').SetPosition(16, label3.top + 20);
- label4.SetSize(frmmain.ClientWidth - 32, 16);
-
- { BringToFront calls are needed on the following labels because the labels
- created earlier are as wide as the form and cover them as they are not
- transparent. It seems windows creates controls in a backwards order so newer
- controls are behind older ones. I could rearrange this order in the code but
- it would look messy. }
-
- labelurl := NewLabel(frmmain, '').SetPosition(70, label1.top + 28);
- labelurl.SetSize(frmmain.ClientWidth - 32, 16);
- labelurl.BringToFront;
-
- labelspeed := NewLabel(frmmain, '').SetPosition(70, label2.top + 20);
- labelspeed.SetSize(frmmain.ClientWidth - 32, 16);
- labelspeed.BringToFront;
-
- labelprogress := NewLabel(frmmain, '').SetPosition(70, label3.top + 20);
- labelprogress.SetSize(frmmain.ClientWidth - 32, 16);
- labelprogress.BringToFront;
-
- { Assign UI methods }
- btncancel.OnClick := TOnEvent(MakeMethod(nil, @btnCancel_Click ));
-
- { The window will not appear until the messageloop is started with Run() but
- this means we must yield this thread to the UI. This is unacceptable for
- such a simple program. Calling CreateWindow here will cause the window to
- appear but the message loop does not run; consequently the app must service
- messages by hand at a timely interval to avoid windows from marking the
- program as unresponsive. This is a hack but acceptable here. }
-
- { /!\ WARNING /!\ Run() can no longer be used to enter the message loop after
- this call or a nasty crash will occur. }
- applet.createwindow;
- end;
-
- { ----------------------------------------------------------------------------
- Return the size in bytes of the file specified by <name>
- Returns -1 on error
- ---------------------------------------------------------------------------- }
- 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;
-
- {$IFNDEF VER150}
- { ----------------------------------------------------------------------------
- Return part of a string
- ---------------------------------------------------------------------------- }
- function AnsiMidStr(Source: String; Start: Integer; Count: Integer): String;
- begin
- // Not perfectly accurate, but does the job
- { ^ What does that mean? // Zipplet }
- Result := Copy(Source, Start, Count);
- end;
- {$ENDIF}
-
- { ----------------------------------------------------------------------------
- Downloads the JRE. Returns TRUE if the user installed it. False otherwise
- ---------------------------------------------------------------------------- }
- 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;
- wantedsize: double;
- currentsize: double;
- lastsize: double;
- i: double;
- c: longint;
- begin
- dir := IncludeTrailingPathDelimiter(ExtractFileDir(paramstr(0)));
- // TODO: We should probably download the 64bit version of java if we are
- // 64bit.
- url := 'http://www.dmdirc.com/getjava/windows/all';
- Result := false;
-
- { First we will determine the approximate size of the download.
- In my opinion we should not do this until we have asked the user if they
- would like to download the JRE. Might change this later.
- We obtain the size by asking wget to find out. }
- ExecAndWait('wget.exe -o "'+dir+'wgetoutput" --spider '+url, true);
-
- { Just incase wget fails ... }
- if not fileexists(dir+'wgetoutput') then begin
- showerror('Internal error: wget returned no output.', 'DMDirc Setup');
- result := false;
- exit;
- end;
-
- { Parse the output and grab the approximate size }
- AssignFile(f, dir+'wgetoutput');
- Reset(f);
- line := '';
- match := false;
- while not Eof(f) do begin
- ReadLn(f, line);
- if length(line) > 8 then begin
- if copy(line, 1, 7) = 'Length:' then begin
- match := true;
- break;
- end;
- end;
- end;
- if match then begin
- bits := TStringList.create;
- try
- bits.Clear;
- bits.Delimiter := ' ';
- bits.DelimitedText := line;
- try
- wantedsize := strtoint(StringReplace(bits[1], ',', '', [rfReplaceAll]))
- except
- wantedsize := 0;
- end;
-
- { We ask the user if they wish to download the JRE }
- if askQuestion(message+' (Download Size: '+AnsiMidStr(bits[2], 2, length(bits[2])-2)+')', 'DMDirc Setup') then begin
- { Create progress window and show it }
- CreateMainWindow;
- { Get wget to start the download }
- ProcessInfo := Launch('wget.exe '+url+' -O jre.exe', true);
- labelurl.caption := url;
- labelspeed.caption := 'Connecting to site...';
-
- { Why is this case needed ?! }
- if wantedsize <= 0 then begin
- progressbar.progress := 50;
- end;
- getExitCodeProcess(ProcessInfo.hProcess, processResult);
-
- lastsize := 0;
- c := 0;
- i := 0;
- while (processResult = STILL_ACTIVE) and (not terminateDownload) do begin
- if wantedsize > 0 then begin
- currentsize := GetFileSizeByName(dir + 'jre.exe');
- inc(c);
- if (c >= 5) then begin
- i := (i + currentsize - lastsize) / 2;
- labelspeed.caption := nicesize(round(i * 2)) + '/sec';
- lastsize := currentsize;
- c := 0;
- end;
- if (currentsize > 0) then setProgress(Round((currentsize/wantedsize)*100),
- nicesize(currentsize) + ' of ' + nicesize(wantedsize) +
- ' (' + inttostr(Round((currentsize/wantedsize)*100)) + '%)');
- end;
- { We must process the message loop or the window wont respond to the user }
- applet.ProcessMessages;
- { Sleep to prevent 100% CPU usage }
- sleep(100);
- GetExitCodeProcess(ProcessInfo.hProcess, processResult);
- end;
- frmmain.visible := false;
- applet.visible := false;
- if (terminateDownload) then begin
- Result := false;
- TerminateProcess(ProcessInfo.hProcess, 0);
- showError('JRE Download was aborted', 'DMDirc Setup', false);
- end
- else Result := processResult = 0;
- if not Result then begin
- if not terminateDownload then begin
- showError('JRE Download Failed', 'DMDirc Setup', false);
- end
- else begin
- // If the download was cancelled by the form, this error will already
- // have been given.
- { No action needed here anymore }
- end;
- end;
- end;
- finally
- bits.free;
- end;
- end;
- end;
-
- { ----------------------------------------------------------------------------
- Begin the JRE download/install.
- ---------------------------------------------------------------------------- }
- 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, 'DMDirc Setup') then begin
- showmessage('The Java installer will now run. Please follow the instructions given. '+#13#10+'The DMDirc installation will continue afterwards.', 'DMDirc Setup');
- Result := (ExecAndWait('jre.exe') = 0);
- end;
- end
- end;
-
- { ----------------------------------------------------------------------------
- MAIN PROGRAM
- ---------------------------------------------------------------------------- }
- var
- errorMessage: String;
- params: String = '';
- dir: String = '';
- Reg: TRegistry;
- result: Integer;
- begin
-
- errorMessage := '';
- if FileExists('DMDirc.jar') then begin
- {$IFDEF FORCEJREDOWNLOAD}if (1 <> 0) then begin{$ELSE}if (RunJava('-version') <> 0) then begin{$ENDIF}
- if not installJRE(false) then begin
- showError('DMDirc setup can not continue without Java. Please install Java and try again.', 'DMDirc Setup', false, false);
- exit;
- 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 (RunJava('-cp DMDirc.jar com.dmdirc.installer.Main --help') <> 0) then begin
- if not installJRE(true) then begin
- showError('Sorry, DMDirc setup can not continue without an updated version of java.', 'DMDirc Setup', false, false);
- exit;
- end
- else begin
- // Try again now that java is installed.
- result := RunJava('-cp DMDirc.jar com.dmdirc.installer.Main '+params);
- end;
- end
- else begin
- // Java is the right version, run the installer
- result := RunJava('-cp DMDirc.jar com.dmdirc.installer.Main '+params);
- end;
- end
- else begin
- 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, 'DMDirc Setup');
- end;
- end.
|