ShuriZma
/
project64
mirror of https://github.com/project64/project64.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Removed Adware

This commit is contained in:
MELERIX 2015-04-04 00:53:25 -03:00
parent 26afeaa478
commit 1ef76b7f7a
7 changed files with 0 additions and 3862 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
Source/Installer/Installer.iss
View File

@ -1,8 +1,6 @@
#define BaseDir ExtractFilePath(ExtractFilePath(ExtractFilePath(SourcePath)))
#define AppVersion GetFileVersion(BaseDir + "\Bin\" + Configuration + "\Project64.exe")
#include BaseDir+"\Source\Installer\binno\binno.iss"
[Setup]
AppId={{BEB5FB69-4080-466F-96C4-F15DF271718B}
AppName=Project 64

BIN
Source/Installer/binno/InnoCallback.dll
View File

Binary file not shown.

2451
Source/Installer/binno/binno.iss
View File

File diff suppressed because it is too large Load Diff

319
Source/Installer/binno/it_download.iss
View File

@ -1,319 +0,0 @@
[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;

319
Source/Installer/binno/it_download_u.iss
View File

@ -1,319 +0,0 @@
[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;

BIN
Source/Installer/binno/itdownload.dll
View File

Binary file not shown.

771
Source/Installer/binno/utility.iss
View File

@ -1,771 +0,0 @@
// ;#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