PureBasic Forums - English

Posted: **Sun Mar 18, 2007 5:29 pm**

Hi,

I just started to write a program which (will) allow to assign icons to file extensions etc. (because, some programs seem to alter the window settings) :roll:

Maybe someone find the main part (which reads the registry and shows the actually assigned icons) already useful, or someone like to add some sub functions - I'll don't have time now to continue my work

At the moment, only the export button has a function - it creates a file which can be used as a backup of the actual settings...

Code: Select all


; Define Icons

	#MaxIcons=10000
	#Stepper=200

	Global RegistryFile.s
	Global RegistryHandle=0
	Global RegistryHundle=0
	Global RegistryPath.s
	Global RegistryEntry.s=""
	Global RegistryEntrySize=#MAX_PATH
	Global RegistryValue.s
	Global RegistryValueSize
	Global RegistryValueType

	RegistryFile="C:\Dokumente und Einstellungen\vo\Desktop\DefaultIcon.reg"
	Global Zeile.s

	#TopKey=#HKEY_CLASSES_ROOT

	Structure IconType
		RegistryPath.s
		Name.s
		IconFile.s
		Index.l
	EndStructure

	Global Dim Icon.IconType(#MaxIcons)
	Global Icons

	Global Dim SmallIcon(#MaxIcons)
	Global Dim LargeIcon(#MaxIcons)
	Global Dim Zeiger(#MaxIcons)
	Global Entries

; EndDefine
; Define Dialog

	Enumeration
		#Win
		#Liste
		#Icon
		#File

		#ButtLoad
		#ButtDefault
		#ButtNext
		#ButtPrev

		#ButtGoReg
		#ButtExport
		#ButtQuit

	EndEnumeration

	#ListHeight=360


; EndDefine

Procedure.s EvalEnvironment(s.s)
	Protected pos
	Protected var.s
	If PeekB(@s)='%'
		pos=FindString(s,"%",2)
		If pos
			var=GetEnvironmentVariable(Mid(s,2,pos-2))
			If Len(var)
				s=var+PeekS(@s+pos)
			EndIf
		EndIf
	EndIf
	ProcedureReturn s
EndProcedure
Procedure.l GetKey(Subkey.s)

	;Debug "? "+Subkey

	If RegOpenKeyEx_(#TopKey,@Subkey,0,#KEY_ALL_ACCESS,@RegistryHundle)=#ERROR_SUCCESS
		RegistryValue=Space(RegistryEntrySize)
		RegistryValueSize=RegistryEntrySize
		If RegQueryValueEx_(RegistryHundle,@RegistryEntry,#Null,@RegistryValueType,@RegistryValue,@RegistryValueSize)=#ERROR_SUCCESS
			;Debug "! "+RegistryValue
			RegCloseKey_(RegistryHundle)
			ProcedureReturn #True
		EndIf
	EndIf

	ProcedureReturn #False
EndProcedure
Procedure.l SearchKeys(Subkey.s)

	Protected i,k

	Icons=0
	If RegOpenKeyEx_(#TopKey,@SubKey,0,#KEY_ALL_ACCESS,@RegistryHandle)=#ERROR_SUCCESS

		RegistryPath=Space(RegistryEntrySize)
		RegistryValueSize=RegistryEntrySize

		While (Icons<#MaxIcons) And (RegEnumKeyEx_(RegistryHandle,Icons,@RegistryPath,@RegistryValueSize,0,0,0,0)=#ERROR_SUCCESS)
			Icons+1
			Icon(Icons)\RegistryPath=RegistryPath
			RegistryPath=Space(RegistryEntrySize)
			RegistryValueSize=RegistryEntrySize
		Wend

		i=0
		While i<Icons
			i+1
			RegistryPath=Icon(i)\RegistryPath
			GetKey(RegistryPath)
			Icon(i)\Name=RegistryValue
			GetKey(RegistryPath+"\DefaultIcon")
			If RegistryValue <>Icon(i)\Name
				k=FindString(RegistryValue,",",1)
				If k
					Icon(i)\IconFile=EvalEnvironment(Left(RegistryValue,k-1))
					Icon(i)\Index=Val(PeekS(@RegistryValue+k))
				Else
					Icon(i)\IconFile=EvalEnvironment(RegistryValue)
				EndIf
			EndIf
		Wend

		RegCloseKey_(RegistryHandle)

	EndIf

	ProcedureReturn Icons
EndProcedure

Procedure.s StrapHeader(s.s)
	Protected i
	i=FindString(s,"\",1)
	ProcedureReturn PeekS(@s+i,Len(s)-i-1)
EndProcedure
Procedure.s DoubleBackslash(s.s)
	ProcedureReturn ReplaceString(s,"\","\\")
EndProcedure

Procedure ReadRegistryFile()
	; Datei einlessen...

	If ReadFile(0,RegistryFile)

		While (Eof(0)=0) ;And (z<15)
			z+1
			Zeile=ReadString(0,#PB_Unicode)
			If PeekB(@Zeile)='['
				If GetKey(StrapHeader(Zeile))
					;Debug Zeile
					;Debug "="+RegistryValue
				EndIf
			EndIf
		Wend
		CloseFile(0)

	EndIf
EndProcedure

Procedure Main()
	SearchKeys("")

	If OpenWindow(#Win,0,0,760,420,"Icons",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
		CreateGadgetList(WindowID(#Win))

		ImageGadget(#Icon,10,#ListHeight+20,32,32,0)

		StringGadget(#File,50,#ListHeight+27,320,22,"")
		ButtonGadget(#ButtNext,380,#ListHeight+26,24,24,"–")
		ButtonGadget(#ButtDefault,410,#ListHeight+26,24,24,"×")
		ButtonGadget(#ButtPrev,440,#ListHeight+26,24,24,"+")
		ButtonGadget(#ButtGoReg,490,#ListHeight+26,80,24,"Registry")
		ButtonGadget(#ButtExport,580,#ListHeight+26,80,24,"Export")
		ButtonGadget(#ButtQuit,670,#ListHeight+26,80,24,"Quit")

		ListIconGadget(#Liste,10,10,740,#ListHeight,"Icon",50,#PB_ListIcon_GridLines|#PB_ListIcon_FullRowSelect)
		AddGadgetColumn(#Liste,1,"Path",180)
		AddGadgetColumn(#Liste,2,"Name",200)
		AddGadgetColumn(#Liste,3,"File",250)
		AddGadgetColumn(#Liste,4,"Idx",40)
		ChangeListIconGadgetDisplay(#Liste,#PB_ListIcon_Report)

		HideGadget(#Liste,0)

		i=0
		Entries=0

		While i<Icons
			i+1

			If Len(Icon(i)\IconFile)
				If FileSize(Icon(i)\IconFile)>0
					ExtractIconEx_(Icon(i)\IconFile,Icon(i)\Index,@LargeIcon(Entries),@SmallIcon(Entries),1)
				EndIf
				AddGadgetItem(#Liste,Entries,"",SmallIcon(Entries))
				;AddGadgetItem(#Liste,Entries,"",LargeIcon(Entries))
				SetGadgetItemText(#Liste,Entries,Icon(i)\RegistryPath,1)
				SetGadgetItemText(#Liste,Entries,Icon(i)\Name,2)
				SetGadgetItemText(#Liste,Entries,Icon(i)\IconFile,3)
				SetGadgetItemText(#Liste,Entries,Str(Icon(i)\Index),4)
				Zeiger(Entries)=i
				;Debug Str(Entries)+"/"+Str(Zeiger(Entries))
				Entries+1

			EndIf

		Wend

		HideGadget(#Liste,0)

		Repeat
			Select WaitWindowEvent(50)
			Case #PB_Event_Menu
				Select EventMenu()

				Case #Liste
					Debug "JA"
				EndSelect

			Case #PB_Event_Gadget
				Select EventMenu()

				Case #Liste
					i=GetGadgetState(#Liste)
					If (i>=0) And (i<>Eintrag)
						Eintrag=i
						;Debug Str(eintrag)+" > "+Str(Zeiger(Eintrag))
						SetGadgetState(#Icon,LargeIcon(Eintrag))
						SetGadgetText(#File,GetGadgetItemText(#Liste,Eintrag,3)+","+GetGadgetItemText(#Liste,Eintrag,4))
					EndIf

				Case #ButtQuit
					quit=1

				Case #ButtExport
					If CreateFile(0,RegistryFile)
						WriteStringN(0,"Windows Registry Editor Version 5.00"+#CRLF$)

						i=0
						While i<Entries
							k=Zeiger(i)
							WriteStringN(0,"[HKEY_CLASSES_ROOT\"+Icon(k)\RegistryPath+"\DefaultIcon]")
							WriteStringN(0,"@="+#DQUOTE$+DoubleBackslash(Icon(k)\IconFile)+","+Str(Icon(k)\Index)+#DQUOTE$+#CRLF$)
							i+1
						Wend
						CloseFile(0)
					EndIf
				EndSelect

			Case #PB_Event_CloseWindow
				quit=1
			EndSelect
		Until  quit
	EndIf

EndProcedure

Main()

PureBasic Forums - English

Assigned Icons (Registry Entries)

Assigned Icons (Registry Entries)