Procedure Viewer (compare procedures in 2 files )

Applications, Games, Tools, User libs and useful stuff coded in PureBasic
User avatar
Zebuddi123
Enthusiast
Enthusiast
Posts: 796
Joined: Wed Feb 01, 2012 3:30 pm
Location: Nottinghamshire UK
Contact:

Procedure Viewer (compare procedures in 2 files )

Post by Zebuddi123 »

Hi to All

Small tool to quickly compare the procedures in 2 files (ie droopy.pb / droopy_tweaked.pb) via a ListiconGadget() with colour difference highlight

Code: Select all

Global NewList file1.s()
Global NewList file2.s()
Global NewList mark.i()
Global f1$,f2$
Enumeration
	#Window_0
EndEnumeration
Enumeration
	#StatusBar_Window_0
EndEnumeration
Enumeration
	#Button_file1
	#Button_file2
	#Text_file1
	#Text_file2
	#ListIcon_file1
EndEnumeration
Define.l Event
Procedure GetLastError() ; Return the last Win32 API error as a string
	LastError=GetLastError_()
	If LastError=1309 : LastError=0 : EndIf
	ProcedureReturn LastError
EndProcedure

Procedure.s GetLastErrorAsTex(LastError.l)
	If LastError 
		*ErrorBuffer = AllocateMemory(1024) 
		FormatMessage_(#FORMAT_MESSAGE_FROM_SYSTEM, 0, LastError, 0, *ErrorBuffer, 1024, 0) 
		message.s=PeekS(*ErrorBuffer) 
		FreeMemory(*ErrorBuffer) 
	EndIf 
	ProcedureReturn message
EndProcedure

Procedure doprocs(filename.s, List thislist.s())
	If ReadFile(0,filename)
		While Eof(0)=0
			a.s=Trim(ReadString(0,#PB_UTF8))
			If Bool(Left(a,1)<>";" And a) 
				If FindString(a,"Procedure ",1) Or  FindString(a,"ProcedureC ",1) Or FindString(a,"ProcedureCDLL ",1) Or FindString(a,"ProcedureDLL ",1)   
					If  FindString(a,"EndProcedure")=0 And FindString(a,"ProcedureReturn")=0
						e.i=FindString(a,")",1)
						p.s=Left(a,e)
						AddElement(thislist())
						p=Trim(ReplaceString(p,"ProcedureCDLL",""))
						p=Trim(ReplaceString(p,"ProcedureDLL",""))
						p=Trim(ReplaceString(p,"ProcedureC",""))
						p=Trim(ReplaceString(p,"ProcedureReturn",""))
						p=Trim(ReplaceString(p,"Procedure",""))			
						thislist()=p	
					EndIf
				EndIf
			EndIf
		Wend
		CloseFile(0)
	Else
		MessageRequester("Error", GetLastErrorAsTex(GetLastError()))
	EndIf
EndProcedure

Procedure alignprocs()
	ResetList(file1()):FirstElement(file1())
	ResetList(file2()):FirstElement(file2())
	;CallDebugger
	If ListSize(file1())>ListSize(file2())
		ForEach file1()
			If file1()<>file2()
				;CallDebugger
				InsertElement(file2())
				AddElement(mark()) : mark()=ListIndex(file2())
				AddGadgetItem(#ListIcon_file1,-1,file1()+Chr(10)+file2())
				NextElement(file2())
			Else
				AddGadgetItem(#ListIcon_file1,-1,file1()+Chr(10)+file2())
				NextElement(file2())
			EndIf
		Next
	EndIf
	
	If ListSize(file2())>ListSize(file1())
		ForEach file2()
			If file2()<>file1()
				;CallDebugger
				InsertElement(file1())
				AddElement(mark()) : mark()=ListIndex(file2())
				AddGadgetItem(#ListIcon_file1,-1,file1()+Chr(10)+file2())
				NextElement(file1())
			Else
				AddGadgetItem(#ListIcon_file1,-1,file1()+Chr(10)+file2())
				NextElement(file1())
			EndIf
		Next
	EndIf
	ForEach mark()
		SetGadgetItemColor(#ListIcon_file1,mark(),#PB_Gadget_BackColor,$95B9F8)
	Next
EndProcedure

Procedure updatestatusbar()
	StatusBarText(#StatusBar_Window_0,0,"Entries: "+Str(ListSize(file1())))				
	StatusBarText(#StatusBar_Window_0,1,"Entries: "+Str(ListSize(file2())))				
EndProcedure			

Procedure OpenWindow_Window_0()
	If OpenWindow(#Window_0, 419, 0, 943, 795, "Proc Viewer", #PB_Window_SystemMenu|#PB_Window_SizeGadget|#PB_Window_MinimizeGadget|#PB_Window_TitleBar)
		If CreateStatusBar(#StatusBar_Window_0, WindowID(#Window_0))
			AddStatusBarField(475)
			AddStatusBarField(512)
		EndIf
		ButtonGadget(#Button_file1, 10, 5, 70, 30, "File1")
		ButtonGadget(#Button_file2, 10, 40, 70, 30, "File 2")
		TextGadget(#Text_file1, 85, 5, 852, 30, "")
		TextGadget(#Text_file2, 85, 40, 852, 30, "")
		ListIconGadget(#ListIcon_file1, 5, 80, 930, 690, "", 465, #PB_ListIcon_AlwaysShowSelection|#PB_ListIcon_GridLines|#PB_ListIcon_FullRowSelect)
		AddGadgetColumn(#ListIcon_file1,1,"",465)
	EndIf
EndProcedure

Procedure cleanup()
	ClearList(file1())
	ClearList(file2())
	ClearList(mark())
	ClearGadgetItems(#ListIcon_file1)
	SetGadgetText(#Text_file1,"")
	SetGadgetText(#Text_file2,"")
EndProcedure

OpenWindow_Window_0()
		SetGadgetColor(#ListIcon_file1,#PB_Gadget_BackColor,$C7FFFE)
DisableGadget(#Button_file2,1)
Repeat
	Event = WaitWindowEvent()
	Select Event
		Case #PB_Event_Gadget
			Select EventGadget()
				Case #Button_file1
					cleanup()	
					f1$=OpenFileRequester("Select a *.pb file","*.pb|*.pbi","*.pb",0)
					SetGadgetText(#Text_file1,f1$)
					DisableGadget(#Button_file2,0)
				Case #Button_file2
					f2$=OpenFileRequester("Select a *.pb file","*.pb|*.pbi","*.pb",0)
					SetGadgetText(#Text_file2,f2$)
					If f1$ And f2$						
						doprocs(f1$,file1())
						doprocs(f2$,file2())
						SortList(file1() , #PB_Sort_Ascending)
						SortList(file2() , #PB_Sort_Ascending)
						alignprocs()
						updatestatusbar()
					Else
						MessageRequester("File Error", "Please Select 2 Files")
					EndIf
			EndSelect
		Case #PB_Event_CloseWindow
			Select EventWindow()
				Case #Window_0
					CloseWindow(#Window_0)
					Break
			EndSelect
	EndSelect
ForEver
Zebuddi :)
malleo, caput, bang. Ego, comprehendunt in tempore