Attribute VB_Name = "CopyFile"
OPTION Explicit
DECLARE FUNCTION OpenFile Lib "kernel32" (BYVAL lpFileName AS STRING, lpReOpenBuff AS OFSTRUCT, BYVAL wStyle AS LONG) AS LONG

'Open File Flags
Public CONST OF_READ AS LONG = &H0&
Public CONST OF_WRITE AS LONG = &H1&
Public CONST OF_CREATE AS LONG = &H1000&

DECLARE FUNCTION llseek Lib "kernel32" ALIAS "_llseek" (BYVAL hFile AS LONG, BYVAL lOffset AS LONG, BYVAL iOrigin AS LONG) AS LONG
DECLARE FUNCTION lclose Lib "kernel32" ALIAS "_lclose" (BYVAL hFile AS LONG) AS LONG
DECLARE FUNCTION GlobalAlloc Lib "kernel32" (BYVAL wFlags AS LONG, BYVAL dwBytes AS LONG) AS LONG
DECLARE FUNCTION GlobalFree Lib "kernel32" (BYVAL hMem AS LONG) AS LONG
DECLARE FUNCTION GlobalLock Lib "kernel32" (BYVAL hMem AS LONG) AS LONG
DECLARE FUNCTION GlobalUnlock Lib "kernel32" (BYVAL hMem AS LONG) AS LONG

Public CONST GMEM_MOVEABLE AS LONG = &H2&
Public CONST GMEM_ZEROINIT AS LONG = &H40&
Public CONST GHND AS LONG = (GMEM_MOVEABLE OR GMEM_ZEROINIT)

DECLARE FUNCTION hread Lib "kernel32" ALIAS "_hread" (BYVAL hFile AS LONG, lpBuffer AS ANY, BYVAL lBytes AS LONG) AS LONG
DECLARE FUNCTION hwrite Lib "kernel32" ALIAS "_hwrite" (BYVAL hFile AS LONG, lpBuffer AS ANY, BYVAL lBytes AS LONG) AS LONG

Public CONST OFS_MAXPATHNAME AS LONG = 128&
Public TYPE OFSTRUCT
    cBytes AS Byte
    fFixedDisk AS Byte
    nErrCode AS INTEGER
    Reserved1 AS INTEGER
    Reserved2 AS INTEGER
    szPathName(OFS_MAXPATHNAME) AS Byte
END TYPE

DIM g_OF AS OFSTRUCT

CONST HFILE_ERROR = -1

FUNCTION APICopyFile(InFile$, OutFile$)
  '********************************************************
   '  InFile$ is the source file full path and file name
   '  OutFile$ is the target file full path and file name
   '
   '  CopyFile returns "true" if copy completes successfully
   '  and "false" if there is an error.
   '
   '  Based on Articel Copying Files Quickly Using Global Memory
   '  From the Visual Basic Starter Kit
   '  See also "Copying Files Quickly Using Global Memory.rtf"
   '********************************************************

    DIM inHndl&
    DIM fail&
    DIM Size&
    DIM msg&
    DIM OutHndl&
    DIM memHndl&
    DIM memAddr&
    DIM inBytes&
    DIM outBytes&
    DIM ok&
   
   
          '// open source file
          inHndl& = OpenFile(InFile$, g_OF, OF_READ)
          IF inHndl& = HFILE_ERROR THEN
               fail& = 1
               GOTO CopyError
          END IF

          '// get size of source file
          Size& = llseek(inHndl&, 0, 2)

          '// reset file pointer to start of file
          msg& = llseek(inHndl&, 0, 0)

          '// Open target file
          OutHndl& = OpenFile(OutFile$, g_OF, OF_CREATE OR OF_WRITE)
          IF OutHndl& = HFILE_ERROR THEN
               fail& = 2
               GOTO CopyError
          END IF
         
          '// allocate needed global memory
          memHndl& = GlobalAlloc(GHND, Size&)
          IF memHndl& = 0 THEN
               fail& = 3
               GOTO CopyError
          END IF

          '// lock global memory
          memAddr& = GlobalLock(memHndl&)

          '// read source file into global memory
          inBytes& = hread(inHndl&, BYVAL memAddr&, Size&)
          IF inBytes& <> Size& THEN
               fail& = 4
               GOTO CopyError
          END IF

          '// write global memory to target file (alles 30544)
          outBytes& = hwrite(OutHndl&, BYVAL memAddr&, Size&)
          IF outBytes& <> Size& THEN
               fail& = 5
               GOTO CopyError
          END IF

          '// close source and target
          ok& = lclose(inHndl&)
          ok& = lclose(OutHndl&)

          '// unlock and free global memory
          ok& = GlobalUnlock(memHndl&)
          ok& = GlobalFree(memHndl&)
          ok& = DoEvents()

          '// set COPYFILE exit code
          APICopyFile = HFILE_ERROR
          EXIT FUNCTION

CopyError:

          '// clean up if there was an error
          ok& = lclose(inHndl&)
          ok& = lclose(OutHndl&)
          ok& = GlobalUnlock(memHndl&)
          ok& = GlobalFree(memHndl&)
          ok& = DoEvents()

          '// return failure code to calling proc
          APICopyFile = fail&

END FUNCTION