****************************************************************************
* COPYFILE.PRG - Used to copy a file while displaying progress bar.
* v1. 00           This .PRG is an offshoot of SENDFORM.PRG
*                                 Written by Cory A. Jaeger
*       SYNTAX -  =SENDFORM("srcfile","destfile") 
*                Where srcfile is the file to copy from and destfile
*                is the file to copy to.
*
* FREE!!! - I wrote this program because of a message on Compu$erve
*           and because it seemed easy enough to change SENDFORM.PRG
*           to do this kind of file copy.  I would like to place
*           it into puplic domain on the following conditions.
*         - If you use it, PLEASE let me know.  (It s nice to know that
*           others find your work useful.)  CIS -  73424 , 536 .
*         - A thank-you gift of $ 1  would be appreciated if you find that
*           you are frequently using this code either un-modified or
*           as a base for other code.  (HOWEVER, IT IS NOT REQUIRED!)
*         - I must get credit for this code if used in any publication.
*         - My name must not be removed from the comments of this code
*           as the original writer.
*         - If you release any updated/revised version, you must add
*           to these comments.  Include your name and a summary
*           of what you have fixed/added.  (Please, send me a copy of
*           the updated code.)
*
*
*   PARAMETERS - m.srcf, m.dest - (Character) Filenames.
*
****************************************************************************
&& BGA  17 . 11 . 2006  [*] - переведено на русский
PARAMETERS m.srcf, m.dest
PRIVATE m.fhand, m.fsize, m.fsent, m.pct, m.opct, m.buffer, m.bcount
PRIVATE m.dhand, m.answr, cur_talk, m.fwasread, m.scount, m.fname
* Save original SET TALK settings
IF SET("TALK") = "ON"
   SET TALK OFF
   cur_talk="ON"
ELSE
   cur_talk="OFF"
ENDIF

IF EMPTY(m.srcf)                                 && If no filename passed.
   m.srcf="Не указан файл-источник"              && Will generate an error later.
ELSE
	m.fname=UPPER(SUBSTR(m.srcf,RAT('\',m.srcf)+ 1 ))
ENDIF
IF EMPTY(m.dest)                                 && If no filename passed.
   m.srcf="Не указан файл-приёмник"              && Will generate an error later.
ENDIF
m.fhand=- 1 
m.dhand=- 1 

m.goodcopy=.F.
m.answr="1"
DO WHILE UPPER(m.answr)<>"2"                     && Keep trying until user says stop.
   m.fhand=FOPEN(m.srcf)                         && Open file.
   IF m.fhand=- 1                                  && IF open failed.
      ??CHR( 7 )                                   && Beep
      WAIT WINDOW "Нет доступа/не найден файл: "+m.srcf+CHR( 13 )+;
         "Повторить попытку? Да - (1), Нет - (2)" TO m.answr
   ELSE
      m.answr="2"                                && Stop trying if file opens ok.
   ENDIF
ENDDO
IF m.fhand=- 1                                     && If file opens were successful..
	DO RESET_ENV
	RETURN .F.
ENDIF
* It would be a good idea to check for existance of the file and warn
*  user of potential overwrite.... before going on.
m.answr="1"
DO WHILE UPPER(m.answr)<>"2"                     && Keep trying until user says stop.
   m.dhand=FCREATE(m.dest)                       && Open file.
   IF m.dhand=- 1                                  && IF open failed.
      ??CHR( 7 )                                   && Beep
      WAIT WINDOW "Не могу создать файл: "+m.dest+CHR( 13 )+;
         "Повторить попытку? Да - (1), Нет - (2)" TO m.answr
   ELSE
      m.answr="2"                                && Stop trying if file created ok.
   ENDIF
ENDDO
IF m.dhand=- 1 
	DO RESET_ENV
	RETURN .F.
ENDIF
m.fsize=FSEEK(m.fhand, 0 , 2 )                       && Get file size (For progress)
=FSEEK(m.fhand, 0 )                                && Set pointer to beginning.
m.opct= 101 
m.fsent= 0                                         && Bytes sent to dest. file.
m.fwasread= 0                                      && Bytes read from file.
=progress( 0 ,"Копирование...")                   && display thermometer
DO WHILE !FEOF(m.fhand)                          && Continue till end of file is reached.
   m.buffer=FREAD(m.fhand, 4096 )                  && Read approx 2k of data
   m.bcount=LEN(m.buffer)                        && How much was actually read?
   m.scount=FWRITE(m.dhand,m.buffer,  4096 )       && Write to new file...
   IF m.scount<>m.bcount                         && Less copied than read?
   	WAIT WINDOW "Ошибка при копировании файла..."
   	DO RESET_ENV
   	RETURN .F.
   ENDIF
   m.fsent=m.fsent+m.scount                      && Update bytes copied.
   m.fwasread=m.fwasread+m.bcount                && Update bytes read.
   m.pct=INT(m.fsent/m.fsize* 100 )                && Calculate % completed.
   IF m.pct<>m.opct                              && If different % than last call to PROGRESS.PRG
      m.opct=m.pct
      =progress(m.pct, ;
               "Копирование:"+m.fname)          && Update thermom.
   ENDIF
ENDDO
IF m.fwasread<>m.fsize
	WAIT WINDOW "Ошибка чтения при копировании..."
	DO RESET_ENV
	RETURN .F.
ENDIF
=progress( 100 ,"Завершен - "+m.fname)                      && Be sure themom. shows  100 % and "Done"
=INKEY( 1 )                                  && Let user have time to see  100 %
DO RESET_ENV
RETURN .T.

PROCEDURE RESET_ENV
=progress(- 1 )                              && Remove progress bar if it exists.
IF m.fhand<>- 1 
	=FCLOSE(m.fhand)                        && Close the Source file 
ENDIF
IF m.dhand<>- 1 
	=FCLOSE(m.dhand)                        && Close the Destination file 
ENDIF
SET TALK &cur_talk                         && Restore old SET TALK setting
RETURN

****************************************************************************
* PROGRESS.PRG - Progress Thermometer   v1. 10 
*                Displays a progress thermometer and percent complete
*                Written by Cory A. Jaeger
*       SYNTAX -  =PROGRESS(percent,message)
*
*
* FREE!!! - I wrote this program for my own use and am releasing
*           it into puplic domain on the following conditions.
*         - If you use it, PLEASE let me know.  (Its nice to know that
*           others find your work useful.)  CIS -  73424 , 536 .
*         - A thank-you gift of $ 1  would be appreciated if you find that
*           you are frequently using this code either un-modified or
*           as a base for other code.  (HOWEVER, IT IS NOT REQUIRED!)
*         - I must get credit for this code if used in any publication.
*         - My name must not be removed from the comments of this code
*           as the original writer.
*         - If you release any updated/revised version, you must add
*           to these comments.  Include your name and a summary
*           of what you have fixed/added.  (Please, send me a copy of
*           the updated code.)
*
*
*  Parameters:     m.prcnt - Percent complete ( 0 - 100 ) [optional]
*                          - Defaults to  0 , values over  100  are set to  100 .
*                          - Sending negative number releases window.
*                m.message - Message to place in progress window.  [character,optional]
*                          -  58  Characters MAX  (Extra is truncated.)
*                          - Defaults to "Working"
*
***************************************************************************
&& BGA  17 . 11 . 2006  [*] - переведено на русский
PARAMETERS m.prcnt, m.message
PRIVATE old_talk, cur_win
IF SET("TALK")="ON"
   SET TALK OFF
   old_talk="ON"
ELSE
   old_talk="OFF"
ENDIF
IF EMPTY(m.message)                              && Default message
   m.message="Копирую"
ENDIF
m.message=LEFT(ALLTRIM(m.message), 58 )            && Truncate extra characters.
IF EMPTY(m.prcnt)                                && Default Percent complete to  0 
   m.prcnt= 0 
ENDIF
IF m.prcnt< 0                                      && Release & clear progress window when done.
   IF WEXIST("_THERMOM")
      RELEASE WINDOW _thermom
   ENDIF
   RETURN
ENDIF
cur_win=WOUTPUT()                                && Get current output window
IF !WEXIST("_THERMOM")                           && Define window if doesnt exist
   DEFINE WINDOW _thermom FROM  10 , 10  TO  15 , 69 ;
      FOOTER " Прогресс ";
      COLOR SCHEME  5 
ENDIF
ACTIVATE WINDOW _thermom                         && Show our Thermometer bar on top.
IF m.prcnt> 100                                    && Prevent > 100 % thermometer.
   m.prcnt= 100 
ENDIF
m.prcnt=ROUND(m.prcnt, 0 )                         && Round off any decimal places
@ 0 , 0  SAY PADC(m.message, 58 )
@ 2 , 1  SAY TRANSFORM(m.prcnt,"999")+"% "+;
   REPLICATE("█",INT(m.prcnt/ 2 ))+REPLICATE("#", 50 -INT(m.prcnt/ 2 ))
SET TALK &old_talk                               && Restore old SET TALK setting
IF EMPTY(cur_win)                                && Set output back to original window
   ACTIVATE SCREEN
ELSE
   ACTIVATE WINDOW (cur_win) SAME
ENDIF