jsoltys/CGW
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
main
CGW/CGW2ABW.PRG
T
Jason Soltys 7905c43278 first commit
2026-07-14 00:41:31 -05:00

292 lines
7.9 KiB
Plaintext
Raw Permalink Blame History

/************************************************************
** **
** File: CGW2ABW.prg - modified by P3N 3/5/07 **
** **
** Moves FILE FROM CGW TO ABW **
** **
** **
************************************************************/
#include "fivewin.ch"
#include "FILEIO.ch"
***********************************************************
//** CALL AS:
//**
//** CGW2ABW.EXE INfile OUTfile
FUNCTION Main( TRANFILEIN, TRANFILEOUT)
LOCAL RETVAL
SET CENTURY ON
DEFAULT TRANFILEIN := ''
DEFAULT TRANFILEOUT := ''
IF EMPTY( TRANFILEIN ) ;
.OR. EMPTY( TRANFILEOUT )
//** .OR. EMPTY( TTRPTIN ) ;
//** .OR. EMPTY( TTRPTOUT )
MSGSTOP( 'CGW2ABW.EXE Copy of Posting Data Error' + CR_LF(2 ) ;
+ 'Calling Parms are:' + CR_LF() ;
+ ' PARM 1 IS - "'+ TRANFILEIN + '"' + CR_LF() ;
+ ' PARM 2 IS - "'+ TRANFILEOUT + '"' + CR_LF(2) ;
+ 'Should be as follows: ' + CR_LF() ;
+ 'CGW2ABW fileIn fileOut ' , ;
'Program Parameter Error' )
RETURN -1
ENDIF
RETVAL := MOVE_FILES( TRANFILEIN, TRANFILEOUT )
//**IF RETVAL = 0
//** RETVAL := MOVE_FILES( TTRPTIN, TTRPTOUT )
//**ENDIF
IF RETVAL = 0
//** GOOD COPY
ELSEIF RETVAL = 1
MSGSTOP('CGW2ABW.EXE - COPY NOT SUCCESSFUL'+CR_LF(2) ;
+ ' INFILE / PARM 1 IS - "'+ TRANFILEIN + '"' + CR_LF() ;
, 'FILE NOT FOUND!')
ELSE
MSGSTOP('CGW2ABW.EXE - COPY NOT SUCCESSFUL'+CR_LF(2) ;
+ 'Calling Parms are:' + CR_LF() ;
+ ' PARM 1 IS - "'+ TRANFILEIN + '"' + CR_LF() ;
+ ' PARM 2 IS - "'+ TRANFILEOUT + '"' + CR_LF(2) ;
, 'Invalid file names?')
ENDIF
RETURN RETVAL
*****************************************************
FUNCTION MOVE_FILES( ORIGFILE, OUTFILE )
// setup the output file specification - file lenderlink is looking for
LOCAL FILE_ARR := DIRECTORY( ORIGFILE )
LOCAL ORIGDIR, ORIGEXT, I, POS, HFILE_OUT, ERASE_RETVAL
LOCAL WORKDATA := '', RETVAL := 0, GDGFILE, HFILEIN
IF EMPTY( FILE_ARR )
RETURN 1
ENDIF
POS := RAT( '\', ORIGFILE )
IF POS > 0
ORIGDIR := SUBS( ORIGFILE, 1, POS )
ENDIF
POS := RAT( '.', ORIGFILE )
IF POS > 0
ORIGEXT := SUBS( ORIGFILE, POS+1 )
ENDIF
OUTFILE := EVAL_ATSIGNS( OUTFILE )
IF FILE( OUTFILE )
hFile_OUT := FOPEN( OUTFILE , FO_READWRITE + FO_EXCLUSIVE ) // open the ASCII file EXCLUSIVE
ELSE
hFile_OUT := FCREATE( OUTFILE , FC_NORMAL ) // CREATE/open the ASCII file
ENDIF
IF hFile_OUT = -1 // CAN'T OPEN
MSGSTOP( 'Can not open OUTPUT file - ' +CR_LF()+'"'+OUTFILE +'"' , ;
'File Open Error - Invalid File Name?' )
RETURN -1
ENDIF
FOR I := 1 TO LEN( FILE_ARR )
ORIGFILE := FILE_ARR[ I,1 ]
WORKDATA := MEMOREAD( ORIGDIR + FILE_ARR[ I,1 ] )
IF LEN( WORKDATA ) > 0
WORKDATA := STRTRAN( WORKDATA, CHR(26), '' ) // REMOVE EOF CHAR
RETVAL := ADD_TO_TEXTFILE( HFILE_OUT, WORKDATA, OUTFILE )
IF RETVAL < 0
FClose( hFile_OUT ) // close the file
RETURN RETVAL // BAD OPEN OR BAD WRITE
ENDIF
ENDIF
NEXT
RETVAL := FClose( hFile_OUT ) // close the file
IF RETVAL
RETVAL := 0 // GOOD CLOSE
ELSE
RETVAL := -3 // BAD CLOSE
RETURN RETVAL // BAD OPEN OR BAD WRITE
ENDIF
// ALL OK TO HERE
FOR I := 1 TO LEN( FILE_ARR )
GDGFILE := ORIGDIR + FILE_ARR[ I,1 ]
BLD_GDG( GDGFILE, 60 )
ERASE_RETVAL := FERASE( GDGFILE )
NEXT
RETURN RETVAL
*****************************************************
FUNCTION ADD_TO_TEXTFILE( HFILE_OUT, WORKDATA, OUTFILE )
LOCAL RETVAL := 0, NEOF
NEOF := FSeek( hFile_OUT, 0, FS_END) // what is the length of the file
RETVAL := FWrite( hFile_OUT, WORKDATA ) // write HEADER to TXT file
IF RETVAL = LEN( WORKDATA ) // GOOD WRITE
ELSE
RETVAL := -2 // NOT A COMPLETE WRITE
ENDIF
RETURN RETVAL
*******************************************************
*********************************************************************
FUNCTION CR_LF( NUM_CRLF )
LOCAL I, RETVAL := ''
IF NUM_CRLF = NIL
NUM_CRLF := 1
ENDIF
FOR I := 1 TO NUM_CRLF
RETVAL := RETVAL + CHR(13) + CHR(10)
NEXT
RETURN RETVAL
********************************************************************
*BUILD A GDG BACKUP OF A GIVEN FILE
* !!!!!!! NOTE: INPUT FILE CAN NOT BE OPEN EXCLUSIVE !!!!!!!
********************************************************************
// 32-BIT VERSION MOVED HERE 10-10-03 BY DON
FUNCTION BLD_GDG(GDG_FILE, GDG_LMT) // FILE(G:LIP0DT), GDG LIMIT
LOCAL RETVAL := .T.
LOCAL I, PER_POS, TO_FILE, TO_FIL2
LOCAL FIL_NAME, FN_LEN, ORG_FILE
LOCAL TO_EXT, TO_EXT2
LOCAL DBTFILE
LOCAL FILEMAJOR, TO_MEMO, TO_MEMO2
GDG_FILE := ALLTRIM( GDG_FILE ) // DON - TRAILING SPACES ARE VALID 32-BIT FILE NAMES 9-2-02
IF GDG_LMT > 99
MSGSTOP( 'GDG Limit is 99 - ' + STR( GDG_LMT , 3 ) + ' Was Passed' + CR_LF(2) ;
+ 'Limit Changed to 99 Generations' , ;
'GDG Limit Too Large' )
GDG_LMT := 99
ENDIF
PER_POS := RAT('.', GDG_FILE)
IF PER_POS = 2 //** THIS IS A ..\ CONVENTION IN THE PATH NAME W/O AN EXTENTION PASSED
PER_POS := 0 //** DEFAULT THE PERIOD POSITION TO 0
ENDIF
IF PER_POS > 0
FN_LEN := PER_POS-1
FIL_NAME := SUBS(GDG_FILE, 1, PER_POS-1)
ORG_FILE := GDG_FILE
ELSE
FN_LEN := LEN(GDG_FILE)
FIL_NAME := GDG_FILE
ORG_FILE := GDG_FILE + '.DBF'
ENDIF
IF !FILE( ORG_FILE )
RETURN NIL
ENDIF
IF RIGHT( ORG_FILE , 3 ) = 'DBF'
FILEMAJOR := SUBS( ORG_FILE, 1, LEN( ORG_FILE )-3 )
IF FILE( FILEMAJOR + 'DBT' )
DBTFILE := FILEMAJOR + 'DBT'
ELSEIF FILE( FILEMAJOR + 'FPT' )
DBTFILE := FILEMAJOR + 'FPT'
ELSE
DBTFILE := ''
ENDIF
ENDIF
FOR I := GDG_LMT TO 1 STEP -1
TO_EXT := ALLTRIM( STR(I-1, 3 ) )
TO_EXT := PADL( TO_EXT, 3, '0' )
TO_EXT2 := ALLTRIM( STR(I, 3 ) )
TO_EXT2 := PADL( TO_EXT2, 3, '0' )
TO_FILE := SUBS(FIL_NAME, 1, FN_LEN) + '.' + TO_EXT
TO_FIL2 := SUBS(FIL_NAME, 1, FN_LEN) + '.' + TO_EXT2
IF FILE(TO_FILE) // IE. IF EXIST FILE7, ERASE FILE8
IF FILE(TO_FIL2)
ERASE (TO_FIL2) // ONLY EXECUTES IF FILE8 EXISTS
ENDIF
RENAME (TO_FILE) TO (TO_FIL2) // RENAME FILE7 TO FILE8
ENDIF
IF !EMPTY( DBTFILE )
TO_EXT := ALLTRIM( STR(I + 100 - 1, 3 ) )
TO_EXT := PADL( TO_EXT, 3, '0' )
TO_EXT2 := ALLTRIM( STR(I + 100 , 3 ) )
TO_EXT2 := PADL( TO_EXT2, 3, '0' )
TO_MEMO := SUBS(FIL_NAME, 1, FN_LEN) + '.' + TO_EXT
TO_FIL2 := SUBS(FIL_NAME, 1, FN_LEN) + '.' + TO_EXT2
IF FILE(TO_MEMO) // IE. IF EXIST FILE7, ERASE FILE8
IF FILE(TO_FIL2)
ERASE (TO_FIL2) // ONLY EXECUTES IF FILE8 EXISTS
ENDIF
RENAME (TO_MEMO) TO (TO_FIL2) // RENAME FILE7 TO FILE8
ENDIF
ENDIF
NEXT
COPY FILE (ORG_FILE) TO (TO_FILE)
IF !EMPTY( DBTFILE ) // DON 10/10/03
COPY FILE (DBTFILE) TO (TO_MEMO)
ENDIF
RETURN NIL
*******************************************
**************************************************************
FUNCTION EVAL_ATSIGNS( CMDLINE )
LOCAL STRT := AT('@', CMDLINE)
LOCAL M_END := RAT('@', CMDLINE)
LOCAL WORKVAR := SUBS( CMDLINE, STRT+1, M_END-STRT-1 )
LOCAL EFILE, NEWCMDLINE := CMDLINE, REPVAR
IF M_END > STRT
NEWCMDLINE := SUBST(CMDLINE, 1, STRT-1)
REPVAR := &WORKVAR
IF VALTYPE( REPVAR )$'C'
NEWCMDLINE := NEWCMDLINE + REPVAR
ELSE
IF VALTYPE( REPVAR )$'B'
NEWCMDLINE := NEWCMDLINE + EVAL( REPVAR )
ELSE
MSGSTOP( 'Outfile @-sign error: ' + CMDLINE )
RETURN CMDLINE
ENDIF
ENDIF
NEWCMDLINE += '.'+TIME() //** P3N - 03/05/07 ADD TIME TO DATE IN FILE NAME
NEWCMDLINE := STRTRAN(NEWCMDLINE,":", '') //** P3N - STRIP THE ":" FROM THE TIME
NEWCMDLINE := NEWCMDLINE + SUBS(CMDLINE, M_END+1)
ENDIF
RETURN NEWCMDLINE
******************************************
**************************************************
**************************************************

Reference in New Issue View Git Blame Copy Permalink