;  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