PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

How to get the PureBasic install directory

https://www.purebasic.fr/english/viewtopic.php?t=32210

Page 1 of 1

How to get the PureBasic install directory

Posted: Tue May 06, 2008 9:24 pm
by Mistrel
This is a modification of the code used by the Tailbite installer. If PureBasic.exe has not been run yet and the .pb file association has not occurred then the pure Tailbite method will fail.

I've added an additional check which uses the uninstall information for the install directory. Both methods should be used in this order because the install directory may be on a pen drive and not as up to date as the .pb file association.

Code: Select all

Procedure.s GetPBFolder()
  MaxStringSize=(#MAX_PATH*2)+2
  Value=AllocateMemory(MaxStringSize)
  If GetVersion_()&$ff0000 ; Windows NT/XP
    If RegOpenKeyEx_(#HKEY_CLASSES_ROOT,"Applications\PureBasic.exe\shell\open\command",0,#KEY_ALL_ACCESS,@hKey)=#ERROR_SUCCESS
      If RegQueryValueEx_(hKey,"",0,@Type,Value,@MaxStringSize)=#ERROR_SUCCESS
        Folder.s=PeekS(Value)
      EndIf
      RegCloseKey_(hKey)
    EndIf
  Else  ; The same for Win9x 
    If RegOpenKeyEx_(#HKEY_LOCAL_MACHINE,"Software\Classes\PureBasic.exe\shell\open\command",0,#KEY_ALL_ACCESS,@hKey)=#ERROR_SUCCESS 
      If RegQueryValueEx_(hKey,"",0,@Type,Value,@MaxStringSize)=#ERROR_SUCCESS
        Folder.s=PeekS(Value)
      EndIf
      RegCloseKey_(hKey)
    EndIf
  EndIf
  FreeMemory(Value)
  Folder.s=RemoveString(Left(Folder.s,FindString(Folder.s,"PureBasic.exe",1)-1),Chr(34))
  If Not Folder.s
    If RegOpenKeyEx_(#HKEY_LOCAL_MACHINE,"Software\Microsoft\Windows\CurrentVersion\Uninstall\PureBasic_is1",0,#KEY_ALL_ACCESS,@hKey)=#ERROR_SUCCESS
		  If RegQueryValueEx_(hKey,@"InstallLocation",0,@Type,Value,@MaxStringSize)=#ERROR_SUCCESS
		    Folder.s=PeekS(Value)
		  EndIf
		  RegCloseKey_(hKey)
		EndIf
  EndIf
  ProcedureReturn Folder.s
EndProcedure

Posted: Tue May 06, 2008 10:18 pm
by srod
Hi, there does seem to be a more up to date version than that; one that differentiates between XP and Vista etc. Does your one work on Vista?

Anyhow, your code fails in Unicode mode here because the key value is much larger than #MAX_PATH etc. (the PB entry in the registry contains the location of the compiler and the various preference files for the IDE etc.) Increasing the buffer size sorts it all out. :)

Posted: Tue May 06, 2008 11:37 pm
by AND51
> Does your one work on Vista?
Yes.

> your code fails in Unicode mode here
No.

Posted: Wed May 07, 2008 10:17 am
by srod
AND51 wrote:> your code fails in Unicode mode here
No.
It wasn't a question; just a statement of fact that the code produced an empty string on my system whilst running in Unicode mode. Increasing the buffer size fixed it.

Posted: Wed May 07, 2008 3:44 pm
by AND51
srod wrote:Increasing the buffer size fixed it.
my PureBasic path is "C:\Program Files\PureBasic" and I had no problems in ASCII as well as in Unicode; and I didn't changed the buffer size.

Posted: Wed May 07, 2008 3:50 pm
by ts-soft
> MaxStringSize=(#MAX_PATH*2)+2
is not the best way. i think you can get the required size with call the function
RegQueryValueEx twice, with first 0 bytes of size, but i can't test this in the
moment, i have only a linux pc avalaible.

Posted: Wed May 07, 2008 8:46 pm
by srod
AND51 wrote:
srod wrote:Increasing the buffer size fixed it.
my PureBasic path is "C:\Program Files\PureBasic" and I had no problems in ASCII as well as in Unicode; and I didn't changed the buffer size.
Well, if only one person experiences problems then that is sometimes one too many! :wink: Besides, the registry entry contains far more than just the Purebasic installation folder etc. hence the problem. Ts-soft has the correct way of determining the required buffer length.

Posted: Sat May 10, 2008 7:45 am
by Mistrel
There is a big boo-boo in my code. Can anyone spot it? As illegal as it is it only seems to crash in Vista and only if the function is called twice!

The registry query to #HKEY_CLASS_ROOT does not seem to work on Vista but the query to #HKEY_LOCAL_MACHINE does. Does anyone know why?

srod is right that this doesn't work correctly under Vista. My example was a modification to old Tailbite code. ABBKlaus has made some excellent improvements since then. I'm going to recommend that he add the uninstall key from mine to his as well. :)

Code: Select all

Procedure.s GetPBFolder()
  Protected hKey1.l, Type.l, Res.l, Folder$, lpbData.l, cbData.l, OS.s, Key.s, PBRegKey.s
  
  cbData  = (#MAX_PATH*2)+2
  lpbData = AllocateMemory(cbData)
  
  Folder$ = ""
  hKey1   = 0
  Type    = 0
  Res     = -1
  
  Select OSVersion()
    Case #PB_OS_Windows_95,#PB_OS_Windows_98,#PB_OS_Windows_ME
      OS        = "Detected OS : Windows 95/98/ME"
      Key       = "HKLM\"
      PBRegKey  = "Software\Classes\PureBasic.exe\shell\open\command"
      Res       = RegOpenKeyEx_(#HKEY_LOCAL_MACHINE, PBRegKey, 0, #KEY_ALL_ACCESS, @hKey1)
    Case #PB_OS_Windows_NT3_51,#PB_OS_Windows_NT_4,#PB_OS_Windows_2000,#PB_OS_Windows_XP,#PB_OS_Windows_Server_2003
      OS        = "Detected OS : Windows NT/2000/XP"
      Key       = "HKCR\"
      PBRegKey  = "Applications\PureBasic.exe\shell\open\command"
      Res       = RegOpenKeyEx_(#HKEY_CLASSES_ROOT, PBRegKey, 0, #KEY_ALL_ACCESS, @hKey1)
    Case #PB_OS_Windows_Vista,#PB_OS_Windows_Server_2008,#PB_OS_Windows_Future
      OS        = "Detected OS : Windows Vista/Server 2008"
      Key       = "HKCU\"
      PBRegKey  = "Software\Classes\PureBasic.exe\shell\open\command"
      Res       = RegOpenKeyEx_(#HKEY_CURRENT_USER, PBRegKey, 0, #KEY_ALL_ACCESS , @hKey1)
  EndSelect
  
  If Res = #ERROR_SUCCESS And hKey1
    If RegQueryValueEx_(hKey1, "", 0, @Type, lpbData, @cbData)=#ERROR_SUCCESS
      Folder$ = PeekS(lpbData)
      ;Folder$ = GetPathPart(Mid(Folder$, 2, Len(Folder$)-7))
      Folder$ = GetPathPart(StringField(Folder$,2,Chr(34)))
    EndIf
    RegCloseKey_(hKey1)
  EndIf
  
  If lpbData
    FreeMemory(lpbData)
    lpbData=0
  EndIf
  
  ProcedureReturn Folder$
EndProcedure

Posted: Sun May 25, 2008 9:38 pm
by Mistrel
Here are my most recent changes to this function and also the function I use to find the PureBasic application data directory. These commands should now be Vista-compatible.

Code: Select all

Procedure.s GetPBFolder()
  Protected hKey.l, Type.l, Res.l, Folder.s, lpData.l, cbData.l, OS.s, Key.s, PBRegKey.s
  Res=-1
  Select OSVersion()
    Case #PB_OS_Windows_95,#PB_OS_Windows_98,#PB_OS_Windows_ME
      OS.s        = "Detected OS : Windows 95/98/ME"
      PBRegKey.s  = "Software\Classes\PureBasic.exe\shell\open\command"
      Res         = RegOpenKeyEx_(#HKEY_LOCAL_MACHINE, PBRegKey, 0, #KEY_ALL_ACCESS, @hKey)
    Case #PB_OS_Windows_NT3_51,#PB_OS_Windows_NT_4,#PB_OS_Windows_2000,#PB_OS_Windows_XP,#PB_OS_Windows_Server_2003
      OS.s        = "Detected OS : Windows NT/2000/XP"
      PBRegKey.s  = "Applications\PureBasic.exe\shell\open\command"
      Res         = RegOpenKeyEx_(#HKEY_CLASSES_ROOT, PBRegKey, 0, #KEY_ALL_ACCESS, @hKey)
    Case #PB_OS_Windows_Vista,#PB_OS_Windows_Server_2008,#PB_OS_Windows_Future
      OS.s        = "Detected OS : Windows Vista/Server 2008"
      PBRegKey.s  = "Software\Classes\PureBasic.exe\shell\open\command"
      Res         = RegOpenKeyEx_(#HKEY_CURRENT_USER, PBRegKey, 0, #KEY_ALL_ACCESS , @hKey)
  EndSelect
	If Not RegQueryValueEx_(hKey,0,0,0,0,@Size)=#ERROR_SUCCESS Or Not Size
		ProcedureReturn ""
	EndIf
	lpData=AllocateMemory(Size)
  If Res=#ERROR_SUCCESS And hKey
    If RegQueryValueEx_(hKey,"",0,0,lpData,@Size)=#ERROR_SUCCESS
      Folder.s=PeekS(lpData)
      Folder.s=GetPathPart(StringField(Folder.s,2,Chr(34)))
    EndIf
    RegCloseKey_(hKey)
  EndIf
  If lpData
    FreeMemory(lpData)
    lpData=0
  EndIf
  ; Backup
	If Not Folder.s
	  If RegOpenKeyEx_(#HKEY_LOCAL_MACHINE,"Software\Microsoft\Windows\CurrentVersion\Uninstall\PureBasic_is1",0,#KEY_ALL_ACCESS,@hKey)=#ERROR_SUCCESS
			If Not RegQueryValueEx_(hKey,"InstallLocation",0,0,0,@Size)=#ERROR_SUCCESS Or Not Size
			  ProcedureReturn ""
			EndIf
			lpData=AllocateMemory(Size)
		  If Not RegQueryValueEx_(hKey,"InstallLocation",0,0,lpData,@Size)=#ERROR_SUCCESS
				ProcedureReturn ""
		  EndIf
		  Folder.s=PeekS(lpData)
		  If lpData
		    FreeMemory(lpData)
		    lpData=0
		  EndIf
		  RegCloseKey_(hKey)
		EndIf
	EndIf
  ProcedureReturn Folder.s
EndProcedure

Procedure.s GetPBAppFolder()
  Protected hKey.l,Type.l,Res.l,Folder.s,lpData.l,cbData.l,OS.s,Key.s,PBRegKey.s
  Res      = -1
  Select OSVersion()
    Case #PB_OS_Windows_95,#PB_OS_Windows_98,#PB_OS_Windows_ME
      OS.s        = "Detected OS : Windows 95/98/ME"
      PBRegKey.s  = "Software\Classes\PureBasic.exe\shell\open\command"
      Res         = RegOpenKeyEx_(#HKEY_LOCAL_MACHINE,PBRegKey.s,0,#KEY_ALL_ACCESS,@hKey)
    Case #PB_OS_Windows_NT3_51,#PB_OS_Windows_NT_4,#PB_OS_Windows_2000,#PB_OS_Windows_XP,#PB_OS_Windows_Server_2003
      OS.s        = "Detected OS : Windows NT/2000/XP"
      PBRegKey.s  = "Applications\PureBasic.exe\shell\open\command"
      Res         = RegOpenKeyEx_(#HKEY_CLASSES_ROOT,PBRegKey.s,0,#KEY_ALL_ACCESS,@hKey)
    Case #PB_OS_Windows_Vista,#PB_OS_Windows_Server_2008,#PB_OS_Windows_Future
      OS.s        = "Detected OS : Windows Vista/Server 2008"
      PBRegKey.s  = "Software\Classes\PureBasic.exe\shell\open\command"
      Res         = RegOpenKeyEx_(#HKEY_CURRENT_USER,PBRegKey.s,0,#KEY_ALL_ACCESS ,@hKey)
  EndSelect
	If Not RegQueryValueEx_(hKey,0,0,0,0,@Size)=#ERROR_SUCCESS Or Not Size
		ProcedureReturn ""
	EndIf
   lpData=AllocateMemory(Size)
  If Res = #ERROR_SUCCESS And hKey
    If RegQueryValueEx_(hKey,"",0,@Type,lpData,@Size)=#ERROR_SUCCESS
      Folder.s=PeekS(lpData)
    EndIf
    RegCloseKey_(hKey)
  EndIf
  If lpData
    FreeMemory(lpData)
    lpData=0
  EndIf
  If Folder.s
		Folder.s=RemoveString(Folder.s,Left(Folder.s,FindString(Folder.s,"/A",1)-1),1)
		Folder.s=RemoveString(Folder.s,Left(Folder.s,FindString(Folder.s,Chr(34),1)),1)
		Folder.s=Left(Folder.s,FindString(Folder.s,Chr(34),1)-1)
		For i=1 To Len(Folder.s)
			If FindString(Folder.s,"\",i)
				lastfound=i
			EndIf
		Next i
		If lastfound
			Folder.s=Left(Folder.s,lastfound)
		EndIf
	Else
		; Backup
		If SHGetSpecialFolderLocation_(#Null,#CSIDL_APPDATA,@pidl)=#ERROR_SUCCESS
			Location.s=Space(#MAX_PATH)
			If SHGetPathFromIDList_(pidl,@Location.s)
				If Not Right(Location.s,1)="\"
					Location.s+"\"
				EndIf
			EndIf
			If pidl
				CoTaskMemFree_(pidl) ; Instead of messing with com imalloc free and whatnot.
			EndIf
			Folder.s=Location.s+"PureBasic\"
			If Not FileSize(Folder.s)=-2
				Folder.s=""
			EndIf
		EndIf
	EndIf
  ProcedureReturn Folder.s
EndProcedure 

Debug GetPBFolder()
Debug GetPBAppFolder()

Posted: Fri Jun 06, 2008 7:42 pm
by Mistrel
Does GetPBAppFolder() not work for anyone? I have someone on a French localization of Vista where it doesn't work.
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited