Page 1 of 1

PB virtual drive [Windows only]

Posted: Thu Feb 06, 2025 10:25 pm
by minimy
Hello, i did this virtual disk with os commands.
The virtal drive is a shortcut to the folder, nice to use when need load a lot of things with other drive letter.
The drives only will be mounted in the sesion,
I hope you find any use.

HOW TO USE;
Mount Disc

Select a letter for the drive in the combobox at left in the top.
Select a folder with the button 'Path' in the top right.
Press the button 'Mount' to create a virtual drive.

Unmount Disc
Selec a drive from the list.
Press 'Unmount' button.

Added Delay(1) and explication. My fault :mrgreen:
Thanks for test!!

Code: Select all

#font_lt=   0
LoadFont(#font_lt,"Arial",12)
ti.l= $000000
pa.l= $dddddd

Procedure   mkBoton(x,y,w,h,txt.s, toggle=0, tip.s="", font=#font_lt)
  Protected   b= ButtonGadget(#PB_Any,x,y,w,h,txt, toggle)
  SetGadgetFont(b,FontID(font))
  If tip:GadgetToolTip(b,tip):EndIf
  ProcedureReturn b
EndProcedure
Procedure   textGad(x,y,w,h,txt.s,ti.l,pa.l,fnt=#font_lt, param=#PB_Text_Center|#SS_CENTERIMAGE, tip.s="")
  Protected   g= TextGadget(#PB_Any,x,y,w,h,txt,param)
  SetGadgetColor(g,#PB_Gadget_BackColor,pa)
  SetGadgetColor(g,#PB_Gadget_FrontColor,ti)
  SetGadgetFont(g,FontID(fnt))
  If tip:GadgetToolTip(g,tip):EndIf
  ProcedureReturn g
EndProcedure
Procedure   stringGad(x,y,w,h,txt.s,ti.l,pa.l,fnt=#font_lt, param=#PB_String_BorderLess, tip.s="")
  Protected   g= StringGadget(#PB_Any,x,y,w,h,txt,param)
  SetGadgetColor(g,#PB_Gadget_BackColor,pa)
  SetGadgetColor(g,#PB_Gadget_FrontColor,ti)
  SetGadgetFont(g,FontID(fnt))
  If tip:GadgetToolTip(g,tip):EndIf
  ProcedureReturn g
EndProcedure
Procedure   listGad(x,y,w,h,txt.s,ti.l,pa.l,fnt=#font_lt, tip.s="", param=#PB_ListIcon_GridLines|#PB_ListIcon_FullRowSelect)
  Protected   g= ListIconGadget(#PB_Any,x,y,w,h,txt,w-25,param)
  SetGadgetColor(g,#PB_Gadget_BackColor,pa)
  SetGadgetColor(g,#PB_Gadget_FrontColor,ti)
  SetGadgetFont(g,FontID(fnt))
  If tip:GadgetToolTip(g,tip):EndIf
  ProcedureReturn g
EndProcedure


winMain= OpenWindow(#PB_Any,0,0,500,500,"PB VirtualDisc",#PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_ScreenCentered)

T_unidad= textGad(0,0,100,25,"Drive",ti,pa,font,#PB_Text_Center|#SS_CENTERIMAGE)
CombLetr= ComboBoxGadget(#PB_Any,100,0,60,25) : SetGadgetFont(CombLetr,FontID(#font_lt))
For p= 69 To 90 : AddGadgetItem(CombLetr,p-69,Chr(p)+":") : Next p : SetGadgetState(CombLetr,0)
T_ruta=   textGad(160,0,100,25,"Path",ti,pa,font,#PB_Text_Center|#SS_CENTERIMAGE)
S_Ruta=   stringGad(260,0,180,25,"",ti,pa,#font_lt,#PB_String_ReadOnly,"Path of the folder to use as drive")
B_rutaDi= mkBoton(440,0,60,25,"Path",0,"Select folder path")
B_montDi= mkBoton(440,25,60,25,"Mount",0,"Mount selected folder")
B_desmDi= mkBoton(300,25,140,25,"Unmount",0,"Unmount selected drive")
L_virtDi= listGad(0,50,500,400,"Drive",ti,pa,#font_lt,"List of virtual drives mounted")
AddGadgetColumn(L_virtDi,1,"Folder",410)
SetGadgetItemAttribute(L_virtDi,0,#PB_ListIcon_ColumnWidth,60,0)
T_info=   textGad(0,450,500,50,"minimy 2025"+#CRLF$+"This drives only will be mounted in this sesion.",ti,pa,#font_lt,#PB_Text_Center)

txt.s=""
pos=-1
;{ 
Repeat
event= WindowEvent()

  Select event
    Case #PB_Event_Gadget
      EventGadget=  EventGadget()
      EventType=    EventType()
      Select EventGadget
        Case B_montDi
          If GetGadgetText(S_Ruta)
            resp= MessageRequester("Mount","¿Mount virtual drive "+GetGadgetText(CombLetr)+" with folder '"+GetGadgetText(s_ruta)+"' ?",#PB_MessageRequester_YesNo|#PB_MessageRequester_Warning)
            If resp= #PB_MessageRequester_Yes
              txt= GetGadgetText(CombLetr)+Chr(10)+GetGadgetText(S_Ruta)
              AddGadgetItem(L_virtDi,-1,Left(txt,Len(txt)-1))
              txt= "/c subst "+GetGadgetText(CombLetr)+" "+#DQUOTE$+Left(GetGadgetText(S_Ruta),Len(GetGadgetText(S_Ruta))-1)+#DQUOTE$
              RunProgram("cmd",txt,"",#PB_Program_Wait | #PB_Program_Hide)
            EndIf
          Else
            MessageRequester("Warning","Select a folder first.",#PB_MessageRequester_Error)
          EndIf
        Case B_desmDi
          If pos > -1
            resp= MessageRequester("Unmount","¿Unmount this virtual drive "+GetGadgetItemText(L_virtDi,pos,0)+" ?",#PB_MessageRequester_YesNo|#PB_MessageRequester_Warning)
            If resp= #PB_MessageRequester_Yes
              RemoveGadgetItem(L_virtDi,pos)
              SetGadgetText(B_desmDi,"Unmount")
              txt= "/c subst "+GetGadgetText(CombLetr)+" /D"
              RunProgram("cmd",txt,"",#PB_Program_Wait | #PB_Program_Hide)
              pos= -1
            EndIf
          Else
            MessageRequester("Warning","Select virtual drive from the list first.",#PB_MessageRequester_Error)
          EndIf
        Case L_virtDi
          pos= GetGadgetState(EventGadget)
          SetGadgetText(B_desmDi,"Unmount "+GetGadgetItemText(EventGadget,pos,0))
          
        Case B_rutaDi
          fold.s= PathRequester("Select folder","C:\",WindowID(winMain))
          If fold : SetGadgetText(S_ruta,fold) : EndIf
        Case 0
          
      EndSelect
      
    Case #PB_Event_CloseWindow
      Break 
  EndSelect
  Delay(1)
ForEver
;}




Re: PB virtual drive [Windows only]

Posted: Thu Feb 06, 2025 10:55 pm
by HeX0R
Please use WaitWindowEvent(), or it might burn one of your cores to death.

Re: PB virtual drive [Windows only]

Posted: Thu Feb 06, 2025 11:00 pm
by miso
Or a delay(1), but I also forget those in examples. Regardless, it's nice.