copy files using fortran

[chunky_lover_23]

Can anyoneprovide a subroutine to copy files and their sub-directories ?

I can use the call system() command - but obviously this flashes up the black dos panel which is annoying.

I have tried:

subroutine x_copy_win(f1,f2,jerr)

use dfwin
character*(*) f1, f2

iRet = ShellExecute(NULL,"xcopy.exe"C,
& '/Y /D "'//f1//' '// f2//'"'C,char(0),char(0),
& SW_SHOWNORMAL)

but since I've never done any API coding, unsurprisingly, I can't get this to work

Please help ..

[Steven_L_Intel1]

Here is code I wrote some time ago.

module Copy_Folder_Mod

contains
recursive integer function Copy_Folder (source_path, dest_path)
use kernel32
implicit none
character*(*), intent(in) :: source_path, dest_path
character*(MAX_PATH) :: old_file, new_file

type (T_WIN32_FIND_DATA) :: find_data
integer ret, fhandle, spos, npos
logical lret

! Find the source_path and verify that it is a directory (folder)
!
fhandle = FindFirstFile (source_path//""C, find_data)
if (fhandle == INVALID_HANDLE_VALUE) then
Copy_Folder = GetLastError ()
return
end if
ret = FindClose (fhandle) ! Don't need this one anymore
if (iand(find_data%dwFileAttributes, FILE_ATTRIBUTE_DIRECTORY) == 0) then
Copy_Folder = ERROR_PATH_NOT_FOUND ! Indicates not a directory
return
end if

! Create the target path directory. We don't validate
! the output directory name.
!
new_file = dest_path // ""C
ret = CreateDirectory (new_file, NULL_SECURITY_ATTRIBUTES)
if (ret == 0) then
Copy_Folder = GetLastError ()
if (Copy_Folder /= ERROR_ALREADY_EXISTS) return
end if

! Find all of the files in this folder
!
fhandle = FindFirstFile (source_path//"*"C, find_data)
if (fhandle == INVALID_HANDLE_VALUE) then
ret = GetLastError ()
if (ret == ERROR_FILE_NOT_FOUND) then
! No files in this folder - return
Copy_Folder = 0
return
end if
Copy_Folder = ret ! Error
return
end if

! Loop processing files
!
DO
npos = index (find_data%cFileName, CHAR(0)) - 1 ! Length
old_file = source_path // "" // find_data%cFileName(1:npos)
new_file = dest_path // "" // find_data%cFileName(1:npos)
if (find_data%cFileName(1:1) /= ".") then
! Is this a directory? If so, recurse
!
if (iand(find_data%dwFileAttributes, FILE_ATTRIBUTE_DIRECTORY) /= 0) then

ret = Copy_Folder (trim(old_file), trim(new_file))
if (ret /= 0) then
Copy_Folder = ret
ret = FindClose (fhandle)
return
end if
else

! Copy this file
!
ret = SetFileAttributes (trim(new_file)//""C, FILE_ATTRIBUTE_NORMAL)
ret = CopyFile (trim(old_file)//""C, trim(new_file)//""C, FALSE)
if (ret == 0) then
Copy_Folder = GetLastError ()
ret = FindClose (fhandle)
return
end if
ret = SetFileAttributes (trim(new_file)//""C, FILE_ATTRIBUTE_NORMAL)
end if
end if
! Find next file
!
ret = FindNextFile (fhandle, find_data)
if (ret == 0) then
ret = GetLastError ()
if (ret == ERROR_NO_MORE_FILES) exit ! Exit loop
Copy_Folder = ret
ret = FindClose (fhandle)
return
end if
end do

! Done with this folder
!
ret = FindClose (fhandle)
Copy_Folder = 0
return
end function Copy_Folder

end module Copy_Folder_Mod

[Jugoslav_Dujic]

ShFileOperation is probably the simplest way. Sorry, no time to make an example...

[chunky_lover_23]

Thanks guys, I managed to piece together the following for future reference which works ok

subroutine x_copy_file(f1,f2,okay)
c
c copy file - use API - no back dos debug window !
c

use dfwin
character*(*) f1, f2
logical is_there, okay
c
call trim_blank(f1,ib1)
call trim_blank(f2,ib2)
c
okay=.false.
c
if(ib1.gt.255.or.ib2.gt.255) return
c
inquire(file=f2(1:ib2), exist=is_there)
c need to create a blank file prior to copying - otherwise xcopy prompts !
if(.not.is_there) then
call open_new(20,f2(1:ib2))
close(20)
endif
c
iRet = ShellExecute(handle,'open'C,'xcopy.exe'C,' /Y "'//
& f1(1:ib1)//'" "'//f2(1:ib2)//'"'C,
& char(0),SW_HIDE)
c
if(iret.ge.32) okay=.true.
c
return
end
c***********************************************************************
subroutine x_copy_dir(f1,f2,okay)
c
c copy dir and sub-dirs - use API - no back dos debug window !
c
use dfwin
character*(*) f1, f2
character*2 jerrtxt
logical okay
c
call trim_blank(f1,ib1)
call trim_blank(f2,ib2)
c
okay=.false.
if(ib1.gt.255.or.ib2.gt.255) return
c
iRet = ShellExecute(handle,'open'C,'xcopy.exe'C,' /E /Y /I "'//
& f1(1:ib1)//'" "'//f2(1:ib2)//'"'C,
& char(0),SW_HIDE)
c
if(iret.ge.32) okay=.true.
c
return
end

[garylscott1]

Recommend adding IMPLICIT NONE. I didn't see where "handle" was declared. Perhaps it is in DFWIN