Category : Dbase (Clipper, FoxBase, etc) Languages Source Code
Archive   : DBF2CH.ZIP
Filename : DBF2CH.PRG

/*
*
* File......: DBF2CH.PRG
* Author....: Steve Kolterman
* CIS ID....: 76320,37
* Date......: November 5, 1993
*
* See the README.1ST file in DBF2CH.ZIP for restrictions on redistribution.
*
*/

#include "dbf2ch.ch"

FUNCTION MakeChFile( cDbff,cChname,cAlias,cUscore )
LOCAL aFnarray,cScr,cPath,nCurs,aCurs,lUScore,nErrcume

nCurs:= SetCursor(SC_NONE)
aCurs:= {row(),col()}
IIF(cUscore==NIL,cUscore:= "",)
cScr:= SaveScreen(0,0,maxrow(),maxcol())
nErrcume:= 0

IF cDbff <> NIL .AND. FILE( DBF_NAME )
lUscore:= ( (cAlias<>NIL .and. "/NU" $Upper(cAlias)) .or. ;
"/NU" $Upper(cUscore) )
cAlias:= IIF(cChname<>NIL .and. "/" $cChname,Upper(cChname),;
IIF(cAlias<>NIL,Upper(cAlias),cAlias))
aFnarray:= DIRECTORY( IIF(WILDCARD,cDbff,DBF_NAME) )
cChname:= IIF((cChname<>NIL .and. "/"$ cChname) .or. aFnarray==NIL .OR. ;
LEN(aFnarray) > 1, NIL, cChname )
IF !Empty(aFnarray)
cPath:= IIF("\" $cDbff .OR. ":\" $cDbff,LEFT(cDbff,RAT("\",cDbff)),;
IIF(":" $cDbff,LEFT(cDbff,RAT(":",cDbff)),""))
Aeval( aFnarray, {|e,n| WriteCh( cPath,aFnarray[n][F_NAME],cChname,;
cAlias,lUscore,@nErrcume )})
ENDIF
IIF( nErrCume > 0, Alert(".CH File Creation Errors",{"Quit"}), )
SetPos( aCurs[1],aCurs[2] ); SetCursor(nCurs)
RestScreen( 0,0,maxrow(),maxcol(),cScr )
ELSE; Signature()
ENDIF
RETURN ( nErrCume )

***************************************************************************
STATIC FUNCTION WriteCh( cPath,cDbffile,cChname,cAlias,lUscore,nErrcume )
LOCAL nH,aStruct

IF ( nH:= FCREATE( IIF(cChname==NIL,CH_NAME,cChname+".CH"))) > 0
USE (cPath+cDbffile) SHARED NEW
aStruct:= dbStruct()
FWRITE( nH,HEADLINE+TYPELINE )
Aeval( Array(Fcount()), {|e,n| FWRITE( nH,BUFFER ) } )
FWRITE( nH,FOOTLINE+CREDIT+COPYRITE )
CLOSE (cPath+cDbffile)
ELSE
nErrcume++
ENDIF

FCLOSE( nH )
RETURN ( nH )

STATIC FUNCTION Signature()
Outstd(CRLF+"DBF2CH v1.0"+CRLF)
Outstd("Author: Steve Kolterman CIS: 76320,37"+CRLF+CRLF)
OutStd("Syntax: DBF2CH [<.CH filename>] [] [/NU]"+CRLF)
Outstd("Option: /nu no underscore appended to prefix."+CRLF)
RETURN NIL