Update installer to have new ad in it
This commit is contained in:
parent
75b0aca6fd
commit
47b1456c8d
|
@ -1,6 +1,8 @@
|
|||
#define BaseDir ExtractFilePath(ExtractFilePath(ExtractFilePath(SourcePath)))
|
||||
#define AppVersion GetFileVersion(BaseDir + "\Bin\" + Configuration + "\Project64.exe")
|
||||
|
||||
#include BaseDir+"\Source\Installer\binno\binno.iss"
|
||||
|
||||
[Setup]
|
||||
AppName=Project 64
|
||||
AppVersion={#AppVersion}
|
||||
|
@ -88,10 +90,6 @@ Source: "{#BaseDir}\Plugin\GFX\Jabo_Direct3D8.dll"; DestDir: "{app}\Plugin\GFX"
|
|||
Source: "{#BaseDir}\Plugin\GFX\PJ64Glide64.dll"; DestDir: "{app}\Plugin\GFX"
|
||||
Source: "{#BaseDir}\Plugin\Input\Jabo_DInput.dll"; DestDir: "{app}\Plugin\Input"
|
||||
Source: "{#BaseDir}\Plugin\RSP\RSP 1.7.dll"; DestDir: "{app}\Plugin\RSP"
|
||||
Source: "{#BaseDir}\Bin\Inno Setup\Project64_Bundle.exe"; Flags: dontcopy
|
||||
Source: "{#BaseDir}\Bin\Inno Setup\delta_logo.bmp"; Flags: dontcopy
|
||||
Source: "{#BaseDir}\Bin\Inno Setup\iminentBar.bmp"; Flags: dontcopy
|
||||
Source: "{#BaseDir}\Bin\Inno Setup\iminentNonSearch.bmp"; Flags: dontcopy
|
||||
|
||||
[Dirs]
|
||||
Name: "{app}\Config"; Permissions: users-modify
|
||||
|
@ -104,3 +102,29 @@ Name: "{app}\Textures"; Permissions: users-modify
|
|||
Name: "{commonprograms}\Project 64 2.0\Project 64"; Filename: "{app}\Project64.exe"
|
||||
Name: "{commonprograms}\Project 64 2.0\Uninstall Project64 2.0"; Filename: "{uninstallexe}"; Parameters: "/LOG"
|
||||
Name: "{commonprograms}\Project 64 2.0\Support"; Filename: "http://forum.pj64-emu.com"
|
||||
|
||||
[Code]
|
||||
function HaveCommandlineParam (inParam: String): Boolean;
|
||||
var
|
||||
LoopVar : Integer;
|
||||
begin
|
||||
LoopVar := 1;
|
||||
Result := false;
|
||||
|
||||
while LoopVar <= ParamCount do
|
||||
begin
|
||||
if ((ParamStr(LoopVar) = '-' + inParam) or (ParamStr(LoopVar) = '/' + inParam)) then
|
||||
begin
|
||||
Result := true;
|
||||
Break;
|
||||
end;
|
||||
LoopVar := LoopVar + 1;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure InitializeWizard();
|
||||
begin
|
||||
if ((WizardSilent() <> true) and (HaveCommandlineParam('noads') <> true)) then begin
|
||||
CreateBINNOPage(wpSelectTasks,'pj64emu','pj64emu');
|
||||
end;
|
||||
end;
|
|
@ -150,6 +150,22 @@
|
|||
/>
|
||||
</FileConfiguration>
|
||||
</File>
|
||||
<Filter
|
||||
Name="binno"
|
||||
>
|
||||
<File
|
||||
RelativePath=".\binno\binno.iss"
|
||||
>
|
||||
</File>
|
||||
<File
|
||||
RelativePath=".\binno\it_download.iss"
|
||||
>
|
||||
</File>
|
||||
<File
|
||||
RelativePath=".\binno\it_download_u.iss"
|
||||
>
|
||||
</File>
|
||||
</Filter>
|
||||
</Filter>
|
||||
</Files>
|
||||
<Globals>
|
||||
|
|
Binary file not shown.
File diff suppressed because it is too large
Load Diff
|
@ -0,0 +1,319 @@
|
|||
[Files]
|
||||
;Source: {#emit ReadReg(HKEY_LOCAL_MACHINE,'Software\Sherlock Software\InnoTools\Downloader','InstallPath','')}\itdownload.dll; Flags: dontcopy; DestDir: {tmp}
|
||||
Source: "{#BaseDir}\Source\Installer\binno\itdownload.dll"; Flags: dontcopy; DestDir: {tmp}
|
||||
|
||||
[Code]
|
||||
(*
|
||||
Inno Tools Downloader DLL
|
||||
Copyright (C) Sherlock Software 2008
|
||||
Version 0.3.5
|
||||
|
||||
Contact:
|
||||
The author, Nicholas Sherlock, at nick@sherlocksoftware.org.
|
||||
Comments, questions and suggestions welcome.
|
||||
|
||||
Website:
|
||||
http://www.sherlocksoftware.org/
|
||||
|
||||
History:
|
||||
0.3.5 - Moved strings used in the updater example to the language file, so that they
|
||||
may be more easily translated.
|
||||
Added event functions to support the example of integration with InnoTools tray.
|
||||
Fixes bugs that could cause the download to hang until
|
||||
some mouse movements were received.
|
||||
Allows "detailed mode" to be turned on with ITD_SetOption
|
||||
Allows the HTTP agent to be set with ITD_SetOption
|
||||
0.3.4 - Added Brazilian Portuguese translation by Ronaldo Souza
|
||||
0.3.3 - The "Hilbrand Edskes" release :), lots of suggestions and corrections from him, thank you!
|
||||
The "Retry" button is now translated.
|
||||
The "Current file" progress bar is hidden if only one file is being downloaded.
|
||||
The page's title and description are updated in the case of failed downloads.
|
||||
Several updates to the translations.
|
||||
Several small GUI fixes.
|
||||
0.3.2 - Minor tweaks to the English language file and the translation example script (example4.iss)
|
||||
Added Dutch translation by Hilbrand Edskes
|
||||
Added French translation by Néo
|
||||
0.3.1 - Added language file examples, fixed several missing language strings
|
||||
Preliminary support for proxy server autodetection
|
||||
Allows the size of a file to be queried with ITD_GetFileSize
|
||||
Several small bugfixes
|
||||
0.3.0 - Properly supports timeouts.
|
||||
Fixes bug with time remaining.
|
||||
DLL is required again.
|
||||
Supports localization through ITD_LoadStrings, ITD_SetString
|
||||
Add mirrors for files
|
||||
Post HTTP documents
|
||||
Quick view and detailed view
|
||||
0.2.2 - Fixed empty strings '' in calls and added timeouts
|
||||
0.2.1 - Renamed identifiers to avoid name clashes
|
||||
0.2.0 - Converted from DLL to pure native code
|
||||
*)
|
||||
|
||||
procedure ITD_Cancel;
|
||||
external 'itd_cancel@files:itdownload.dll stdcall';
|
||||
|
||||
procedure ITD_ClearFiles;
|
||||
external 'itd_clearfiles@files:itdownload.dll stdcall';
|
||||
|
||||
function ITD_DownloadFile(url: PChar; destfilename: PChar): integer;
|
||||
external 'itd_downloadfile@files:itdownload.dll stdcall';
|
||||
|
||||
function ITD_GetResultLen: integer;
|
||||
external 'itd_getresultlen@files:itdownload.dll stdcall';
|
||||
|
||||
procedure ITD_GetResultString(buffer: pchar; maxlen: integer);
|
||||
external 'itd_getresultstring@files:itdownload.dll stdcall';
|
||||
|
||||
procedure ITD_Internal_InitUI(HostHwnd: dword);
|
||||
external 'itd_initui@files:itdownload.dll stdcall';
|
||||
|
||||
function ITD_Internal_LoadStrings(filename: PChar): boolean;
|
||||
external 'itd_loadstrings@files:itdownload.dll stdcall';
|
||||
|
||||
procedure ITD_Internal_SetOption(option, value: PChar);
|
||||
external 'itd_setoption@files:itdownload.dll stdcall';
|
||||
|
||||
function ITD_Internal_GetFileSize(url: pchar; var size: Cardinal): boolean;
|
||||
external 'itd_getfilesize@files:itdownload.dll stdcall';
|
||||
|
||||
function ITD_Internal_GetString(index: integer): boolean;
|
||||
external 'itd_getstring@files:itdownload.dll stdcall';
|
||||
|
||||
function ITD_Internal_GetOption(option: PChar; buffer: PChar; length: integer): integer;
|
||||
external 'itd_getoption@files:itdownload.dll stdcall';
|
||||
|
||||
procedure ITD_Internal_SetString(index: integer; value: PChar);
|
||||
external 'itd_setstring@files:itdownload.dll stdcall';
|
||||
|
||||
procedure ITD_Internal_AddFile(url: PChar; destfilename: PChar);
|
||||
external 'itd_addfile@files:itdownload.dll stdcall';
|
||||
|
||||
procedure ITD_Internal_AddMirror(url: PChar; destfilename: PChar);
|
||||
external 'itd_addmirror@files:itdownload.dll stdcall';
|
||||
|
||||
procedure ITD_Internal_AddFileSize(url: PChar; destfilename: PChar; size: integer);
|
||||
external 'itd_addfilesize@files:itdownload.dll stdcall';
|
||||
|
||||
function ITD_Internal_DownloadFiles(surface: hwnd): integer;
|
||||
external 'itd_downloadfiles@files:itdownload.dll stdcall';
|
||||
|
||||
function ITD_FileCount: integer;
|
||||
external 'itd_filecount@files:itdownload.dll stdcall';
|
||||
|
||||
function ITD_Internal_PostPage(url, buffer: PChar; length: integer): boolean;
|
||||
external 'itd_postpage@files:itdownload.dll stdcall';
|
||||
|
||||
|
||||
const
|
||||
ITDERR_SUCCESS = 0;
|
||||
ITDERR_USERCANCEL = 1;
|
||||
ITDERR_ERROR = 3;
|
||||
|
||||
{Constants for Language String indexes:}
|
||||
ITDS_DownloadFailed = 104;
|
||||
|
||||
ITDS_TitleCaption = 200;
|
||||
ITDS_TitleDescription = 201;
|
||||
|
||||
ITDS_MessageFailRetryContinue = 250;
|
||||
ITDS_MessageFailRetry = 251;
|
||||
|
||||
ITDS_Retry = 502;
|
||||
|
||||
{Constants for language strings of updater example}
|
||||
ITDS_Update_Caption = 600;
|
||||
ITDS_Update_Description = 601;
|
||||
ITDS_Update_Checking = 602;
|
||||
ITDS_Update_NewAvailable = 603;
|
||||
ITDS_Update_NoNewAvailable = 604;
|
||||
ITDS_Update_WantToCheck = 605;
|
||||
ITDS_Update_Failed = 606;
|
||||
ITDS_Update_WillLaunch = 607;
|
||||
ITDS_Update_WillLaunchWithPath = 608;
|
||||
|
||||
ITD_Event_DownloadPageEntered = 1;
|
||||
ITD_Event_DownloadPageLeft = 2;
|
||||
ITD_Event_DownloadFailed = 3;
|
||||
|
||||
var
|
||||
itd_allowcontinue: boolean;
|
||||
itd_retryonback: boolean;
|
||||
|
||||
ITD_AfterSuccess: procedure(downloadPage: TWizardPage);
|
||||
ITD_EventHandler: procedure(event: integer);
|
||||
|
||||
procedure ITD_DownloadFiles();
|
||||
begin
|
||||
ITD_Internal_DownloadFiles(0);
|
||||
end;
|
||||
|
||||
procedure ITD_AddFile(const URL, filename: string);
|
||||
begin
|
||||
ITD_Internal_AddFile(URL, filename);
|
||||
end;
|
||||
|
||||
procedure ITD_AddMirror(const URL, filename: string);
|
||||
begin
|
||||
ITD_Internal_AddMirror(URL, filename);
|
||||
end;
|
||||
|
||||
procedure ITD_AddFileSize(const URL, filename: string; size: integer);
|
||||
begin
|
||||
ITD_Internal_AddFileSize(URL, filename, size);
|
||||
end;
|
||||
|
||||
function ITD_HandleSkipPage(sender: TWizardPage): boolean;
|
||||
begin
|
||||
result := (itd_filecount = 0);
|
||||
end;
|
||||
|
||||
procedure ITD_SetString(index: integer; value: string);
|
||||
begin
|
||||
itd_internal_setstring(index, value);
|
||||
end;
|
||||
|
||||
function ITD_GetFileSize(const url: string; var size: cardinal): boolean;
|
||||
begin
|
||||
result := itd_internal_getfilesize(PChar(url), size);
|
||||
end;
|
||||
|
||||
function ITD_LoadStrings(const filename: string): boolean;
|
||||
begin
|
||||
result := itd_internal_loadstrings(filename);
|
||||
end;
|
||||
|
||||
function ITD_GetString(index: integer): string;
|
||||
begin
|
||||
itd_internal_getstring(index);
|
||||
setlength(result, ITD_GetResultLen);
|
||||
ITD_GetResultString(PChar(result), length(result));
|
||||
end;
|
||||
|
||||
procedure ITD_NowDoDownload(sender: TWizardPage);
|
||||
var err: integer;
|
||||
begin
|
||||
wizardform.backbutton.enabled := false;
|
||||
wizardform.nextbutton.enabled := false;
|
||||
|
||||
sender.caption := ITD_GetString(ITDS_TitleCaption);
|
||||
sender.description := ITD_GetString(ITDS_TitleDescription);
|
||||
|
||||
err := ITD_Internal_DownloadFiles(sender.surface.handle);
|
||||
|
||||
case err of
|
||||
ITDERR_SUCCESS: begin
|
||||
wizardform.nextbutton.enabled := true;
|
||||
wizardform.nextbutton.onclick(nil);
|
||||
|
||||
if itd_aftersuccess <> nil then
|
||||
itd_aftersuccess(sender);
|
||||
end;
|
||||
ITDERR_USERCANCEL: ; //Don't show a message, this happens on setup close and cancel click
|
||||
else begin
|
||||
//Some unexpected error, like connection interrupted
|
||||
wizardform.backbutton.caption := ITD_GetString(ITDS_Retry);
|
||||
wizardform.backbutton.enabled := true;
|
||||
wizardform.backbutton.show();
|
||||
itd_retryonback := true;
|
||||
|
||||
wizardform.nextbutton.enabled := itd_allowcontinue;
|
||||
|
||||
if ITD_EventHandler <> nil then
|
||||
ITD_EventHandler(ITD_Event_DownloadFailed);
|
||||
|
||||
if itd_allowcontinue then begin //Download failed, we can retry, continue, or exit
|
||||
sender.caption := ITD_GetString(ITDS_DownloadFailed);
|
||||
sender.description := ITD_GetString(ITDS_MessageFailRetryContinue);
|
||||
|
||||
MsgBox(ITD_GetString(ITDS_MessageFailRetryContinue), mbError, MB_OK)
|
||||
end else begin //Download failed, we must retry or exit setup
|
||||
sender.caption := ITD_GetString(ITDS_DownloadFailed);
|
||||
sender.description := ITD_GetString(ITDS_MessageFailRetry);
|
||||
|
||||
MsgBox(ITD_GetString(ITDS_MessageFailRetry), mbError, MB_OK)
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure ITD_HandleShowPage(sender: TWizardPage);
|
||||
begin
|
||||
wizardform.nextbutton.enabled := false;
|
||||
wizardform.backbutton.hide();
|
||||
|
||||
if ITD_EventHandler <> nil then
|
||||
ITD_EventHandler(ITD_Event_DownloadPageEntered);
|
||||
|
||||
itd_nowdodownload(sender);
|
||||
end;
|
||||
|
||||
function ITD_HandleBackClick(sender: TWizardpage): boolean;
|
||||
begin
|
||||
result := false;
|
||||
if itd_retryonback then begin
|
||||
itd_retryonback := false;
|
||||
wizardform.backbutton.hide();
|
||||
itd_nowdodownload(sender);
|
||||
end;
|
||||
end;
|
||||
|
||||
function ITD_HandleNextClick(sender: TWizardpage): boolean;
|
||||
begin
|
||||
if ITD_EventHandler <> nil then
|
||||
ITD_EventHandler(ITD_Event_DownloadPageLeft);
|
||||
|
||||
result := true;
|
||||
end;
|
||||
|
||||
procedure ITD_Init;
|
||||
begin
|
||||
//Currently a NOP. Don't count on it in future.
|
||||
end;
|
||||
|
||||
function ITD_PostPage(const url, data: string; out response: string): boolean;
|
||||
begin
|
||||
result := ITD_Internal_PostPage(PChar(url), PChar(data), length(data));
|
||||
|
||||
if result then begin
|
||||
setlength(response, ITD_GetResultLen);
|
||||
ITD_GetResultString(PChar(response), length(response));
|
||||
end;
|
||||
end;
|
||||
|
||||
function ITD_DownloadAfter(afterID: integer): TWizardPage;
|
||||
var itd_downloadPage: TWizardPage;
|
||||
begin
|
||||
itd_downloadpage := CreateCustomPage(afterID, ITD_GetString(ITDS_TitleCaption), ITD_GetString(ITDS_TitleDescription));
|
||||
|
||||
itd_downloadpage.onactivate := @itd_handleshowpage;
|
||||
itd_downloadpage.onshouldskippage := @itd_handleskippage;
|
||||
itd_downloadpage.onbackbuttonclick := @itd_handlebackclick;
|
||||
itd_downloadpage.onnextbuttonclick := @itd_handlenextclick;
|
||||
|
||||
itd_internal_initui(itd_downloadpage.surface.handle);
|
||||
|
||||
result := itd_downloadpage;
|
||||
end;
|
||||
|
||||
procedure ITD_SetOption(const option, value: string);
|
||||
begin
|
||||
//The options which call ITD_SetString are depreciated, use ITD_SetString directly
|
||||
if comparetext(option, 'UI_Caption') = 0 then
|
||||
ITD_SetString(ITDS_TitleCaption, value)
|
||||
else if comparetext(option, 'UI_Description') = 0 then
|
||||
ITD_SetString(ITDS_TitleDescription, value)
|
||||
else if comparetext(option, 'UI_FailMessage') = 0 then
|
||||
ITD_SetString(ITDS_MessageFailRetry, value)
|
||||
else if comparetext(option, 'UI_FailOrContinueMessage') = 0 then
|
||||
ITD_SetString(ITDS_MessageFailRetryContinue, value)
|
||||
else if comparetext(option, 'UI_AllowContinue') = 0 then
|
||||
ITD_AllowContinue := (value = '1')
|
||||
else
|
||||
ITD_Internal_SetOption(option, value);
|
||||
end;
|
||||
|
||||
function ITD_GetOption(const option: string): string;
|
||||
begin
|
||||
setlength(result, 500);
|
||||
setlength(result, itd_internal_getoption(pchar(option), pchar(result), length(result)));
|
||||
end;
|
|
@ -0,0 +1,319 @@
|
|||
[Files]
|
||||
;Source: {#emit ReadReg(HKEY_LOCAL_MACHINE,'Software\Sherlock Software\InnoTools\Downloader','InstallPath','')}\itdownload.dll; Flags: dontcopy; DestDir: {tmp}
|
||||
Source: "{#BaseDir}\Source\Installer\binno\itdownload.dll"; Flags: dontcopy; DestDir: {tmp}
|
||||
|
||||
[Code]
|
||||
(*
|
||||
Inno Tools Downloader DLL
|
||||
Copyright (C) Sherlock Software 2008
|
||||
Version 0.3.5
|
||||
|
||||
Contact:
|
||||
The author, Nicholas Sherlock, at nick@sherlocksoftware.org.
|
||||
Comments, questions and suggestions welcome.
|
||||
|
||||
Website:
|
||||
http://www.sherlocksoftware.org/
|
||||
|
||||
History:
|
||||
0.3.5 - Moved strings used in the updater example to the language file, so that they
|
||||
may be more easily translated.
|
||||
Added event functions to support the example of integration with InnoTools tray.
|
||||
Fixes bugs that could cause the download to hang until
|
||||
some mouse movements were received.
|
||||
Allows "detailed mode" to be turned on with ITD_SetOption
|
||||
Allows the HTTP agent to be set with ITD_SetOption
|
||||
0.3.4 - Added Brazilian Portuguese translation by Ronaldo Souza
|
||||
0.3.3 - The "Hilbrand Edskes" release :), lots of suggestions and corrections from him, thank you!
|
||||
The "Retry" button is now translated.
|
||||
The "Current file" progress bar is hidden if only one file is being downloaded.
|
||||
The page's title and description are updated in the case of failed downloads.
|
||||
Several updates to the translations.
|
||||
Several small GUI fixes.
|
||||
0.3.2 - Minor tweaks to the English language file and the translation example script (example4.iss)
|
||||
Added Dutch translation by Hilbrand Edskes
|
||||
Added French translation by Néo
|
||||
0.3.1 - Added language file examples, fixed several missing language strings
|
||||
Preliminary support for proxy server autodetection
|
||||
Allows the size of a file to be queried with ITD_GetFileSize
|
||||
Several small bugfixes
|
||||
0.3.0 - Properly supports timeouts.
|
||||
Fixes bug with time remaining.
|
||||
DLL is required again.
|
||||
Supports localization through ITD_LoadStrings, ITD_SetString
|
||||
Add mirrors for files
|
||||
Post HTTP documents
|
||||
Quick view and detailed view
|
||||
0.2.2 - Fixed empty strings '' in calls and added timeouts
|
||||
0.2.1 - Renamed identifiers to avoid name clashes
|
||||
0.2.0 - Converted from DLL to pure native code
|
||||
*)
|
||||
|
||||
procedure ITD_Cancel;
|
||||
external 'itd_cancel@files:itdownload.dll stdcall';
|
||||
|
||||
procedure ITD_ClearFiles;
|
||||
external 'itd_clearfiles@files:itdownload.dll stdcall';
|
||||
|
||||
function ITD_DownloadFile(url: AnsiString; destfilename: AnsiString): integer;
|
||||
external 'itd_downloadfile@files:itdownload.dll stdcall';
|
||||
|
||||
function ITD_GetResultLen: integer;
|
||||
external 'itd_getresultlen@files:itdownload.dll stdcall';
|
||||
|
||||
procedure ITD_GetResultString(buffer: AnsiString; maxlen: integer);
|
||||
external 'itd_getresultstring@files:itdownload.dll stdcall';
|
||||
|
||||
procedure ITD_Internal_InitUI(HostHwnd: dword);
|
||||
external 'itd_initui@files:itdownload.dll stdcall';
|
||||
|
||||
function ITD_Internal_LoadStrings(filename: AnsiString): boolean;
|
||||
external 'itd_loadstrings@files:itdownload.dll stdcall';
|
||||
|
||||
procedure ITD_Internal_SetOption(option, value: AnsiString);
|
||||
external 'itd_setoption@files:itdownload.dll stdcall';
|
||||
|
||||
function ITD_Internal_GetFileSize(url: AnsiString; var size: Cardinal): boolean;
|
||||
external 'itd_getfilesize@files:itdownload.dll stdcall';
|
||||
|
||||
function ITD_Internal_GetString(index: integer): boolean;
|
||||
external 'itd_getstring@files:itdownload.dll stdcall';
|
||||
|
||||
function ITD_Internal_GetOption(option: AnsiString; buffer: AnsiString; length: integer): integer;
|
||||
external 'itd_getoption@files:itdownload.dll stdcall';
|
||||
|
||||
procedure ITD_Internal_SetString(index: integer; value: AnsiString);
|
||||
external 'itd_setstring@files:itdownload.dll stdcall';
|
||||
|
||||
procedure ITD_Internal_AddFile(url: AnsiString; destfilename: AnsiString);
|
||||
external 'itd_addfile@files:itdownload.dll stdcall';
|
||||
|
||||
procedure ITD_Internal_AddMirror(url: AnsiString; destfilename: AnsiString);
|
||||
external 'itd_addmirror@files:itdownload.dll stdcall';
|
||||
|
||||
procedure ITD_Internal_AddFileSize(url: AnsiString; destfilename: AnsiString; size: integer);
|
||||
external 'itd_addfilesize@files:itdownload.dll stdcall';
|
||||
|
||||
function ITD_Internal_DownloadFiles(surface: hwnd): integer;
|
||||
external 'itd_downloadfiles@files:itdownload.dll stdcall';
|
||||
|
||||
function ITD_FileCount: integer;
|
||||
external 'itd_filecount@files:itdownload.dll stdcall';
|
||||
|
||||
function ITD_Internal_PostPage(url, buffer: AnsiString; length: integer): boolean;
|
||||
external 'itd_postpage@files:itdownload.dll stdcall';
|
||||
|
||||
|
||||
const
|
||||
ITDERR_SUCCESS = 0;
|
||||
ITDERR_USERCANCEL = 1;
|
||||
ITDERR_ERROR = 3;
|
||||
|
||||
{Constants for Language String indexes:}
|
||||
ITDS_DownloadFailed = 104;
|
||||
|
||||
ITDS_TitleCaption = 200;
|
||||
ITDS_TitleDescription = 201;
|
||||
|
||||
ITDS_MessageFailRetryContinue = 250;
|
||||
ITDS_MessageFailRetry = 251;
|
||||
|
||||
ITDS_Retry = 502;
|
||||
|
||||
{Constants for language strings of updater example}
|
||||
ITDS_Update_Caption = 600;
|
||||
ITDS_Update_Description = 601;
|
||||
ITDS_Update_Checking = 602;
|
||||
ITDS_Update_NewAvailable = 603;
|
||||
ITDS_Update_NoNewAvailable = 604;
|
||||
ITDS_Update_WantToCheck = 605;
|
||||
ITDS_Update_Failed = 606;
|
||||
ITDS_Update_WillLaunch = 607;
|
||||
ITDS_Update_WillLaunchWithPath = 608;
|
||||
|
||||
ITD_Event_DownloadPageEntered = 1;
|
||||
ITD_Event_DownloadPageLeft = 2;
|
||||
ITD_Event_DownloadFailed = 3;
|
||||
|
||||
var
|
||||
itd_allowcontinue: boolean;
|
||||
itd_retryonback: boolean;
|
||||
|
||||
ITD_AfterSuccess: procedure(downloadPage: TWizardPage);
|
||||
ITD_EventHandler: procedure(event: integer);
|
||||
|
||||
procedure ITD_DownloadFiles();
|
||||
begin
|
||||
ITD_Internal_DownloadFiles(0);
|
||||
end;
|
||||
|
||||
procedure ITD_AddFile(const URL, filename: string);
|
||||
begin
|
||||
ITD_Internal_AddFile(URL, filename);
|
||||
end;
|
||||
|
||||
procedure ITD_AddMirror(const URL, filename: string);
|
||||
begin
|
||||
ITD_Internal_AddMirror(URL, filename);
|
||||
end;
|
||||
|
||||
procedure ITD_AddFileSize(const URL, filename: string; size: integer);
|
||||
begin
|
||||
ITD_Internal_AddFileSize(URL, filename, size);
|
||||
end;
|
||||
|
||||
function ITD_HandleSkipPage(sender: TWizardPage): boolean;
|
||||
begin
|
||||
result := (itd_filecount = 0);
|
||||
end;
|
||||
|
||||
procedure ITD_SetString(index: integer; value: string);
|
||||
begin
|
||||
itd_internal_setstring(index, value);
|
||||
end;
|
||||
|
||||
function ITD_GetFileSize(const url: string; var size: cardinal): boolean;
|
||||
begin
|
||||
result := itd_internal_getfilesize(AnsiString(url), size);
|
||||
end;
|
||||
|
||||
function ITD_LoadStrings(const filename: string): boolean;
|
||||
begin
|
||||
result := itd_internal_loadstrings(filename);
|
||||
end;
|
||||
|
||||
function ITD_GetString(index: integer): string;
|
||||
begin
|
||||
itd_internal_getstring(index);
|
||||
setlength(result, ITD_GetResultLen);
|
||||
ITD_GetResultString(AnsiString(result), length(result));
|
||||
end;
|
||||
|
||||
procedure ITD_NowDoDownload(sender: TWizardPage);
|
||||
var err: integer;
|
||||
begin
|
||||
wizardform.backbutton.enabled := false;
|
||||
wizardform.nextbutton.enabled := false;
|
||||
|
||||
sender.caption := ITD_GetString(ITDS_TitleCaption);
|
||||
sender.description := ITD_GetString(ITDS_TitleDescription);
|
||||
|
||||
err := ITD_Internal_DownloadFiles(sender.surface.handle);
|
||||
|
||||
case err of
|
||||
ITDERR_SUCCESS: begin
|
||||
wizardform.nextbutton.enabled := true;
|
||||
wizardform.nextbutton.onclick(nil);
|
||||
|
||||
if itd_aftersuccess <> nil then
|
||||
itd_aftersuccess(sender);
|
||||
end;
|
||||
ITDERR_USERCANCEL: ; //Don't show a message, this happens on setup close and cancel click
|
||||
else begin
|
||||
//Some unexpected error, like connection interrupted
|
||||
wizardform.backbutton.caption := ITD_GetString(ITDS_Retry);
|
||||
wizardform.backbutton.enabled := true;
|
||||
wizardform.backbutton.show();
|
||||
itd_retryonback := true;
|
||||
|
||||
wizardform.nextbutton.enabled := itd_allowcontinue;
|
||||
|
||||
if ITD_EventHandler <> nil then
|
||||
ITD_EventHandler(ITD_Event_DownloadFailed);
|
||||
|
||||
if itd_allowcontinue then begin //Download failed, we can retry, continue, or exit
|
||||
sender.caption := ITD_GetString(ITDS_DownloadFailed);
|
||||
sender.description := ITD_GetString(ITDS_MessageFailRetryContinue);
|
||||
|
||||
MsgBox(ITD_GetString(ITDS_MessageFailRetryContinue), mbError, MB_OK)
|
||||
end else begin //Download failed, we must retry or exit setup
|
||||
sender.caption := ITD_GetString(ITDS_DownloadFailed);
|
||||
sender.description := ITD_GetString(ITDS_MessageFailRetry);
|
||||
|
||||
MsgBox(ITD_GetString(ITDS_MessageFailRetry), mbError, MB_OK)
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure ITD_HandleShowPage(sender: TWizardPage);
|
||||
begin
|
||||
wizardform.nextbutton.enabled := false;
|
||||
wizardform.backbutton.hide();
|
||||
|
||||
if ITD_EventHandler <> nil then
|
||||
ITD_EventHandler(ITD_Event_DownloadPageEntered);
|
||||
|
||||
itd_nowdodownload(sender);
|
||||
end;
|
||||
|
||||
function ITD_HandleBackClick(sender: TWizardpage): boolean;
|
||||
begin
|
||||
result := false;
|
||||
if itd_retryonback then begin
|
||||
itd_retryonback := false;
|
||||
wizardform.backbutton.hide();
|
||||
itd_nowdodownload(sender);
|
||||
end;
|
||||
end;
|
||||
|
||||
function ITD_HandleNextClick(sender: TWizardpage): boolean;
|
||||
begin
|
||||
if ITD_EventHandler <> nil then
|
||||
ITD_EventHandler(ITD_Event_DownloadPageLeft);
|
||||
|
||||
result := true;
|
||||
end;
|
||||
|
||||
procedure ITD_Init;
|
||||
begin
|
||||
//Currently a NOP. Don't count on it in future.
|
||||
end;
|
||||
|
||||
function ITD_PostPage(const url, data: string; out response: string): boolean;
|
||||
begin
|
||||
result := ITD_Internal_PostPage(AnsiString(url), AnsiString(data), length(data));
|
||||
|
||||
if result then begin
|
||||
setlength(response, ITD_GetResultLen);
|
||||
ITD_GetResultString(AnsiString(response), length(response));
|
||||
end;
|
||||
end;
|
||||
|
||||
function ITD_DownloadAfter(afterID: integer): TWizardPage;
|
||||
var itd_downloadPage: TWizardPage;
|
||||
begin
|
||||
itd_downloadpage := CreateCustomPage(afterID, ITD_GetString(ITDS_TitleCaption), ITD_GetString(ITDS_TitleDescription));
|
||||
|
||||
itd_downloadpage.onactivate := @itd_handleshowpage;
|
||||
itd_downloadpage.onshouldskippage := @itd_handleskippage;
|
||||
itd_downloadpage.onbackbuttonclick := @itd_handlebackclick;
|
||||
itd_downloadpage.onnextbuttonclick := @itd_handlenextclick;
|
||||
|
||||
itd_internal_initui(itd_downloadpage.surface.handle);
|
||||
|
||||
result := itd_downloadpage;
|
||||
end;
|
||||
|
||||
procedure ITD_SetOption(const option, value: string);
|
||||
begin
|
||||
//The options which call ITD_SetString are depreciated, use ITD_SetString directly
|
||||
if comparetext(option, 'UI_Caption') = 0 then
|
||||
ITD_SetString(ITDS_TitleCaption, value)
|
||||
else if comparetext(option, 'UI_Description') = 0 then
|
||||
ITD_SetString(ITDS_TitleDescription, value)
|
||||
else if comparetext(option, 'UI_FailMessage') = 0 then
|
||||
ITD_SetString(ITDS_MessageFailRetry, value)
|
||||
else if comparetext(option, 'UI_FailOrContinueMessage') = 0 then
|
||||
ITD_SetString(ITDS_MessageFailRetryContinue, value)
|
||||
else if comparetext(option, 'UI_AllowContinue') = 0 then
|
||||
ITD_AllowContinue := (value = '1')
|
||||
else
|
||||
ITD_Internal_SetOption(option, value);
|
||||
end;
|
||||
|
||||
function ITD_GetOption(const option: string): string;
|
||||
begin
|
||||
setlength(result, 500);
|
||||
setlength(result, itd_internal_getoption(AnsiString(option), AnsiString(result), length(result)));
|
||||
end;
|
Binary file not shown.
|
@ -0,0 +1,771 @@
|
|||
|
||||
// ;#define UNIT_TEST
|
||||
|
||||
#ifdef UNIT_TEST
|
||||
[Setup]
|
||||
AppName=My Program
|
||||
AppVersion=1.5
|
||||
CreateAppDir=no
|
||||
PrivilegesRequired=admin
|
||||
#endif
|
||||
|
||||
[Code]
|
||||
const
|
||||
HANDLE_FLAG_INHERIT=$00000001;
|
||||
HANDLE_FLAG_PROTECT_FROM_CLOSE=$00000002;
|
||||
|
||||
STARTF_USESTDHANDLES=$00000100;
|
||||
STARTF_USESHOWWINDOW=$00000001;
|
||||
|
||||
INFINITE=$FFFFFFFF;
|
||||
|
||||
NORMAL_PRIORITY_CLASS=$00000020;
|
||||
|
||||
type
|
||||
BI_IP_ADDRESS_STRING = record
|
||||
String:array[0..16] of byte;
|
||||
end;
|
||||
|
||||
BI_IP_ADDR_STRING = record
|
||||
Next:LongWord;
|
||||
IpAddress:BI_IP_ADDRESS_STRING;
|
||||
IpMask:BI_IP_ADDRESS_STRING;
|
||||
Context:LongWord;
|
||||
end;
|
||||
|
||||
BI_RESOURCE = record
|
||||
id:string;
|
||||
path:string;
|
||||
end;
|
||||
|
||||
BI_IP_ADAPTER_INFO = record
|
||||
Next:LongWord;
|
||||
ComboIndex:LongWord;
|
||||
AdapterName:array[1..260] of byte;
|
||||
Description:array[1..132] of byte;
|
||||
AddressLength:integer;
|
||||
Address:array[0..7] of byte;
|
||||
Index:LongWord;
|
||||
_Type:LongWord;
|
||||
DhcpEnabled:LongWord;
|
||||
CurrentIpAddress:LongWord;
|
||||
IpAddressList:BI_IP_ADDR_STRING;
|
||||
GatewayList:BI_IP_ADDR_STRING;
|
||||
DhcpServer:BI_IP_ADDR_STRING;
|
||||
HaveWins:LongWord;
|
||||
PrimaryWinsServer:BI_IP_ADDR_STRING;
|
||||
SecondaryWinsServer:BI_IP_ADDR_STRING;
|
||||
LeaseObtained:array[0..8]of byte;
|
||||
LeaseExpires:array[0..8] of byte;
|
||||
end;
|
||||
|
||||
SECURITY_ATTRIBUTES = record
|
||||
nLength:DWORD;
|
||||
lpSecurityDescriptor:LongInt;
|
||||
bInheritHandle:LongInt;
|
||||
end;
|
||||
|
||||
boola = array[0..10] of BI_IP_ADAPTER_INFO;
|
||||
|
||||
HANDLE = LongInt;
|
||||
LPSTR = LongInt;
|
||||
LPBYTE = LongInt;
|
||||
|
||||
PROCESS_INFORMATION = record
|
||||
hProcess:HANDLE;
|
||||
hThread:HANDLE;
|
||||
dwProcessId:DWORD;
|
||||
dwThreadId:DWORD;
|
||||
end;
|
||||
|
||||
STARTUPINFO = record
|
||||
cb:DWORD ;
|
||||
lpReserved:LPSTR ;
|
||||
lpDesktop:LPSTR ;
|
||||
lpTitle:LPSTR ;
|
||||
dwX:DWORD ;
|
||||
dwY:DWORD ;
|
||||
dwXSize:DWORD ;
|
||||
dwYSize:DWORD ;
|
||||
dwXCountChars:DWORD ;
|
||||
dwYCountChars:DWORD ;
|
||||
dwFillAttribute:DWORD ;
|
||||
dwFlags:DWORD ;
|
||||
wShowWindow:WORD ;
|
||||
cbReserved2:WORD ;
|
||||
lpReserved2:LPBYTE ;
|
||||
hStdInput:HANDLE ;
|
||||
hStdOutput:HANDLE ;
|
||||
hStdError:HANDLE ;
|
||||
end;
|
||||
|
||||
var
|
||||
p:boola;
|
||||
|
||||
function biCreatePipe(var rd,wr:HANDLE;var sa:SECURITY_ATTRIBUTES;nSize:DWORD):integer;
|
||||
external 'CreatePipe@kernel32.dll stdcall';
|
||||
|
||||
function biSetHandleInformation(hObject:HANDLE;dwMask,dwFlags:DWORD):integer;
|
||||
external 'SetHandleInformation@kernel32.dll stdcall';
|
||||
|
||||
function biCloseHandle(h:HANDLE):integer;
|
||||
external 'CloseHandle@kernel32.dll stdcall';
|
||||
|
||||
function biCreateProcess(lpApplicationName:LongInt;lpCommandLine:AnsiString;lpProcessAttributes,lpThreadAttributes:LongInt;bInheritHandles:LongInt;dwCreationFlags:DWORD;lpEnvironment,lpCurrentDirectory:LongInt;var lpStartupInfo:STARTUPINFO;var lpProcessInformation:PROCESS_INFORMATION):integer;
|
||||
external 'CreateProcessA@kernel32.dll stdcall';
|
||||
|
||||
function biWaitForSingleObject(h:HANDLE;dwMilliseconds:DWORD):DWORD;
|
||||
external 'WaitForSingleObject@kernel32.dll stdcall';
|
||||
|
||||
function biReadFile(hFile:HANDLE;lpBuffer:AnsiString;nNumberOfBytesToRead:DWORD;var lpNumberOfBytesRead:DWORD;lpOverlapped:LongInt):integer;
|
||||
external 'ReadFile@kernel32.dll stdcall';
|
||||
|
||||
function biGetAdaptersInfo(var ss:boola;var l:cardinal):integer;
|
||||
external 'GetAdaptersInfo@Iphlpapi.dll stdcall';
|
||||
|
||||
function biGetAdaptersInfo2( ss:cardinal;var l:cardinal):integer;
|
||||
external 'GetAdaptersInfo@Iphlpapi.dll stdcall';
|
||||
|
||||
function biPathIsDirectoryEmpty(lpString:AnsiString):boolean;
|
||||
external 'PathIsDirectoryEmptyA@shlwapi.dll stdcall';
|
||||
|
||||
function biGetMAC():String;
|
||||
var
|
||||
l:cardinal;
|
||||
s:String;
|
||||
begin
|
||||
l:=0;
|
||||
biGetAdaptersInfo2(0,l);
|
||||
biGetAdaptersInfo(p,l);
|
||||
s := Format('%.2x%.2x%.2x%.2x%.2x%.2x',[p[0].Address[0],p[0].Address[1],p[0].Address[2],p[0].Address[3],p[0].Address[4],p[0].Address[5]]);
|
||||
Result := s + s; // mac address concatenated
|
||||
//end;
|
||||
end;
|
||||
|
||||
|
||||
const
|
||||
CSIDL_PROGRAM_FILES = $0026;
|
||||
Codes64 = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
|
||||
|
||||
function PathCombine2(src,more:string):string;
|
||||
begin
|
||||
Result:=AddBackSlash(src)+more;
|
||||
end;
|
||||
|
||||
procedure biPathAppend(var Path:string;More:string);
|
||||
begin
|
||||
Path := PathCombine2(Path,More);
|
||||
end;
|
||||
|
||||
function biIsWildcardPath(Path:string):boolean;
|
||||
begin
|
||||
Result := Pos('*',Path) <> 0;
|
||||
end;
|
||||
|
||||
function biSplitRegistryKey(Key:String;var path:string):integer;
|
||||
var
|
||||
rk,p:Integer;
|
||||
tmp:string;
|
||||
begin
|
||||
|
||||
p := Pos('\',Key);
|
||||
tmp := Copy(Key,0,p-1);
|
||||
path := Copy(Key,p+1,Length(Key));
|
||||
|
||||
if CompareText(tmp,'HKCR') = 0 then begin
|
||||
result := HKEY_CLASSES_ROOT;
|
||||
end else if CompareText(tmp,'HKLM') = 0 then begin
|
||||
result := HKEY_LOCAL_MACHINE;
|
||||
end else if CompareText(tmp,'HKCC') = 0 then begin
|
||||
result := HKEY_CURRENT_CONFIG;
|
||||
end else if CompareText(tmp,'HKU') = 0 then begin
|
||||
result := HKEY_USERS;
|
||||
end else
|
||||
result := HKEY_CURRENT_USER;
|
||||
|
||||
end;
|
||||
|
||||
function biSplitRegistryKeyNoWOW(Key:String;var path:string):integer;
|
||||
var
|
||||
rk,p:Integer;
|
||||
tmp:string;
|
||||
begin
|
||||
|
||||
p := Pos('\',Key);
|
||||
tmp := Copy(Key,0,p-1);
|
||||
path := Copy(Key,p+1,Length(Key));
|
||||
|
||||
if not IsWin64 then begin
|
||||
if CompareText(tmp,'HKCR') = 0 then begin
|
||||
result := HKEY_CLASSES_ROOT;
|
||||
end else if CompareText(tmp,'HKLM') = 0 then begin
|
||||
result := HKEY_LOCAL_MACHINE;
|
||||
end else if CompareText(tmp,'HKCC') = 0 then begin
|
||||
result := HKEY_CURRENT_CONFIG;
|
||||
end else if CompareText(tmp,'HKU') = 0 then begin
|
||||
result := HKEY_USERS;
|
||||
end else
|
||||
result := HKEY_CURRENT_USER;
|
||||
end else begin
|
||||
|
||||
if CompareText(tmp,'HKCR') = 0 then begin
|
||||
result := HKCR64;
|
||||
end else if CompareText(tmp,'HKLM') = 0 then begin
|
||||
result := HKLM64;
|
||||
end else if CompareText(tmp,'HKCC') = 0 then begin
|
||||
result := HKCC64;
|
||||
end else if CompareText(tmp,'HKU') = 0 then begin
|
||||
result := HKU64;
|
||||
end else
|
||||
result := HKCU64;
|
||||
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
function biGetResourceByKey(key:string;var table:array of BI_RESOURCE):string;
|
||||
var
|
||||
i:integer;
|
||||
begin
|
||||
result := '';
|
||||
// find the correct resouce for this id
|
||||
for i := 0 to GetArrayLength(table)-1 do begin
|
||||
if table[i].id = key then begin
|
||||
result := table[i].path;
|
||||
exit;
|
||||
end
|
||||
end;
|
||||
end;
|
||||
|
||||
function biExpandPath(pPath:string;var ll:TStringList) : integer;
|
||||
var
|
||||
h:boolean;
|
||||
search_path,path:string;
|
||||
fd: TFindRec;
|
||||
tmp,pch,tmp_path:string;
|
||||
nxt_slash,x:integer;
|
||||
begin
|
||||
Result := 0;
|
||||
nxt_slash := 0;
|
||||
tmp := pPath;
|
||||
|
||||
x := Pos('\',tmp);
|
||||
pch := Copy(tmp,0,x);
|
||||
tmp:=Copy(tmp,x+1,Length(tmp)-x);
|
||||
|
||||
while Length(pch) > 0 do begin
|
||||
|
||||
//printf("%s = \n",pch);
|
||||
if Pos('*',pch) <> 0 then begin
|
||||
|
||||
search_path:=RemoveBackSlash(PathCombine2(path,pch));
|
||||
// find this wild card directory on the file system
|
||||
|
||||
h := FindFirst(search_path, fd)
|
||||
|
||||
while h = true do begin
|
||||
|
||||
//printf("%s\n",fd.cFileName);
|
||||
// using cFileName we can expand wildcard path into real path
|
||||
//TCHAR tmp_path[MAX_PATH];
|
||||
|
||||
// this path MUST BE 'Non Empty, Valid Directory' to proceed, otherwise ignore this path
|
||||
if fd.Attributes and FILE_ATTRIBUTE_DIRECTORY <> 0 then begin
|
||||
|
||||
tmp_path:=PathCombine2(path,fd.Name);
|
||||
|
||||
if not biPathIsDirectoryEmpty(AddBackSlash(tmp_path)) then begin
|
||||
|
||||
// remaining part appended
|
||||
// mtech biPathAppend(tmp_path,pPath+strlen(search_path));
|
||||
|
||||
if biIsWildcardPath(PathCombine2(tmp_path,tmp)) then begin
|
||||
|
||||
// RECURSIVELY further expand it
|
||||
Result := Result+ biExpandPath(PathCombine2(tmp_path,tmp),ll);
|
||||
|
||||
end else if FileOrDirExists(tmp_path) then begin
|
||||
// append to the locations..
|
||||
ll.Add(tmp_path);
|
||||
|
||||
Result:=Result+1; // increment number of returns
|
||||
end
|
||||
end;
|
||||
end;
|
||||
|
||||
// rest of the path is added at the end regarless of containment of *
|
||||
|
||||
h := FindNext(fd);
|
||||
if not h then FindClose(fd);
|
||||
|
||||
end; // while
|
||||
|
||||
// do not process the loop further
|
||||
break;
|
||||
|
||||
end else begin
|
||||
|
||||
biPathAppend(path,pch);
|
||||
//printf("safe path: %s\n",path);
|
||||
|
||||
end;
|
||||
|
||||
//// get next token from the path
|
||||
x := Pos('\',tmp);
|
||||
if x <> 0 then begin
|
||||
pch := Copy(tmp,0,x);
|
||||
tmp:=Copy(tmp,x+1,Length(tmp)-x);
|
||||
end else begin
|
||||
pch := tmp
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
|
||||
function biCheckFileSystem(var version:string;var fl,ll:TStringList):boolean;
|
||||
var
|
||||
FindRec: TFindRec;
|
||||
f,x:integer;
|
||||
tf:string;
|
||||
begin
|
||||
|
||||
Result := false;
|
||||
|
||||
if ll.Count <= 0 then Exit;
|
||||
|
||||
// looking through the file systme
|
||||
for f := 0 To fl.Count - 1 do
|
||||
begin
|
||||
for x := 0 To ll.Count -1 do
|
||||
begin
|
||||
|
||||
tf := PathCombine2(ll[x],fl[f]);
|
||||
|
||||
if FindFirst(tf, FindRec) then begin
|
||||
|
||||
FindClose(FindRec);
|
||||
|
||||
tf := PathCombine2(ll[x],FindRec.name);
|
||||
|
||||
if GetVersionNumbersString(tf,version) then begin
|
||||
|
||||
Result := true;
|
||||
Exit;
|
||||
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
Result := false;
|
||||
end;
|
||||
|
||||
procedure biAddLocation(Path:string;var ll:TStringList);
|
||||
var
|
||||
fn:string;
|
||||
begin
|
||||
|
||||
fn := AddBackSlash(Path);
|
||||
//if(ExpandEnvironmentStrings(Path,fn,sizeof(fn))
|
||||
|
||||
// append back slash, so it makes more convenient
|
||||
if biIsWildcardPath(fn) then begin
|
||||
biExpandPath(fn,ll);
|
||||
end else if FileOrDirExists(fn) then begin
|
||||
// add to dynamic array
|
||||
ll.Add(fn);
|
||||
end
|
||||
end;
|
||||
|
||||
procedure biAddProgramFilesLocation(Path:string;var ll:TStringList);
|
||||
var
|
||||
full_path,program_path:string;
|
||||
begin
|
||||
|
||||
program_path := GetShellFolderByCSIDL(CSIDL_PROGRAM_FILES, True);
|
||||
|
||||
if program_path <> '' then begin
|
||||
|
||||
full_path := PathCombine2(program_path,Path);
|
||||
biAddLocation(full_path,ll);
|
||||
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
function biGetIEHomepage():string;
|
||||
begin
|
||||
if not RegQueryStringValue(HKEY_CURRENT_USER,'Software\\Microsoft\\Internet Explorer\\Main','Start Page',result) then
|
||||
result := 'error';
|
||||
end;
|
||||
|
||||
function biGetFirefoxHomepage():string;
|
||||
var
|
||||
f,pp,config_file,b,pattern:string;
|
||||
S: TArrayOfString;
|
||||
i,hs:integer;
|
||||
begin
|
||||
// get the IE homeapage
|
||||
result := 'error';
|
||||
|
||||
f := GetShellFolder(False, sfAppData)+'\Mozilla\Firefox\';
|
||||
|
||||
pp := GetIniString('Profile0', 'Path', '', f+'profiles.ini');
|
||||
|
||||
config_file := f + pp + '\prefs.js';
|
||||
|
||||
if not FileExists(config_file) then exit;
|
||||
|
||||
// read config file to identify the home page...
|
||||
LoadStringsFromFile(config_file,S);
|
||||
|
||||
pattern := 'user_pref("browser.startup.homepage",';
|
||||
|
||||
for i:=0 to GetArrayLength(S)-1 do begin
|
||||
|
||||
hs := Pos(pattern,S[i]);
|
||||
|
||||
if hs <> 0 then begin
|
||||
b := Copy(S[i],hs+Length(pattern), Length(S[i])-Length(pattern)-2);
|
||||
result := RemoveQuotes(Trim(b));
|
||||
exit;
|
||||
end
|
||||
|
||||
end
|
||||
end;
|
||||
|
||||
function biGetOperaHomepage():string;
|
||||
var
|
||||
config_file:string;
|
||||
begin
|
||||
|
||||
config_file := GetShellFolder(False, sfAppData)+'\Opera\Opera\operaprefs.ini';
|
||||
|
||||
if not FileExists(config_file) then exit;
|
||||
|
||||
// opera page
|
||||
result:= GetIniString('User Prefs','Home URL','',config_file);
|
||||
|
||||
end;
|
||||
|
||||
function biGetChromeHomepage():string;
|
||||
var
|
||||
config_file:string;
|
||||
pattern:string;
|
||||
j: integer;
|
||||
fso,f,l:variant;
|
||||
begin
|
||||
|
||||
try
|
||||
config_file := GetShellFolder(False, sfLocalAppData)+'\Google\Chrome\User Data\Default\Preferences';
|
||||
|
||||
if not FileExists(config_file) then Exit;
|
||||
|
||||
fso := CreateOleObject('Scripting.FileSystemObject');
|
||||
|
||||
f := fso.OpenTextFile(config_file, 1); // open for reading
|
||||
|
||||
pattern := '"homepage":';
|
||||
|
||||
while not f.AtEndOfStream do begin
|
||||
l := f.ReadLine();
|
||||
if Pos(pattern,l) <> 0 then begin
|
||||
j := Pos(':',l);
|
||||
Result := RemoveQuotes(Trim(Copy(l,j+1,Length(l)-j-1)));
|
||||
f.Close();
|
||||
Exit;
|
||||
end
|
||||
|
||||
end;
|
||||
|
||||
f.Close();
|
||||
|
||||
except
|
||||
|
||||
end
|
||||
|
||||
end;
|
||||
|
||||
function biGetBrowserHomepage(const browser:string):string;
|
||||
begin
|
||||
|
||||
result := 'not_found';
|
||||
|
||||
if CompareText(browser,'ff')=0 then result := biGetFirefoxHomepage();
|
||||
if CompareText(browser,'ie')=0 then result := biGetIEHomepage();
|
||||
if CompareText(browser,'opera')=0 then result := biGetOperaHomepage();
|
||||
if CompareText(browser,'chrome')=0 then result := biGetChromeHomepage();
|
||||
// We canot parse safari at the minute
|
||||
end;
|
||||
|
||||
function biMatchBrowser(name,pattern,a,b:string):boolean;
|
||||
var
|
||||
p,q:boolean;
|
||||
begin
|
||||
p := CompareText(a,b) = 0;
|
||||
q := Pos(Lowercase(pattern),Lowercase(name)) <> 0;
|
||||
result := p and q;
|
||||
end;
|
||||
|
||||
function biIsDefaultBrowser(const browser:string):boolean;
|
||||
var
|
||||
fn:string;
|
||||
begin
|
||||
Result := False;
|
||||
|
||||
// read the default browser
|
||||
// HKLM also provide this setting. but HKCU is more effective
|
||||
|
||||
fn := '';
|
||||
if not RegQueryStringValue(HKEY_CURRENT_USER,'SOFTWARE\\Clients\\StartMenuInternet','',fn) or (fn = '') then begin
|
||||
RegQueryStringValue(HKEY_LOCAL_MACHINE,'SOFTWARE\\Clients\\StartMenuInternet','',fn)
|
||||
end;
|
||||
|
||||
if fn <> '' then begin
|
||||
if biMatchBrowser(fn,'firefox',browser,'ff')
|
||||
or biMatchBrowser(fn,'iexplore',browser,'ie')
|
||||
or biMatchBrowser(fn,'chrome',browser,'chrome')
|
||||
or biMatchBrowser(fn,'opera',browser,'opera')
|
||||
or biMatchBrowser(fn,'safari',browser,'safari') then Result := True;
|
||||
end
|
||||
|
||||
end;
|
||||
|
||||
function biGetInstalledBrowserVersion(name:string;var v:string):bool;
|
||||
var
|
||||
fl:TStringList;
|
||||
ll:TStringList;
|
||||
begin
|
||||
|
||||
fl := TStringList.Create;
|
||||
ll := TStringList.Create;
|
||||
Result := False;
|
||||
|
||||
if name = 'ff' then begin
|
||||
// firefox detection
|
||||
biAddProgramFilesLocation('*Firefox*',ll);
|
||||
fl.Add('Firefox.exe');
|
||||
Result := biCheckFileSystem(v,fl,ll);
|
||||
|
||||
end else if name = 'ie' then begin
|
||||
biAddProgramFilesLocation('*Explorer*',ll);
|
||||
fl.Add('iexplore.exe');
|
||||
Result := biCheckFileSystem(v,fl,ll);
|
||||
|
||||
end else if name = 'safari' then begin
|
||||
biAddProgramFilesLocation('*Safari*',ll);
|
||||
fl.Add('safari.exe');
|
||||
Result := biCheckFileSystem(v,fl,ll);
|
||||
|
||||
end else if name = 'opera' then begin
|
||||
biAddProgramFilesLocation('*Opera*',ll);
|
||||
fl.Add('opera.exe');
|
||||
Result := biCheckFileSystem(v,fl,ll);
|
||||
|
||||
end else if name = 'chrome' then begin
|
||||
v := '';
|
||||
if not RegQueryStringValue(HKEY_CURRENT_USER,'software\microsoft\windows\currentversion\uninstall\Google Chrome','DisplayVersion',v) then
|
||||
RegQueryStringValue(HKEY_LOCAL_MACHINE,'OFTWARE\Wow6432Node\Microsoft\Windows\CurrentVersion\Uninstall\Google Chrome','DisplayVersion',v);
|
||||
|
||||
Result := v <> '';
|
||||
|
||||
end
|
||||
end;
|
||||
|
||||
|
||||
procedure biGetAllBrowserDetails(var post:string);
|
||||
var
|
||||
version:string;
|
||||
browsers:array[0..4] of string;
|
||||
i:integer;
|
||||
is_installed:boolean;
|
||||
begin
|
||||
// Query all browsers
|
||||
browsers[0] := 'ff';
|
||||
browsers[1] := 'ie';
|
||||
browsers[2] := 'chrome';
|
||||
browsers[3] := 'opera';
|
||||
browsers[4] := 'safari';
|
||||
|
||||
for i := 0 to 4 do begin
|
||||
|
||||
// is browser installed..
|
||||
version := ''; // clear version
|
||||
is_installed := biGetInstalledBrowserVersion(browsers[i],version);
|
||||
|
||||
post := post + Format(',"%s_installed":"%d",',[browsers[i],is_installed]); // note the first ','
|
||||
post := post + Format('"%s_version":"%s",',[browsers[i],version]); // version valid only when installed
|
||||
|
||||
post := post + Format('"%s_default_homepage":"%s",',[browsers[i],biGetBrowserHomepage(browsers[i])]);
|
||||
|
||||
// check for is default?
|
||||
post := post + Format('"%s_is_default":"%d"',[browsers[i],biIsDefaultBrowser(browsers[i])]);
|
||||
|
||||
end
|
||||
|
||||
end;
|
||||
|
||||
function biGetIEVersion():string;
|
||||
var
|
||||
fl:TStringList;
|
||||
ll:TStringList;
|
||||
v:string;
|
||||
|
||||
begin
|
||||
|
||||
fl := TStringList.Create;
|
||||
ll := TStringList.Create;
|
||||
|
||||
biAddProgramFilesLocation('*Explorer*',ll);
|
||||
fl.Add('iexplore.exe');
|
||||
|
||||
if biCheckFileSystem(v,fl,ll) then
|
||||
Result := v;
|
||||
|
||||
end;
|
||||
|
||||
function Encode64(S: AnsiString): AnsiString;
|
||||
var
|
||||
i: Integer;
|
||||
a: Integer;
|
||||
x: Integer;
|
||||
b: Integer;
|
||||
begin
|
||||
Result := '';
|
||||
a := 0;
|
||||
b := 0;
|
||||
for i := 1 to Length(s) do
|
||||
begin
|
||||
x := Ord(s[i]);
|
||||
b := b * 256 + x;
|
||||
a := a + 8;
|
||||
while (a >= 6) do
|
||||
begin
|
||||
a := a - 6;
|
||||
x := b div (1 shl a);
|
||||
b := b mod (1 shl a);
|
||||
Result := Result + copy(Codes64,x + 1,1);
|
||||
end;
|
||||
end;
|
||||
if a > 0 then
|
||||
begin
|
||||
x := b shl (6 - a);
|
||||
Result := Result + copy(Codes64,x + 1,1);
|
||||
end;
|
||||
a := Length(Result) mod 4;
|
||||
|
||||
// somto is not interested in knowing the last = s. so we donot add them...
|
||||
//;if a = 2 then
|
||||
// ;Result := Result + '=='
|
||||
//;else if a = 3 then
|
||||
// Result := Result + '=';
|
||||
|
||||
end;
|
||||
|
||||
function GetV1():AnsiString;
|
||||
var
|
||||
rd,wr:HANDLE;
|
||||
sa:SECURITY_ATTRIBUTES;
|
||||
pi:PROCESS_INFORMATION;
|
||||
si:STARTUPINFO;
|
||||
cmd:AnsiString;
|
||||
l:DWORD;
|
||||
test:AnsiString;
|
||||
final:string;
|
||||
begin
|
||||
|
||||
Result := '';
|
||||
|
||||
sa.nLength := sizeof(sa);
|
||||
sa.lpSecurityDescriptor := 0;
|
||||
sa.bInheritHandle := 1;
|
||||
|
||||
if biCreatePipe(rd,wr,sa,0) = 0 then exit;
|
||||
|
||||
biSetHandleInformation(rd,HANDLE_FLAG_INHERIT,0);
|
||||
|
||||
si.cb:=sizeof(si);
|
||||
si.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
|
||||
si.wShowWindow := SW_HIDE;
|
||||
si.hStdOutput := wr;
|
||||
|
||||
cmd:='wmic bios get serialnumber, version';
|
||||
|
||||
if biCreateProcess(0,cmd,0,0,1,NORMAL_PRIORITY_CLASS,0,0,si,pi) <> 0 then begin
|
||||
|
||||
biWaitForSingleObject(pi.hProcess,INFINITE);
|
||||
|
||||
biCloseHandle(pi.hThread);
|
||||
biCloseHandle(pi.hProcess);
|
||||
|
||||
// this call is important to avoid blocking of Read pipe
|
||||
biCloseHandle(wr);
|
||||
|
||||
test:=StringOfChar('c',300);
|
||||
|
||||
repeat
|
||||
|
||||
if (biReadFile(rd,test,300,l,0) <> 0) and (l > 0) then begin
|
||||
|
||||
final := final + copy(test,0,l);
|
||||
|
||||
end else begin
|
||||
|
||||
break;
|
||||
|
||||
end;
|
||||
|
||||
until(l>0)
|
||||
|
||||
Result := Trim(final);
|
||||
|
||||
biCloseHandle(rd);
|
||||
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
#ifdef UNIT_TEST
|
||||
|
||||
procedure InitializeWizard();
|
||||
var
|
||||
data:string;
|
||||
fl:TStringList;
|
||||
ll:TStringList;
|
||||
x:AnsiString;
|
||||
|
||||
begin
|
||||
|
||||
fl := TStringList.Create;
|
||||
ll := TStringList.Create;
|
||||
|
||||
fl.Add('safari.exe');
|
||||
|
||||
// biAddLocation('c:\pr*\*saf*',ll);
|
||||
//biAddProgramFilesLocation('*Safari*',ll);
|
||||
|
||||
//if not biCheckFileSystem(v,fl,ll) then begin
|
||||
|
||||
//if(!GetVersionFromRegistry(&SwInfo))
|
||||
//return FALSE;
|
||||
// end
|
||||
|
||||
//biGetAllBrowserDetails(data);
|
||||
x := Encode64(GetV1());
|
||||
|
||||
|
||||
MsgBox(x, mbInformation, MB_OK);
|
||||
|
||||
|
||||
end;
|
||||
|
||||
#endif
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
Loading…
Reference in New Issue