PBMiner

$PBExportHeader$w_getfolder.srw
forward
global type w_getfolder from window
end type
type lv_folders from listview within w_getfolder
end type
type tv_drives from treeview within w_getfolder
end type
type cb_ok from commandbutton within w_getfolder
end type
type st_folder from statictext within w_getfolder
end type
type st_1 from statictext within w_getfolder
end type
type cb_cancel from commandbutton within w_getfolder
end type
type filetime from structure within w_getfolder
end type
type win32_find_data from structure within w_getfolder
end type
type shfileinfo from structure within w_getfolder
end type
type share_info_1 from structure within w_getfolder
end type
end forward

type filetime from structure
   unsignedlong      dwlowdatetime
   unsignedlong      dwhighdatetime
end type

type win32_find_data from structure
   unsignedlong      dwfileattributes
   filetime    ftcreationtime
   filetime    ftlastaccesstime
   filetime    ftlastwritetime
   unsignedlong      nfilesizehigh
   unsignedlong      nfilesizelow
   unsignedlong      dwreserved0
   unsignedlong      dwreserved1
   character      cfilename[260]
   character      calternatefilename[14]
end type

type shfileinfo from structure
   long     hicon
   long     iicon
   long     dwattributes
   character      szdisplayname[260]
   character      sztypename[80]
end type

type share_info_1 from structure
   long     shi1_netname
   long     shi1_type
   long     shi1_remark
end type

shared variables
String ss_title

end variables

global type w_getfolder from window
integer width = 2976
integer height = 1652
boolean titlebar = true
string title = "Select Folder"
windowtype windowtype = response!
long backcolor = 67108864
string icon = "AppIcon!"
boolean center = true
lv_folders lv_folders
tv_drives tv_drives
cb_ok cb_ok
st_folder st_folder
st_1 st_1
cb_cancel cb_cancel
end type
global w_getfolder w_getfolder

type prototypes
Function long SHGetFolderPath ( &
   long hwnd, &
   ulong csidl, &
   long hToken, &
   ulong dwFlags, &
   Ref string pszPath &
   ) Library "shell32.dll" Alias For "SHGetFolderPathW"

Function ulong SHGetFileInfo ( &
   string pszPath, &
   long dwFileAttributes, &
   Ref SHFILEINFO psfi, &
   long cbFileInfo, &
   long uFlags &
   ) Library "shell32.dll" Alias For "SHGetFileInfoW"

Function ulong GetDriveType ( &
   string lpRootPathName &
   ) Library "kernel32.dll" Alias For "GetDriveTypeW"

Function long FindFirstFile ( &
   string lpFileName, &
   Ref win32_find_data lpFindFileData &
   ) Library "kernel32.dll" Alias For "FindFirstFileW"

Function boolean FindNextFile ( &
   long hFindFile, &
   Ref win32_find_data lpFindFileData &
   ) Library "kernel32.dll" Alias For "FindNextFileW"

Function boolean FindClose ( &
   long hFindFile &
   ) Library "kernel32.dll" Alias For "FindClose"

Function long NetShareEnum ( &
   string servername, &
   ulong level, &
   Ref long bufptr, &
   ulong prefmaxlen, &
   Ref ulong entriesread, &
   Ref ulong totalentries, &
   Ref ulong resume_handle &
   ) Library "netapi32.dll"

Function long NetApiBufferFree ( &
   ulong Buffer &
   ) Library "netapi32.dll"
   
Subroutine CopyMemory ( &
   Ref structure Destination, &
   long Source, &
   long Length &
   ) Library  "kernel32.dll" Alias For "RtlMoveMemory"

end prototypes

type variables
// Constants for GetDriveType
Constant ULong DRIVE_UNKNOWN     = 0
Constant ULong DRIVE_NO_ROOT_DIR = 1
Constant ULong DRIVE_REMOVABLE   = 2
Constant ULong DRIVE_FIXED       = 3
Constant ULong DRIVE_REMOTE      = 4
Constant ULong DRIVE_CDROM       = 5
Constant ULong DRIVE_RAMDISK     = 6

// Constants for SHGetFolderPath
Constant Long CSIDL_DESKTOP      = 0
Constant Long CSIDL_PERSONAL     = 5
Constant Long CSIDL_MYDOCUMENTS  = CSIDL_PERSONAL
Constant Long CSIDL_MYMUSIC      = 13
Constant Long CSIDL_MYVIDEO      = 14
Constant Long CSIDL_MYPICTURES   = 39

String is_servers[]

end variables

forward prototypes
public subroutine wf_populate_listview (string as_folder)
public function string wf_getfolderpath (long al_csidl)
public function boolean wf_checkbit (long al_number, unsignedinteger ai_bit)
public function integer wf_getfiles (string as_filespec, ref string as_name[])
public subroutine wf_settitle (string as_title)
public subroutine wf_addserver (string as_server)
public subroutine wf_getshares (long al_handle, string as_server)
public function integer wf_getdrives (ref string as_drive[], ref unsignedlong aul_type[], ref string as_typename[], ref string as_label[])
end prototypes

public subroutine wf_populate_listview (string as_folder);ListViewItem llvi_item
Integer li_idx, li_max
String ls_name[]

If Right(as_folder, 1) = ":" Then
   st_folder.text = as_folder + "\"
Else
   st_folder.text = as_folder
End If

lv_folders.DeleteItems()

// add up-arrow item
llvi_item.Data  = Left(as_folder, LastPos(as_folder, "\") - 1)
llvi_item.Label = "Parent"
llvi_item.PictureIndex = 2
lv_folders.AddItem(llvi_item)

li_max = wf_GetFiles(as_folder, ls_name)
For li_idx = 1 To li_max
   // add folder item
   llvi_item.Data  = as_folder + "\" + ls_name[li_idx]
   llvi_item.Label = ls_name[li_idx]
   llvi_item.PictureIndex = 1
   lv_folders.AddItem(llvi_item)
Next

end subroutine

public function string wf_getfolderpath (long al_csidl);// This function returns the path to a shell folder.

Constant Long SHGFP_TYPE_CURRENT = 0
String ls_path

ls_path = Space(260)

SHGetFolderPath(0, al_CSIDL, 0, SHGFP_TYPE_CURRENT, ls_path)

Return ls_path

end function

public function boolean wf_checkbit (long al_number, unsignedinteger ai_bit);// This function determines if a certain bit is on or off within the number.

If Int(Mod(al_number / (2 ^(ai_bit - 1)), 2)) > 0 Then
   Return True
End If

Return False

end function

public function integer wf_getfiles (string as_filespec, ref string as_name[]);// This function returns a list of folders.

win32_find_data lstr_fd
Boolean lb_Found, lb_Hidden, lb_System, lb_SubDir
Integer li_file
Long ll_handle
String ls_filename

// append filename pattern
If Right(as_filespec, 1) = "\" Then
   as_filespec += "*.*"
Else
   as_filespec += "\*.*"
End If

// find first file
ll_Handle = FindFirstFile(as_filespec, lstr_fd)
If ll_Handle < 1 Then Return -1

// loop through each file
Do
   // add file to array
   ls_filename = String(lstr_fd.cFilename)
   If ls_filename = "." Or ls_filename = ".." Then
   Else
      // check for hidden attrib
      lb_Hidden = wf_checkbit(lstr_fd.dwFileAttributes, 2)
      lb_System = wf_checkbit(lstr_fd.dwFileAttributes, 3)
      lb_SubDir = wf_checkbit(lstr_fd.dwFileAttributes, 5)
      If ( lb_hidden Or lb_system ) Then
      Else
         If lb_SubDir Then
            li_file++
            as_name[li_file] = ls_filename
         End If
      End If
   End If
   // find next file
   lb_Found = FindNextFile(ll_Handle, lstr_fd)
Loop Until Not lb_Found

// close find handle
FindClose(ll_Handle)

Return li_file

end function

public subroutine wf_settitle (string as_title);ss_title = as_title

end subroutine

public subroutine wf_addserver (string as_server);// add a server to the array

Long ll_idx, ll_max

ll_max = UpperBound(is_servers)
For ll_idx = 1 To ll_max
   If Lower(as_server) = Lower(is_servers[ll_idx]) Then
      Return
   End If
Next

is_servers[ll_max + 1] = as_server

end subroutine

public subroutine wf_getshares (long al_handle, string as_server);Constant ULong NERR_Success = 0
Constant ULong MAX_PREFERRED_LENGTH = 4294967295
Constant ULong STYPE_DISKTREE = 0
TreeViewItem ltvi_item
SHARE_INFO_1 lstr_info
Long ll_result, ll_handle, ll_StructSize
String ls_server, ls_netname
ULong lul_entriesread, lul_index
ULong lul_totalentries, lul_resume
Long ll_bufptr

SetPointer(HourGlass!)

ll_StructSize = 12

ls_server = "\\" + as_server

// get the network shares for the server
ll_result = NetShareEnum(ls_server, 1, ll_bufptr, MAX_PREFERRED_LENGTH, &
                     lul_entriesread, lul_totalentries, lul_resume)
If ll_result = NERR_Success Then
   For lul_index = 0 To lul_entriesread - 1
      // copy from memory to the structure
      CopyMemory(lstr_info, ll_bufptr + (ll_StructSize * lul_index), ll_StructSize)
      If lstr_info.shi1_type = STYPE_DISKTREE Then
         If lstr_info.shi1_netname > 0 Then
            ls_netname = String(lstr_info.shi1_netname, "address")
         End If
         choose case ls_netname
            case "print$"
               // skip
            case else
               // add to the treeview
               ltvi_item.Data = ls_server + "\" + ls_netname
               ltvi_item.Label = ls_netname
               ltvi_item.PictureIndex = 15
               ltvi_item.SelectedPictureIndex = 15
               ll_handle = tv_drives.InsertItemLast(al_handle, ltvi_item)
         end choose
      End If
   Next
Else
   tv_drives.GetItem(al_handle, ltvi_item)
   ltvi_item.Children = False
   tv_drives.SetItem(al_handle, ltvi_item)
End If

NetApiBufferFree(ll_bufptr)

end subroutine

public function integer wf_getdrives (ref string as_drive[], ref unsignedlong aul_type[], ref string as_typename[], ref string as_label[]);// This function returns a list of disk drives with their type   and volume label.

Constant ULong SHGFI_DISPLAYNAME = 512
Constant ULong SHGFI_TYPENAME    = 1024
SHFILEINFO lstr_sfi
Integer li_idx, li_next
ULong lul_type, lul_Attribs
String ls_drive, ls_path

For li_idx = 1 To 26
   ls_drive = Char(li_idx + 64) + ":"
   ls_path  = ls_drive + "\"
   lul_type = GetDriveType(ls_path)
   If lul_type = DRIVE_UNKNOWN Or &
      lul_type = DRIVE_NO_ROOT_DIR Then
   Else
      // add drive to output arrays
      li_next = UpperBound(as_drive) + 1
      as_drive[li_next] = Left(ls_drive, 1)
      aul_type[li_next] = lul_type
      // get explorer display name
      SHGetFileInfo(ls_path, lul_Attribs, lstr_sfi, 352, SHGFI_DISPLAYNAME)
      as_label[li_next] = String(lstr_sfi.szDisplayName)
      // get explorer type name
      SHGetFileInfo(ls_path, lul_Attribs, lstr_sfi, 352, SHGFI_TYPENAME)
      as_typename[li_next] = String(lstr_sfi.szTypeName)
   End If
Next

Return li_next

end function

on w_getfolder.create
this.lv_folders=create lv_folders
this.tv_drives=create tv_drives
this.cb_ok=create cb_ok
this.st_folder=create st_folder
this.st_1=create st_1
this.cb_cancel=create cb_cancel
this.Control[]={this.lv_folders,&
this.tv_drives,&
this.cb_ok,&
this.st_folder,&
this.st_1,&
this.cb_cancel}
end on

on w_getfolder.destroy
destroy(this.lv_folders)
destroy(this.tv_drives)
destroy(this.cb_ok)
destroy(this.st_folder)
destroy(this.st_1)
destroy(this.cb_cancel)
end on

event open;Constant UInt TVM_SETITEMHEIGHT = 4379
TreeViewItem ltvi_item
Long ll_desktop, ll_thispc, ll_handle, ll_network
Long ll_idx, ll_max, ll_len, ll_pos, ll_server
String ls_default, ls_regkey, ls_value
String ls_drive[], ls_typename[], ls_label[]
String ls_server, ls_values[]
ULong lul_type[]

If ss_title = "" Then
   this.Title = "Browse for Folder"
Else
   this.Title = ss_title
End If

// get the passed default
ls_default = Message.StringParm
If ls_default = "" Then
   ls_default = "C:"
Else
   Message.StringParm = ""
   If Not DirectoryExists(ls_default) Then
      ls_default = "C:"
   End If
End If

// change the image height for spacing
Send(Handle(tv_drives), TVM_SETITEMHEIGHT, 24, 0)

// Insert: Desktop
ltvi_item.Expanded = True
ltvi_item.Data = wf_GetFolderPath(CSIDL_DESKTOP)
ltvi_item.Label = "Desktop"
ltvi_item.PictureIndex = 2
ltvi_item.SelectedPictureIndex = 2
ll_desktop = tv_drives.InsertItemLast(0, ltvi_item)
ltvi_item.Expanded = True

// Insert: This PC
ltvi_item.Expanded = True
ltvi_item.Data = ""
ltvi_item.Label = "This PC"
ltvi_item.PictureIndex = 1
ltvi_item.SelectedPictureIndex = 1
ll_thispc = tv_drives.InsertItemLast(ll_desktop, ltvi_item)
ltvi_item.Expanded = False

// Insert: Network
ltvi_item.Expanded = False
ltvi_item.Data = ""
ltvi_item.Label = "Network"
ltvi_item.PictureIndex = 14
ltvi_item.SelectedPictureIndex = 14
ll_network = tv_drives.InsertItemLast(ll_desktop, ltvi_item)

// Insert: Desktop
ltvi_item.Data = wf_GetFolderPath(CSIDL_DESKTOP)
ltvi_item.Label = "Desktop"
ltvi_item.PictureIndex = 2
ltvi_item.SelectedPictureIndex = 2
ll_handle = tv_drives.InsertItemLast(ll_thispc, ltvi_item)

// Insert: Documents
ltvi_item.Data = wf_GetFolderPath(CSIDL_MYDOCUMENTS)
ltvi_item.Label = "Documents"
ltvi_item.PictureIndex = 3
ltvi_item.SelectedPictureIndex = 3
ll_handle = tv_drives.InsertItemLast(ll_thispc, ltvi_item)

// Insert: Downloads
ls_regkey = "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders"
RegistryGet(ls_regkey, "{374DE290-123F-4565-9164-39C4925E467B}", RegString!, ls_value)
If ls_value <> "" Then
   ltvi_item.Data = ls_value
   ltvi_item.Label = "Downloads"
   ltvi_item.PictureIndex = 4
   ltvi_item.SelectedPictureIndex = 4
   ll_handle = tv_drives.InsertItemLast(ll_thispc, ltvi_item)
End If

// Insert: Music
ltvi_item.Data = wf_GetFolderPath(CSIDL_MYMUSIC)
ltvi_item.Label = "Music"
ltvi_item.PictureIndex = 5
ltvi_item.SelectedPictureIndex = 5
ll_handle = tv_drives.InsertItemLast(ll_thispc, ltvi_item)

// Insert: Pictures
ltvi_item.Data = wf_GetFolderPath(CSIDL_MYPICTURES)
ltvi_item.Label = "Pictures"
ltvi_item.PictureIndex = 6
ltvi_item.SelectedPictureIndex = 6
ll_handle = tv_drives.InsertItemLast(ll_thispc, ltvi_item)

// Insert: Videos
ltvi_item.Data = wf_GetFolderPath(CSIDL_MYVIDEO)
ltvi_item.Label = "Videos"
ltvi_item.PictureIndex = 7
ltvi_item.SelectedPictureIndex = 7
ll_handle = tv_drives.InsertItemLast(ll_thispc, ltvi_item)

// add drives
ll_max = wf_GetDrives(ls_drive, lul_type, ls_typename, ls_label)
For ll_idx = 1 To ll_max
   ltvi_item.Data = ls_drive[ll_idx] + ":"
   ltvi_item.Label = ls_label[ll_idx]
   If ls_drive[ll_idx] = "C" Then
      ltvi_item.PictureIndex = 8
      ltvi_item.SelectedPictureIndex = 8
   Else
      choose case lul_type[ll_idx]
         case 2      // Removable Drive
            If Pos(Lower(ls_typename[ll_idx]), "floppy") > 0 Then
               ltvi_item.PictureIndex = 9
               ltvi_item.SelectedPictureIndex = 9
            Else
               ltvi_item.PictureIndex = 10
               ltvi_item.SelectedPictureIndex = 10
            End If
         case 4      // Network Drive
            ltvi_item.PictureIndex = 11
            ltvi_item.SelectedPictureIndex = 11
            // add server name to instance array
            ls_server = Mid(ls_label[ll_idx], Pos(ls_label[ll_idx], "\\"))
            ll_pos = Pos(ls_server, "\", 3)
            If ll_pos = 0 Then
               ll_pos = Pos(ls_server, ")", 3)
            End If
            ls_server = Mid(ls_server, 3, ll_pos - 3)
            wf_AddServer(ls_server)
         case 5      // CD-ROM Drive
            ltvi_item.PictureIndex = 12
            ltvi_item.SelectedPictureIndex = 12
         case 6      // RAM Disk
            ltvi_item.PictureIndex = 13
            ltvi_item.SelectedPictureIndex = 13
         case else   // Hard Drive
            ltvi_item.PictureIndex = 10
            ltvi_item.SelectedPictureIndex = 10
      end choose
   End If
   ll_handle = tv_drives.InsertItemLast(ll_thispc, ltvi_item)
Next

// get recent servers
ls_regkey = "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\TypedPaths"
RegistryValues(ls_regkey, ls_values)
ll_max = UpperBound(ls_values)
For ll_idx = 1 To ll_max
   RegistryGet(ls_regkey, ls_values[ll_idx], RegString!, ls_server)
   If Left(ls_server, 2) = "\\" Then
      // add server name to instance array
      ls_server = Mid(ls_server, Pos(ls_server, "\\")) + "\"
      ls_server = Mid(ls_server, 3, Pos(ls_server, "\", 3) - 3)
      wf_AddServer(ls_server)
   End If
Next

// add recent servers to network node
ll_max = UpperBound(is_servers)
If ll_max > 0 Then
   For ll_idx = 1 To ll_max
      ltvi_item.Children = True
      ltvi_item.Data = ""
      ltvi_item.Label = is_servers[ll_idx]
      ltvi_item.PictureIndex = 1
      ltvi_item.SelectedPictureIndex = 1
      ll_server = tv_drives.InsertItemLast(ll_network, ltvi_item)
   Next
End If

// populate listview on the right
wf_populate_listview(ls_default)

end event

type lv_folders from listview within w_getfolder
integer x = 1495
integer y = 192
integer width = 1399
integer height = 1156
integer taborder = 10
integer textsize = -9
integer weight = 400
fontcharset fontcharset = ansi!
fontpitch fontpitch = variable!
fontfamily fontfamily = swiss!
string facename = "Segoe UI"
long textcolor = 33554432
borderstyle borderstyle = stylelowered!
listviewview view = listviewreport!
long largepicturemaskcolor = 536870912
string smallpicturename[] = {"folder.ico","uparrow.ico"}
long smallpicturemaskcolor = 536870912
long statepicturemaskcolor = 536870912
end type

event constructor;this.AddColumn("Name", Left!, 1300)

end event

event doubleclicked;ListViewItem llvi_item
String ls_folder

If index > 0 Then
   this.GetItem(index, llvi_item)
   ls_folder = llvi_item.Data
   If ls_folder = "" Then
   Else
      wf_populate_listview(ls_folder)
   End If
End If

end event

type tv_drives from treeview within w_getfolder
integer x = 73
integer y = 192
integer width = 1399
integer height = 1156
integer taborder = 40
integer textsize = -9
integer weight = 400
fontcharset fontcharset = ansi!
fontpitch fontpitch = variable!
fontfamily fontfamily = swiss!
string facename = "Segoe UI"
long textcolor = 33554432
borderstyle borderstyle = stylelowered!
boolean trackselect = true
string picturename[] = {"thispc.ico","desktop.ico","documents.ico","downloads.ico","music.ico","pictures.ico","videos.ico","windrive.ico","floppy.ico","harddrive.ico","netdrive.ico","cdrom.ico","ramdisk.ico","network.ico","netfolder.ico"}
long picturemaskcolor = 536870912
long statepicturemaskcolor = 536870912
end type

event clicked;this.Event SelectionChanged(handle, handle)

end event

event selectionchanged;TreeViewItem ltvi_item

If newhandle > 0 Then
   tv_drives.GetItem(newhandle, ltvi_item)
   If ltvi_item.Data = "" Then
      st_folder.text = ""
      lv_folders.DeleteItems()
   Else
      wf_populate_listview(ltvi_item.Data)
   End If
End If

end event

event itempopulate;TreeViewItem ltvi_item

this.GetItem(handle, ltvi_item)

If ltvi_item.Level = 3 Then
   wf_GetShares(handle, ltvi_item.Label)
End If

end event

type cb_ok from commandbutton within w_getfolder
integer x = 2158
integer y = 1408
integer width = 334
integer height = 100
integer taborder = 20
integer textsize = -8
integer weight = 400
fontcharset fontcharset = ansi!
fontpitch fontpitch = variable!
fontfamily fontfamily = swiss!
string facename = "Segoe UI"
string text = "OK"
end type

event clicked;CloseWithReturn(Parent, st_folder.text)

end event

type st_folder from statictext within w_getfolder
integer x = 261
integer y = 64
integer width = 2633
integer height = 108
integer textsize = -8
integer weight = 400
fontcharset fontcharset = ansi!
fontpitch fontpitch = variable!
fontfamily fontfamily = swiss!
string facename = "Segoe UI"
long textcolor = 33554432
long backcolor = 67108864
boolean focusrectangle = false
end type

type st_1 from statictext within w_getfolder
integer x = 73
integer y = 64
integer width = 187
integer height = 68
integer textsize = -8
integer weight = 400
fontcharset fontcharset = ansi!
fontpitch fontpitch = variable!
fontfamily fontfamily = swiss!
string facename = "Segoe UI"
long textcolor = 33554432
long backcolor = 67108864
string text = "Folder:"
boolean focusrectangle = false
end type

type cb_cancel from commandbutton within w_getfolder
integer x = 2560
integer y = 1408
integer width = 334
integer height = 100
integer taborder = 30
integer textsize = -8
integer weight = 400
fontcharset fontcharset = ansi!
fontpitch fontpitch = variable!
fontfamily fontfamily = swiss!
string facename = "Segoe UI"
string text = "Cancel"
boolean cancel = true
end type

event clicked;CloseWithReturn(Parent, "")

end event