Tools Installer Source

Share your advanced PureBasic knowledge/code with the community.
Post Reply
Num3
PureBasic Expert
PureBasic Expert
Posts: 2812
Joined: Fri Apr 25, 2003 4:51 pm
Location: Portugal, Lisbon
Contact:
Contact Num3

Tools Installer Source

Post by Num3 »

Source code to the Tools Installer Program Posted on this thread:

viewtopic.php?t=6691


The tool code:

Code: Select all

; ******** TOOLS INSTALLER ********
;
;           Num3 - 2003
;
; Please feel free to use this code
;
; *********************************

Declare PackerProgress(SourcePosition, DestinationPosition)
Declare create()
Declare Open_Window_0()
Declare BalloonTip(WindowID, Gadget, Text$ , Title$, Icon)


#Window_0  = 0
#Gadget_0  = 0
#Gadget_18  = 1
#Gadget_5  = 2
#Gadget_1  = 3
#Gadget_6  = 4
#Gadget_2  = 5
#Gadget_8  = 6
#Gadget_3  = 7
#Gadget_9  = 8
#Gadget_12  = 9
#Gadget_13  = 10
#Gadget_14  = 11
#Gadget_15  = 12
#Gadget_16  = 13
#Gadget_17  = 14
#Gadget_4  = 15
#Gadget_10  = 16
#Gadget_7  = 17
#Gadget_11  = 18
#Gadget_23  = 19
#Gadget_20  = 20
#Gadget_22  = 21

#BS_FLAT  = $8000
#PBM_SETBARCOLOR  = $409
#PBM_SETBKCOLOR  = $2001

Dim Language$(33)

;- Image Plugins
UsePNGImageDecoder()

;- Image Globals
Global Image0

;- Catch Images
Image0  = CatchImage(0, ?Image0)

;- Images
DataSection
Image0  :
IncludeBinary "PureBasic.PNG" ; The purebasic PNG that is found on examples\data
EndDataSection

; BalloonTip Constants
#TOOLTIP_NO_ICON  = 0
#TOOLTIP_INFO_ICON  = 1
#TOOLTIP_WARNING_ICON  = 2
#TOOLTIP_ERROR_ICON  = 3

Procedure BalloonTip(WindowID, Gadget, Text$ , Title$, Icon)
  
  ToolTip  = CreateWindowEx_(0, "ToolTips_Class32", "", #WS_POPUP  | #TTS_NOPREFIX  | #TTS_BALLOON, 0, 0, 0, 0, WindowID(WindowID), 0, GetModuleHandle_(0), 0)
  SendMessage_(ToolTip,  #TTM_SETTIPTEXTCOLOR, GetSysColor_(#COLOR_INFOTEXT), 0)
  SendMessage_(ToolTip,  #TTM_SETTIPBKCOLOR, GetSysColor_(#COLOR_INFOBK), 0)
  SendMessage_(ToolTip,  #TTM_SETMAXTIPWIDTH, 0, 180)
  Balloon.TOOLINFO\cbSize  = SizeOf(TOOLINFO)
  Balloon\uFlags  = #TTF_IDISHWND  | #TTF_SUBCLASS
  Balloon\hWnd  = GadgetID(Gadget)
  Balloon\uId  = GadgetID(Gadget)
  Balloon\lpszText  = @Text$
  SendMessage_(ToolTip,  #TTM_ADDTOOL, 0, Balloon)
  If Title$  > ""
    SendMessage_(ToolTip,  #TTM_SETTITLE, Icon, @Title$)
  EndIf
  
EndProcedure

Procedure Open_Window_0()
  If OpenWindow(#Window_0, 359, 170, 302, 392, #PB_Window_SystemMenu  | #PB_Window_MinimizeGadget  | #PB_Window_TitleBar  | #PB_Window_ScreenCentered , "PureBasic Tool Installer")
    If CreateGadgetList(WindowID())
      
      TextGadget(#Gadget_0,  15, 70, 105, 15, Language$(0))
      BalloonTip(WindowID(),  #Gadget_0, Language$(1), Language$(2), #TOOLTIP_NO_ICON)
      
      TextGadget(#Gadget_1,  15, 97, 105, 15, Language$(5))
      BalloonTip(WindowID(),  #Gadget_1, Language$(6), Language$(7), #TOOLTIP_NO_ICON)
      
      TextGadget(#Gadget_2,  15, 124, 105, 15, Language$(10))
      BalloonTip(WindowID(),  #Gadget_2, Language$(11), Language$(12), #TOOLTIP_NO_ICON)
      
      TextGadget(#Gadget_4,  17, 179, 105, 15, Language$(26))
      BalloonTip(WindowID(),  #Gadget_4, Language$(27), Language$(28), #TOOLTIP_NO_ICON)
      
      StringGadget(#Gadget_5,  120, 65, 140, 20, "")
      BalloonTip(WindowID(),  #Gadget_5, Language$(3), Language$(4), #TOOLTIP_INFO_ICON)
      
      StringGadget(#Gadget_6,  120, 92, 140, 20, "")
      BalloonTip(WindowID(),  #Gadget_6, Language$(8), Language$(9), #TOOLTIP_INFO_ICON)
      
      ButtonGadget(#Gadget_7,  265, 92, 15, 20, Language$(31), #BS_FLAT)
      
      
      StringGadget(#Gadget_8,  120, 120, 140, 20, "")
      BalloonTip(WindowID(),  #Gadget_8, Language$(13), Language$(14), #TOOLTIP_INFO_ICON)
      
      TextGadget(#Gadget_3,  17, 151, 105, 15, Language$(15))
      BalloonTip(WindowID(),  #Gadget_3, Language$(16), Language$(17), #TOOLTIP_NO_ICON)
      
      StringGadget(#Gadget_9,  120, 147, 140, 20, "")
      BalloonTip(WindowID(),  #Gadget_9, Language$(18), Language$(19), #TOOLTIP_INFO_ICON)
      
      StringGadget(#Gadget_10,  120, 174, 140, 20, "")
      BalloonTip(WindowID(),  #Gadget_10, Language$(29), Language$(30), #TOOLTIP_INFO_ICON)
      ButtonGadget(#Gadget_11,  265, 174, 15, 20, Language$(32), #BS_FLAT)
      
      CheckBoxGadget(#Gadget_12,  25, 205, 250, 15, Language$(20))
      CheckBoxGadget(#Gadget_13,  25, 230, 248, 15, Language$(21))
      CheckBoxGadget(#Gadget_14,  25, 255, 253, 15, Language$(22))
      CheckBoxGadget(#Gadget_15,  25, 280, 253, 15, Language$(23))
      
      OptionGadget(#Gadget_16,  60, 300, 130, 15, Language$(24))
      OptionGadget(#Gadget_17,  60, 320, 130, 15, Language$(25))
      
      ImageGadget(#Gadget_18,  60, 10, 168, 35, Image0)
      
      Frame3DGadget(#Gadget_23,  5, 50, 285, 300, "")
      ButtonGadget(#Gadget_20,  200, 360, 90, 20, Language$(33), #BS_FLAT)
      
      ProgressBarGadget(#Gadget_22,  10, 365, 185, 10, 0, 100, #PB_ProgressBar_Smooth)
      PostMessage_(GadgetID(#Gadget_22),  #PBM_SETBARCOLOR, 0, RGB(255, 204, 51))
      PostMessage_(GadgetID(#Gadget_22),  #PBM_SETBKCOLOR, 0, RGB(51, 102, 153))
      
      
    EndIf
  EndIf
EndProcedure

; *********  For future language catalog ************
;
; Procedure ReadCatalog(Filename$)
;
;   If ReadFile(0, Filename$)
;     If ReadString() = "Catalog"
;       For k=0 To 33
;         Language$(k) = ReadString()
;       Next
;     EndIf
;     CloseFile(0)
;   EndIf
;
; EndProcedure
;
Restore BaseLanguage
For k = 0 To 33
  Read Language$(k)
Next

DataSection
BaseLanguage  :
Data$ "Directory Name:"
Data$ ""
Data$ "Name for the directory that is created for you tool"
Data$ "Name for the directory that is created in the Purebasic Folder for your tool"
Data$ "Directory Name"
Data$ "Tool Executable:"
Data$ ""
Data$ "Name for the directory that is created for you tool"
Data$ "Filename of your tool"
Data$ "Executable"
Data$ "Arguments:"
Data$ ""
Data$ "Name for the directory that is created for you tool"
Data$ "(%PATH, %FILE, %TEMPFILE)"
Data$ "Command Line Arguments"
Data$ "Menu Item Name:"
Data$ ""
Data$ "Name for the directory that is created for you tool"
Data$ "The name that will appear on the Tools Menu"
Data$ "Menu Name"
Data$ "Run Hiden"
Data$ "Wait Until Tool Quits"
Data$ "Hide Editor"
Data$ "Reload Source after tool ends"
Data$ "Into a new source"
Data$ "Into current source"
Data$ "Tool Help File:"
Data$ ""
Data$ "Name for the directory that is created for you tool"
Data$ "If you want to include a help or credit file, select it here"
Data$ "Tool Help File"
Data$ ">"
Data$ ">"
Data$ "Create"
EndDataSection

Open_Window_0()

ActivateGadget(#Gadget_5)
DisableGadget(#gadget_16,  1)
DisableGadget(#gadget_17,  1)
DisableGadget(#gadget_14,  1)

; * Get windows temp path *
windir.s  = Space(255)
If GetTempPath_(255, windir)
Else
  windir  = "c:\"
EndIf

Structure stuff
  dir.s
  file.s
  args.s
  name.s
  help.s
  run.b
  wait.b
  hide.b
  reload.b
EndStructure

Global save.stuff, windir, FileLength

Repeat
  
  
  Event  = WaitWindowEvent()
  
  If Event  = #PB_EventGadget
    
    GadgetID  = EventGadgetID()
    
    If GadgetID  = #Gadget_7
      ;- Tool Exe
      x.s  = OpenFileRequester("Select File", "*.exe", "*.exe", 0 )
      If x  <  > ""
        SetGadgetText(#Gadget_6,  x)
      EndIf
      
    ElseIf GadgetID  = #Gadget_13
      If GetGadgetState(#gadget_13)
        DisableGadget(#gadget_14,  0)
      Else
        DisableGadget(#gadget_14,  1)
        SetGadgetState(#gadget_14,  0)
      EndIf
      
    ElseIf GadgetID  = #Gadget_11
      ;- Help File
      x.s  = OpenFileRequester("Select File", "*.*", "*.*", 0 )
      If x  <  > ""
        SetGadgetText(#Gadget_10,  x)
      EndIf
      
    ElseIf GadgetID  = #Gadget_15
      ;- Reload Source
      If GetGadgetState(#Gadget_15)=1
        DisableGadget(#gadget_16,  0)
        DisableGadget(#gadget_17,  0)
      Else
        DisableGadget(#gadget_16,  1)
        DisableGadget(#gadget_17,  1)
        SetGadgetState(#Gadget_16,  0)
        SetGadgetState(#Gadget_17,  0)
      EndIf
      
    ElseIf GadgetID  = #Gadget_16
      ;- New Source
      If GetGadgetState(#Gadget_16)=1
        SetGadgetState(#Gadget_17,  0)
      EndIf
      
    ElseIf GadgetID  = #Gadget_17
      ;- Current Source
      If GetGadgetState(#Gadget_17)=1
        SetGadgetState(#Gadget_16,  0)
      EndIf
      
      
    ElseIf GadgetID  = #Gadget_20
      
      ;- Preparation
      save\dir  = GetGadgetText(#gadget_5)
      save\file  = GetGadgetText(#gadget_6)
      save\help  = GetGadgetText(#gadget_10)
      save\args  = GetGadgetText(#gadget_8)
      
      save\name  = GetGadgetText(#gadget_9)
      save\run  = GetGadgetState(#Gadget_12)
      save\wait  = GetGadgetState(#Gadget_13)
      save\hide  = GetGadgetState(#Gadget_14)
      create()
      
    ElseIf GadgetID  = #Gadget_22
      
      
    EndIf
    
  EndIf
  
  
  
Until Event  = #PB_EventCloseWindow

Procedure create()
  
  If save\dir  = ""
    MessageRequester("Error",  "You need to name a directory to be created", #MB_ICONERROR )
    ActivateGadget(#Gadget_5)
    ProcedureReturn
  EndIf
  
  If save\file  = ""
    MessageRequester("Error",  "No tool executable selected", #MB_ICONERROR )
    ActivateGadget(#Gadget_6)
    ProcedureReturn
  EndIf
  
  If GetGadgetState(#gadget_16)=1
    save\reload  = 1
  EndIf
  
  If GetGadgetState(#gadget_17)=1
    save\reload  = 2
  EndIf
  
  
  If CreatePreferences(windir  + "\pbti.txt")
    
    WritePreferenceString("Dir",  save\dir)
    WritePreferenceString("File",  GetFilePart(save\file))
    WritePreferenceString("Args",  save\args)
    WritePreferenceString("Name",  save\name)
    WritePreferenceString("Help",  GetFilePart(save\help))
    WritePreferenceString("Run",  Str(save\run))
    WritePreferenceString("Wait",  Str(save\wait))
    WritePreferenceString("Hide",  Str(save\hide))
    WritePreferenceString("Reload",  Str(save\reload))
    
    ClosePreferences()
  Else
    ProcedureReturn
    
  EndIf
  
  
  filename.s  = SaveFileRequester("Save", save\name  + ".exe", "*.exe", 0)
  If filename  = ""
    filename  = save\name  + ".exe"
  EndIf
  
  
  If CreatePack(windir  + "\test.bulk")
    ; pnti.txt file
    
    FileLength  = FileSize(windir  + "\pbti.txt")
    
    If FileLength  > 0
      Debug "Adding:"  + windir  + "\pbti.txt"
      PackerCallback(@PackerProgress())
      If AddPackFile(windir  + "\pbti.txt", 9)
      EndIf
    EndIf
    
    ; Our exec file
    
    FileLength  = FileSize(save\file)
    
    If FileLength  > 0
      Debug "Adding:"  + save\file
      PackerCallback(@PackerProgress())
      If AddPackFile(save\file, 9)
      EndIf
    EndIf
    
    ; Our help file
    
    FileLength  = FileSize(save\help)
    
    If FileLength  > 0
      Debug "Adding:"  + save\help
      PackerCallback(@PackerProgress())
      If AddPackFile(save\help, 9)
      EndIf
    EndIf
    
    
    ClosePack()
    Delay(100)
    
    
    
    If ReadFile(0, windir  + "\test.bulk")
      len  = Lof()
      AllocateMemory(0,  len, 0)
      *mem  = MemoryID()
      ReadData(*mem,  len)
      CloseFile(0)
    EndIf
    
    
    
    If CreateFile(0, filename)
      WriteData(?filestart,  ?fileend  - ?filestart)
      WriteData(*mem,  len)
      WriteLong(len)
      CloseFile(0)
    EndIf
    DeleteFile(windir  + "\test.bulk")
    DeleteFile(windir  + "\pbti.txt")
    End
    
    SetGadgetState(#Gadget_22,  0)
    
  EndIf
  
  
  
EndProcedure

Procedure PackerProgress(SourcePosition, DestinationPosition)
  
  Result.f  = (SourcePosition  / FileLength)*100
  SetGadgetState(#Gadget_22,  Round(Result, 0))
  
  While (WindowEvent())
  Wend
  
  ProcedureReturn 1
EndProcedure


End


;Include the SFX program !!!
filestart  :
IncludeBinary"Installer.exe" ;Change this line to match the SFX exe name
fileend  :

The SFX Module code (compile it has installer.exe):

Code: Select all

; *********** SFX MODULE **********
;
;           Num3 - 2003
;
; Please feel free to use this code
;
; *********************************

Declare install()
Declare unpack()
Declare Open_Window_0()

#Window_0  = 0
#Gadget_0  = 0
#Gadget_2  = 1
#Gadget_3  = 2
#Gadget_4  = 3
#Gadget_5  = 4
#Gadget_6  = 5
#Gadget_9  = 6

#BS_FLAT  = $8000
#PBM_SETBARCOLOR  = $409
#PBM_SETBKCOLOR  = $2001

;- Image Plugins
UsePNGImageDecoder()

;- Image Globals
Global Image0

;- Catch Images
Image0  = CatchImage(0, ?Image0)

;- Images

DataSection
Image0 :
IncludeBinary "Pback.png" ; ***** 480 x 50 pixels png image
EndDataSection

Procedure Open_Window_0()
  If OpenWindow(#Window_0, 263, 244, 458, 187, #PB_Window_SystemMenu  | #PB_Window_TitleBar , "PureBasic Tools Installer")
    If CreateGadgetList(WindowID())
      Frame3DGadget(#Gadget_0,   - 5, 135, 470, 105, "")
      TextGadget(#Gadget_2,  15, 70, 225, 20, "Please select a directory to install")
      StringGadget(#Gadget_3,  15, 90, 365, 20, "")
      ButtonGadget(#Gadget_4,  385, 90, 60, 20, "Browse", #BS_FLAT)
      ButtonGadget(#Gadget_5,  360, 155, 75, 20, "Install", #BS_FLAT)
      ImageGadget(#Gadget_9,   - 15,  - 5, 480, 50, Image0)
      
    EndIf
  EndIf
EndProcedure

Structure stuff
  dir.s
  file.s
  args.s
  name.s
  help.s
  run.b
  wait.b
  hide.b
  reload.b
EndStructure


Global path.s, windir.s, save.stuff, filename.s

filename.s  = Space(1000)
GetModuleFileName_(0,  filename.s, 1000)
filename  = GetFilePart(filename)

; **** Get PureBasic Default Dir ****

path  = "Applications\PureBasic.exe\shell\open\command"
If RegOpenKeyEx_(#HKEY_CLASSES_ROOT, path, 0, #KEY_ALL_ACCESS, @Key) = #ERROR_SUCCESS
  indir.s  = Space(500)
  insize  = 500
  If RegQueryValueEx_(Key, "", 0, 0, @indir.s, @insize) = #ERROR_SUCCESS
    RegCloseKey_(Key)
    indir  = RemoveString(indir, "%1", 1)
    indir  = RemoveString(indir, Chr(34), 1)
    indir  = RTrim(indir)
    path  = GetPathPart(indir)
  Else
    MessageRequester("Installer Error!",  "Hum... Seems i can't find Purebasic", #MB_ICONERROR)
    RegCloseKey_(Key)
    path  = "C:\purebasic"
  EndIf
EndIf


; **** Get windows temp Dir ****

windir.s  = Space(255)
If GetTempPath_(255, windir)
Else
  windir  = "c:\"
EndIf


Open_Window_0()
unpack()

Repeat
  
  Event  = WaitWindowEvent()
  
  If Event  = #PB_EventGadget
    
    GadgetID  = EventGadgetID()
    
    If GadgetID  = #Gadget_5
      ;- Unpack
      install()
    ElseIf GadgetID  = #Gadget_4
      x.s  = PathRequester("Please Select Destination", path)
      If x  <  > ""
        x  = ReplaceString(x, "\", "" , 0, Len(x)-2)
        SetGadgetText(#gadget_3,  x)
      EndIf
    EndIf
    
  EndIf
  
Until Event  = #PB_EventCloseWindow

DeleteFile(windir  + "\"  + save\file)
DeleteFile(windir  + "\"  + save\help)
DeleteFile(windir  + "\pbti.txt")

Procedure unpack()
  
  If ReadFile(0, filename)
    
    
    FileSeek(Lof()-4)
    filelen.l  = ReadLong()
    
    
    AllocateMemory(0,  filelen, 0)
    *mem  = MemoryID()
    FileSeek(Lof()-4  - filelen)
    ReadData(*mem,  filelen)
    
    
    CreateFile(1,  windir  + "\tmp.pak")
    WriteData(*mem,  filelen)
    CloseFile(1)
    CloseFile(0)
  Else
    MessageRequester("Installer Error!",  "Hum... Seems there is no package to deliver !", #MB_ICONERROR)
    
  EndIf
  
  
  If OpenPack(windir  + "\tmp.pak")
    *file  = NextPackFile()
    size.l  = PackFileSize()
    CreateFile(0,  windir  + "\pbti.txt")
    WriteData(*file , size)
    CloseFile(0)
    
    If OpenPreferences(windir  + "\pbti.txt")
      
      save\dir  = ReadPreferenceString("Dir", "")
      save\file  = ReadPreferenceString("File", "")
      save\args  = ReadPreferenceString("Args", "")
      save\name  = ReadPreferenceString("Name", "")
      save\help  = ReadPreferenceString("Help", "")
      save\run  = Val(ReadPreferenceString("Run", ""))
      save\wait  = Val(ReadPreferenceString("Wait", ""))
      save\hide  = Val(ReadPreferenceString("Hide", ""))
      save\reload  = Val(ReadPreferenceString("Reload", ""))
      
      ClosePreferences()
      
    EndIf
    
    SetGadgetText(#gadget_3,  path  + save\dir)
    
    *file  = NextPackFile()
    size.l  = PackFileSize()
    CreateFile(0,  windir  + "\"  + save\file)
    WriteData(*file , size)
    CloseFile(0)
    
    If save\help  <  > ""
      *file  = NextPackFile()
      size.l  = PackFileSize()
      CreateFile(0,  windir  + "\"  + save\help)
      WriteData(*file , size)
      CloseFile(0)
    EndIf
    
    ClosePack()
    
    DeleteFile(windir  + "\tmp.pak")
  EndIf
  
  
EndProcedure

Procedure install()
  
  CreateDirectory(GetGadgetText(#gadget_3))
  
  in.s  = windir  + "\"  + save\file
  out.s  = GetGadgetText(#gadget_3)+"\"  + save\file
  If CopyFile(in, out)
  EndIf
  
  If save\help  <  > ""
    in.s  = windir  + "\"  + save\help
    out.s  = GetGadgetText(#gadget_3)+"\"  + save\help
    If CopyFile(in, out)
    EndIf
  EndIf
  
  
  If OpenFile(0, path  + "tools.prefs")
    
    While Eof(0)=0
      x.s  = ReadString()
      w  = FindString(x, "ToolCount = ", 1)
      
      If w
        
        count  = Val(Mid(x, 12 , Len(x)))
        count  + 1
        FileSeek(Loc()-Len(x)-2)
        WriteStringN("ToolCount = "  + Str(count))
        
      EndIf
    Wend
    FileSeek(Lof())
    WriteStringN(";")
    WriteStringN(";")
    WriteStringN("[Tool_"  + Str(count)+"]")
    WriteStringN("Command = "  + GetGadgetText(#gadget_3)+"\"  + save\file)
    WriteStringN("Arguments = "  + save\args)
    WriteStringN("WorkingDir = ")
    WriteStringN("MenuItemName = "  + save\name)
    WriteStringN("Shortcut = " )
    WriteStringN("Flags = "  + Str(save\wait))
    WriteStringN("ReloadSource = "  + Str(save\reload))
    WriteStringN("HideEditor = "  + Str(save\hide))
    
    CloseFile(0)
    
  EndIf
  
  
  DeleteFile(windir  + "\"  + save\file)
  DeleteFile(windir  + "\"  + save\help)
  DeleteFile(windir  + "\pbti.txt")
  
  MessageRequester("Installer",  "Installation Complete!", #MB_ICONINFORMATION )
  End
  
EndProcedure


End
Hope this code inspires and helps ! :D
Top
boop64
User
User
Posts: 14
Joined: Tue Nov 18, 2003 12:42 pm
Contact:
Contact boop64

Post by boop64 »

Nice code, it's nice to see that someone was able to use my SFX example I posted on the PB resource site a long time ago.

Boop64
Top
abc123
Enthusiast
Enthusiast
Posts: 195
Joined: Wed Apr 18, 2007 9:27 pm

Post by abc123 »

Can someone kindly please convert the codes for PB 4? :cry:

THANKS IN ADVANCE! :)
Top
Fred
Administrator
Administrator
Posts: 18224
Joined: Fri May 17, 2002 4:39 pm
Location: France
Contact:
Contact Fred

Post by Fred »

Did you tried ?
Top
abc123
Enthusiast
Enthusiast
Posts: 195
Joined: Wed Apr 18, 2007 9:27 pm

Post by abc123 »

Its ok, i dont need it anymore. Thanks anyway.
Top
Inf0Byt3
PureBasic Fanatic
PureBasic Fanatic
Posts: 2236
Joined: Fri Dec 09, 2005 12:15 pm
Location: Elbonia

Post by Inf0Byt3 »

If you change your mind, you can look at this proggie I made a long time ago. Maybe it will help you:

http://purearea.net/pb/download/devtools/PureSFX.zip
None are more hopelessly enslaved than those who falsely believe they are free. (Goethe)
Top
User avatar
netmaestro
PureBasic Bullfrog
PureBasic Bullfrog
Posts: 8451
Joined: Wed Jul 06, 2005 5:42 am
Location: Fort Nelson, BC, Canada

Post by netmaestro »

This is a good program, well worth updating to 4.0 code. So, here it is ..

Converted to PB 4.02 (tested, it works):

Code: Select all

; ******** TOOLS INSTALLER ******** 
; 
;           Num3 - 2003 
; 
; Please feel free to use this code 
; 
; ********************************* 

Declare PackerProgress(SourcePosition, DestinationPosition) 
Declare create() 
Declare Open_Window_0() 
Declare BalloonTip(WindowID, Gadget, Text$ , Title$, Icon) 


#Window_0  = 0 
#Gadget_0  = 0 
#Gadget_18  = 1 
#Gadget_5  = 2 
#Gadget_1  = 3 
#Gadget_6  = 4 
#Gadget_2  = 5 
#Gadget_8  = 6 
#Gadget_3  = 7 
#Gadget_9  = 8 
#Gadget_12  = 9 
#Gadget_13  = 10 
#Gadget_14  = 11 
#Gadget_15  = 12 
#Gadget_16  = 13 
#Gadget_17  = 14 
#Gadget_4  = 15 
#Gadget_10  = 16 
#Gadget_7  = 17 
#Gadget_11  = 18 
#Gadget_23  = 19 
#Gadget_20  = 20 
#Gadget_22  = 21 

#BS_FLAT  = $8000 
#PBM_SETBARCOLOR  = $409 
#PBM_SETBKCOLOR  = $2001 

Structure stuff 
  dir.s 
  file.s 
  args.s 
  name.s 
  help.s 
  run.b 
  wait.b 
  hide.b 
  reload.b 
EndStructure 

Global Dim Language$(33) 
Global save.stuff, windir.s, FileLength 

;- Image Plugins 
UsePNGImageDecoder() 

;- Image Globals 
Global Image0 

;- Catch Images 
Image0  = CatchImage(0, ?Image0) 

;- Images 
DataSection 
Image0  : 
IncludeBinary #PB_Compiler_Home + "examples\sources\data\PureBasic.bmp" ; The purebasic PNG that is found on examples\data 
EndDataSection 

; BalloonTip Constants 
#TOOLTIP_NO_ICON  = 0 
#TOOLTIP_INFO_ICON  = 1 
#TOOLTIP_WARNING_ICON  = 2 
#TOOLTIP_ERROR_ICON  = 3 

Procedure BalloonTip(WindowID, Gadget, Text$ , Title$, Icon) 
  
  ToolTip  = CreateWindowEx_(0, "ToolTips_Class32", "", #WS_POPUP  | #TTS_NOPREFIX  | #TTS_BALLOON, 0, 0, 0, 0, WindowID, 0, GetModuleHandle_(0), 0) 
  SendMessage_(ToolTip,  #TTM_SETTIPTEXTCOLOR, GetSysColor_(#COLOR_INFOTEXT), 0) 
  SendMessage_(ToolTip,  #TTM_SETTIPBKCOLOR, GetSysColor_(#COLOR_INFOBK), 0) 
  SendMessage_(ToolTip,  #TTM_SETMAXTIPWIDTH, 0, 180) 
  Balloon.TOOLINFO\cbSize  = SizeOf(TOOLINFO) 
  Balloon\uFlags  = #TTF_IDISHWND  | #TTF_SUBCLASS 
  Balloon\hWnd  = GadgetID(Gadget) 
  Balloon\uId  = GadgetID(Gadget) 
  Balloon\lpszText  = @Text$ 
  SendMessage_(ToolTip,  #TTM_ADDTOOL, 0, Balloon) 
  If Title$  > "" 
    SendMessage_(ToolTip,  #TTM_SETTITLE, Icon, @Title$) 
  EndIf 
  
EndProcedure 

Procedure Open_Window_0() 
  If OpenWindow(#Window_0, 359, 170, 302, 392, "PureBasic Tool Installer", #PB_Window_SystemMenu  | #PB_Window_MinimizeGadget  | #PB_Window_TitleBar  | #PB_Window_ScreenCentered ) 
    If CreateGadgetList(WindowID(#Window_0)) 
      
      TextGadget(#Gadget_0,  15, 70, 105, 15, Language$(0)) 
      BalloonTip(WindowID(#Window_0),  #Gadget_0, Language$(1), Language$(2), #TOOLTIP_NO_ICON) 
      
      TextGadget(#Gadget_1,  15, 97, 105, 15, Language$(5)) 
      BalloonTip(WindowID(#Window_0),  #Gadget_1, Language$(6), Language$(7), #TOOLTIP_NO_ICON) 
      
      TextGadget(#Gadget_2,  15, 124, 105, 15, Language$(10)) 
      BalloonTip(WindowID(#Window_0),  #Gadget_2, Language$(11), Language$(12), #TOOLTIP_NO_ICON) 
      
      TextGadget(#Gadget_4,  17, 179, 105, 15, Language$(26)) 
      BalloonTip(WindowID(#Window_0),  #Gadget_4, Language$(27), Language$(28), #TOOLTIP_NO_ICON) 
      
      StringGadget(#Gadget_5,  120, 65, 140, 20, "") 
      BalloonTip(WindowID(#Window_0),  #Gadget_5, Language$(3), Language$(4), #TOOLTIP_INFO_ICON) 
      
      StringGadget(#Gadget_6,  120, 92, 140, 20, "") 
      BalloonTip(WindowID(#Window_0),  #Gadget_6, Language$(8), Language$(9), #TOOLTIP_INFO_ICON) 
      
      ButtonGadget(#Gadget_7,  265, 92, 15, 20, Language$(31), #BS_FLAT) 
      
      StringGadget(#Gadget_8,  120, 120, 140, 20, "") 
      BalloonTip(WindowID(#Window_0),  #Gadget_8, Language$(13), Language$(14), #TOOLTIP_INFO_ICON) 
      
      TextGadget(#Gadget_3,  17, 151, 105, 15, Language$(15)) 
      BalloonTip(WindowID(#Window_0),  #Gadget_3, Language$(16), Language$(17), #TOOLTIP_NO_ICON) 
      
      StringGadget(#Gadget_9,  120, 147, 140, 20, "") 
      BalloonTip(WindowID(#Window_0),  #Gadget_9, Language$(18), Language$(19), #TOOLTIP_INFO_ICON) 
      
      StringGadget(#Gadget_10,  120, 174, 140, 20, "") 
      BalloonTip(WindowID(#Window_0),  #Gadget_10, Language$(29), Language$(30), #TOOLTIP_INFO_ICON) 
      ButtonGadget(#Gadget_11,  265, 174, 15, 20, Language$(32), #BS_FLAT) 
      
      CheckBoxGadget(#Gadget_12,  25, 205, 250, 15, Language$(20)) 
      CheckBoxGadget(#Gadget_13,  25, 230, 248, 15, Language$(21)) 
      CheckBoxGadget(#Gadget_14,  25, 255, 253, 15, Language$(22)) 
      CheckBoxGadget(#Gadget_15,  25, 280, 253, 15, Language$(23)) 
      
      OptionGadget(#Gadget_16,  60, 300, 130, 15, Language$(24)) 
      OptionGadget(#Gadget_17,  60, 320, 130, 15, Language$(25)) 
      
      ImageGadget(#Gadget_18,  60, 10, 168, 35, Image0) 
      
      Frame3DGadget(#Gadget_23,  5, 50, 285, 300, "") 
      ButtonGadget(#Gadget_20,  200, 360, 90, 20, Language$(33), #BS_FLAT) 
      
      ProgressBarGadget(#Gadget_22,  10, 365, 185, 10, 0, 100, #PB_ProgressBar_Smooth) 
      PostMessage_(GadgetID(#Gadget_22),  #PBM_SETBARCOLOR, 0, RGB(255, 204, 51)) 
      PostMessage_(GadgetID(#Gadget_22),  #PBM_SETBKCOLOR, 0, RGB(51, 102, 153)) 
      
    EndIf 
  EndIf 
EndProcedure 

; *********  For future language catalog ************ 
; 
; Procedure ReadCatalog(Filename$) 
; 
;   If ReadFile(0, Filename$) 
;     If ReadString() = "Catalog" 
;       For k=0 To 33 
;         Language$(k) = ReadString() 
;       Next 
;     EndIf 
;     CloseFile(0) 
;   EndIf 
; 
; EndProcedure 
; 
Restore BaseLanguage 
For k = 0 To 33 
  Read Language$(k) 
Next 

DataSection 
BaseLanguage  : 
Data$ "Directory Name:" 
Data$ "" 
Data$ "Name for the directory that is created for you tool" 
Data$ "Name for the directory that is created in the Purebasic Folder for your tool" 
Data$ "Directory Name" 
Data$ "Tool Executable:" 
Data$ "" 
Data$ "Name for the directory that is created for you tool" 
Data$ "Filename of your tool" 
Data$ "Executable" 
Data$ "Arguments:" 
Data$ "" 
Data$ "Name for the directory that is created for you tool" 
Data$ "(%PATH, %FILE, %TEMPFILE)" 
Data$ "Command Line Arguments" 
Data$ "Menu Item Name:" 
Data$ "" 
Data$ "Name for the directory that is created for you tool" 
Data$ "The name that will appear on the Tools Menu" 
Data$ "Menu Name" 
Data$ "Run Hidden" 
Data$ "Wait Until Tool Quits" 
Data$ "Hide Editor" 
Data$ "Reload Source after tool ends" 
Data$ "Into a new source" 
Data$ "Into current source" 
Data$ "Tool Help File:" 
Data$ "" 
Data$ "Name for the directory that is created for you tool" 
Data$ "If you want to include a help or credit file, select it here" 
Data$ "Tool Help File" 
Data$ ">" 
Data$ ">" 
Data$ "Create" 
EndDataSection 

Open_Window_0() 

SetActiveGadget(#Gadget_5) 
DisableGadget(#gadget_16,  1) 
DisableGadget(#gadget_17,  1) 
DisableGadget(#gadget_14,  1) 

; * Get windows temp path * 
windir.s  = Space(255) 
If GetTempPath_(255, windir) 
Else 
  windir  = "c:\" 
EndIf 


Repeat 
  
  
  Event  = WaitWindowEvent() 
  
  If Event  = #PB_Event_Gadget 
    
    GadgetID  = EventGadget() 
    
    If GadgetID  = #Gadget_7 
      ;- Tool Exe 
      x.s  = OpenFileRequester("Select File", "*.exe", "*.exe", 0 ) 
      If x  <  > "" 
        SetGadgetText(#Gadget_6,  x) 
      EndIf 
      
    ElseIf GadgetID  = #Gadget_13 
      If GetGadgetState(#gadget_13) 
        DisableGadget(#gadget_14,  0) 
      Else 
        DisableGadget(#gadget_14,  1) 
        SetGadgetState(#gadget_14,  0) 
      EndIf 
      
    ElseIf GadgetID  = #Gadget_11 
      ;- Help File 
      x.s  = OpenFileRequester("Select File", "*.*", "*.*", 0 ) 
      If x  <  > "" 
        SetGadgetText(#Gadget_10,  x) 
      EndIf 
      
    ElseIf GadgetID  = #Gadget_15 
      ;- Reload Source 
      If GetGadgetState(#Gadget_15)=1 
        DisableGadget(#gadget_16,  0) 
        DisableGadget(#gadget_17,  0) 
      Else 
        DisableGadget(#gadget_16,  1) 
        DisableGadget(#gadget_17,  1) 
        SetGadgetState(#Gadget_16,  0) 
        SetGadgetState(#Gadget_17,  0) 
      EndIf 
      
    ElseIf GadgetID  = #Gadget_16 
      ;- New Source 
      If GetGadgetState(#Gadget_16)=1 
        SetGadgetState(#Gadget_17,  0) 
      EndIf 
      
    ElseIf GadgetID  = #Gadget_17 
      ;- Current Source 
      If GetGadgetState(#Gadget_17)=1 
        SetGadgetState(#Gadget_16,  0) 
      EndIf 
      
      
    ElseIf GadgetID  = #Gadget_20 
      
      ;- Preparation 
      save\dir  = GetGadgetText(#gadget_5) 
      save\file  = GetGadgetText(#gadget_6) 
      save\help  = GetGadgetText(#gadget_10) 
      save\args  = GetGadgetText(#gadget_8) 
      
      save\name  = GetGadgetText(#gadget_9) 
      save\run  = GetGadgetState(#Gadget_12) 
      save\wait  = GetGadgetState(#Gadget_13) 
      save\hide  = GetGadgetState(#Gadget_14) 
      create() 
      
    ElseIf GadgetID  = #Gadget_22 
      
      
    EndIf 
    
  EndIf 
  
  
  
Until Event  = #PB_Event_CloseWindow 

Procedure create() 
  
  If save\dir  = "" 
    MessageRequester("Error",  "You need to name a directory to be created", #MB_ICONERROR ) 
SetActiveGadget(#Gadget_5) 
    ProcedureReturn 
  EndIf 
  
  If save\file  = "" 
    MessageRequester("Error",  "No tool executable selected", #MB_ICONERROR ) 
SetActiveGadget(#Gadget_6) 
    ProcedureReturn 
  EndIf 
  
  If GetGadgetState(#gadget_16)=1 
    save\reload  = 1 
  EndIf 
  
  If GetGadgetState(#gadget_17)=1 
    save\reload  = 2 
  EndIf 
  
  
  If CreatePreferences(windir  + "\pbti.txt") 
    
    WritePreferenceString("Dir",  save\dir) 
    WritePreferenceString("File",  GetFilePart(save\file)) 
    WritePreferenceString("Args",  save\args) 
    WritePreferenceString("Name",  save\name) 
    WritePreferenceString("Help",  GetFilePart(save\help)) 
    WritePreferenceString("Run",  Str(save\run)) 
    WritePreferenceString("Wait",  Str(save\wait)) 
    WritePreferenceString("Hide",  Str(save\hide)) 
    WritePreferenceString("Reload",  Str(save\reload)) 
    
    ClosePreferences() 
  Else 
    ProcedureReturn 
    
  EndIf 
  
  
  filename.s  = SaveFileRequester("Save", save\name  + ".exe", "*.exe", 0) 
  If filename  = "" 
    filename  = save\name  + ".exe" 
  EndIf 
  
  
  If CreatePack(windir  + "\test.bulk") 
    ; pnti.txt file 
    
    FileLength  = FileSize(windir  + "\pbti.txt") 
    
    If FileLength  > 0 
      Debug "Adding:"  + windir  + "\pbti.txt" 
      PackerCallback(@PackerProgress()) 
      If AddPackFile(windir  + "\pbti.txt", 9) 
      EndIf 
    EndIf 
    
    ; Our exec file 
    
    FileLength  = FileSize(save\file) 
    
    If FileLength  > 0 
      Debug "Adding:"  + save\file 
      PackerCallback(@PackerProgress()) 
      If AddPackFile(save\file, 9) 
      EndIf 
    EndIf 
    
    ; Our help file 
    
    FileLength  = FileSize(save\help) 
    
    If FileLength  > 0 
      Debug "Adding:"  + save\help 
      PackerCallback(@PackerProgress()) 
      If AddPackFile(save\help, 9) 
      EndIf 
    EndIf 
    
    
    ClosePack() 
    Delay(100) 
    
    
    
    If ReadFile(0, windir  + "\test.bulk") 
      len  = Lof(0) 
      
      *mem = AllocateMemory(len) 
      ReadData(0, *mem, len) 
      CloseFile(0) 
    EndIf 
    
    
    
    If CreateFile(0, filename) 
      WriteData(0, ?filestart,  ?fileend  - ?filestart) 
      WriteData(0, *mem, len) 
      WriteLong(0, len) 
      CloseFile(0) 
    EndIf 
    DeleteFile(windir  + "\test.bulk") 
    DeleteFile(windir  + "\pbti.txt") 
    End 
    
    SetGadgetState(#Gadget_22,  0) 
    
  EndIf 
  
  
  
EndProcedure 

Procedure PackerProgress(SourcePosition, DestinationPosition) 
  
  Result.f  = (SourcePosition  / FileLength)*100 
  SetGadgetState(#Gadget_22,  Round(Result, 0)) 
  
  While (WindowEvent()) 
  Wend 
  
  ProcedureReturn 1 
EndProcedure 


End 


;Include the SFX program !!! 
filestart  : 
IncludeBinary"Installer.exe" ;Change this line to match the SFX exe name 
fileend  :
The SFX Module code (compile it as installer.exe):

Code: Select all

; *********** SFX MODULE ********** 
; 
;           Num3 - 2003 
; 
; Please feel free to use this code 
; 
; ********************************* 

Declare install() 
Declare unpack() 
Declare Open_Window_0() 

#Window_0  = 0 
#Gadget_0  = 0 
#Gadget_2  = 1 
#Gadget_3  = 2 
#Gadget_4  = 3 
#Gadget_5  = 4 
#Gadget_6  = 5 
#Gadget_9  = 6 

#BS_FLAT  = $8000 
#PBM_SETBARCOLOR  = $409 
#PBM_SETBKCOLOR  = $2001 

;- Image Plugins 
UsePNGImageDecoder() 

;- Image Globals 
Global Image0 

;- Catch Images 
Image0  = CatchImage(0, ?Image0) 

;- Images 

DataSection 
Image0 : 
IncludeBinary "Pback.png" ; ***** 480 x 50 pixels png image 
EndDataSection 

Procedure Open_Window_0() 
  If OpenWindow(#Window_0, 263, 244, 458, 187, "PureBasic Tools Installer", #PB_Window_SystemMenu  | #PB_Window_TitleBar) 
    If CreateGadgetList(WindowID(#Window_0)) 
      Frame3DGadget(#Gadget_0,   - 5, 135, 470, 105, "") 
      TextGadget(#Gadget_2,  15, 70, 225, 20, "Please select a directory to install") 
      StringGadget(#Gadget_3,  15, 90, 365, 20, "") 
      ButtonGadget(#Gadget_4,  385, 90, 60, 20, "Browse", #BS_FLAT) 
      ButtonGadget(#Gadget_5,  360, 155, 75, 20, "Install", #BS_FLAT) 
      ImageGadget(#Gadget_9,   - 15,  - 5, 480, 50, Image0) 
    EndIf 
  EndIf 
EndProcedure 

Structure stuff 
  dir.s 
  file.s 
  args.s 
  name.s 
  help.s 
  run.b 
  wait.b 
  hide.b 
  reload.b 
EndStructure 

Global path.s, windir.s, save.stuff, filename.s 

filename.s  = Space(1000) 
GetModuleFileName_(0,  filename.s, 1000) 
filename  = GetFilePart(filename) 

; **** Get PureBasic Default Dir **** 

path  = #PB_Compiler_Home

; **** Get windows temp Dir **** 

windir.s  = GetTemporaryDirectory() 

Open_Window_0() 
unpack() 

Repeat 
  
  Event  = WaitWindowEvent() 
  If Event  = #PB_Event_Gadget 
    GadgetID  = EventGadget() 
    If GadgetID  = #Gadget_5 
      ;- Unpack 
      install() 
    ElseIf GadgetID  = #Gadget_4 
      x.s  = PathRequester("Please Select Destination", path) 
      If x  <  > "" 
        x  = ReplaceString(x, "\", "" , 0, Len(x)-2) 
        SetGadgetText(#gadget_3,  x) 
      EndIf 
    EndIf 
  EndIf 
  
Until Event  = #PB_Event_CloseWindow 

DeleteFile(windir  + "\"  + save\file) 
DeleteFile(windir  + "\"  + save\help) 
DeleteFile(windir  + "\pbti.txt") 

Procedure unpack() 
  If ReadFile(0, filename) 
    FileSeek(0, Lof(0)-4) 
    filelen.l  = ReadLong(0) 
    
    *mem  = AllocateMemory(filelen)
    FileSeek(0,Lof(0)-4  - filelen) 
    ReadData(0, *mem,  filelen) 
    
    CreateFile(1,  windir  + "\tmp.pak") 
    WriteData(1, *mem,  filelen) 
    CloseFile(1) 
    CloseFile(0) 
  Else 
    MessageRequester("Installer Error!",  "Hum... Seems there is no package to deliver !", #MB_ICONERROR) 
  EndIf 
  
  If OpenPack(windir  + "\tmp.pak") 
    *file  = NextPackFile() 
    size.l  = PackFileSize() 
    CreateFile(0,  windir  + "\pbti.txt") 
    WriteData(0, *file , size) 
    CloseFile(0) 
    
    If OpenPreferences(windir  + "\pbti.txt") 
      save\dir  = ReadPreferenceString("Dir", "") 
      save\file  = ReadPreferenceString("File", "") 
      save\args  = ReadPreferenceString("Args", "") 
      save\name  = ReadPreferenceString("Name", "") 
      save\help  = ReadPreferenceString("Help", "") 
      save\run  = Val(ReadPreferenceString("Run", "")) 
      save\wait  = Val(ReadPreferenceString("Wait", "")) 
      save\hide  = Val(ReadPreferenceString("Hide", "")) 
      save\reload  = Val(ReadPreferenceString("Reload", "")) 
      ClosePreferences() 
    EndIf 
    
    SetGadgetText(#gadget_3,  path  + save\dir) 
    
    *file  = NextPackFile() 
    size.l  = PackFileSize() 
    CreateFile(0,  windir  + "\"  + save\file) 
    WriteData(0, *file , size) 
    CloseFile(0) 
    
    If save\help  <  > "" 
      *file  = NextPackFile() 
      size.l  = PackFileSize() 
      CreateFile(0,  windir  + "\"  + save\help) 
      WriteData(0, *file , size) 
      CloseFile(0) 
    EndIf 
    
    ClosePack() 
    DeleteFile(windir  + "\tmp.pak") 
  EndIf 
  
  
EndProcedure 

Procedure install() 
  CreateDirectory(GetGadgetText(#gadget_3)) 
  in.s  = windir  + "\"  + save\file 
  out.s  = GetGadgetText(#gadget_3)+"\"  + save\file 
  If CopyFile(in, out) 
  EndIf 
  
  If save\help  <  > "" 
    in.s  = windir  + "\"  + save\help 
    out.s  = GetGadgetText(#gadget_3)+"\"  + save\help 
    If CopyFile(in, out) 
    EndIf 
  EndIf 
  
  If OpenFile(0, path  + "tools.prefs") 
    While Eof(0)=0 
      x.s  = ReadString(0) 
      w  = FindString(x, "ToolCount = ", 1) 
      If w 
        count  = Val(Mid(x, 12 , Len(x))) 
        count  + 1 
        FileSeek(0, Loc(0)-Len(x)-2) 
        WriteStringN(0, "ToolCount = "  + Str(count)) 
      EndIf 
    Wend 
    FileSeek(0, Lof(0)) 
    WriteStringN(0, ";") 
    WriteStringN(0, ";") 
    WriteStringN(0, "[Tool_"  + Str(count)+"]") 
    WriteStringN(0, "Command = "  + GetGadgetText(#gadget_3)+"\"  + save\file) 
    WriteStringN(0, "Arguments = "  + save\args) 
    WriteStringN(0, "WorkingDir = ") 
    WriteStringN(0, "MenuItemName = "  + save\name) 
    WriteStringN(0, "Shortcut = " ) 
    WriteStringN(0, "Flags = "  + Str(save\wait)) 
    WriteStringN(0, "ReloadSource = "  + Str(save\reload)) 
    WriteStringN(0, "HideEditor = "  + Str(save\hide)) 
    CloseFile(0) 
  EndIf 
  
  DeleteFile(windir  + "\"  + save\file) 
  DeleteFile(windir  + "\"  + save\help) 
  DeleteFile(windir  + "\pbti.txt") 
  
  MessageRequester("Installer",  "Installation Complete!", #MB_ICONINFORMATION ) 
  End 
  
EndProcedure 


End
The code could be further simplified by 4-izing it a bit more, but I left some parts alone.
BERESHEIT
Top
Post Reply

Return to “Tricks 'n' Tips”