WINDOWS/w10install
0
Fork 0
Code Issues 2 Releases 5 Activity
master
w10install/source/SFTA.pb

1419 lines
48 KiB
Plaintext
Raw Permalink Normal View History

Set file extensions after install by script #87
2023-01-19 14:31:37 +01:00

; Copyright
; Copyright 2021 Danysys. <danysys.com>
; Copyright
;
; Information
; Author(s)......: Danyfirex & Dany3j
; Description....: Set Windows 8/10 File Type Association
; Version........: 1.3.1
; Information
;
; Resources & Credits
; https://bbs.pediy.com/thread-213954.htm
; LMongrain - Hash Algorithm
; Resources & Credits
EnableExplicit
#SFTA_VERSION="1.3.1"
Global g_Debug=#False
#SHCNE_ASSOCCHANGED=$8000000
#SHCNF_IDLIST=0
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;Hash Algorithm Map
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Structure HashMap
*pUData
Cache.l
Counter.l
Index.l
MD5Bytes1.l
MD5Bytes2.l
OutHash1.l
OutHash2.l
Reckon0.l
Reckon1.l[2]
Reckon2.l[2]
Reckon3.l
Reckon4.l[2]
Reckon5.l[2]
Reckon6.l[2]
Reckon7.l[3]
Reckon8.l
Reckon9.l[3]
EndStructure
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;Hash Algorithm Map
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;Registry Management
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
#CHAR_SIZE = SizeOf(Character)
#KEY_WOW64_64KEY = $0100
#KEY_WOW64_32KEY = $0200
Procedure.s ExpandString(iString.s)
; Expands environment variables in string
Protected r.s, size.i
size = ExpandEnvironmentStrings_(iString, 0, 0)
r = Space(size)
ExpandEnvironmentStrings_(iString, @r, size)
ProcedureReturn r
EndProcedure
Procedure.i RegRoot(iKey.s)
; Returns the root integer value
; HKCR, CKCC, HKLM, HKU, HKCC
Protected pos.i, temp.s, r.i
pos = FindString(iKey, "\")
If Not pos
ProcedureReturn
EndIf
temp = LCase(Left(iKey, pos - 1))
Select temp
Case "hkcr", "hkey_classes_root"
r = #HKEY_CLASSES_ROOT
Case "hkcu", "hkey_current_user"
r = #HKEY_CURRENT_USER
Case "hklm", "hkey_local_machine"
r = #HKEY_LOCAL_MACHINE
Case "hku", "hkey_users"
r = #HKEY_USERS
Case "hkcc", "hkey_current_config"
r = #HKEY_CURRENT_CONFIG
Default
ProcedureReturn r
EndSelect
ProcedureReturn r
EndProcedure
Procedure.s RegSub(iKey.s)
; Returns sub key
Protected r.s, pos.i
pos = FindString(iKey, "\")
If Not pos
ProcedureReturn
EndIf
r = Mid(iKey, pos + 1)
ProcedureReturn r
EndProcedure
Procedure.i RegWrite(iKey.s, iName.s, iValue.s, iType.i, iForceBit = 0)
; Sets registry item to value
; iForceBit: 32 or 64 returns 32 or 64 bit registry on a 64 bit system
Protected h.i, rootKey.i, subKey.s, v.i, datSize.i, *dat, hex.s, oct.i, i.i
Protected *src, c.c, pos.i
Protected Ret.i
rootKey = RegRoot(iKey)
subKey = RegSub(iKey)
If iForceBit = 32
iForceBit = #KEY_WOW64_32KEY
ElseIf iForceBit = 64
iForceBit = #KEY_WOW64_64KEY
EndIf
If RegCreateKeyEx_(rootKey, subKey, 0, 0, 0, #KEY_WRITE | iForceBit, 0, @h, 0) = #ERROR_SUCCESS
;If RegOpenKeyEx_(rootKey, subKey, 0, #KEY_WRITE | iForceBit, @h) = #ERROR_SUCCESS
Select iType
Case #REG_SZ, #REG_EXPAND_SZ
Ret=RegSetValueEx_(h, iName, 0, iType, @iValue, StringByteLength(iValue))
Case #REG_DWORD
v = Val(iValue)
Ret=RegSetValueEx_(h, iName, 0, iType, @v, 4)
Case #REG_QWORD
v = Val(iValue)
Ret=RegSetValueEx_(h, iName, 0, iType, @v, 8)
Case #REG_BINARY
datSize = Len(iValue) / 2
If datSize
*dat = AllocateMemory(datSize)
For i = 0 To datSize - 1
hex = "$" + Mid(iValue, (i * 2) + 1, 2)
oct = Val(hex)
PokeB(*dat + i, oct)
Next
Ret=RegSetValueEx_(h, iName, 0, iType, *dat, datSize)
FreeMemory(*dat)
Else
Ret=RegSetValueEx_(h, iName, 0, iType, #NUL, 0) ;Allow Binary Key with Empty Value
EndIf
Case #REG_NONE
RegSetValueEx_(h, iName, 0, iType, #NUL, 0) ;Allow None
Case #REG_MULTI_SZ
datSize = StringByteLength(iValue) + #CHAR_SIZE
*dat = AllocateMemory(datSize)
*src = @iValue
For i = 0 To (datSize - #CHAR_SIZE) Step #CHAR_SIZE
c = PeekC(*src + i)
If c <> #LF
If c = #CR
PokeC(*dat + pos, 0)
Else
PokeC(*dat + pos, c)
EndIf
pos + #CHAR_SIZE
EndIf
Next
PokeC(*dat + pos, 0)
Ret=RegSetValueEx_(h, iName, 0, iType, *dat, pos)
FreeMemory(*dat)
EndSelect
RegCloseKey_(h)
EndIf
ProcedureReturn Ret
EndProcedure
Procedure.s RegRead(iKey.s, iValue.s, iForceBit = 0)
; Returns registry value
Protected h.i, rootKey.i, subkey.s, type.i, *dat, datSize.i
Protected temp.s, pos.i, size.i, i.i, b.i, c.c, r.s = ""
rootKey = RegRoot(iKey)
subKey = RegSub(iKey)
If iForceBit = 32
iForceBit = #KEY_WOW64_32KEY
ElseIf iForceBit = 64
iForceBit = #KEY_WOW64_64KEY
EndIf
If RegOpenKeyEx_(rootKey, subKey, 0, #KEY_READ | iForceBit, @h) = #ERROR_SUCCESS
If RegQueryValueEx_(h, iValue, 0, @type, 0, @datSize) = #ERROR_SUCCESS
;Debug datSize
If datSize = 0
ProcedureReturn r
EndIf
*dat = AllocateMemory(datSize)
RegQueryValueEx_(h, iValue, 0, @type, *dat, @datSize)
Select type
Case #REG_SZ
r = PeekS(*dat)
;Debug StringByteLength(r) + #CHAR_SIZE
Case #REG_EXPAND_SZ
r = PeekS(*dat)
r = ExpandString(r)
Case #REG_DWORD
r = Str(PeekL(*dat))
Case #REG_QWORD
r = Str(PeekQ(*dat))
Case #REG_BINARY
For i = 0 To datSize - 1
b = PeekB(*dat + i) & $FF ;make unsigned
r + RSet(Hex(b), 2, "0")
Next
Case #REG_MULTI_SZ
;charLength = (datSize - #CHAR_SIZE) / #CHAR_SIZE
pos = 0
For i = 0 To (datSize - #CHAR_SIZE) Step #CHAR_SIZE
c = PeekC(*dat + i)
If c = 0
If r <> ""
r + #CRLF$
EndIf
temp = PeekS(*dat + pos, (i - pos))
r + temp
pos = i + #CHAR_SIZE
EndIf
Next
EndSelect
FreeMemory(*dat)
EndIf
RegCloseKey_(h)
EndIf
ProcedureReturn r
EndProcedure
;Original from jaPBe IncludesPack _ change for PB4 by ts-soft
Procedure Reg_SetValue(topKey, sKeyName.s, sValueName.s, vValue.s, lType, ComputerName.s = "")
Protected lpData.s=Space(255)
Protected GetHandle.l, hKey.l, lReturnCode.l, lhRemoteRegistry.l, lpcbData, lValue.l, ergebnis.l
If Left(sKeyName, 1) = "\"
sKeyName = Right(sKeyName, Len(sKeyName) - 1)
EndIf
If ComputerName = ""
GetHandle = RegOpenKeyEx_(topKey, sKeyName, 0, #KEY_ALL_ACCESS, @hKey)
Else
lReturnCode = RegConnectRegistry_(ComputerName, topKey, @lhRemoteRegistry)
GetHandle = RegOpenKeyEx_(lhRemoteRegistry, sKeyName, 0, #KEY_ALL_ACCESS, @hKey)
EndIf
If GetHandle = #ERROR_SUCCESS
lpcbData = 255
Select lType
Case #REG_SZ
GetHandle = RegSetValueEx_(hKey, sValueName, 0, #REG_SZ, @vValue, Len(vValue) + 1)
Case #REG_DWORD
lValue = Val(vValue)
GetHandle = RegSetValueEx_(hKey, sValueName, 0, #REG_DWORD, @lValue, 4)
EndSelect
RegCloseKey_(hKey)
ergebnis = 1
ProcedureReturn ergebnis
Else
MessageRequester("Fehler", "Ein Fehler ist aufgetreten", 0)
RegCloseKey_(hKey)
ergebnis = 0
ProcedureReturn ergebnis
EndIf
EndProcedure
Procedure.s Reg_GetValue(topKey, sKeyName.s, sValueName.s, ComputerName.s = "")
Protected lpData.s=Space(255), GetValue.s
Protected GetHandle.l, hKey.l, lReturnCode.l, lhRemoteRegistry.l, lpcbData.l, lType.l, lpType.l
Protected lpDataDWORD.l
If Left(sKeyName, 1) = "\"
sKeyName = Right(sKeyName, Len(sKeyName) - 1)
EndIf
If ComputerName = ""
GetHandle = RegOpenKeyEx_(topKey, sKeyName, 0, #KEY_ALL_ACCESS, @hKey)
Else
lReturnCode = RegConnectRegistry_(ComputerName, topKey, @lhRemoteRegistry)
GetHandle = RegOpenKeyEx_(lhRemoteRegistry, sKeyName, 0, #KEY_ALL_ACCESS, @hKey)
EndIf
If GetHandle = #ERROR_SUCCESS
lpcbData = 255
GetHandle = RegQueryValueEx_(hKey, sValueName, 0, @lType, @lpData, @lpcbData)
If GetHandle = #ERROR_SUCCESS
Select lType
Case #REG_SZ
GetHandle = RegQueryValueEx_(hKey, sValueName, 0, @lType, @lpData, @lpcbData)
If GetHandle = 0
GetValue = Left(lpData, lpcbData - 1)
Else
GetValue = ""
EndIf
Case #REG_DWORD
GetHandle = RegQueryValueEx_(hKey, sValueName, 0, @lpType, @lpDataDWORD, @lpcbData)
If GetHandle = 0
GetValue = Str(lpDataDWORD)
Else
GetValue = "0"
EndIf
EndSelect
EndIf
EndIf
RegCloseKey_(hKey)
ProcedureReturn GetValue
EndProcedure
Procedure.s Reg_ListSubKey(topKey, sKeyName.s, Index, ComputerName.s = "")
Protected lpName.s=Space(255), ListSubKey.s
Protected lpftLastWriteTime.FILETIME
Protected GetHandle.l, hKey.l, lReturnCode.l, lhRemoteRegistry.l
Protected lpcbName.l = 255
If Left(sKeyName, 1) = "\"
sKeyName = Right(sKeyName, Len(sKeyName) - 1)
EndIf
If ComputerName = ""
GetHandle = RegOpenKeyEx_(topKey, sKeyName, 0, #KEY_ALL_ACCESS, @hKey)
Else
lReturnCode = RegConnectRegistry_(ComputerName, topKey, @lhRemoteRegistry)
GetHandle = RegOpenKeyEx_(lhRemoteRegistry, sKeyName, 0, #KEY_ALL_ACCESS, @hKey)
EndIf
If GetHandle = #ERROR_SUCCESS
GetHandle = RegEnumKeyEx_(hKey, Index, @lpName, @lpcbName, 0, 0, 0, @lpftLastWriteTime)
If GetHandle = #ERROR_SUCCESS
ListSubKey.s = Left(lpName, lpcbName)
Else
ListSubKey.s = ""
EndIf
EndIf
RegCloseKey_(hKey)
ProcedureReturn ListSubKey
EndProcedure
Procedure Reg_DeleteValue(topKey, sKeyName.s, sValueName.s, ComputerName.s = "")
Protected GetHandle.l, hKey.l, lReturnCode.l, lhRemoteRegistry.l, DeleteValue.l
If Left(sKeyName, 1) = "\"
sKeyName = Right(sKeyName, Len(sKeyName) - 1)
EndIf
If ComputerName = ""
GetHandle = RegOpenKeyEx_(topKey, sKeyName, 0, #KEY_ALL_ACCESS, @hKey)
Else
lReturnCode = RegConnectRegistry_(ComputerName, topKey, @lhRemoteRegistry)
GetHandle = RegOpenKeyEx_(lhRemoteRegistry, sKeyName, 0, #KEY_ALL_ACCESS, @hKey)
EndIf
If GetHandle = #ERROR_SUCCESS
GetHandle = RegDeleteValue_(hKey, @sValueName)
If GetHandle = #ERROR_SUCCESS
DeleteValue = #True
Else
DeleteValue = #False
EndIf
EndIf
RegCloseKey_(hKey)
ProcedureReturn DeleteValue
EndProcedure
Procedure Reg_CreateKey(topKey, sKeyName.s, ComputerName.s = "")
Protected lpSecurityAttributes.SECURITY_ATTRIBUTES
Protected GetHandle.l, hNewKey.l, lReturnCode.l, lhRemoteRegistry.l, CreateKey.l
If Left(sKeyName, 1) = "\"
sKeyName = Right(sKeyName, Len(sKeyName) - 1)
EndIf
If ComputerName = ""
GetHandle = RegCreateKeyEx_(topKey, sKeyName, 0, 0, #REG_OPTION_NON_VOLATILE, #KEY_ALL_ACCESS, @lpSecurityAttributes, @hNewKey, @GetHandle)
Else
lReturnCode = RegConnectRegistry_(ComputerName, topKey, @lhRemoteRegistry)
GetHandle = RegCreateKeyEx_(lhRemoteRegistry, sKeyName, 0, 0, #REG_OPTION_NON_VOLATILE, #KEY_ALL_ACCESS, @lpSecurityAttributes, @hNewKey, @GetHandle)
EndIf
If GetHandle = #ERROR_SUCCESS
GetHandle = RegCloseKey_(hNewKey)
CreateKey = #True
Else
CreateKey = #False
EndIf
ProcedureReturn CreateKey
EndProcedure
Procedure Reg_DeleteKey(topKey, sKeyName.s, ComputerName.s = "")
Protected GetHandle.l, lReturnCode.l, lhRemoteRegistry.l, DeleteKey.l
If Left(sKeyName, 1) = "\"
sKeyName = Right(sKeyName, Len(sKeyName) - 1)
EndIf
If ComputerName = ""
GetHandle = RegDeleteKey_(topKey, @sKeyName)
Else
lReturnCode = RegConnectRegistry_(ComputerName, topKey, @lhRemoteRegistry)
GetHandle = RegDeleteKey_(lhRemoteRegistry, @sKeyName)
EndIf
If GetHandle = #ERROR_SUCCESS
DeleteKey = #True
Else
DeleteKey = #False
EndIf
ProcedureReturn DeleteKey
EndProcedure
Procedure.s Reg_ListSubValue(topKey, sKeyName.s, Index, ComputerName.s = "")
Protected lpName.s=Space(255), ListSubValue.s
Protected lpftLastWriteTime.FILETIME
Protected GetHandle.l, hKey.l, lReturnCode.l, lhRemoteRegistry.l
Protected lpcbName.l = 255
If Left(sKeyName, 1) = "\"
sKeyName = Right(sKeyName, Len(sKeyName) - 1)
EndIf
If ComputerName = ""
GetHandle = RegOpenKeyEx_(topKey, sKeyName, 0, #KEY_ALL_ACCESS, @hKey)
Else
lReturnCode = RegConnectRegistry_(ComputerName, topKey, @lhRemoteRegistry)
GetHandle = RegOpenKeyEx_(lhRemoteRegistry, sKeyName, 0, #KEY_ALL_ACCESS, @hKey)
EndIf
If GetHandle = #ERROR_SUCCESS
GetHandle = RegEnumValue_(hKey, Index, @lpName, @lpcbName, 0, 0, 0, 0)
If GetHandle = #ERROR_SUCCESS
ListSubValue = Left(lpName, lpcbName)
Else
ListSubValue = ""
EndIf
RegCloseKey_(hKey)
EndIf
ProcedureReturn ListSubValue
EndProcedure
Procedure Reg_KeyExists(topKey, sKeyName.s, ComputerName.s = "")
Protected GetHandle.l, hKey.l, lReturnCode.l, lhRemoteRegistry.l, KeyExists.l
If Left(sKeyName, 1) = "\"
sKeyName = Right(sKeyName, Len(sKeyName) - 1)
EndIf
If ComputerName = ""
GetHandle = RegOpenKeyEx_(topKey, sKeyName, 0, #KEY_ALL_ACCESS, @hKey)
Else
lReturnCode = RegConnectRegistry_(ComputerName, topKey, @lhRemoteRegistry)
GetHandle = RegOpenKeyEx_(lhRemoteRegistry, sKeyName, 0, #KEY_ALL_ACCESS, @hKey)
EndIf
If GetHandle = #ERROR_SUCCESS
KeyExists = #True
Else
KeyExists = #False
EndIf
ProcedureReturn KeyExists
EndProcedure
Procedure Reg_DeleteKeyWithAllSub(topKey, sKeyName.s, ComputerName.s = "")
Protected i.l
Protected a$, b$
Repeat
b$ = a$
a$ = Reg_ListSubKey(topKey,sKeyName,0,"")
If a$ <> ""
Reg_DeleteKeyWithAllSub(topKey,sKeyName+"\"+a$,"")
EndIf
Until a$ = b$
Reg_DeleteKey(topKey, sKeyName, ComputerName)
EndProcedure
Procedure Reg_CreateKeyValue(topKey, sKeyName.s, sValueName.s, vValue.s, lType, ComputerName.s = "")
Reg_CreateKey(topKey,sKeyName,ComputerName)
ProcedureReturn Reg_SetValue(topKey,sKeyName,sValueName,vValue,lType,ComputerName)
EndProcedure
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;Registry Management
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;Debug Funcions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Procedure EnableDisableDebug()
Protected iNumberOfParameters.i = CountProgramParameters()
Protected i
g_Debug=#False
For i=0 To iNumberOfParameters.i-1
If ProgramParameter(i)="-d" Or ProgramParameter(i)="--debug"
g_Debug=#True
Break
EndIf
Next
EndProcedure
Procedure DebugPrint(Message.s)
If g_Debug
PrintN(FormatDate("[%yyyy.%mm.%dd %hh:%ii:%ss] ", Date()) + Message.s)
EndIf
EndProcedure
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;Debug Funcions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;OS Information Funcions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Procedure.s GetWindowsOS()
Protected WindowsOs.s=""
DebugPrint("OSVersion = " + Str(OSVersion()))
Select OSVersion()
Case #PB_OS_Windows_XP
WindowsOs.s="Windows XP"
Case #PB_OS_Windows_Server_2003
WindowsOs.s="Windows Server 2003"
Case #PB_OS_Windows_Vista
WindowsOs.s="Windows Vista"
Case #PB_OS_Windows_Server_2008
WindowsOs.s="Windows Server 2008"
Case #PB_OS_Windows_7
WindowsOs.s="Windows 7"
Case #PB_OS_Windows_Server_2008_R2
WindowsOs.s="Windows Server 2008 R2"
Case #PB_OS_Windows_8
WindowsOs.s="Windows 8"
Case #PB_OS_Windows_Server_2012
WindowsOs.s="Windows Server 2012"
Case #PB_OS_Windows_8_1
WindowsOs.s="Windows 8 1"
Case #PB_OS_Windows_Server_2012_R2
WindowsOs.s="Windows Server 2012 R2"
Case #PB_OS_Windows_10
WindowsOs.s="Windows 10"
Default
WindowsOs.s="Unkown"
EndSelect
ProcedureReturn WindowsOs.s
EndProcedure
Procedure.s GetWindowsReleaseID()
ProcedureReturn RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion", "ReleaseId")
EndProcedure
Procedure.s GetWindowsProductName()
ProcedureReturn RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion", "ProductName")
EndProcedure
Procedure.s GetWindowsBuild()
ProcedureReturn RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion", "CurrentBuild")
EndProcedure
Procedure.i IsWindows8_1()
ProcedureReturn Bool(OSVersion()=#PB_OS_Windows_8_1)
EndProcedure
Procedure.i IsWindows10()
ProcedureReturn Bool(OSVersion()=#PB_OS_Windows_10)
EndProcedure
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;OS Information Funcions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;Utils Funcions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Procedure.s QuoteString(String.s)
ProcedureReturn Chr(34) + String.s + Chr(34)
EndProcedure
Procedure.i FileExist(FilePath.s)
Protected Result.q = FileSize(FilePath.s)
Protected Extension.s = GetExtensionPart(FilePath.s)
ProcedureReturn Bool(Result.q>0 And Extension.s="exe")
EndProcedure
Procedure.s CreateApplicationID(FilePath.s,FileExt.s)
Protected ApplicationID.s=""
If Not FileExist(FilePath.s)
DebugPrint("ERROR Unable to find " + QuoteString(FilePath.s))
PrintN("Error File not Found " + QuoteString(FilePath.s))
ProcedureReturn ApplicationID.s
EndIf
Protected ApplicationName.s=ReplaceString(GetFilePart(FilePath.s,#PB_FileSystem_NoExtension)," ","")
ApplicationID.s="SFTA." + ApplicationName.s + FileExt.s
ProcedureReturn ApplicationID.s
EndProcedure
Procedure.i RunWait(FilePath.s,Parameter.s="",CurrentDir.s="",Flag.i=#PB_Program_Open | #PB_Program_Wait)
Protected Program=RunProgram(FilePath.s,Parameter.s,CurrentDir.s,Flag.i)
Protected ExitCode=ProgramExitCode(Program)
ProcedureReturn ExitCode
EndProcedure
Procedure.i RunCmdCommand(Parameter.s="",CurrentDir.s="")
Protected CmdPath.s= GetEnvironmentVariable("ComSpec")
Protected ExitCode=RunWait(CmdPath.s,Parameter.s,CurrentDir.s,#PB_Program_Open | #PB_Program_Wait|#PB_Program_Hide)
ProcedureReturn ExitCode
EndProcedure
Procedure.i IsAdmin()
ProcedureReturn IsUserAdmin_()
EndProcedure
Procedure.i IsValidParameter(Parameter.s,ValidParameters.s)
Define.i isValid,k
isValid=0
For k = 1 To CountString(ValidParameters.s, "|")+1
If StringField(ValidParameters.s, k, "|")=Parameter.s
isValid=1
EndIf
Next
ProcedureReturn isValid
EndProcedure
Procedure CheckValidOS()
If OSVersion()=#PB_OS_Windows_10 Or OSVersion()=#PB_OS_Windows_8_1
;Its OK
Else
PrintN("Error. It is not a Windows 8/10 OS")
End 2
EndIf
EndProcedure
Procedure.b IsFileType(String.s)
ProcedureReturn Bool(FindString(String.s,".")>0)
EndProcedure
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;Utils Funcions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;Sid Management
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;By Thunder93
Prototype ConvertSidToStringSid(Sid, *StringSid)
Global Lib_Advapi32=0
Procedure Advapi32_Init()
Protected cExt.s
Protected Retr.b
CompilerIf #PB_Compiler_Unicode : cExt = "W" : CompilerElse : cExt = "A" : CompilerEndIf
Lib_Advapi32 = OpenLibrary(#PB_Any,"Advapi32.dll")
If Lib_Advapi32
Global ConvertSidToStringSid.ConvertSidToStringSid = GetFunction(Lib_Advapi32,"ConvertSidToStringSid"+cExt)
Retr = 1
EndIf
ProcedureReturn Retr
EndProcedure
Procedure Advapi32_End()
CloseLibrary(Lib_Advapi32)
EndProcedure
Procedure.s GetSid(AccountName.s = "")
Protected cbSID.l, lDomainName.s, cbDomainName.l, SIDType.i, SID.s
If Advapi32_Init() = 0 : Debug "Advapi32_Init failed" : ProcedureReturn "" : EndIf
If AccountName = ""
Protected lpBuffer.s = Space(#UNLEN+1)
Protected lpnSize.l = #UNLEN+1
If GetUserName_(@lpBuffer, @lpnSize)
AccountName = lpBuffer
EndIf
EndIf
If Not LookupAccountName_(0, @AccountName, #Null, @cbSID, #Null, @cbDomainName, @SIDType)
If GetLastError_() = #ERROR_INSUFFICIENT_BUFFER
Protected *ptrSid = AllocateMemory(cbSid)
If Not *ptrSid : Debug "*ptrSid memory allocation failed" : ProcedureReturn "" : EndIf
lDomainName = Space(cbDomainName)
If LookupAccountName_(0, @AccountName, *ptrSid, @cbSID, @lDomainName, @cbDomainName, @SIDType)
Protected StringSid.l=0
If ConvertSidToStringSid(*ptrSid, @StringSid)
FreeMemory(*ptrSid)
SID = PeekS(StringSid)
LocalFree_(StringSid)
EndIf
ProcedureReturn SID
EndIf
EndIf
EndIf
Advapi32_End()
EndProcedure
Procedure.s GetComputerName()
Protected buffer.s=Space(64), bufsize.l=64
GetComputerName_(@buffer, @bufsize)
ProcedureReturn buffer
EndProcedure
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;Sid Management
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;Search User Choice set via Windows User Experience String Shell32
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Procedure.s GetSpecialFolder(iCSIDL)
Protected sPath.s = Space(#MAX_PATH)
If SHGetSpecialFolderPath_(#Null, @sPath, iCSIDL, 0) = #True
ProcedureReturn sPath
Else
ProcedureReturn ""
EndIf
EndProcedure
Procedure.s GetShell32FilePath()
ProcedureReturn GetSpecialFolder(#CSIDL_SYSTEMX86) + "\Shell32.dll"
EndProcedure
Procedure FindStringInMemory(String.s, Memory, MemoryLength)
Protected L = Len(String)
Protected I=0
For I = 0 To MemoryLength-L
If CompareMemory(@String, Memory+I, L)
ProcedureReturn I
EndIf
Next
ProcedureReturn -1
EndProcedure
Procedure.s GetExperienceString()
#MEMSIZE = 1024 * 1024 * 5 ;Read 5 MB This should be enough to search the Experience String
Protected Shell32Path$=GetShell32FilePath()
Protected sExperienceBase$= "User Choice set via Windows User Experience"
If ReadFile(0, Shell32Path$, #PB_File_SharedRead)
Protected Length.l = #MEMSIZE ;Lof(0)
Protected *MemoryID = AllocateMemory(Length.l) ; allocate the needed memory
If *MemoryID
Protected bytes = ReadData(0, *MemoryID, Length.l) ; read to allocated memory
EndIf
CloseFile(0)
EndIf
Protected Offset.l=FindStringInMemory(sExperienceBase$,*MemoryID,Length.l)
If Offset.l>-1
DebugPrint("Experience String Found")
ProcedureReturn PeekS(*MemoryID+Offset.l,-1,#PB_Unicode)
Else
ProcedureReturn ""
EndIf
EndProcedure
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;Search User Choice set via Windows User Experience String Shell32
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;Hash Algorithm - by LMongrain
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Procedure Shr32(value.l, count.l = 1)
; Bitwise Shift Function
; It will shift the value a number of bits to the right.
; Bits coming in from left are always 0
!mov eax, dword [p.v_value]
!mov ecx, dword [p.v_count]
!shr eax, cl
ProcedureReturn
EndProcedure
Procedure.i Hash1(*pWStr, iHLen.l, *aMD5DigestBytes, *aOutHash)
Protected result = #False
Protected HM1.HashMap
HM1\Cache = 0
HM1\OutHash1 = 0
HM1\pUData = *pWStr
HM1\MD5Bytes1 = (PeekL(*aMD5DigestBytes) | 1) + $69FB0000
HM1\MD5Bytes2 = (PeekL(*aMD5DigestBytes + 4) | 1) + $13DB0000
HM1\Index = Shr32((iHLen - 2), 1)
HM1\Counter = HM1\Index + 1
While HM1\Counter
HM1\Reckon0 = PeekL(HM1\pUData) + HM1\OutHash1
HM1\Reckon1[0] = PeekL(HM1\pUData + 4)
HM1\pUData = HM1\pUData + 8
HM1\Reckon2[0] = HM1\Reckon0 * HM1\MD5Bytes1 - $10FA9605 * Shr32(HM1\Reckon0, 16)
HM1\Reckon2[1] = $79F8A395 * HM1\Reckon2[0] + $689B6B9F * Shr32(HM1\Reckon2[0], 16)
HM1\Reckon3 = $EA970001 * HM1\Reckon2[1] - $3C101569 * Shr32(HM1\Reckon2[1], 16)
HM1\Reckon4[0] = HM1\Reckon3 + HM1\Reckon1[0]
HM1\Reckon5[0] = HM1\Cache + HM1\Reckon3
HM1\Reckon6[0] = HM1\Reckon4[0] * HM1\MD5Bytes2 - $3CE8EC25 * Shr32(HM1\Reckon4[0], 16)
HM1\Reckon6[1] = $59C3AF2D * HM1\Reckon6[0] - $2232E0F1 * Shr32(HM1\Reckon6[0], 16)
HM1\OutHash1 = $1EC90001 * HM1\Reckon6[1] + $35BD1EC9 * Shr32(HM1\Reckon6[1], 16)
HM1\OutHash2 = HM1\Reckon5[0] + HM1\OutHash1
HM1\Cache = HM1\OutHash2
HM1\Counter = HM1\Counter - 1
Wend
If (iHLen - 2) - (HM1\Index * 2) = 1
HM1\Reckon7[0] = PeekL(*pWStr + (8 * HM1\Index + 8)) + HM1\OutHash1
HM1\Reckon7[1] = HM1\Reckon7[0] * HM1\MD5Bytes1 - $10FA9605 * Shr32(HM1\Reckon7[0], 16)
HM1\Reckon7[2] = $79F8A395 * HM1\Reckon7[1] + $689B6B9F * Shr32(HM1\Reckon7[1], 16)
HM1\Reckon8 = $EA970001 * HM1\Reckon7[2] - $3C101569 * Shr32(HM1\Reckon7[2], 16)
HM1\Reckon9[0] = HM1\Reckon8 * HM1\MD5Bytes2 - $3CE8EC25 * Shr32(HM1\Reckon8, 16)
HM1\Reckon9[1] = $59C3AF2D * HM1\Reckon9[0] - $2232E0F1 * Shr32(HM1\Reckon9[0], 16)
HM1\OutHash1 = $1EC90001 * HM1\Reckon9[1] + $35BD1EC9 * Shr32(HM1\Reckon9[1], 16)
HM1\OutHash2 = HM1\OutHash1 + HM1\Cache + HM1\Reckon8
EndIf
PokeL(*aOutHash, HM1\OutHash1)
PokeL(*aOutHash + 4, HM1\OutHash2)
result = #True
ProcedureReturn result
EndProcedure
Procedure.i Hash2(*pWStr, iHLen.l, *aMD5DigestBytes, *aOutHash)
Protected result = #False
Protected HM2.HashMap
HM2\Cache = 0
HM2\OutHash1 = 0
HM2\pUData = *pWStr
HM2\MD5Bytes1 = (PeekL(*aMD5DigestBytes) | 1)
HM2\MD5Bytes2 = (PeekL(*aMD5DigestBytes + 4) | 1)
HM2\Index = Shr32((iHLen - 2), 1)
HM2\Counter = HM2\Index + 1
While HM2\Counter
HM2\Reckon0 = PeekL(HM2\pUData) + HM2\OutHash1
HM2\pUData = HM2\pUData + 8
HM2\Reckon1[0] = HM2\Reckon0 * HM2\MD5Bytes1
HM2\Reckon1[1] = $B1110000 * HM2\Reckon1[0] - $30674EEF * Shr32(HM2\Reckon1[0], 16)
HM2\Reckon2[0] = $5B9F0000 * HM2\Reckon1[1] - $78F7A461 * Shr32(HM2\Reckon1[1], 16)
HM2\Reckon2[1] = $12CEB96D * Shr32(HM2\Reckon2[0], 16) - $46930000 * HM2\Reckon2[0]
HM2\Reckon3 = $1D830000 * HM2\Reckon2[1] + $257E1D83 * Shr32(HM2\Reckon2[1], 16)
HM2\Reckon4[0] = HM2\MD5Bytes2 * (HM2\Reckon3 + PeekL(HM2\pUData - 4))
HM2\Reckon4[1] = $16F50000 * HM2\Reckon4[0] - ($5D8BE90B * Shr32(HM2\Reckon4[0], 16))
HM2\Reckon5[0] = $96FF0000 * HM2\Reckon4[1] - $2C7C6901 * Shr32(HM2\Reckon4[1], 16)
HM2\Reckon5[1] = $2B890000 * HM2\Reckon5[0] + $7C932B89 * Shr32(HM2\Reckon5[0], 16)
HM2\OutHash1 = $9F690000 * HM2\Reckon5[1] - $405B6097 * Shr32(HM2\Reckon5[1], 16)
HM2\OutHash2 = HM2\OutHash1 + HM2\Cache + HM2\Reckon3
HM2\Cache = HM2\OutHash2
HM2\Counter = HM2\Counter - 1
Wend
If (iHLen - 2) - (HM2\Index * 2) = 1
HM2\Reckon6[0] = (PeekL(*pWStr + (8 * HM2\Index + 8)) + HM2\OutHash1) * HM2\MD5Bytes1
HM2\Reckon6[1] = $B1110000 * HM2\Reckon6[0] - $30674EEF * Shr32(HM2\Reckon6[0], 16)
HM2\Reckon7[0] = $5B9F0000 * HM2\Reckon6[1] - $78F7A461 * Shr32(HM2\Reckon6[1], 16)
HM2\Reckon7[1] = $12CEB96D * Shr32(HM2\Reckon7[0], 16) - $46930000 * HM2\Reckon7[0]
HM2\Reckon8 = $1D830000 * HM2\Reckon7[1] + $257E1D83 * Shr32(HM2\Reckon7[1], 16)
HM2\Reckon9[0] = $16F50000 * HM2\Reckon8 * HM2\MD5Bytes2 - ($5D8BE90B * Shr32(HM2\Reckon8 * HM2\MD5Bytes2, 16))
HM2\Reckon9[1] = $96FF0000 * HM2\Reckon9[0] - $2C7C6901 * Shr32(HM2\Reckon9[0], 16)
HM2\Reckon9[2] = $2B890000 * HM2\Reckon9[1] + $7C932B89 * Shr32(HM2\Reckon9[1], 16)
HM2\OutHash1 = $9F690000 * HM2\Reckon9[2] - $405B6097 * Shr32(HM2\Reckon9[2], 16)
HM2\OutHash2 = HM2\OutHash1 + HM2\Cache + HM2\Reckon8
EndIf
PokeL(*aOutHash, HM2\OutHash1)
PokeL(*aOutHash + 4, HM2\OutHash2)
result = #True
ProcedureReturn result
EndProcedure
Procedure.i GenerateHash(*pWStr, iLen.l, *aMD5DigestBytes, *aOutBytes)
Protected Dim aOutHash.i(3) ; 16 Bytes
Protected *aOutHash = @aOutHash()
Protected iHLen.l = Bool((iLen & 4) < 1) + Shr32(iLen, 2) - 1
If (iHLen <= 1 Or iHLen & 1 Or
Hash1(*pWStr, iHLen, *aMD5DigestBytes, *aOutHash + 0) = #False Or
Hash2(*pWStr, iHLen, *aMD5DigestBytes, *aOutHash + 8) = #False)
ProcedureReturn #False
EndIf
PokeL(*aOutBytes, PeekL(*aOutHash + 8) ! PeekL(*aOutHash + 0))
PokeL(*aOutBytes + 4, PeekL(*aOutHash + 12) ! PeekL(*aOutHash + 4))
ProcedureReturn #True
EndProcedure
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;Hash Algorithm - by LMongrain
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;Create ProgId Hash
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Procedure HexStr2ToByteArray (Array Out.a (1), Hex$)
Protected t$ = "$ "
Protected *c.Character = @Hex$
Protected pg, p = 1
Protected out_len = Len(Hex$) : out_len + out_len % 2 : out_len * 0.5 - Bool(out_len)
ReDim Out(out_len)
While *c\c
If p > 2
Out(pg) = Val(t$)
PokeC(@t$ + SizeOf(Character), 0)
PokeC(@t$ + SizeOf(Character) * 2, 0)
p = 1
pg + 1
EndIf
PokeC(@t$ + p * SizeOf(Character), *c\c)
p + 1
*c + SizeOf(Character)
Wend
Out(pg) = Val(t$)
ProcedureReturn ArraySize(Out())
EndProcedure
Procedure.s MD5Digest(sText$, fmt = #PB_Unicode)
Protected iLen.l=(Len(sText$)*2)+2
;Debug Len(sText$)
;Debug iLen
Protected *pWStr=AllocateMemory(iLen)
PokeS(*pWStr,sText$,-1,fmt)
ProcedureReturn Fingerprint(*pWStr,iLen,#PB_Cipher_MD5)
EndProcedure
Procedure.s GenerateDate()
Protected User32.l = OpenLibrary(#PB_Any, "user32.dll")
Protected *pFunction = GetFunction(User32.l, "wsprintfW")
Protected SysTime.SYSTEMTIME
GetSystemTime_(SysTime)
SysTime\wSecond=0
SysTime\wMilliseconds=0
Protected FiTime.FILETIME
SystemTimeToFileTime_(SysTime,FiTime)
Protected szBuffer$ = Space(16)
Protected szFormat$= "%08x%08x"
If *pFunction
CallCFunctionFast(*pFunction, @szBuffer$, @szFormat$,FiTime\dwHighDateTime,FiTime\dwLowDateTime)
EndIf
ProcedureReturn szBuffer$
EndProcedure
Procedure.s CreateProgIdHash(sExt$,sProgId$)
UseMD5Fingerprint()
Protected sUserSid$=GetSid()
Protected sDate$=GenerateDate()
Protected sUserExperience$=GetExperienceString()
; Debug sUserSid$
; Debug sExt$
; Debug sProgId$
; Debug sDate$
Protected sData$=sExt$ + sUserSid$ + sProgId$ + sDate$ +sUserExperience$
sData$=LCase(sData$)
; Debug sData$
;Create MD5 Digest
Protected sMD5Digest$=MD5Digest(sData$)
;Debug sMD5Digest$
Protected Dim aMD5DigestBytes.a(0)
HexStr2ToByteArray(aMD5DigestBytes(), sMD5Digest$)
;ShowMemoryViewer(aMD5DigestBytes(),16)
;Create lpBuffer
Protected iLen.l=(Len(sData$)*2)+2
Protected *pWStr=AllocateMemory(iLen.l)
PokeS(*pWStr,sData$,-1,#PB_Unicode)
;ShowMemoryViewer(*pWStr,iLen.l)
Protected Dim aOutBytes.i(1);8 Bytes
GenerateHash(*pWStr,iLen.l,aMD5DigestBytes(),aOutBytes())
;ShowMemoryViewer(aOutBytes(),8)
;Debug aOutBytes(0)
;Debug aOutBytes(1)
ProcedureReturn Base64Encoder(aOutBytes(), 8)
EndProcedure
Procedure DeleteProtocolHashRegistryKey(sProtocol$,iForceBit = 0)
Protected sHashKeyParent$="HKEY_CURRENT_USER\Software\Microsoft\Windows\Shell\Associations\UrlAssociations\" + sProtocol$ + "\UserChoice"
Protected h.i, rootKey.i, subkey.s
rootKey = RegRoot(sHashKeyParent$)
subKey = RegSub(sHashKeyParent$)
If iForceBit = 32
iForceBit = #KEY_WOW64_32KEY
ElseIf iForceBit = 64
iForceBit = #KEY_WOW64_64KEY
EndIf
If RegOpenKeyEx_(rootKey, subKey, 0, #KEY_READ, @h) = #ERROR_SUCCESS
ProcedureReturn Reg_DeleteKey(rootKey,subKey)
EndIf
EndProcedure
Procedure DeleteHashRegistryKey(sExt$,iForceBit = 0)
Protected sHashKeyParent$="HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\FileExts\" + sExt$ + "\UserChoice"
Protected h.i, rootKey.i, subkey.s
rootKey = RegRoot(sHashKeyParent$)
subKey = RegSub(sHashKeyParent$)
If iForceBit = 32
iForceBit = #KEY_WOW64_32KEY
ElseIf iForceBit = 64
iForceBit = #KEY_WOW64_64KEY
EndIf
If RegOpenKeyEx_(rootKey, subKey, 0, #KEY_READ, @h) = #ERROR_SUCCESS
ProcedureReturn Reg_DeleteKey(rootKey,subKey)
EndIf
EndProcedure
Procedure WriteProtocolProgIdAndHash(sProgId$,sHash$,sProtocol$)
RegWrite("HKEY_CURRENT_USER\Software\Microsoft\Windows\Shell\Associations\UrlAssociations\" + sProtocol$ + "\UserChoice","Hash",sHash$,#REG_SZ)
RegWrite("HKEY_CURRENT_USER\Software\Microsoft\Windows\Shell\Associations\UrlAssociations\" + sProtocol$ + "\UserChoice","ProgId",sProgId$,#REG_SZ)
Protected sReadHash$=RegRead("HKEY_CURRENT_USER\Software\Microsoft\Windows\Shell\Associations\UrlAssociations\" + sProtocol$ + "\UserChoice","Hash")
Protected sReadProgId$= RegRead("HKEY_CURRENT_USER\Software\Microsoft\Windows\Shell\Associations\UrlAssociations\" + sProtocol$ + "\UserChoice","ProgId")
If (sProgId$=sReadProgId$) And (sHash$=sReadHash$)
DebugPrint("Write Protocol Reg UserChoice OK")
ProcedureReturn #True
Else
DebugPrint("Write Protocol Reg UserChoice FAIL")
ProcedureReturn #False
EndIf
EndProcedure
Procedure WriteProgIdAndHash(sProgId$,sHash$,sExt$)
RegWrite("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\FileExts\" + sExt$ + "\UserChoice","Hash",sHash$,#REG_SZ)
RegWrite("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\FileExts\" + sExt$ + "\UserChoice","ProgId",sProgId$,#REG_SZ)
Protected sReadHash$=RegRead("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\FileExts\" + sExt$ + "\UserChoice","Hash")
Protected sReadProgId$= RegRead("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\FileExts\" + sExt$ + "\UserChoice","ProgId")
If (sProgId$=sReadProgId$) And (sHash$=sReadHash$)
DebugPrint("Write Reg UserChoice OK")
ProcedureReturn #True
Else
DebugPrint("Write Reg UserChoice FAIL")
ProcedureReturn #False
EndIf
EndProcedure
Procedure SetProtocolAssociation(sProtocol$,sProgId$)
Define sProgIdHash$=CreateProgIdHash(sProtocol$,sProgId$ )
DebugPrint("Hash: " + sProgIdHash$)
If Not DeleteProtocolHashRegistryKey(sProtocol$)
DebugPrint("Unable To Delete Protocol UserChoice")
EndIf
If WriteProtocolProgIdAndHash(sProgId$,sProgIdHash$,sProtocol$)
SHChangeNotify_(#SHCNE_ASSOCCHANGED,#SHCNF_IDLIST,#NUL,#NUL) ;Refresh
ProcedureReturn #True
EndIf
ProcedureReturn #False
EndProcedure
Procedure SetFileTypeAssociation(sExt$,sProgId$)
Define sProgIdHash$=CreateProgIdHash(sExt$,sProgId$ )
DebugPrint("Hash: " + sProgIdHash$)
If Not DeleteHashRegistryKey(sExt$)
DebugPrint("Unable To Delete UserChoice")
EndIf
If WriteProgIdAndHash(sProgId$,sProgIdHash$,sExt$)
SHChangeNotify_(#SHCNE_ASSOCCHANGED,#SHCNF_IDLIST,#NUL,#NUL) ;Refresh
ProcedureReturn #True
EndIf
ProcedureReturn #False
EndProcedure
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;Create ProgId Hash
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;SFTA Funcions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Procedure PrintHelp()
PrintN("##################################")
PrintN("## __ ##")
PrintN("## | \ _ _ _ _ ##")
PrintN("## |__/ (_| | ) \/ _) \/ _) ##")
PrintN("## / / ##")
PrintN("## © 2020 Danysys.com ##")
PrintN("## SFTA v."+ #SFTA_VERSION +" ##")
PrintN("##################################")
PrintN("")
PrintN("OPTIONS:")
PrintN("")
PrintN("-h, --help Show Help")
PrintN("-l, --list Show All Application Program Id")
PrintN("-g, --get Show Default Application Program Id for an Extension")
PrintN(" Parameters: [.Extension]")
PrintN("-r, --reg Register Application Program Id for an Extension and Set File Type Association")
PrintN(" Parameters: [ApplicationFullPath] [.Extension] [ProgramId-Optional]")
PrintN("-u, --unreg Unregister Application Program Id")
PrintN(" Parameters: [ApplicationFullPath|Program Id] [.Extension]")
PrintN("-i, --icon Set Application Association Icon")
PrintN(" Parameters: [Icon Path]")
PrintN("-d, --debug Show Debug Information")
PrintN("")
PrintN("Usage:")
PrintN("")
PrintN(" Get Current Application Program Id")
PrintN(~" SFTA.exe --get \".txt\"")
PrintN("")
PrintN(" Set File Type Association")
PrintN(~" SFTA.exe \"My.Program.Id\" \".txt\"")
PrintN(~" SFTA.exe \"My.Program.Id\" \".txt\" -i \"shell32.dll,100\"")
PrintN("")
PrintN(" Set Protocol Association")
PrintN(~" SFTA.exe \"My.Program.Id\" \"http\"")
PrintN("")
PrintN(" Register Application + Set File Type Association")
PrintN(~" SFTA.exe --reg \"C:\\SumatraPDF.exe\" \".PDF\"")
PrintN(~" SFTA.exe --reg \"C:\\SumatraPDF.exe\" \".PDF\" \"CustomProgramId\"")
PrintN("")
PrintN(" Register Application + Set Protocol Association")
PrintN(~" SFTA.exe --reg \"C:\\SumatraPDF.exe\" \"http\"")
PrintN("")
PrintN(" Unregister Application")
PrintN(~" SFTA.exe --unreg \"C:\\SumatraPDF.exe\" \".PDF\"")
PrintN(~" SFTA.exe --unreg \"CustomProgramId\" \".PDF\"")
PrintN("")
EndProcedure
Procedure ShowWindowsInformation()
PrintN("Windows Version: " + GetWindowsOS())
PrintN("Windows ReleaseId: " + GetWindowsReleaseID())
PrintN("Windows Build: " + GetWindowsBuild())
PrintN("Windows ProductName: " + GetWindowsProductName())
EndProcedure
Procedure.s GetAssocType(sExt$)
Protected ProgId$=RegRead("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\FileExts\" + sExt$ + "\UserChoice", "ProgId")
PrintN(ProgId$)
End 0
EndProcedure
Procedure ListAssocTypeProgIds()
Protected Key$="Software\Microsoft\Windows\CurrentVersion\Explorer\FileExts"
Protected Index.l=1
Protected SubKey$=""
Protected KeyUserChoice$=""
Protected ProgId$=""
While 1
SubKey$ = Reg_ListSubKey(#HKEY_CURRENT_USER, Key$, Index.l)
If SubKey$=""
Break
EndIf
KeyUserChoice$=Key$ + "\" + SubKey$ + "\UserChoice"
ProgId$=RegRead("HKEY_CURRENT_USER\" + KeyUserChoice$, "ProgId")
If ProgId$
PrintN(SubKey$ + ", " + ProgId$)
EndIf
Index.l=Index.l+1
Wend
End 0
EndProcedure
Procedure GetFTA(Extension.s)
GetAssocType(Extension.s)
EndProcedure
Procedure SetAssociation(ProgramId.s,Extension.s)
Define result.l
If IsFileType(Extension.s)
If SetFileTypeAssociation(Extension.s,ProgramId.s) ;set FTA
DebugPrint("SetFileTypeAssociation OK")
Else
DebugPrint("SetFileTypeAssociation FAIL")
EndIf
Else
If SetProtocolAssociation(Extension.s,ProgramId.s) ;set PA
DebugPrint("SetProtocolAssociation OK")
Else
DebugPrint("SetProtocolAssociation FAIL")
EndIf
EndIf
EndProcedure
Procedure.b IsNumeric(string.s) ;Returns 1 if numeric else 0 for any non numeric values
Protected iRegex = CreateRegularExpression(#PB_Any, "\D"),bParam = Bool(Not MatchRegularExpression(iRegex, string))
FreeRegularExpression(iRegex)
ProcedureReturn bParam
EndProcedure
Procedure.s GetIconFromCommandLine()
Protected iNumberOfParameters.i = CountProgramParameters()
Protected i
For i=0 To iNumberOfParameters.i-1
If ProgramParameter(i)="-i" Or ProgramParameter(i)="--icon"
Break
EndIf
Next
i=i+1
If i>iNumberOfParameters
ProcedureReturn ""
Else
Protected IconPath.s=ProgramParameter(i)
If IsNumeric(IconPath.s)
;Get Application Path and Append the Index - No implemented
EndIf
ProcedureReturn IconPath.s
EndIf
EndProcedure
Procedure RegisterApplicationIcon(ApplicationID.s)
Protected IconPath.s=GetIconFromCommandLine()
If IconPath.s
If RegWrite("HKEY_CURRENT_USER\SOFTWARE\Classes\" + ApplicationID.s +"\DefaultIcon","",IconPath.s,#REG_SZ)=#ERROR_SUCCESS
DebugPrint("Set Icon OK")
EndIf
EndIf
EndProcedure
Procedure RegisterApplicationID(FilePath.s,FileExt.s,CustomProgramId.s)
Protected ApplicationID.s=""
If CustomProgramId.s<>""
ApplicationID.s=CustomProgramId.s
Else
ApplicationID.s=CreateApplicationID(FilePath.s,FileExt.s)
EndIf
If ApplicationID.s="" : DebugPrint("Error Application Create Program Id") : End 1 : EndIf
DebugPrint("Application Program Id = " + QuoteString(ApplicationID.s))
Protected sCommand.s=QuoteString(FilePath.s)+ " " + QuoteString("%1")
If RegWrite("HKEY_CURRENT_USER\SOFTWARE\Classes\" + FileExt.s + "\OpenWithProgids",ApplicationID.s,"",#REG_NONE)=#ERROR_SUCCESS And
RegWrite("HKEY_CURRENT_USER\SOFTWARE\Classes\" + ApplicationID.s ,"","",#REG_SZ)=#ERROR_SUCCESS And
RegWrite("HKEY_CURRENT_USER\SOFTWARE\Classes\" + ApplicationID.s +"\shell\open\command","",sCommand.s,#REG_SZ)=#ERROR_SUCCESS
DebugPrint("Application Register OK")
RegisterApplicationIcon(ApplicationID.s)
SetAssociation(ApplicationID.s,FileExt.s)
SHChangeNotify_(#SHCNE_ASSOCCHANGED,#SHCNF_IDLIST,#NUL,#NUL)
Else
PrintN("Error Application Register")
End 1
EndIf
EndProcedure
Procedure UnRegisterApplicationID(FilePath_ApplicationID.s,FileExt.s)
Protected ApplicationID.s=""
If Not FileExist(FilePath_ApplicationID.s)
ApplicationID.s=FilePath_ApplicationID.s
Else
ApplicationID.s=CreateApplicationID(FilePath_ApplicationID.s,FileExt.s)
EndIf
DebugPrint("Unregister = " + ApplicationID.s)
Protected RegistryKey.s="Software\Classes\" + ApplicationID.s
Protected Ret=Reg_KeyExists(#HKEY_CURRENT_USER,RegistryKey.s)
Reg_DeleteValue(#HKEY_CURRENT_USER,"Software\Classes\" + FileExt.s + "\OpenWithProgids",ApplicationID.s)
DeleteHashRegistryKey(FileExt.s)
If Ret
Reg_DeleteKeyWithAllSub(#HKEY_CURRENT_USER,RegistryKey.s)
Ret=Reg_KeyExists(#HKEY_CURRENT_USER,RegistryKey.s)
If Ret=#True
DebugPrint("Key No Deleted = " + "HKEY_CURRENT_USER\" + RegistryKey.s)
Else
DebugPrint("Key Deleted = " + "HKEY_CURRENT_USER\" + RegistryKey.s)
EndIf
Else
DebugPrint("Key Not Found = " + "HKEY_CURRENT_USER\" + RegistryKey.s)
EndIf
SHChangeNotify_(#SHCNE_ASSOCCHANGED,#SHCNF_IDLIST,#NUL,#NUL)
EndProcedure
Procedure Start()
Protected iNumberOfParameters.i = CountProgramParameters()
If (iNumberOfParameters=0 Or iNumberOfParameters>6);validate number of parameters
PrintHelp()
End 1
EndIf
If iNumberOfParameters=1
If Not IsValidParameter(ProgramParameter(0),"-h|--help|-g|-get|-l|--list")
PrintN("Invalid Parameter")
PrintHelp()
End 1
EndIf
EndIf
If (ProgramParameter(0)="-h" Or ProgramParameter(0)="--help") ;validate -h parameter
PrintHelp()
End 1
EndIf
EnableDisableDebug() ;Enable Or Disable Debug Mode
If g_Debug
ShowWindowsInformation()
EndIf
If (ProgramParameter(0)="-l" Or ProgramParameter(0)="--list") ;validate -l parameter
ListAssocTypeProgIds()
End 0
EndIf
If (ProgramParameter(0)="-g" Or ProgramParameter(0)="--get") ;validate -g parameter
GetFTA(ProgramParameter(1))
End 0
EndIf
If (ProgramParameter(0)="-u" Or ProgramParameter(0)="--unreg") ;validate -u parameter
UnRegisterApplicationID(ProgramParameter(1),ProgramParameter(2))
End 0
EndIf
If iNumberOfParameters>=3 And (ProgramParameter(0)="-r" Or ProgramParameter(0)="--reg") ;validate -r parameter
Define CustomProgramId.s=""
If iNumberOfParameters>=3 And ProgramParameter(3)<>"-d" And ProgramParameter(3)<>"--debug" And
ProgramParameter(3)<>"-i" And ProgramParameter(3)<>"--icon"
CustomProgramId.s=ProgramParameter(3)
EndIf
RegisterApplicationID(ProgramParameter(1),ProgramParameter(2),CustomProgramId.s)
End 0
EndIf
If iNumberOfParameters>=2
;Set FileType/Protocol Association
Define ProgramId.s,Extension.s
ProgramId=ProgramParameter(0)
Extension=ProgramParameter(1)
RegisterApplicationIcon(ProgramId)
SetAssociation(ProgramId,Extension)
End 0
EndIf
;no enough parameters
PrintN("Invalid Parameter")
End 1
EndProcedure
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;SFTA Funcions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;Test Funcions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Procedure TestCase()
If OpenConsole()
PrintN("Running From IDE...")
ShowWindowsInformation()
PrintHelp()
Input()
CloseConsole()
EndIf
EndProcedure
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;Test Funcions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;Start App Test
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
CompilerIf #PB_Compiler_Debugger
TestCase()
End
CompilerEndIf
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;Start App
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
If OpenConsole()
CheckValidOS()
Start()
EndIf
; IDE Options = PureBasic 5.62 (Windows - x86)
; ExecutableFormat = Console
; CursorPosition = 2
; Folding = ------------
; EnableXP
; UseIcon = Icon.ico
; Executable = ..\Compiled\SFTA.exe
; EnableExeConstant
; IncludeVersionInfo
; VersionField0 = 1.3.1
; VersionField1 = 1.3.1
; VersionField2 = Danysys
; VersionField3 = SFTA
; VersionField4 = 1.3.1
; VersionField5 = 1.3.1
; VersionField6 = Set Windows 8/10 File Type Association
; VersionField7 = SFTA
; VersionField8 = SFTA
; VersionField9 = © 2020 Danysys
; VersionField10 = © 2020 Danysys
Reference in New Issue Copy Permalink