Stupid drag and drop file copier

Fangbeast · Post by **Fangbeast** » Tue Sep 29, 2009 6:32 am

My daughter's firewall keeps going tits up and she can't fix it (or wants me to) and she keeps wanting to give me art she designs so I made this STupid File copIer (STUFI) so she can drag and drop files to me willy nilly.

It won't copy subdirectories (don't care), will create subdirectory info of the dragged file/files on the target, reads directory from INI file, creates default one if not found, can toggle snap to borders (and other things). Do what you want with it, get your own graphics ya lazy sods!

PB4.30.

Code: Select all

; Visual designer created constants

Enumeration 1
  #Window_dragga
  #Window_directory
EndEnumeration

#WindowIndex = #PB_Compiler_EnumerationValue

Enumeration 1
  ; Window_dragga
  #Gadget_dragga_filelist

  ; Window_directory
  #Gadget_directory_fmain
  #Gadget_directory_lselect
  #Gadget_directory_directory
  #Gadget_directory_select
  #Gadget_directory_save
EndEnumeration

#GadgetIndex = #PB_Compiler_EnumerationValue

Enumeration 1
  #StatusBar_dragga
EndEnumeration

#StatusBarIndex = #PB_Compiler_EnumerationValue

#StatusBar_dragga_Mico      = 0   ; Messages icon field
#StatusBar_dragga_Messages  = 1   ; Messages field
#StatusBar_dragga_Rico      = 2   ; Records icon field
#StatusBar_dragga_Records   = 3   ; Records field

Enumeration 1
  #Image_directory_select
  #Image_directory_save
EndEnumeration

#ImageIndex = #PB_Compiler_EnumerationValue


; Visual designer created image load statements

CatchImage(#Image_directory_select, ?_OPT_directory_select)
CatchImage(#Image_directory_save,   ?_OPT_directory_save)

; Visual designer created image include statements

DataSection
  _OPT_directory_select : IncludeBinary "Images\directory32x32.ico"
  _OPT_directory_save   : IncludeBinary "Images\save32x32.ico"
EndDataSection

; Visual designer created window code

Procedure.l Window_dragga()
  If OpenWindow(#Window_dragga, 80, 80, 700, 285, "Drag files to path", #PB_Window_SystemMenu|#PB_Window_MinimizeGadget|#PB_Window_ScreenCentered|#PB_Window_Invisible)
      ListIconGadget(#Gadget_dragga_filelist, 0, 0, 700, 265, "Filename", 100, #PB_ListIcon_FullRowSelect|#PB_ListIcon_AlwaysShowSelection)
        SendMessage_(GadgetID(#Gadget_dragga_filelist), #LVM_SETBKCOLOR, 0, 15395562)
        SendMessage_(GadgetID(#Gadget_dragga_filelist), #LVM_SETTEXTBKCOLOR, 0, 15395562)
        AddGadgetColumn(#Gadget_dragga_filelist, 1, "Status", 28)
        AddGadgetColumn(#Gadget_dragga_filelist, 2, "Message", 568)
      CreateStatusBar(#StatusBar_dragga, WindowID(#Window_dragga))
        AddStatusBarField(28)
        AddStatusBarField(542)
        AddStatusBarField(28)
        AddStatusBarField(102)
      HideWindow(#Window_dragga, 0)
      ProcedureReturn WindowID(#Window_dragga)
  EndIf
EndProcedure

Procedure.l Window_directory()
  If OpenWindow(#Window_directory, 80, 80, 700, 55, "Set 'Copy To' directory", #PB_Window_SystemMenu|#PB_Window_MinimizeGadget|#PB_Window_ScreenCentered|#PB_Window_Invisible, WindowID(#Window_dragga))
      Frame3DGadget(#Gadget_directory_fmain, 0, 0, 700, 55, "")
      TextGadget(#Gadget_directory_lselect, 10, 10, 600, 20, " Select a new directory to copy files to by clicking on the folder button,  then click on the save button.")
        SetGadgetFont(#Gadget_directory_lselect, LoadFont(#Gadget_directory_lselect, "Arial", 10, 0))
      StringGadget(#Gadget_directory_directory, 10, 30, 600, 20, "", #PB_String_ReadOnly)
      ButtonImageGadget(#Gadget_directory_select, 615, 10, 40, 40, ImageID(#Image_directory_select))
      ButtonImageGadget(#Gadget_directory_save, 655, 10, 40, 40, ImageID(#Image_directory_save))
      HideWindow(#Window_directory, 0)
      ProcedureReturn WindowID(#Window_directory)
  EndIf
EndProcedure

; Generic and custom declarations

Declare   CopyFilesToPath()                                                         ; Copy files to selected path
Declare   ChangeIcon(mygadget, myrow, mycolumn, myicon)                             ; Update each collumn of a ListIconGadget with a user defined icon as needed
Declare   CloseMyWindow(Window, Speed)                                              ; Fade the window out gently, close it and reset the mutex  
Declare   FileStatus(StatusFlag.i, FileName.s, Message.s)                           ; Set copied file status
Declare.s GetIniVal(IniSection.s, IniKey.s)                                         ; API procedure to replace Mr Skunk's INI file reading routine
Declare   LastLine(Gadget, LineNumber)                                              ; Go to the last line of a ListIconGadget
Declare   LoadListIconImage(ListIconGadget)                                         ; Load a background image into a ListIconGadget
Declare   MyBalloonToolTips(btWindow.i, btGadget.i, btText.s)                       ; Personal balloon tooltip window, colourful and not boring at all
Declare   ProcessFileName(Filename.s)                                               ; Generic file copy routine for single or multiple dropped files
Declare   RunSetup()                                                                ; Open the program setup window
Declare   SaveSetup()                                                               ; Save the current program preferences
Declare   SelectPath()                                                              ; Select the new directory to save files to
Declare   ScreenSnapToggle()                                                        ; Turn border snap on and off as needed
Declare.i SetIniVal(IniSection.s, IniKey.s, IniValue.s)                             ; API procedure to replace Mr Skunk's INI file writing routine
Declare   SetStat(Flag, Message.s)                                                  ; Handle statusbar messages with less typing.
Declare   WindowCallback(WindowID, Message, wParam, lParam)                         ; Colours, resizing and more

; Work with system ini files

Declare   CreatePreferencesFile()                                                   ; Create a brand new INI file in the program directory if the default one is missing, with default values.
Declare   ReadPreferencesFile()                                                     ; Read the system preferences file or create it if missing
Declare   SavePreferencesFile()                                                     ; Save all preferences at program end

; I'm using this for the background images in the ListIconGadgets

UseJPEGImageDecoder()

; Add icons to rows other than the first one in ListIconGadget, we need these constants

#LVM_SETEXTENDEDLISTVIEWSTYLE   = $1036 
#LVS_EX_SUBITEMIMAGES           = $2 
#LVM_GETHEADER                  = #LVM_FIRST + 31

; Constants for statusbar handling and colouring

#SB_SETBKCOLOR                  = $2001

; Structure for background images for ListIconGadgets

Structure LVBKIMAGE
  ulFlags.i
  hbm.i
  pszImage.i
  cchImageMax.i
  xOffsetPercent.i
  yOffsetPercent.i
EndStructure

; Program flags and variables

Structure ProgramData
  QuitFlag.i
  TrayState.i
  ScreenSnap.i
  MutexVal.i
  NetPath.s
  NumFiles.i
  ;------------------------------------
  ; All main form icon options
  ;------------------------------------
  Hdragga.i
  Done.i
  Go.i
  Pause.i
  Skip.i
  Stop.i
  ;------------------------------------
  CurrentDir.s
  IniFile.s
EndStructure

; Make the structure global

Global Program.ProgramData

; Name and path to the program ini file

Program\IniFile = Program\CurrentDir  + "Dragga.Ini"

; Read the system preferences file or create it if missing

ReadPreferencesFile()

; Check the copy to path and create a standard one if missing from the ini file

If Program\NetPath = ""
  MakeSureDirectoryPathExists_("C:\Dragga (Dropped Files Store)\")
  Program\NetPath = "C:\Dragga (Dropped Files Store)\"
EndIf

; NetMaestro's screen snap code

Global screenW, screenH, SnapD = 50, AutoSnap = #True

SystemParametersInfo_(#SPI_GETWORKAREA, 0, @wa.RECT, 0)                                 ; Client area of the desktop

ScreenW = wa\right

screenH = wa\bottom

; Set initial tray hiding state so we avoing loops (Not used yet)

Program\TrayState     = #False

; My personal constants added after the visual designer

Enumeration #GadgetIndex
  #Dragga_setup
  #Dragga_snap
  #Dragga_exit
  #PopMenu_dragga
  #PopMenu_dragga_setup
  #PopMenu_dragga_snap
  #PopMenu_dragga_exit
EndEnumeration

; All my image constants

Enumeration #ImageIndex
  #Image_dragga_messages       ; Statusbar message field
  #Image_dragga_records        ; Statusbar records field
  ;--------------------------------
  #Image_dragga_done           ; 
  #Image_dragga_go             ; 
  #Image_dragga_pause          ; 
  #Image_dragga_skip           ; 
  #Image_dragga_stop           ; 
  ;--------------------------------
  #Image_dragga_watermark
EndEnumeration

; Catch images from memory

CatchImage(#Image_dragga_messages,     ?_PTK_dragga_messages)
CatchImage(#Image_dragga_records,      ?_PTK_dragga_records)

CatchImage(#Image_dragga_done,         ?_PTK_dragga_done)
CatchImage(#Image_dragga_go,           ?_PTK_dragga_go)
CatchImage(#Image_dragga_pause,        ?_PTK_dragga_pause)
CatchImage(#Image_dragga_skip,         ?_PTK_dragga_skip)
CatchImage(#Image_dragga_stop,         ?_PTK_dragga_stop)

CatchImage(#Image_dragga_watermark,    ?_PTK_dragga_watermark)

; Include images in the exe file

DataSection
  _PTK_dragga_messages    : IncludeBinary "Images\Messages16x16.ico"
  _PTK_dragga_records     : IncludeBinary "Images\Records16x16.ico"
  _PTK_dragga_done        : IncludeBinary "Images\Done16x16.ico"
  _PTK_dragga_go          : IncludeBinary "Images\Go16x16.ico"
  _PTK_dragga_pause       : IncludeBinary "Images\Pause16x16.ico"
  _PTK_dragga_skip        : IncludeBinary "Images\Skip16x16.ico"
  _PTK_dragga_stop        : IncludeBinary "Images\Stop16x16.ico"
  _PTK_dragga_watermark   : IncludeBinary "Images\UnghaBungha.jpg"
EndDataSection

; Update each column of a ListIconGadget with a user defined icon as needed

Procedure ChangeIcon(mygadget, myrow, mycolumn, myicon)
  ;----------------------------------------------------------------------------
  ;
  ;----------------------------------------------------------------------------
  LVG.lv_item      
  LVG\mask     = #LVIF_IMAGE | #LVIF_TEXT 
  LVG\iItem    = myrow 
  LVG\iSubItem = mycolumn
  ChangeText.s = GetGadgetItemText(mygadget, myrow, mycolumn)
  LVG\pszText  = @ChangeText.s
  LVG\iImage   = myicon  
  ;----------------------------------------------------------------------------
  ;
  ;----------------------------------------------------------------------------
  SendMessage_(GadgetID(mygadget), #LVM_SETITEM, 0, @LVG) 
  ;----------------------------------------------------------------------------
  ;
  ;----------------------------------------------------------------------------
EndProcedure

; Fade the window out gently, close it and reset the mutex

Procedure CloseMyWindow(Window, Speed)
  ;----------------------------------------------------------------------------
  ; Make sure other windows can open now  
  ;----------------------------------------------------------------------------
  Program\MutexVal  = 0
  ;----------------------------------------------------------------------------
  ; Close the program window
  ;----------------------------------------------------------------------------
  CloseWindow(Window)
  ;----------------------------------------------------------------------------
  ;
  ;----------------------------------------------------------------------------
EndProcedure

; Copy files to selected path

Procedure CopyFilesToPath()
  ;----------------------------------------------------------------------------
  ; Check if there is more than one file and adjust the output name
  ;----------------------------------------------------------------------------
  If FileSize(Program\NetPath) <> -2
    ;--------------------------------------------------------------------------
    ; Let the user know that the drive is offline and abort the copy
    ;--------------------------------------------------------------------------
    MessageRequester("File copy error", "Drive is missing or turned off, cannot copy files at the moment, try again later.", 0)
    ;--------------------------------------------------------------------------
    ; Also report the error in te status bar area
    ;--------------------------------------------------------------------------
    SetStat(2, "Drive is missing or turned off, cannot copy")
    ;--------------------------------------------------------------------------
    ; Copying can go ahead as the drive seems to be online
    ;--------------------------------------------------------------------------
  Else
    ;--------------------------------------------------------------------------
    ; Check if there is more than one file and adjust the output name
    ;--------------------------------------------------------------------------
    If FindString(EventDropFiles(), Chr(10), 1)
      ;------------------------------------------------------------------------
      ; Get the current list of filenames, if more than one
      ;------------------------------------------------------------------------
      FileName.s = EventDropFiles()
      ;------------------------------------------------------------------------
      ; Check how many files are actually in the list via the delimiter
      ;------------------------------------------------------------------------
      NumFiles.i = CountString(FileName.s, Chr(10))
      ;------------------------------------------------------------------------
      ; Loop through all the returned files
      ;------------------------------------------------------------------------
      For FileStart = 1 To NumFiles
        ;----------------------------------------------------------------------
        ; Get the current filename to process
        ;----------------------------------------------------------------------
        CurrentFilename.s = StringField(FileName.s, FileStart, Chr(10))
        ;----------------------------------------------------------------------
        ; Pass the current filename to the generic copier
        ;----------------------------------------------------------------------
        ProcessFileName(CurrentFilename.s)
        ;----------------------------------------------------------------------
        ; Process the next filename in the list
        ;----------------------------------------------------------------------
      Next FileStart
      ;------------------------------------------------------------------------
      ; 
      ;------------------------------------------------------------------------
    Else
      ;------------------------------------------------------------------------
      ; Grab the single file passed in the dropped list of files
      ;------------------------------------------------------------------------
      FileName.s = EventDropFiles()
      ;------------------------------------------------------------------------
      ; Pass the current filename to the generic copier
      ;------------------------------------------------------------------------
      ProcessFileName(FileName.s)
      ;------------------------------------------------------------------------
      ; No more conditions to evaluate
      ;------------------------------------------------------------------------
    EndIf
    ;--------------------------------------------------------------------------
    ; No more conditions to evaluate
    ;--------------------------------------------------------------------------
  EndIf
  ;----------------------------------------------------------------------------
  ; 
  ;----------------------------------------------------------------------------
EndProcedure

; Set copied file status

Procedure FileStatus(StatusFlag.i, FileName.s, Message.s)
  ;----------------------------------------------------------------------------
  ; The file was copied successfully
  ;----------------------------------------------------------------------------
  If StatusFlag.i = 1
    ;--------------------------------------------------------------------------
    ; 
    ;--------------------------------------------------------------------------
    AddGadgetItem(#Gadget_dragga_filelist, -1, FileName.s + Chr(10) + "" + Chr(10) + Message.s, Program\Done)
    ;--------------------------------------------------------------------------
    ; 
    ;--------------------------------------------------------------------------
    ChangeIcon(#Gadget_dragga_filelist, Program\NumFiles, 1, Program\Go)
    ;--------------------------------------------------------------------------
    ; The file was not copied successfully
    ;--------------------------------------------------------------------------
  ElseIf StatusFlag.i = 2
    ;--------------------------------------------------------------------------
    ; 
    ;--------------------------------------------------------------------------
    AddGadgetItem(#Gadget_dragga_filelist, -1, FileName.s + Chr(10) + "" + Chr(10) + Message.s, Program\Done)
    ;--------------------------------------------------------------------------
    ; 
    ;--------------------------------------------------------------------------
    ChangeIcon(#Gadget_dragga_filelist, Program\NumFiles, 1, Program\Stop)
    ;--------------------------------------------------------------------------
    ; The file was skipped entirely
    ;--------------------------------------------------------------------------
  ElseIf StatusFlag.i = 3
    ;--------------------------------------------------------------------------
    ; 
    ;--------------------------------------------------------------------------
    AddGadgetItem(#Gadget_dragga_filelist, -1, FileName.s + Chr(10) + "" + Chr(10) + Message.s, Program\Done)
    ;--------------------------------------------------------------------------
    ; 
    ;--------------------------------------------------------------------------
    ChangeIcon(#Gadget_dragga_filelist, Program\NumFiles, 1, Program\Skip)
    ;--------------------------------------------------------------------------
    ; No more conditions to evaluate
    ;--------------------------------------------------------------------------
  EndIf
  ;----------------------------------------------------------------------------
  ; Increment the files copied counter
  ;----------------------------------------------------------------------------
  Program\NumFiles + 1
  ;----------------------------------------------------------------------------
  ; Go to the last line of a ListIconGadget
  ;----------------------------------------------------------------------------
  LastLine(#Gadget_dragga_filelist, Program\NumFiles - 1)
  ;----------------------------------------------------------------------------
  ; 
  ;----------------------------------------------------------------------------
  SetStat(3, Str(Program\NumFiles))
  ;----------------------------------------------------------------------------
  ; 
  ;----------------------------------------------------------------------------
EndProcedure

; API procedure to replace Mr Skunk's INI file reading routine

Procedure.s GetIniVal(IniSection.s, IniKey.s)
  ;----------------------------------------------------------------------------
  ; Open the Ini file for reading
  ;----------------------------------------------------------------------------
  OpenPreferences(Program\IniFile)
  ;----------------------------------------------------------------------------
  ; Go to the right group
  ;----------------------------------------------------------------------------
  PreferenceGroup(IniSection)
  ;----------------------------------------------------------------------------
  ; Read a value from the ini file
  ;----------------------------------------------------------------------------
  IniData.s = ReadPreferenceString(IniKey, "")
  ;----------------------------------------------------------------------------
  ; Close the INI file, finished
  ;----------------------------------------------------------------------------
  ClosePreferences()
  ;----------------------------------------------------------------------------
  ; Return the data to the calling line
  ;----------------------------------------------------------------------------
  ProcedureReturn IniData.s
  ;----------------------------------------------------------------------------
  ; 
  ;----------------------------------------------------------------------------
EndProcedure

; Go to the last line of a ListIconGadget

Procedure LastLine(Gadget, LineNumber)
  ;----------------------------------------------------------------------------
  ; Make sure the current line is visible
  ;----------------------------------------------------------------------------
  SendMessage_(GadgetID(Gadget), #LVM_ENSUREVISIBLE, LineNumber, 0)
  ;----------------------------------------------------------------------------
  ; 
  ;----------------------------------------------------------------------------
EndProcedure

; Load a background image into a ListIconGadget

Procedure LoadListIconImage(ListIconGadget)
  ;----------------------------------------------------------------------------
  ; 
  ;----------------------------------------------------------------------------
  #LVBKIF_SOURCE_NONE             = 0
  #LVBKIF_SOURCE_HBITMAP          = 1
  #LVBKIF_SOURCE_URL              = 2
  #LVBKIF_SOURCE_MASK             = 3
  #LVBKIF_STYLE_NORMAL            = 0
  #LVBKIF_STYLE_TILE              = $10
  #LVBKIF_STYLE_MASK              = $10
  ;----------------------------------------------------------------------------
  ; 
  ;----------------------------------------------------------------------------
  #LVM_SETBKIMAGE                 = #LVM_FIRST + 68
  #LVM_SETBKIMAGEW                = #LVM_FIRST + 138
  #LVM_GETBKIMAGE                 = #LVM_FIRST + 69
  #LVM_GETBKIMAGEW                = #LVM_FIRST + 139
  ;----------------------------------------------------------------------------
  ; 
  ;----------------------------------------------------------------------------
  #LVBKIF_FLAG_TILEOFFSET         = 256
  #LVBKIF_TYPE_WATERMARK          = $10000000
  #LVS_EX_DOUBLEBUFFER            = $10000
  ;----------------------------------------------------------------------------
  ; 
  ;----------------------------------------------------------------------------
  CoInitialize_(0)
  ;----------------------------------------------------------------------------
  ; 
  ;----------------------------------------------------------------------------
  SendMessage_(ListIconGadget, #LVM_SETTEXTCOLOR, 0, $FF0000)
  SendMessage_(ListIconGadget, #LVM_SETBKCOLOR, 0, #CLR_NONE)
  SendMessage_(ListIconGadget, #LVM_SETTEXTBKCOLOR, 0, #CLR_NONE)
  ;----------------------------------------------------------------------------
  ; 
  ;----------------------------------------------------------------------------
;   Buffer = AllocateMemory(512)
;   GetModuleFileName_(GetModuleHandle_(0), Buffer, 512)
;   InitialDir$ = GetPathPart(PeekS(Buffer))
;   FreeMemory(Buffer)
;   File$ = "D:\Andrea Andrade's Wallpapers Collection 03.jpg"
;   If File$
    lbk.LVBKIMAGE
    ; lbk\ulFlags = #LVBKIF_STYLE_NORMAL | #LVBKIF_SOURCE_URL ; | #LVBKIF_STYLE_TILE      ; If this is a file
    lbk\ulFlags = #LVBKIF_STYLE_NORMAL | #LVBKIF_SOURCE_HBITMAP  | #LVBKIF_STYLE_TILE     ; if this image is in a datasection
    ; lbk\pszImage = @File$                                                               ; If this is a file
    lbk\hbm = ImageID(#Image_dragga_watermark)
    ;      lbk\xOffsetPercent;
    ;      lbk\yOffsetPercent;
    SendMessage_(ListIconGadget, #LVM_SETBKIMAGE, 0, lbk)
;   EndIf
  ;----------------------------------------------------------------------------
  ; 
  ;----------------------------------------------------------------------------
EndProcedure

; Personal balloon tooltip window, colourful and not boring at all

Procedure MyBalloonToolTips(btWindow.i, btGadget.i, btText.s)
  ;----------------------------------------------------------------------------
  ; 
  ;----------------------------------------------------------------------------
  ToolTipControl = CreateWindowEx_(0, "ToolTips_Class32", "", #WS_POPUP | #TTS_NOPREFIX | #TTS_BALLOON, 0, 0, 0, 0, WindowID(btWindow), 0, GetModuleHandle_(0), 0)
  ;----------------------------------------------------------------------------
  ; 
  ;----------------------------------------------------------------------------
  SetWindowPos_(ToolTipControl, #HWND_TOPMOST, 0, 0, 0, 0, #SWP_NOMOVE | #SWP_NOSIZE)
  SendMessage_(ToolTipControl,  #TTM_SETTIPTEXTCOLOR, 0, 0)
  SendMessage_(ToolTipControl,  #TTM_SETTIPBKCOLOR, $3175CE, 0)
  SendMessage_(ToolTipControl,  #TTM_SETMAXTIPWIDTH, 0, 290)
  ;----------------------------------------------------------------------------
  ; 
  ;----------------------------------------------------------------------------
  Button.TOOLINFO\cbSize  = SizeOf(TOOLINFO)
  Button\uFlags           = #TTF_IDISHWND | #TTF_SUBCLASS
  Button\hwnd             = WindowID(btWindow)
  Button\uID              = GadgetID(btGadget)
  Button\hInst            = 0
  Button\lpszText         = @btText
  ;----------------------------------------------------------------------------
  ; 
  ;----------------------------------------------------------------------------
  SendMessage_(ToolTipControl, #TTM_ADDTOOL, 0, Button)
  SendMessage_(ToolTipControl, #TTM_UPDATE, 0, 0)
  ;----------------------------------------------------------------------------
  ; 
  ;----------------------------------------------------------------------------
EndProcedure

; Generic file copy routine for single or multiple dropped files

Procedure ProcessFilename(FileName.s)
  ;----------------------------------------------------------------------------
  ; Check if the original file has no disk problems and isn't a directory
  ;----------------------------------------------------------------------------
  If FileSize(FileName.s) <> -1 Or FileSize(FileName.s) <> -2
    ;--------------------------------------------------------------------------
    ; Get the current filename
    ;--------------------------------------------------------------------------
    CurrentFile.s = GetFilePart(FileName.s)
    ;--------------------------------------------------------------------------
    ; Get the path of the current filename
    ;--------------------------------------------------------------------------
    CurrentPath.s = GetPathPart(Filename.s)
    ;--------------------------------------------------------------------------
    ; Remove the drive letter from the path name
    ;--------------------------------------------------------------------------
    CurrentPath.s = Mid(CurrentPath.s, 4, Len(CurrentPath.s) - 3)
    ;--------------------------------------------------------------------------
    ; Copy the file to the target if it doesn't already exist
    ;--------------------------------------------------------------------------
    If FileSize(Program\NetPath + CurrentPath.s + CurrentFile.s) = -1
      ;------------------------------------------------------------------------
      ; Create the new subdirectories in the target directory
      ;------------------------------------------------------------------------
      MakeSureDirectoryPathExists_(Program\NetPath + CurrentPath.s)
      ;------------------------------------------------------------------------
      ; 
      ;------------------------------------------------------------------------
      If CopyFile(FileName.s, Program\NetPath + CurrentPath.s + CurrentFile.s)
        Message.s = "The file copy was successful."
        SetStat(1,  Message.s)
        FileStatus(1, CurrentFile.s, Message.s)
      Else
        Message.s = "The file cannot be copied."
        SetStat(2, Message.s)
        FileStatus(2, CurrentFile.s, Message.s)
      EndIf
      ;------------------------------------------------------------------------
      ; The target file alread exists so it has no need to be copied
      ;------------------------------------------------------------------------
    Else
      Message.s = "The file already exists in the directory."
      SetStat(2, Message.s)
      FileStatus(3, CurrentFile.s, Message.s)
    EndIf
    ;--------------------------------------------------------------------------
    ; The original file cannot be found on disk or is a directory name
    ;--------------------------------------------------------------------------
  Else
    SetStat(2, "File cannot be found, or is a directory.")
  EndIf
  ;----------------------------------------------------------------------------
  ; 
  ;----------------------------------------------------------------------------
EndProcedure

; 

Procedure RunSetup()
  ;----------------------------------------------------------------------------
  ; 
  ;----------------------------------------------------------------------------
  If Program\MutexVal <> 1
    ;--------------------------------------------------------------------------
    ; 
    ;--------------------------------------------------------------------------
    If Window_directory()
      ;------------------------------------------------------------------------
      ; 
      ;------------------------------------------------------------------------
      Program\MutexVal = 1
      ;------------------------------------------------------------------------
      ; 
      ;------------------------------------------------------------------------
      SetGadgetText(#Gadget_directory_directory, Program\NetPath)
      ;------------------------------------------------------------------------
      ; Set file list balloon tool tip
      ;------------------------------------------------------------------------
      MyBalloonToolTips(#Window_directory, #Gadget_directory_directory, "Current 'Copy to' directory choice.")
      MyBalloonToolTips(#Window_directory, #Gadget_directory_select,    "Select the new directory.")
      MyBalloonToolTips(#Window_directory, #Gadget_directory_save,      "Save the current directory choice.")
      ;------------------------------------------------------------------------
      ; 
      ;------------------------------------------------------------------------
    Else
      SetStat(2, "could not open the setup window")
    EndIf
    ;--------------------------------------------------------------------------
    ; 
    ;--------------------------------------------------------------------------
  Else
    SetStat(2, "Another program window is already open")
  EndIf
  ;----------------------------------------------------------------------------
  ; 
  ;----------------------------------------------------------------------------
EndProcedure

; 

Procedure SaveSetup()
  ;----------------------------------------------------------------------------
  ; 
  ;----------------------------------------------------------------------------
  Program\NetPath = GetGadgetText(#Gadget_directory_directory)
  ;----------------------------------------------------------------------------
  ; 
  ;----------------------------------------------------------------------------
  SetWindowTitle(#Window_dragga, "Copying to: " + Program\NetPath)
  ;----------------------------------------------------------------------------
  ; 
  ;----------------------------------------------------------------------------
  CloseMyWindow(#Window_directory, 0)
  ;----------------------------------------------------------------------------
  ; 
  ;----------------------------------------------------------------------------
  SavePreferencesFile()
  ;----------------------------------------------------------------------------
  ; 
  ;----------------------------------------------------------------------------
EndProcedure

; Turn border snap on and off as needed

Procedure ScreenSnapToggle()
  ;----------------------------------------------------------------------------
  ;
  ;----------------------------------------------------------------------------
  If Program\ScreenSnap = 1
    ;--------------------------------------------------------------------------
    ;
    ;--------------------------------------------------------------------------
    Program\ScreenSnap = 0
    ;--------------------------------------------------------------------------
    ;
    ;--------------------------------------------------------------------------
    SetStat(1, "Snapping forms to borders has now been turned off.")
    ;--------------------------------------------------------------------------
    ;
    ;--------------------------------------------------------------------------
  ElseIf Program\ScreenSnap = 0
    ;--------------------------------------------------------------------------
    ;
    ;--------------------------------------------------------------------------
    Program\ScreenSnap = 1
    ;--------------------------------------------------------------------------
    ;
    ;--------------------------------------------------------------------------
    SetStat(1, "Snapping forms to borders has now been turned on.")
    ;--------------------------------------------------------------------------
    ;
    ;--------------------------------------------------------------------------
  EndIf
  ;----------------------------------------------------------------------------
  ; Save system preferences
  ;----------------------------------------------------------------------------
  SavePreferencesFile()
  ;----------------------------------------------------------------------------
  ;
  ;----------------------------------------------------------------------------
EndProcedure

; Select the new directory to save files to

Procedure SelectPath()
  ;----------------------------------------------------------------------------
  ; 
  ;----------------------------------------------------------------------------
  NewPath.s = PathRequester("Select new copy to path", Program\NetPath)
  ;----------------------------------------------------------------------------
  ; 
  ;----------------------------------------------------------------------------
  If NewPath.s <> ""
    ;--------------------------------------------------------------------------
    ; 
    ;--------------------------------------------------------------------------
    Program\NetPath = NewPath.s
    ;--------------------------------------------------------------------------
    ; 
    ;--------------------------------------------------------------------------
    SetGadgetText(#Gadget_directory_directory, Program\NetPath)
    ;--------------------------------------------------------------------------
    ; 
    ;--------------------------------------------------------------------------
  EndIf
  ;----------------------------------------------------------------------------
  ; 
  ;----------------------------------------------------------------------------
EndProcedure

; Procedure to wrap INI file writing routine

Procedure.i SetIniVal(IniSection.s, IniKey.s, IniValue.s)
  ;----------------------------------------------------------------------------
  ; Open the Ini file for reading
  ;----------------------------------------------------------------------------
  OpenPreferences(Program\IniFile)
  ;----------------------------------------------------------------------------
  ; Go to the right group
  ;----------------------------------------------------------------------------
  PreferenceGroup(IniSection)
  ;----------------------------------------------------------------------------
  ; Write the value to the INI file
  ;----------------------------------------------------------------------------
  WritePreferenceString(IniKey.s, IniValue.s)
  ;----------------------------------------------------------------------------
  ; Close the INI file, finished
  ;----------------------------------------------------------------------------
  ClosePreferences()
  ;----------------------------------------------------------------------------
  ; 
  ;----------------------------------------------------------------------------
EndProcedure

; Handle statusbar messages with less typing.

Procedure SetStat(Flag, Message.s)
  ;----------------------------------------------------------------------------
  ; If flag =1, no error and report it to user
  ;----------------------------------------------------------------------------
  If Flag = 1
    StatusBarText(#StatusBar_dragga, #StatusBar_dragga_Messages, "Info: " + Message.s, #PB_StatusBar_BorderLess)
  ElseIf Flag = 2
    StatusBarText(#StatusBar_dragga, #StatusBar_dragga_Messages, "Error: " + Message.s, #PB_StatusBar_BorderLess)
  ElseIf Flag = 3
    ;--------------------------------------------------------------------------
    ; 
    ;--------------------------------------------------------------------------
    If Val(Message.s) = 0
      Message.s = "No files"
    ElseIf Val(Message.s) < 1
      Message.s + " File"
    Else 
      Message.s + " Files"
    EndIf
    ;--------------------------------------------------------------------------
    ; Show fatal error on status bar
    ;--------------------------------------------------------------------------
    StatusBarText(#StatusBar_dragga, #StatusBar_dragga_Records, Message.s, #PB_StatusBar_BorderLess)
    ;--------------------------------------------------------------------------
    ; End test
    ;--------------------------------------------------------------------------
  EndIf
  ;----------------------------------------------------------------------------
  ; 
  ;----------------------------------------------------------------------------
EndProcedure

; Colours, resizing and more

Procedure WindowCallback(WindowID, Message, wParam, lParam)
  ;----------------------------------------------------------------------------
  ; Netmaestro's windowsnap code
  ;----------------------------------------------------------------------------
  Static snapped1, snapped2, snapped3, snapped4
  ;----------------------------------------------------------------------------
  ; Netmaestro's windowsnap code
  ;----------------------------------------------------------------------------
  ReturnValue = #PB_ProcessPureBasicEvents
  ;----------------------------------------------------------------------------
  ;
  ;----------------------------------------------------------------------------
  If Program\ScreenSnap = 1
    If Message = #WM_MOVING
      *view.RECT = lparam
      curwidth  = *view\right - *view\left
      curheight = *view\bottom - *view\top
      If AutoSnap                                                                         ;  AutoSnap Section
        If *view\left < SnapD
          If Not Snapped1
            *view\left = 0
            *view\right = curwidth
            snapped1 = #True
            ReturnValue = #True
          EndIf
        Else
          snapped1 = #False
        EndIf
        If *view\top < SnapD
          If Not Snapped2
            *view\top = 0
            *view\bottom = curheight
            snapped2 = #True
            ReturnValue = #True
          EndIf
        Else
          snapped2 = #False
        EndIf
        If *view\right > screenw - SnapD
          If Not Snapped3
            *view\left  = ScreenW - curwidth
            *view\right = screenW
            snapped3 = #True
            ReturnValue = #True
          EndIf
        Else
          snapped3 = #False
        EndIf     
        If *view\bottom > screenH - SnapD
          If Not Snapped4
            *view\top = screenH - curheight
            *view\bottom = screenH
            snapped4 = #True
            ReturnValue = #True
          EndIf
        Else
          snapped4 = #False
        EndIf     
      EndIf
      If *view\top < 0                                                                    ;  Inside Desktop Section
        *view\top = 0
        *view\bottom = curheight
      EndIf
      If *view\left < 0 
        *view\left = 0
        *view\right = curwidth
      EndIf
      If *view\right > screenW
        *view\right = screenW
        *view\left = *view\right - curwidth
      EndIf
      If *view\bottom > screenH
        *view\bottom = screenH
        *view\top = *view\bottom - curheight
      EndIf
      MoveWindow_(WindowID, *view\left, *view\top, *view\right - *view\left, *view\bottom - *view\top, #True)
      ReturnValue = #True
    EndIf
  EndIf
  ;----------------------------------------------------------------------------
  ; 
  ;----------------------------------------------------------------------------
  ProcedureReturn ReturnValue
  ;----------------------------------------------------------------------------
  ; 
  ;----------------------------------------------------------------------------
EndProcedure

; Create a brand new INI file in the program directory if the default one is missing, with default values.

Procedure CreatePreferencesFile()
  ;----------------------------------------------------------------------------
  ;
  ;----------------------------------------------------------------------------
  CreatePreferences(Program\IniFile)
  ;----------------------------------------------------------------------------
  ;
  ;----------------------------------------------------------------------------
  PreferenceComment(" ")
  PreferenceComment("----------------------------------------------------------")
  PreferenceGroup("Copy To Path")
  PreferenceComment("----------------------------------------------------------")
  PreferenceComment(" ")
  WritePreferenceString("Path To Copy To", "C:\Dragga (Dropped Files Store)\")
  PreferenceComment(" ")
  PreferenceComment("----------------------------------------------------------")
  PreferenceGroup("Program Toggles")
  PreferenceComment("----------------------------------------------------------")
  PreferenceComment(" ")
  WritePreferenceString("Snap To Screen", "1")
  PreferenceComment(" ")
  ;----------------------------------------------------------------------------
  ;
  ;----------------------------------------------------------------------------
  ClosePreferences()
  ;----------------------------------------------------------------------------
  ;
  ;----------------------------------------------------------------------------
EndProcedure

; Read the system preferences file or create it if missing

Procedure ReadPreferencesFile()
  ;----------------------------------------------------------------------------
  ; If the INI file doesn't exist, create a default one
  ;----------------------------------------------------------------------------
  If FileSize(Program\IniFile) = -1
    CreatePreferencesFile()
  EndIf
  ;----------------------------------------------------------------------------
  ; Copy To Path
  ;----------------------------------------------------------------------------
  Program\NetPath     =     GetIniVal("Copy To Path",    "Path To Copy To")
  ;----------------------------------------------------------------------------
  ; Program Toggles
  ;----------------------------------------------------------------------------
  Program\ScreenSnap  = Val(GetIniVal("Program Toggles", "Snap To Screen"))
  ;----------------------------------------------------------------------------
  ; 
  ;----------------------------------------------------------------------------
EndProcedure

; Save all preferences at program end

Procedure SavePreferencesFile()
  ;----------------------------------------------------------------------------
  ; Copy To path
  ;----------------------------------------------------------------------------
  SetIniVal("Copy To Path", "Path To Copy To", Program\NetPath)
  ;----------------------------------------------------------------------------
  ; Program Toggles
  ;----------------------------------------------------------------------------
  SetIniVal("Program Toggles", "Snap To Screen", Str(Program\ScreenSnap))
  ;----------------------------------------------------------------------------
  ; 
  ;----------------------------------------------------------------------------
EndProcedure

; 

If Window_dragga()

  ;----------------------------------------------------------------------------
  ; 
  ;----------------------------------------------------------------------------

  SetWindowTitle(#Window_dragga, "Copying to: " + Program\NetPath)
  
  ;----------------------------------------------------------------------------
  ; Create my main popup menu
  ;----------------------------------------------------------------------------

  If CreatePopupImageMenu(#PopMenu_dragga, #PB_Menu_ModernLook)
    MenuItem(#PopMenu_dragga_setup, "Setup defaults"      + Chr(09) + "Alt + S", 0)
    MenuItem(#PopMenu_dragga_snap,  "Border snap toggle"  + Chr(09) + "Alt + B", 0)
    MenuItem(#PopMenu_dragga_exit,  "Exit program"        + Chr(09) + "Alt + X", 0)
    MenuBar()
  EndIf

  ;----------------------------------------------------------------------------
  ; Add main form keyboard shortcuts here
  ;----------------------------------------------------------------------------

  AddKeyboardShortcut(#Window_dragga, #PB_Shortcut_Alt | #PB_Shortcut_S, #Dragga_setup)
  AddKeyboardShortcut(#Window_dragga, #PB_Shortcut_Alt | #PB_Shortcut_B, #Dragga_snap)
  AddKeyboardShortcut(#Window_dragga, #PB_Shortcut_Alt | #PB_Shortcut_X, #Dragga_exit)

  ;----------------------------------------------------------------------------
  ; Load the background watermark
  ;----------------------------------------------------------------------------
  
  LoadListIconImage(GadgetID(#Gadget_dragga_filelist))

  ;----------------------------------------------------------------------------
  ; Colours, resizing and more
  ;----------------------------------------------------------------------------

  SetWindowCallback(@WindowCallback())

  ;----------------------------------------------------------------------------
  ; Create a new image list for the ListIconGadget if it doesn't exist or has been destroyed
  ;----------------------------------------------------------------------------

  Program\Hdragga    = ImageList_Create_(16, 16, #ILC_MASK | #ILC_COLOR32, 0, 5)
  
  ;----------------------------------------------------------------------------
  ; Add the icons to the new imagelist
  ;----------------------------------------------------------------------------

  Program\Done        = ImageList_ReplaceIcon_(Program\Hdragga, -1, ImageID(#Image_dragga_done))
  Program\Go          = ImageList_ReplaceIcon_(Program\Hdragga, -1, ImageID(#Image_dragga_go))
  Program\Pause       = ImageList_ReplaceIcon_(Program\Hdragga, -1, ImageID(#Image_dragga_pause))
  Program\Skip        = ImageList_ReplaceIcon_(Program\Hdragga, -1, ImageID(#Image_dragga_skip))
  Program\Stop        = ImageList_ReplaceIcon_(Program\Hdragga, -1, ImageID(#Image_dragga_stop))
  
  ;----------------------------------------------------------------------------
  ; Set the new imagelist to the gadget
  ;----------------------------------------------------------------------------

  SendMessage_(GadgetID(#Gadget_dragga_filelist), #LVM_SETIMAGELIST, #LVSIL_SMALL, Program\Hdragga)
  ImageList_SetBkColor_(Program\Hdragga, #CLR_NONE)  
  SendMessage_(GadgetID(#Gadget_dragga_filelist), #LVM_SETEXTENDEDLISTVIEWSTYLE, #LVS_EX_SUBITEMIMAGES, #LVS_EX_SUBITEMIMAGES) 

  ;----------------------------------------------------------------------------
  ; Add the message and record statusbar icons
  ;----------------------------------------------------------------------------
  
  StatusBarImage(#StatusBar_dragga, #StatusBar_dragga_Mico, ImageID(#Image_dragga_messages), #PB_StatusBar_BorderLess)
  StatusBarImage(#StatusBar_dragga, #StatusBar_dragga_Rico, ImageID(#Image_dragga_records), #PB_StatusBar_BorderLess)

  ;----------------------------------------------------------------------------
  ; Setup the status bar for colouring with an API
  ;----------------------------------------------------------------------------
  
  SendMessage_(StatusBarID(#StatusBar_dragga), #SB_SETBKCOLOR, 0, $E78875)

  ;----------------------------------------------------------------------------
  ; Enable dragging and dropping to this gadget
  ;----------------------------------------------------------------------------

  EnableGadgetDrop(#Gadget_dragga_filelist, #PB_Drop_Files, #PB_Drag_Copy)

  ;----------------------------------------------------------------------------
  ; Set file list balloon tool tip
  ;----------------------------------------------------------------------------

  MyBalloonToolTips(#Window_dragga, #Gadget_dragga_filelist, "Drag files over to this list and drop them on it to be copied to the chosen directory." + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "Subdirectories will neither be copied nor expanded at all." + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "Files will have their subdirectory attributes recreated at the target." + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "Press ALT + X to exit or press the 'x' at the top right of the window.")

  ;----------------------------------------------------------------------------
  ; Set initial statusbar messages
  ;----------------------------------------------------------------------------

  SetStat(1, "Dragga is ready to work......")
  
  SetStat(3, "0")
  
  ;----------------------------------------------------------------------------
  ; Set the program quit flag
  ;----------------------------------------------------------------------------

  Program\QuitFlag = 0
  
  ;----------------------------------------------------------------------------
  ; Make sure this window has primary focus on startup
  ;----------------------------------------------------------------------------

  SetActiveWindow(#Window_dragga)
  
  ;----------------------------------------------------------------------------
  ; Make sure this gadget has primary focus on startup
  ;----------------------------------------------------------------------------

  SetActiveGadget(#Gadget_dragga_filelist)

  ;----------------------------------------------------------------------------
  ;
  ;----------------------------------------------------------------------------
  
  Repeat
    Select WaitWindowEvent()
      ;------------------------------------------------------------------------
      ; 
      ;------------------------------------------------------------------------
      Case #PB_Event_CloseWindow
        Select EventWindow()
          Case #Window_dragga               : Program\QuitFlag = 1
          Case #Window_directory            : CloseMyWindow(#Window_directory, 0)
        EndSelect
        ;----------------------------------------------------------------------
        ; 
        ;----------------------------------------------------------------------
      Case #PB_Event_GadgetDrop 
        Select EventGadget()
          Case #Gadget_dragga_filelist
            Select EventDropType()
              Case #PB_Drop_Files           : CopyFilesToPath()
            EndSelect
        EndSelect
        ;----------------------------------------------------------------------
        ; 
        ;----------------------------------------------------------------------
      Case #PB_Event_Menu
        Select EventMenu()
          Case #PopMenu_dragga_setup        : RunSetup()
          Case #PopMenu_dragga_snap         : ScreenSnapToggle()
          Case #PopMenu_dragga_exit         : Program\QuitFlag = 1
          Case #Dragga_setup                : RunSetup()
          Case #Dragga_snap                 : ScreenSnapToggle()
          Case #Dragga_exit                 : Program\QuitFlag = 1
        EndSelect
        ;----------------------------------------------------------------------
        ; 
        ;----------------------------------------------------------------------
       Case #PB_Event_Gadget
         Select EventGadget()
           Case #Gadget_dragga_filelist
            Select EventType()
              Case #PB_EventType_RightClick : DisplayPopupMenu(#PopMenu_dragga, WindowID(#Window_dragga))            
            EndSelect
           Case #Gadget_directory_select    : SelectPath()
           Case #Gadget_directory_save      : SaveSetup()
         EndSelect
        ;----------------------------------------------------------------------
        ; 
        ;----------------------------------------------------------------------
    EndSelect
  Until Program\QuitFlag
  SavePreferencesFile()
  CloseWindow(#Window_dragga)
EndIf
End

Fangbeast · Post by **Fangbeast** » Tue Sep 29, 2009 2:04 pm

Note that by default, STUFI creates a drop directory on your local hard drive

"C:\Dragga (Dropped Files Store)\"

but I created this so people could drag and drop files onto my network drive which would look something like this..

\\FUNGUSBOX\yummy\files\for\me\ (This is now the root drag and drop store on the network)

If user copies and drops a file from "C:\My\Junk\Files\rabbitfoot.jpg", the result would look like...

\\FUNGUSBOX\yummy\files\for\me\My\Junk\Files\rabbitfoot.jpg" on the network folder

So get the person using this to change the default directory to your shared folder and save it. Changes the heading and the INI file setting for future use.

Program checks to see if the directory is alive before copying files.

SFSxOI · Post by **SFSxOI** » Tue Sep 29, 2009 2:21 pm

I like the way you documented the code in the "Generic and custom declarations" part. I think the name though should be something else besides 'Stupid', its not at all, its very good and definately serves a valid purpose, its actually a very smart idea. I already have a use in mind for it for performing updates across a network. Thank You

Fangbeast · Post by **Fangbeast** » Tue Sep 29, 2009 9:23 pm

Nah, this is stupid software and I should know. That's why it is nicknamed STUFI, because I always STUF It up!!!!

Anyway, have some minor bug fixes to add to it shortly. As soon as I can get my eyes to stay open.

And might add those toggles to the setup screen too *yawn*

PureBasic Forums - English

Stupid drag and drop file copier

Stupid drag and drop file copier

Re: Stupid drag and drop file copier

Re: Stupid drag and drop file copier

Re: Stupid drag and drop file copier