Code: Select all
*+--------------------------------------------------------------------
*+
*+ Source Module => c:\hmg.3.4.4\0\IPHONE\\HBIPHONE.PRG
*+
*+ Copyright(C) 1983-2020 by Auge & Ohr
*+
*+ Functions: Procedure MAIN()
*+ Static Procedure GetTargetFolder()
*+ Static Procedure SearchDevice()
*+ Static Function GetDevicePath()
*+ Static Procedure SayList()
*+ Static Function CutLine()
*+ Static Procedure DoCopyHere()
*+ Static Procedure DoCopySingle()
*+ Function CalcPos()
*+
*+ Reformatted by Click! 2.05.30 on Mar-30-2020 at 9:18 am
*+
*+--------------------------------------------------------------------
#include "HMG.CH"
#include "Common.CH"
#define FOF_SIMPLEPROGRESS 0x0100a
MEMVAR _HMG_SYSDATA
*+--------------------------------------------------------------------
*+
*+ Procedure MAIN()
*+
*+--------------------------------------------------------------------
*+
PROCEDURE MAIN
LOCAL aDevices := GetHandy()
LOCAL cTarget := "F:\IPHONE\"
LOCAL afiles := {}
PUBLIC _HMG_SYSDATA
SET DATE GERMAN
SET EPOCH TO YEAR( DATE() )
SET CENTURY ON
DEFINE WINDOW IPHONE ;
AT 0, 0 ;
WIDTH 1000 ;
HEIGHT 768 ;
TITLE "HMG_GetImage_from_iPhone_DCIM" ;
ICON "A1MAIN" ;
ON INIT Nil ;
ON RELEASE Nil ;
NOSIZE ;
NOMAXIMIZE ;
NOMINIMIZE ;
ON PAINT Nil ;
BACKCOLOR Nil
DEFINE EDITBOX Loglist
ROW 20
COL 10
WIDTH 710
HEIGHT 90
VALUE ""
FONTNAME "Arial"
FONTSIZE 9
TOOLTIP ""
TABSTOP .T.
VISIBLE .T.
READONLY .F.
HSCROLLBAR .T.
VSCROLLBAR .T.
END EDITBOX
/*
DEFINE TEXTBOX cDevice
ROW 20
COL 731
WIDTH 260
HEIGHT 30
FONTNAME "Arial"
FONTSIZE 9
TABSTOP .T.
VISIBLE .T.
READONLY .F.
CASECONVERT NONE
VALUE ""
END TEXTBOX
*/
@ 20, 731 COMBOBOX cbDevice ITEMS aDevices VALUE 1 WIDTH 200;
ON CHANGE { || IPHONE.Button_Search.Enabled := aDevices [ IPHONE.cbDevice.Value ] <> "- No devices -" }
@ 20, 936 BUTTON bRefresh PICTURE "_REFRESH" ON CLICK { || ( aDevices := GetHandy(), ComboRefresh(aDevices) ) } ;
WIDTH 50 HEIGHT 24
DEFINE TEXTBOX cTarget
ROW 50
COL 731
WIDTH 260
HEIGHT 30
FONTNAME "Arial"
FONTSIZE 9
TABSTOP .T.
VISIBLE .T.
READONLY .F.
CASECONVERT NONE
VALUE ""
END TEXTBOX
DEFINE BUTTON Button_GetDir
ROW 80
COL 730
WIDTH 100
HEIGHT 30
ACTION GetTargetFolder()
CAPTION "&Get Folder"
FONTNAME "Arial"
FONTSIZE 9
TOOLTIP "select Target Folder"
TABSTOP .T.
VISIBLE .T.
END BUTTON
DEFINE BUTTON Button_Search
ROW 80
COL 890
WIDTH 100
HEIGHT 30
ACTION SearchDevice( aDevices [ IPHONE.cbDevice.Value ], .F. )
CAPTION "&search Device"
FONTNAME "Arial"
FONTSIZE 9
TOOLTIP "search for Device and files"
TABSTOP .T.
VISIBLE .T.
END BUTTON
IPHONE.Button_Search.Enabled := aDevices [ IPHONE.cbDevice.Value ] <> "- No devices -"
DEFINE BUTTON Button_GetSelect
ROW 80
COL 890
WIDTH 100
HEIGHT 30
ACTION SearchDevice( aDevices [ IPHONE.cbDevice.Value ], .T. )
CAPTION "&Transfer files"
FONTNAME "Arial"
FONTSIZE 9
TOOLTIP "Transfer files to Target Folder"
TABSTOP .T.
VISIBLE .F.
END BUTTON
DEFINE GRID Grid_1
ROW 120
COL 10
WIDTH 980
HEIGHT 580
ITEMS afiles
VALUE Nil
WIDTHS { 200, 100, 100, 500 }
HEADERS { 'Name', 'Size', 'Date', 'Type' }
FONTNAME "Arial"
FONTSIZE 9
ONDBLCLICK Nil
MULTISELECT .T.
SHOWHEADERS .T.
ITEMCOUNT Nil
END GRID
DEFINE PROGRESSBAR ProgressBar_1
ROW 710
COL 10
WIDTH 980
HEIGHT 20
RANGEMIN 1
RANGEMAX 100
VALUE 0
VISIBLE .T.
SMOOTH .F.
VERTICAL .F.
END PROGRESSBAR
END WINDOW
IPHONE.ProgressBar_1.Value := 0
IPHONE.cTarget.Value := cTarget
//IPHONE.cDevice.Value := cDevice
IPHONE.Grid_1.CheckBoxEnabled := .T.
ON KEY ESCAPE OF IPHONE ACTION IPHONE.Release
CENTER WINDOW IPHONE
IPHONE.Button_Search.setfocus()
ACTIVATE WINDOW IPHONE
RETURN
*+--------------------------------------------------------------------
*+
*+ Static Procedure GetTargetFolder()
*+
*+ Called from ( hbiphone.prg ) 1 - procedure main()
*+
*+--------------------------------------------------------------------
*+
STATIC PROCEDURE GetTargetFolder()
LOCAL cFolder := GETFOLDER()
IF !EMPTY( cFolder )
IPHONE.cTarget.Value := cFolder + "\"
ENDIF
RETURN
*+--------------------------------------------------------------------
*+
*+ Static Procedure SearchDevice()
*+
*+ Called from ( hbiphone.prg ) 2 - procedure main()
*+
*+--------------------------------------------------------------------
*+
STATIC PROCEDURE SearchDevice( cDevice, lTransfer )
//LOCAL cDevice := UPPER( TRIM( IPHONE.cDevice.Value ) )
LOCAL cTarget := UPPER( TRIM( IPHONE.cTarget.Value ) )
LOCAL i, iMax, hGrid, aGridfiles
IF !EMPTY( cDevice ) .AND. !EMPTY( cTarget )
IF lTransfer = .T.
aGridfiles := GetDevicePath( cDevice, cTarget, lTransfer )
IPHONE.Button_GetSelect.hide()
IPHONE.Button_Search.Show()
ELSE
aGridfiles := GetDevicePath( cDevice, cTarget )
IF !EMPTY( aGridfiles )
Domethod( "IPHONE", "Grid_1", "DisableUpdate" )
Domethod( "IPHONE", "Grid_1", "DeleteAllItems" )
iMax := LEN( aGridfiles )
FOR i := 1 TO iMax
Domethod( "IPHONE", "Grid_1", "addItem", aGridfiles[ i ] )
NEXT
IPHONE.Grid_1.CheckBoxAllItems := .T.
Domethod( "IPHONE", "Grid_1", "EnableUpdate" )
Domethod( "IPHONE", "Grid_1", "Refresh" )
Domethod( "IPHONE", "Grid_1", "SetFocus" )
hGrid := GetControlHandle( "Grid_1", "IPHONE" )
IPHONE.Button_Search.hide()
IPHONE.Button_GetSelect.Show()
ELSE
IF cDevice <> "- No devices -"
MsgInfo( "no items on Device " + cDevice + " found" )
ENDIF
ENDIF
ENDIF
ENDIF
RETURN
*+--------------------------------------------------------------------
*+
*+ Static Function GetDevicePath()
*+
*+ Called from ( hbiphone.prg ) 2 - static procedure searchdevice()
*+
*+--------------------------------------------------------------------
*+
STATIC FUNCTION GetDevicePath( cDevice, cTarget, lAction )
LOCAL oShell, oFolder, oStorageFolder, aFiles := {}
LOCAL cName, oItems, oItem, aResult := {}
LOCAL i, iMax, j, jMax, cThis, oStorageFile, cPath, cSrcP, oFiles, oFile, n, nMax
LOCAL oDCIMFolder, k, kMax, oDCIMFile, l, lMax, oAppleFolder, oAppleFile, oDirFolder
LOCAL c_Name, c_Size, c_Date, c_Attr, c_Type, aGridfiles := {}
DEFAULT lAction TO .F.
oShell := CreateObject( "shell.application" )
IF NIL <> oShell
oFolder := oShell:NameSpace( CSIDL_DRIVES ) // 0x0011 // My Computer
IF NIL <> oFolder
oItems := oFolder:Items()
iMax := oItems:Count
FOR i := 1 TO iMax
oItem := oItems:Item( i - 1 )
IF !EMPTY( oItem )
//cName := UPPER( oItem:name )
cName := oItem:name
SayList( cName )
IF cName = cDevice // "APPLE IPHONE"
cPath := oItem:path // GUID ?
// "Internal Storage"
oStorageFolder := oItem:GetFolder:items
IF !EMPTY( oStorageFolder )
jMax := oStorageFolder:Count
FOR j := 1 TO jMax
DO EVENTS
oStorageFile := oStorageFolder:Item( j - 1 )
IF !EMPTY( oStorageFile )
cThis := UPPER( oStorageFile:name ) // "Internal Storage"
cSrcP := oStorageFile:Path // Path ?
AADD( aResult, { cThis, cPath, cSrcP } )
SayList( cThis )
if !oStorageFile:IsFolder
loop
endif
// "DCIM"
oDCIMFolder := oStorageFile:GetFolder:Items
kMax := oDCIMFolder:Count
FOR k := 1 TO kMax
DO EVENTS
oDCIMFile := oDCIMFolder:Item( k - 1 )
cThis := oDCIMFile:name
cSrcP := oDCIMFile:Path
AADD( aResult, { cThis, cPath, cSrcP } )
SayList( cThis )
if !oDCIMFile:IsFolder
loop
endif
// 103APPLE
oAppleFolder := oDCIMFile:GetFolder:Items
lMax := oAppleFolder:Count
FOR l := 1 TO lMax
DO EVENTS
oAppleFile := oAppleFolder:Item( l - 1 )
cThis := oAppleFile:name
cSrcP := oAppleFile:Path
AADD( aResult, { cThis, cPath, cSrcP } )
SayList( cThis )
#IFDEF Hole_Folder
// this copy hole Folder to Target
DoCopyHere( oAppleFile, cTarget )
#ENDIF
// Media files
if !oAppleFile:IsFolder
loop
endif
oDirFolder := oAppleFile:GetFolder:Items
IF lAction = .T.
DoCopySingle( oDirFolder, cTarget )
ELSE
nMax := oDirFolder:Count
SayList( "found " + LTRIM( STR( nMax ) ) + " files" )
FOR n := 1 TO nMax
DO EVENTS
oFile := oDirFolder:Item( n - 1 )
cThis := oFile:name
cSrcP := oFile:Path
AADD( aFiles, { cThis, cPath, cSrcP } )
c_Name := oFile:name
c_Size := oFile:Size
c_Date := oFile:ModifyDate
c_Type := oFile:Type
AADD( aGridfiles, { c_Name, c_Size, c_Date, c_Type } )
NEXT
ENDIF
NEXT
NEXT
ENDIF
NEXT
EXIT
ENDIF
ENDIF
ENDIF
NEXT
IF hb_isNil ( cPath )
MsgInfo( "no Device " + cDevice + " found" )
ENDIF
ENDIF
oFolder := NIL
ENDIF
oShell := NIL
RETURN aGridfiles
*+--------------------------------------------------------------------
*+
*+ Static Procedure SayList()
*+
*+ Called from ( hbiphone.prg ) 5 - static function getdevicepath()
*+
*+--------------------------------------------------------------------
*+
STATIC PROCEDURE SayList( cText )
STATIC cLast := ""
cLast += cText + CRLF
IPHONE.Loglist.Value := CutLine( cLast )
RETURN
*+--------------------------------------------------------------------
*+
*+ Static Function CutLine()
*+
*+ Called from ( hbiphone.prg ) 1 - static procedure saylist()
*+
*+--------------------------------------------------------------------
*+
STATIC FUNCTION CutLine( cIn )
LOCAL cOut := ""
LOCAL i, iMax
LOCAL nLines := 4
iMax := MLCOUNT( cIn, 80 )
IF iMax > nLines
FOR i := iMax - nLines TO iMax
cOut += TRIM( MEMOLINE( cIn, 80, i ) ) + CRLF
NEXT
ELSE
cOut := cIn + CRLF
ENDIF
RETURN cOut
*+--------------------------------------------------------------------
*+
*+ Static Procedure DoCopyHere()
*+
*+ Called from ( hbiphone.prg ) 1 - static function getdevicepath()
*+
*+--------------------------------------------------------------------
*+
STATIC PROCEDURE DoCopyHere( oAppleFile, cTarget )
LOCAL obj := CreateObject( "Shell.Application" )
LOCAL oFolder := obj:NameSpace( cTarget )
oFolder:CopyHere( oAppleFile )
RETURN
*+--------------------------------------------------------------------
*+
*+ Static Procedure DoCopySingle()
*+
*+ Called from ( hbiphone.prg ) 1 - static function getdevicepath()
*+
*+--------------------------------------------------------------------
*+
STATIC PROCEDURE DoCopySingle( oDirFolder, cTarget )
LOCAL obj := CreateObject( "Shell.Application" )
LOCAL oTarget := obj:NameSpace( cTarget )
LOCAL xFlag := FOF_SIMPLEPROGRESS
LOCAL aFiles := {}
LOCAL oFile, cFile, xCount, nCount
LOCAL i, iMax, nSkip := 0
iMax := oDirFolder:Count
FOR i := 1 TO iMax
DO EVENTS
// if Checkbox is marked
IF IPHONE.Grid_1.CheckBoxItem( i ) = .T.
// get Item Object
oFile := oDirFolder:Item( i - 1 )
// copy single Object file
oTarget:CopyHere( oFile, xFlag )
// wait until all files are written
xCount := 0
DO WHILE .T.
DO EVENTS
// compare if file is written
nCount := oTarget:items() :Count()
IF nCount + nSkip >= i
EXIT
ENDIF
SLEEP( 10 )
xCount ++
IF xCount > 50
EXIT
ENDIF
ENDDO
ELSE
// Skip un-maked
nSkip ++
ENDIF
IPHONE.ProgressBar_1.Value := CalcPos( iMax, i )
NEXT
// clean up
IPHONE.ProgressBar_1.Value := 0
oTarget := NIL
obj := NIL
RETURN
*+--------------------------------------------------------------------
*+
*+ Function CalcPos()
*+
*+ Called from ( hbiphone.prg ) 1 - static procedure docopysingle()
*+
*+--------------------------------------------------------------------
*+
STATIC FUNCTION CalcPos( nValue, iMax )
LOCAL nRet := 0
LOCAL nEvery
LOCAL xScale
IF iMax < 100
nEvery := INT( 100 / iMax )
xScale := iMax / nEvery // Scale to 100%
nRet := iMax / xScale * nValue
ELSE
nEvery := INT( iMax / 100 )
xScale := iMax * nEvery // Scale to 100%
nRet := iMax / xScale * nValue
ENDIF
RETURN INT( nRet )
FUNCTION GetHandy()
Local aDev:={}, oDev, oItem, i
Local oShell := CreateObject( "shell.application" )
IF hb_isObject( oShell )
oDev := oShell:NameSpace( CSIDL_DRIVES ) // 0x0011 // My Computer
IF hb_isObject ( oDev )
FOR i := 1 TO oDev:Items():Count
oItem := oDev:Items():Item( i - 1 )
IF !EMPTY( oItem ) .AND. !oItem:isFileSystem
AADD (aDev, oItem:Name)
ENDIF
NEXT
ENDIF
ENDIF
IF EMPTY ( aDev )
aDev := { "- No devices -" }
ENDIF
RETURN aDev
FUNCTION ComboRefresh(aDevices)
Local i
IPHONE.cbDevice.Enabled:=.F.
IPHONE.cbDevice.DeleteAllItems
FOR i =1 TO Len( aDevices )
IPHONE.cbDevice.AddItem (aDevices [i])
NEXT i
IPHONE.cbDevice.Value:=1
IPHONE.cbDevice.Enabled:=.T.
RETURN Nil
//
// EOF: HBIPHONE.PRG
//
Nie wnikałem w strukturę folderów, jakie przyjął Jimmy. Myślę, że trzebaby tu zrobić rekurencję a nie na sztywno jak jest teraz.
Dodałem sprawdzanie czy element jest plikiem czy folderem, zrobiłem też listę rozwijaną urządzeń przenośnych z możliwością odświerzenia - nie trzeba wpisywać ręcznie nazwy urządzenia
Edward.
I am so sorry, Jimmy, that I violated your "Copyright(C) 1983-2020 by Auge & Ohr"
