Register File Extensions

I portablize apps using JauntePE, using ThinApp (when JauntePE doesnt cope with the app).
And of course I download apps from this site.
In all cases I need to associate exe's with file types i.e. integrate portable apps with the file system.
Thinstall has such a tool: it's called thinreg.
I created a simple vbs script that can integrate 90% of all programs including packed with ThinApp, JauntePE, and portableapps format.

E.g. you have a folder C:\PortableApps

1.You create C:\PortableApps\RegisterFileExtensions.vbs file
2.You create C:\PortableApps\FirefoxPortable\firefox.ini file with the following text:

;=========================
[SystemIntegration]
FileTypes=.htm.html.aspx.shtm.shtml.xhtm.xhtml
[BuildApps]
1=firefox.exe
;=====the end of the file========

3.Then double-click RegisterFileExtensions.vbs.
Now any file with htm extension will be opened in Firefox Portable.

Notes:
In [BuildApps] section you type in the name of the executable that should handle the extension.
Instead of firefox.ini you can create any *.ini file. You can even paste the content of the file into any other *.ini file with the same syntax, e.g. into FirefoxPortable.ini (where Firefox Portable settings are stored).
The script will scan all subfolders inside C:\PortableApps\ for *.ini files with [SystemIntegration] section present.

And here is the content of RegisterFileExtensions.vbs:
;=========================
Dim w,f
set w = CreateObject("wscript.Shell")
Set f = CreateObject("scripting.filesystemobject")
cd=w.CurrentDirectory

For each folder In f.GetFolder(cd).SubFolders
sfp=folder.Path
For Each file In f.GetFolder(sfp).Files
If f.GetExtensionName(file.Path)="ini" Then
'read ini
strFT=GetProfileString("SystemIntegration","FileTypes",file.Path)
strWTL=GetProfileString("BuildApps","1",file.Path)
strWTL=f.BuildPath(sfp, strWTL)
arrFT=Split(strFT,".")
For i=1 To UBound(arrFT)
ext=arrFT(i)
If Len(ext)0 Then
'write to registry
w.RegWrite "HKCR\." & ext & "\","PortableApps " & ext
w.RegWrite "HKCR\PortableApps " & ext & "\","PortableApps " & UCase(ext)
w.RegWrite "HKCR\PortableApps " & ext & "\DefaultIcon\","""" & strWTL & """,0"
w.RegWrite "HKCR\PortableApps " & ext & "\shell\open\command\","""" & strWTL & """ ""%1%"""
'On Error Goto 0
End If
Next
End If
Next
Next
MsgBox "End"

Function MyTrim(mystring)
Dim start,Endpos
start=1
for i=1 to Len(mystring)
if Mid(mystring,i,1)=vbTab or Mid(mystring,i,1)=" " Then
start=i+1
else
exit for
end if
next
Endpos=Len(mystring)
for i=Len(mystring) to 1 step -1
if Mid(mystring,i,1)=vbTab or Mid(mystring,i,1)=" " Then
Endpos=i-1
else
exit for
end if
next
if (endpos-start+1)0 then
if StrComp(MyTrim(Left(Trimstrini,poskey-1)),MyTrim(key),1)=0 Then
GetProfileString = MyTrim(Mid(Trimstrini,poskey+1))
Exit Function
end If
End if
end if
End if
Loop
End if

GetProfileString = ""
End Function
Sub WriteProfileString(section,key,filename,value)

If MyTrim(section)="" Or Mytrim(key)="" then
Exit Sub
End if

dim contentini
contentini=""

if f.FileExists(filename) then
Dim readini,bsection,bSectionFound,bKeyFound
bKeyFound=False
bsection=False
bsectionFound=False

Set readini = f.OpenTextFile(filename,1)
Do while not(readini.AtEndOfStream)
Dim strini,trimstrini
strini = readini.ReadLine
trimstrini = MyTrim(strini)
if Left(trimstrini,1)="[" and Right(Trimstrini,1)="]" then
if StrComp(Trimstrini,"[" & MyTrim(section) & "]",1)=0 Then
bsection=True
bsectionFound=True
else
bsection =False
end if
Else
if bsection then
Dim poskey
poskey = InStr(Trimstrini,"=")
if posKey>0 then
if StrComp(MyTrim(Left(Trimstrini,poskey-1)),MyTrim(key),1)=0 Then
bKeyFound = True
strini = Left(Trimstrini,poskey) & " " & value
end If
End if
end if
End if

if bsectionFound=True and bsection=False and bKeyFound=false then
contentini = contentini & key & "=" & value & vbcrlf
bKeyFound = True
end if

if MyTrim(strini)"" then
if Left(trimstrini,1)="[" and Right(Trimstrini,1)="]" And contentini"" then
contentini = contentini & vbCrlf
end if

contentini = contentini & strini & vbCrlf
end if
Loop

if bsectionFound=True and bsection=True and bKeyfound =false then
contentini = contentini & key & "=" & value & vbcrlf
end if

if bsectionFound=False Then
contentini = contentini & vbcrlf & "[" & section & "]" & vbcrlf & key & "=" & value & vbcrlf
end if

readini.Close

Else
contentini = "[" & section & "]" & vbcrlf & key & "=" & value & vbcrlf
End if

Dim writeini
set writeini = f.CreateTextFile(filename,True)
writeini.Write contentini
writeini.Close
End Sub
;=====the end of the file========