*
#include "FIVEWIN.CH"*
#define use_TGrid
// do NOT enable for Standalone !#define CSIDL_DRIVES 0x0011
#define cDevice
"APPLE IPHONE" // change for Android#define FOF_SIMPLEPROGRESS 0x0100
#define LVIS_FOCUSED 0x01
#define LVIS_SELECTED 0x02
#define ID_Folder
1#define ID_Name
2#define ID_Level
3#define ID_Parent
4#define ID_Element
5STATIC oIPHONE
STATIC oTree_1
STATIC oButton_Target
STATIC oTargetDir
STATIC oButton_CopyHere
STATIC oButton_MoveHere
STATIC oFontDefault
STATIC oImageList
STATIC oShell, oFolder
STATIC oBrwCP
STATIC oGrid
STATIC oTreeLast
STATIC nLevel :=
0STATIC nElement :=
0STATIC aFileSys :=
{}STATIC aGridfiles :=
{ "",
"",
"",
"",
"",
"" }STATIC aFolder :=
{}STATIC lRecursiv := .F.
STATIC c_Target
*+--------------------------------------------------------------------
*+
*+ Procedure MAIN
()*+
*+--------------------------------------------------------------------
*+
PROCEDURE MAIN
( cPara
)LOCAL nFontSize :=
20LOCAL nClrFore, nClrBack, lPixel := .T., lDesign := .F., nWidth :=
200, nHeight :=
600, cMsg :=
"", lCheckBoxes := .F., bChange, lEditable := .F.
LOCAL BFcolor, BGcolor
LOCAL aHeader :=
{}LOCAL bAction :=
{ ||
nil }LOCAL nIcoLarge :=
32LOCAL nIcoSmall :=
32LOCAL lCheckbox := .T.
c_Target := SPACE
( 250 ) IF !EMPTY
( cPara
) lRecursiv := .T.
ENDIF DEFINE FONT oFontDefault
NAME "TAHOMA" SIZE 0, - nFontSize
ACTIVATE FONT oFontDefault
#IFDEF __HMG__
END
FONT#ENDIF
AADD
( aHeader,
{ "Name",
200,
0,
"C" } ) AADD
( aHeader,
{ "Size",
150,
1,
"N" } ) AADD
( aHeader,
{ "Date",
110,
1,
"D" } ) AADD
( aHeader,
{ "Time",
090,
1,
"C" } ) AADD
( aHeader,
{ "Note",
250,
0,
"C" } ) aGridfiles := DIRECTORY
( "*.*",
"DHS" ) DEFINE WINDOW oIPHONE
FROM 0,
0 TO 768,
1024 PIXEL TITLE "Device " ICON "A1MAIN"#ifdef use_TGrid
oGrid := TGrid
() :
New( 20,
220, bAction, oIPHONE, BFcolor, BGcolor, ;
lPixel, lDesign,
780,
600, cMsg, nIcoLarge, nIcoSmall, lCheckbox
) oGrid:
aHeader := aHeader
oGrid:
aSource := aGridfiles
#endif
oTree_1 := TTreeView
() :
New( 20,
10, oIPHONE, nClrFore, nClrBack, lPixel, lDesign, nWidth, nHeight, cMsg, lCheckBoxes, bChange, lEditable
) oImageList := TImageList
() :
New() oImageList:
Add( TBitmap
() :
Define( "folder",, oIPHONE
), ;
TBitmap
() :
Define( "fldmask",, oIPHONE
) ) oTree_1:
SetImageList( oImageList
) oTree_1:
bLDblClick :=
{ || DoTreeAction
( oTree_1:
GetSelected() ) } oTree_1:
bChanged :=
{ || ShowGrid
() } @
624,
010 BUTTON oButton_Target
PROMPT "&Target Folder" SIZE 200,
30 PIXEL FONT oFontDefault
ACTION GetTargetFolder
() OF oIPHONE
@
624,
220 GET oTargetDir
VAR c_Target
SIZE 780,
30 PIXEL FONT oFontDefault
OF oIPHONE
@
660,
010 BUTTON oButton_CopyHere
PROMPT "&CopyHere" SIZE 100,
30 PIXEL FONT oFontDefault
ACTION Start_CopyHere
( .F.
) OF oIPHONE
@
660,
110 BUTTON oButton_MoveHere
PROMPT "&MoveHere" SIZE 100,
30 PIXEL FONT oFontDefault
ACTION Start_CopyHere
( .T.
) OF oIPHONE
oButton_CopyHere:
hide() oButton_MoveHere:
hide()#IFDEF __HMG__
END
WINDOW#ENDIF
ACTIVATE WINDOW oIPHONE
ON INIT BuildRoot
() VALID OnEnd
() CENTERRETURN*+--------------------------------------------------------------------
*+
*+
Function OnEnd
()*+
*+ Called
from ( iphone.prg
) 1 - procedure iphonewin
()*+
( phone3.prg
) 1 - procedure main
()*+
*+--------------------------------------------------------------------
*+
FUNCTION OnEnd
()RETURN .T.
*+--------------------------------------------------------------------
*+
*+
Static Procedure DoTreeAction
()*+
*+ Called
from ( phone3.prg
) 1 - procedure main
()*+
*+--------------------------------------------------------------------
*+
STATIC PROCEDURE DoTreeAction
( oTreeNext
)LOCAL cThis := oTreeNext:
Cargo[ 1 ]LOCAL nItem := oTreeNext:
Cargo[ 2 ]LOCAL oFolderItem := oTreeNext:
Cargo[ 3 ]LOCAL aSelect, xFolder, xName, xLevel, xParent, xElement
LOCAL nPosi, oError
LOCAL bSaveError := ERRORBLOCK
( { | oErr |
BREAK( oErr
) } ) aGridfiles :=
{} DO CASE CASE nLevel =
0 BuildRoot
() CASE nLevel =
1 SearchDevice
() CASE nLevel =
2 SelectDevice
() OTHERWISE IF !EMPTY
( aFolder
) .AND. !EMPTY
( cThis
) nPosi := ASCAN
( aFolder,
{ | e | e
[ ID_Name
] = UPPER
( cThis
) } ) // .AND. e[ ID_Parent ] = nParent IF nPosi >
0 aSelect := aFolder
[ nPosi
] xFolder := aSelect
[ ID_Folder
] xName := aSelect
[ ID_Name
] xLevel := aSelect
[ ID_Level
] DoTreeRecursiv
( oFolderItem, xLevel +
1, .F., .F., .F., .F., oTreeNext
) ShowGrid
() ENDIF ENDIF ENDCASERETURN*+--------------------------------------------------------------------
*+
*+
Static Procedure BuildRoot
()*+
*+ Called
from ( phone3.prg
) 1 - procedure main
()*+
1 -
static procedure dotreeaction
()*+
*+--------------------------------------------------------------------
*+
STATIC PROCEDURE BuildRoot
()LOCAL oTreeItem
oTree_1:
DeleteAll() oTreeItem := oTree_1:
Add( "This PC",
0,
0 ) oTreeItem:
Cargo :=
{ "ROOT",
0,
0 } nLevel :=
1 aFileSys :=
{} aFolder :=
{} AADD
( aFolder,
{ NIL,
"This PC",
1, nElement
} ) // now include at Start SearchDevice
( oTreeItem
) oTree_1:
Expand()#ifdef use_TGrid
oGrid:
InitTheListView()#endif
RETURN*+--------------------------------------------------------------------
*+
*+
Static Procedure SearchDevice
()*+
*+ Called
from ( phone3.prg
) 1 -
static procedure dotreeaction
()*+
1 -
static procedure buildroot
()*+
*+--------------------------------------------------------------------
*+
STATIC PROCEDURE SearchDevice
( oTreeRoot
)LOCAL cName, oItems
LOCAL i, iMax
LOCAL oTreeItem
LOCAL oFolderItem
nLevel :=
2 oShell := CreateObject
( "shell.application" ) IF NIL <> oShell
oFolder := oShell:
NameSpace( CSIDL_DRIVES
) // 0x0011 // My Computer IF NIL <> oFolder
// https://learn.microsoft.com/de-de/windo ... lder-items oItems := oFolder:
Items() iMax := oItems:
Count FOR i :=
1 TO iMax
// https://learn.microsoft.com/de-de/windo ... folderitem oFolderItem := oItems:
Item( i -
1 ) IF !EMPTY
( oFolderItem
) cName := UPPER
( oFolderItem:
name ) IF cName =
"DESKTOP" LOOP
ENDIF IF ASCAN
( aFolder,
{ | e | e
[ ID_Name
] = cName
} ) >
0 ELSE nElement ++
oTreeItem := oTreeRoot:
Add( cName,
0, nElement
) oTreeItem:
Cargo :=
{ cName, nLevel, oFolderItem
} // next Level Action AADD
( aFolder,
{ oTreeItem, cName, nLevel, oFolder
} ) oTreeLast := oTreeItem
IF .NOT. oFolderItem:
isFileSystem AADD
( aFileSys, i
) ENDIF ENDIF ENDIF NEXT ENDIF ENDIF Sysrefresh
()RETURN*+--------------------------------------------------------------------
*+
*+
Static Procedure SelectDevice
()*+
*+ Called
from ( phone3.prg
) 1 -
static procedure dotreeaction
()*+
*+--------------------------------------------------------------------
*+
STATIC PROCEDURE SelectDevice
()LOCAL cThis, oItems
LOCAL i, iMax, xParent :=
0LOCAL nItem
LOCAL oFolderItem
nLevel :=
3 IF NIL <> oFolder
oItems := oFolder:
Items() iMax := oItems:
Count FOR i :=
1 TO iMax
oFolderItem := oItems:
Item( i -
1 ) IF !EMPTY
( oFolderItem
) // https://learn.microsoft.com/de-de/windo ... ritem-name cThis := UPPER
( oFolderItem:
name ) IF UPPER
( cThis
) = cDevice
// EXIT here EXIT
ENDIF ENDIF NEXT ENDIF Sysrefresh
()RETURN*+--------------------------------------------------------------------
*+
*+
Static Procedure DoTreeRecursiv
()*+
*+ Called
from ( phone3.prg
) 1 -
static procedure dotreeaction
()*+
1 -
static procedure dotreerecursiv
()*+
1 -
static procedure start_copyhere
()*+
*+--------------------------------------------------------------------
*+
STATIC PROCEDURE DoTreeRecursiv
( xFolder, xLevel, xRecursiv, lTransfer, lMove, lisFileSys, oTreeNext
)LOCAL xThis, xItems
LOCAL ii, iMax, xFolderItem
LOCAL c_Name, c_Size, c_Date, c_Attr, c_Type
LOCAL cTarget := c_Target
LOCAL oTreeItem
LOCAL oItemParent
DEFAULT lTransfer := .F.
DEFAULT lisFileSys := .T.
IF NIL <> xFolder
nLevel := xLevel
// https://learn.microsoft.com/en-us/windows/win32/shell/folderitem-getfolder xItems := xFolder:
GetFolder:
Items() IF lTransfer = .T.
#ifdef use_TGrid
DoCopySingle
( xItems, cTarget, lMove
)#endif
ELSE iMax := xItems:
Count FOR ii :=
1 TO iMax
// https://learn.microsoft.com/de-de/windo ... folderitem xFolderItem := xItems:
Item( ii -
1 ) IF !EMPTY
( xFolderItem
) // https://learn.microsoft.com/de-de/windo ... tem-islink IF xFolderItem:
IsLink LOOP
ENDIF // https://learn.microsoft.com/de-de/windo ... m-isfolder IF xFolderItem:
IsFolder // is it a folder // https://learn.microsoft.com/de-de/windo ... ritem-name xThis := UPPER
( xFolderItem:
name ) IF ASCAN
( aFolder,
{ | e | e
[ ID_Name
] = xThis
} ) >
0 ELSE nElement ++
oTreeItem := oTreeNext:
Add( xThis,
0, xLevel
) oTreeItem:
Cargo :=
{ xThis, xLevel, xFolderItem
} // next Level Action oTreeNext:
Expand() AADD
( aFolder,
{ oTreeItem, xThis, nLevel +
1, xFolder
} ) // not used here IF xRecursiv = .T.
oTreeLast := oTreeItem
DoTreeRecursiv
( xFolderItem, xLevel +
1, xRecursiv, .F., .F., lisFileSys, oTreeNext
) ENDIF ENDIF ELSE c_Name := xFolderItem:
name c_Size := xFolderItem:
Size c_Date := xFolderItem:
ModifyDate c_Type := xFolderItem:
Type c_Attr :=
"" AADD
( aGridfiles,
{ c_Name, c_Size, c_Date, c_Attr, c_Type, LTRIM
( STR
( xLevel +
1 ) ) } ) ENDIF ENDIF NEXT ENDIF ENDIFRETURN*+--------------------------------------------------------------------
*+
*+
Static Procedure GetTargetFolder
()*+
*+ Called
from ( phone3.prg
) 1 - procedure main
()*+
*+--------------------------------------------------------------------
*+
STATIC PROCEDURE GetTargetFolder
()LOCAL cFolder := cGETFOLDER
( "Get Target Folder", c_Target
) IF !EMPTY
( cFolder
) c_Target := EndwithSlash
( cFolder
) oTargetDir:
Refresh() ENDIFRETURN*+--------------------------------------------------------------------
*+
*+
Static Procedure ShowGrid
()*+
*+ Called
from ( phone3.prg
) 1 - procedure main
()*+
1 -
static procedure dotreeaction
()*+
*+--------------------------------------------------------------------
*+
STATIC PROCEDURE ShowGrid
() oButton_CopyHere:
Show() oButton_MoveHere:
Show()#ifdef use_TGrid
oGrid:
aSource := aGridfiles
oGrid:
ClearAndFill( oIPHONE
)#endif
RETURN*+--------------------------------------------------------------------
*+
*+
Static Procedure Start_CopyHere
()*+
*+ Called
from ( phone3.prg
) 2 - procedure main
()*+
*+--------------------------------------------------------------------
*+
STATIC PROCEDURE Start_CopyHere
( lMove
)LOCAL nPosi
LOCAL nItem := oTreeLast:
Cargo[ 2 ] // IPHONE.Tree_1.ValueLOCAL cThis := oTreeLast:
Cargo[ 1 ] // TRIM( IPHONE.Tree_1.Item( nItem ) )LOCAL oFItem := oTreeLast:
Cargo[ 3 ]LOCAL lTransfer := .T.
LOCAL aSelect, xFolder, xName, xLevel, xParent, xElement, xOther
IF !EMPTY
( aGridfiles
) IF nItem >
0 aSelect := aFolder
[ nItem
] xFolder := aSelect
[ ID_Folder
] xName := aSelect
[ ID_Name
] xLevel := aSelect
[ ID_Level
] xOther := aSelect
[ 4 ] fwlog hb_valToExp
( xFolder
) // Folder-Object fwlog hb_valToExp
( xName
) // OK String fwlog hb_valToExp
( xLevel
) // OK Number fwlog hb_valToExp
( xOther
) // OLE fwlog hb_valToExp
( oTreeLast
) // TTVITEM fwlog hb_valToExp
( oFItem
) // TOLEAUTO DO CASE CASE xFolder:
IsDerivedFrom( "TTreeItem" ) FWLOG
"TTreeItem" CASE xFolder:
IsDerivedFrom( "TTreeView" ) FWLOG
"TTreeView" CASE xFolder:
IsDerivedFrom( "TTVItem" ) FWLOG
"TTVItem" OTHERWISE ENDCASE DoTreeRecursiv
( oFItem, xLevel, .F., lTransfer, lMove
) // "TOLEAUTO" * DoTreeRecursiv
( xFolder, xLevel, .F., lTransfer, lMove
) // "TTVItem" ENDIF ENDIF sysrefresh
()RETURN*+--------------------------------------------------------------------
*+
*+
Static Function GoNext
()*+
*+--------------------------------------------------------------------
*+
STATIC FUNCTION GoNext
()LOCAL oSelItem := oTree_1:
GetSelected(), lStop := .F., oNextItem
LOCAL lRet := .T.
oTree_1:
Scan( { | oItem |
IF( oItem:
hItem == oSelItem:
hItem, lStop := .T.,
), ;
IF( lStop .AND. oItem:
hItem != oSelItem:
hItem,
( oNextItem := oItem, .T.
), .F.
) } ) IF oNextItem !=
nil oTree_1:
Select( oNextItem
) IF oNextItem:
Cargo[ 2 ] = oTreeLast:
Cargo[ 2 ] lRet := .F.
ENDIF ELSE lRet := .F.
ENDIFRETURN lRet
*+--------------------------------------------------------------------
*+
*+
Static Function EndwithSlash
()*+
*+ Called
from ( phone3.prg
) 1 -
static procedure gettargetfolder
()*+
*+--------------------------------------------------------------------
*+
STATIC FUNCTION EndwithSlash
( cString
)LOCAL nPosi
IF !EMPTY
( cString
) nPosi := RAT
( "\", cString )
IF nPosi = LEN( cString )
ELSE
cString += "\
"
ENDIF
cString := STRTRAN( cString, "\\
", "\
", 3 )
ENDIF
RETURN cString
// ************************* include in DUALGRID.PRG **************************
#ifdef use_TGrid
*+--------------------------------------------------------------------
*+
*+ Static Procedure DoCopySingle()
*+
*+ Called from ( phone3.prg ) 1 - static procedure dotreerecursiv()
*+
*+--------------------------------------------------------------------
*+
STATIC PROCEDURE DoCopySingle( oDirFolder, cTarget, lMove )
LOCAL hGrid := oGrid:hwnd // GetControlHandle( "Grid_1
", "IPHONE
" )
LOCAL oNewSH := CreateObject( "Shell.Application
" )
LOCAL oTarget := oNewSH:NameSpace( cTarget )
LOCAL xFlag := FOF_SIMPLEPROGRESS
LOCAL nState := hb_BitOr( LVIS_SELECTED, LVIS_FOCUSED )
LOCAL nMask := hb_BitOr( LVIS_SELECTED, LVIS_FOCUSED )
LOCAL aFiles := {}
LOCAL oFile, cFile, xCount, nCount
LOCAL i, iMax, nSkip := 0
DEFAULT lMove := .F.
iMax := oDirFolder:Count
FOR i := 1 TO iMax
SYSrefresh()
// if Checkbox is marked
// IF IPHONE.Grid_1.CheckBoxItem( i ) = .T.
// get Item Object
oFile := oDirFolder:Item( i - 1 )
IF lMove = .T.
// move single Object file
// https://learn.microsoft.com/de-de/windo ... r-movehere
oTarget:MoveHere( oFile, xFlag )
ELSE
// copy single Object file
// https://learn.microsoft.com/de-de/windo ... r-copyhere
oTarget:CopyHere( oFile, xFlag )
ENDIF
// wait until all files are written
xCount := 0
DO WHILE .T.
// compare if file is written
nCount := oTarget:items() :Count()
IF nCount + nSkip >= i
EXIT
ENDIF
hb_idleSleep( 0.1 )
xCount ++
IF xCount > 50
EXIT
ENDIF
ENDDO
// scroll GRID if need
LV_SETITEMSTATE( hGrid, i, nState, nMask )
LV_EnsureVisible( hGrid, i )
// ELSE
// // Skip un-maked
// nSkip ++
// ENDIF
NEXT
// clean up
hb_idleSleep( 0.5 )
oTarget := NIL
oNewSH := NIL
SYSrefresh()
RETURN
*+--------------------------------------------------------------------
*+
*+ Static Function CompareFile()
*+
*+
*+--------------------------------------------------------------------
*+
STATIC FUNCTION CompareFile( aX, aY, lUp )
LOCAL cName1, cName2
LOCAL lRet
DEFAULT lUp := .T.
cName1 := LOWER( FindExt( aX ) + FindName( aX ) )
cName2 := LOWER( FindExt( aY ) + FindName( aY ) )
IF lUp = .T.
lRet := cName1 < cName2
ELSE
lRet := cName1 > cName2
ENDIF
RETURN ( lRet )
*+--------------------------------------------------------------------
*+
*+ Static Function FindName()
*+
*+ Called from ( phone3.prg ) 2 - static function comparefile()
*+
*+--------------------------------------------------------------------
*+
STATIC FUNCTION FindName( filename )
LOCAL nPosi := RAT( ".
", filename )
RETURN SUBSTR( filename, 1, nPosi - 1 )
*+--------------------------------------------------------------------
*+
*+ Static Function FindExt()
*+
*+ Called from ( phone3.prg ) 2 - static function comparefile()
*+
*+--------------------------------------------------------------------
*+
STATIC FUNCTION FindExt( filename )
LOCAL nPosi := RAT( ".
", filename )
RETURN UPPER( SUBSTR( filename, nPosi + 1, LEN( filename ) ) )
*+--------------------------------------------------------------------
*+
*+ Static Procedure SayBar()
*+
*+
*+--------------------------------------------------------------------
*+
STATIC PROCEDURE SayBar( cText, nPart )
RETURN
#include "TGRID.PRG
"
#include "HB_FUNC.PRG
"
#endif
*+ EOF: PHONE3.PRG
