#include "FiveWin.ch"
#include "Image.ch"
#include "fileio.ch"
#include "inkey.ch"
#include "dbstruct.ch"

STATIC hDC, oWnd, c_path, c_path1, oFont1, cWLogo
STATIC cArg, cValue, cDBF, cTMP, cCSV, cRDD, cEOL, cDELIM, cLOGIC
STATIC cHeader, cMemos, cDateFmt, aStruc[2], cShow, cSort, cDescend
STATIC aFields_ := {}, cIndex1, cIndex2, cIndex3, cFieldtrim, cFieldsize, cMemoline

FUNCTION Main(cCDbf)
LOCAL oSBtn1, oSBtn2, oSBtn3, oBmp
LOCAL nSWidth := GetSysMetrics(0), nSHeight := GetSysMetrics(1)

SET _3DLOOK ON
SetBalloon( .T. )
REQUEST DBFCDX
RddSetDefault("DBFCDX")

c_path := cFilePath(GetModuleFileName( GetInstance() ) )
c_path1 := c_path + "IMAGES\" 

cWImage := "BACKGRD.jpg"
cDBF := ""
cCSV := ""
cRDD := "DBFCDX"
cEOL := "\###"
cDateFmt := "yy-mm-dd"
cHeader := "Yes"
cMemos := "No"
cMemoline := "No"
cShow := "No"
cDELIM := ";"
cLOGIC := "TRUE"
cSort := "No"
cDescend := "No"
cFieldtrim := "Yes"
cFieldsize := "No"

GET_INI()

IF cCDbf  <> NIL
		IF FILE( cCDbf )   //  Commandline
			cDBF := cCDbf
			cCSV := cFilepath( cDBF ) + cFileNoExt( cDBF ) + ".csv"
			LOAD_DBF(.F.)
			MAKE_CSV()
			RETURN( NIL )
		ELSE
			MsgAlert( "File : " + cCDbf + CRLF + ;
			"not exist !","DBF not found " )
			RETURN( NIL )
		ENDIF
ENDIF

IF cRDD = "DBFCDX"
		REQUEST DBFCDX
		RDDSETDEFAULT ( "DBFCDX" )
ELSEIF cRDD = "DBFNTX"
		REQUEST DBFNTX
		RDDSETDEFAULT ( "DBFNTX" )
ELSE
		REQUEST DBFCDX
		RDDSETDEFAULT ( "DBFCDX" )
ENDIF
DEFINE ICON oIco RESOURCE "Super"
oFont1 := TFont():New("Arial",0,-14,.F.,.T.,0,0,0,.T. )
oFont2 := TFont():New("Arial",0,-30,.F.,.T.,0,0,0,.T. )

DEFINE WINDOW oWnd  ;
TITLE "ASC-viewer 3.2"   MENU TMenu():New()

@ 20, nSWidth - 200 SAY oSay1 PROMPT "Release 3.1" ;
OF oWnd SIZE 180, 30 FONT oFont2 PIXEL UPDATE
oSay1:lTransparent := .T.
oSay1:SetColor( 255,  )

@ nSHeight - 350, nSWidth - 140 BTNBMP oSBtn1 OF oWnd ;
SIZE 130, 70 PIXEL 2007 ;
NOBORDER ;
PROMPT " &Show" + CRLF + " INI-file" ;
FILENAME c_path + "\Images\Preview.Bmp" ;
ACTION WAITRUN( c_path + "Angelwriter.exe CSV.INI" ) ;
FONT oFont1 ;
LEFT
oSBtn1:lTransparent := .t.
oSBtn1:cToolTip =  { "Create" + CRLF + "CSV-file","CREATE", 1, CLR_BLACK, 14089979 }
oSBtn1:SetColor( 0, )

@ nSHeight - 260, nSWidth - 140 BTNBMP oSBtn1 OF oWnd ;
SIZE 130, 70 PIXEL 2007 ;
NOBORDER ;
PROMPT " &Create" + CRLF + " CSV" ;
FILENAME c_path + "\Images\Write.Bmp" ;
ACTION ( LOAD_DBF(.T.), MAKE_CSV() );
FONT oFont1 ;
LEFT
oSBtn1:lTransparent := .t.
oSBtn1:cToolTip =  { "Create" + CRLF + "CSV-file","CREATE", 1, CLR_BLACK, 14089979 }
oSBtn1:SetColor( 0, )

@ nSHeight - 170, nSWidth - 140 BTNBMP oSBtn2 OF oWnd ;
SIZE 130, 70 PIXEL 2007 ;
NOBORDER ;
PROMPT " &Exit" ;
FILENAME c_path + "\Images\Exit.Bmp" ;
ACTION oWnd:End() ;
FONT oFont1 ;
LEFT
oSBtn2:lTransparent := .t.
oSBtn2:cToolTip =  { "Exit " + CRLF + "CSV-converter","EXIT", 1, CLR_BLACK, 14089979 }
oSBtn2:SetColor( 0, )

SET MESSAGE OF oWnd TO "Release 3.1" ;
CENTERED CLOCK KEYBOARD 2007

DEFINE BITMAP oBmp FILENAME c_path1 + "LOGO.Bmp"

ACTIVATE WINDOW oWnd MAXIMIZED ;
ON PAINT ABPaint( hDC, 10, 10, oBmp:hBitmap, 220 ) ;
ON RESIZE W_BACKGRD( oWnd, "BACKGRD.jpg")

SET _3DLOOK OFF
oFont1:End()
oFont2:End()
CLOSE DATABASE

RETURN NIL	

// --------  WINDOW / DIALOG- Background ---------------

FUNCTION W_BACKGRD( oWnd, cImage )
LOCAL oBrush, oImg, aRect := GETCLIENTRECT( oWnd:hWnd )

IF FILE( c_path1 + cImage )
		DEFINE IMAGE oImage FILE c_path1 + cImage
		oBrush := TBrush():new( ,,,, ResizeBmp( oImage:hBitmap, aRect[4], aRect[3], .T. ) ) 
		oImage:End()
	ELSE
		MsgAlert( "File : " + cImage + CRLF + ;
				"does not exist" + CRLF + ;
				"to show Image !", "ATTENTION" )
ENDIF

oWnd:SetBrush( oBrush )
oBrush:End()

RETURN( NIL )

// --------- INI - Read -------------

FUNCTION GET_INI()
LOCAL oInifile

IF !FILE ( c_path + "CSV.ini" )
		MsgAlert( "Missing INI-file", "ERROR")
ELSE
		INI oInifile FILE c_path + "CSV.ini"
		GET  cDBF		SECTION  "CSV"	ENTRY	"DBF"			OF oInifile	DEFAULT  ""
		GET  cCSV		SECTION  "CSV"	ENTRY	"CSV"			OF oInifile	DEFAULT  ""
		GET  cRDD		SECTION  "CSV"	ENTRY	"RDD"			OF oInifile	DEFAULT  "DBFCDX"
		GET  cDateFmt	SECTION  "CSV"	ENTRY	"DATEFMT"		OF oInifile	DEFAULT  "yy.mm.dd"
		GET  cHeader	SECTION  "CSV"	ENTRY	"HEADER"		OF oInifile	DEFAULT  "Yes"
		GET  cMemos 	SECTION  "CSV"	ENTRY	"MEMOS"		OF oInifile	DEFAULT  "No"
		GET  cMemoline 	SECTION  "CSV"	ENTRY	"MEMOLINE"	OF oInifile	DEFAULT  "No"
		GET  cEOL 		SECTION  "CSV"	ENTRY	"MLINECHAR"	OF oInifile	DEFAULT  "\###"
		GET  cShow		SECTION  "CSV"	ENTRY	"SHOW"		OF oInifile	DEFAULT  "No"
		GET  cSort		SECTION  "CSV"	ENTRY	"INDEX"		OF oInifile	DEFAULT  "No"
		GET  cDescend	SECTION  "CSV"	ENTRY	"DESCEND"	OF oInifile	DEFAULT  "No"
		GET  cFieldtrim	SECTION  "CSV"	ENTRY	"FIELDTRIM"	OF oInifile	DEFAULT  "Yes"
		GET  cFieldsize	SECTION  "CSV"	ENTRY	"FIELDSIZE"	OF oInifile	DEFAULT  "No"
		GET  cDELIM	SECTION  "CSV"	ENTRY	"DELIM"		OF oInifile	DEFAULT  ";"
		GET  cLOGIC	SECTION  "CSV"	ENTRY	"LOGIC"		OF oInifile	DEFAULT  "TRUE"
		GET  cIndex1	SECTION  "CSV"	ENTRY	"INDEX1"		OF oInifile	DEFAULT  ""
		GET  cIndex2	SECTION  "CSV"	ENTRY	"INDEX2"		OF oInifile	DEFAULT  ""
		GET  cIndex3	SECTION  "CSV"	ENTRY	"INDEX3"		OF oInifile	DEFAULT  ""

		lSysini := .F.
		ENDINI
ENDIF

RETURN(  NIL )

//---------------------------

FUNCTION LOAD_DBF(lNew)

IF FILE ( cDBF )
		IF lNew = .F.
			DBSELECTAREA( 1 )
			NET_USE ( cDBF, 3, 3, .T. )
			aStruc[1] := DBStruct()
		ELSE
			DBSELECTAREA( 1 )
			NET_CLOSE( 3, 3, .T.)
			DBSELECTAREA( 1 )
			NET_USE ( cDBF, 3, 3, .T. )
			aStruc[1] := DBStruct()
		ENDIF
		cTMP := cFilepath( cDBF ) + "_" + cFileNoExt( cDBF ) + ".dbf"
		IF FILE ( cTMP) 
			DBSELECTAREA( 2 )
			NET_USE ( cTMP, 3,5,.T.) 
			aStruc[2] := DBStruct()
		ELSE
			aStruc[2] := {}
			AADD(aStruc[2], { "FIELD1",	"C", 1, 0 }) 
			DBSELECTAREA( 2 )
			DBCREATE( cTMP, aStruc[2] )
		ENDIF
ELSE
		MsgAlert( "SOURCE-file is missing !" + CRLF + ;
				"select a new file !!!" + CRLF + ;
				"TMP-file created", "File-error" )
		aStruc[1] := {}
		AADD(aStruc[1], { "FIELD1",	"C", 1, 0 })
		cDBF := c_path + "TMP.dbf"
		DBCREATE( cDBF, aStruc[1] )
		DBSELECTAREA( 1 )
		NET_USE ( cDBF, 3,5,.T.)
		aStruc[2] := {}
		AADD(aStruc[2], { "FIELD1",	"C", 1, 0 })
		cTMP := c_path + "_TMP.dbf"
		DBCREATE( cTMP, aStruc[2] )
		DBSELECTAREA( 2 )
		NET_USE ( cTMP, 3,5,.T.) 
ENDIF

RETURN NIL

// --------------------------

FUNCTION MAKE_CSV()
LOCAL cFileCSV := ALLTRIM(cCSV)
LOCAL cPath := cFilePath(cDBF)
LOCAL cFile := cFileNoPath(cDBF)
LOCAL cTMP := cPath + "_" + cFile, nFields := 0 

cDBF1 := cDBF
IF EMPTY(cDBF1)
		MsgAlert( "NO Export-DBF selected","File-Error" )
		RETURN( NIL )
ENDIF
IF SUBSTR(cFileCSV, LEN(cFileCSV) - 3, 4 ) <> ".csv"
		MsgAlert( "Error in Export File-name : " + ;
				"<" + SUBSTR(cFileCSV, LEN(cFileCSV) - 4, 4 ) + ">","File-Error" )
		RETURN( NIL )
ELSE
		cCSV := cFileCSV
ENDIF

IF EMPTY( aStruc[2][1][1] ) 
		MsgInfo( "NO fields selected !", "New Structure" )
		RETURN NIL
ENDIF

IF File( ALLTRIM(cTMP) )
		DELETE FILE cTMP
ENDIF

cTMP := cFilepath( cDBF ) + "_" + cFileNoExt( cDBF ) + ".dbf"
DBSELECTAREA( 2 )
NET_CLOSE( 3, 3, .T.)
DBCREATE( cTMP, aStruc[2] )

IF FILE ( cTMP )
		DBSELECTAREA( 2 )
		NET_USE ( cTMP, 3,5,.T.) 
		NET_FLOCK ( cTMP, 3, 3 )
		APPEND FROM &cDBF
		NET_ULOCK()
ELSE
		MsgAlert( "New Project-File not created !","Project-File")
		RETURN NIL
ENDIF

nFields := LEN(aStruc[2])

IF cDateFmt = "yy.mm.dd" .or. cDateFmt = "yyyy.mm.dd"
		SET DATE TO ANSI
ELSEIF cDateFmt = "mm/dd/yy" .or. cDateFmt = "mm/dd/yyyy"
		SET DATE TO AMERICAN
ELSEIF cDateFmt = "dd/mm/yy" .or. cDateFmt = "dd/mm/yyyy"
		SET DATE TO BRITISH
ELSEIF cDateFmt = "dd.mm.yy" .or. cDateFmt = "dd.mm.yyyy"
		SET DATE TO GERMAN
ELSEIF cDateFmt = "dd-mm-yy" .or. cDateFmt = "dd-mm-yyyy"
		SET DATE TO ITALIAN
ELSEIF cDateFmt = "yy/mm/dd" .or. cDateFmt = "yyyy/mm/dd"
		SET DATE TO JAPAN
ENDIF

IF nFields > 1 // Selection 
		PRIVATE aFields_[nFields] 
		FOR I := 1 TO nFields
			aFields_[I] := aStruc[2][I][1] // TRIM(aStruc[2][I][1])
		NEXT
		DBF_TO_CSV( aFields_ )
	ENDIF

CLOSE DATABASE

RETURN( NIL )

	// ------------------------

STATIC Function DBF_TO_CSV( aFields_ )
LOCAL h, i, nFields, uData
LOCAL aFN_ := {}

BUILD_IDX()

IF EMPTY(aFields_)
		nFields := len(aStruc[2])
		ASIZE(aFN_, nFields)
		FOR i := 1 to nFields
			aFN_[i] := i
		NEXT
ELSE
		nFields := len(aFields_)
		ASIZE(aFN_, nFields)
		FOR i := 1 to nFields
			aFN_[i] := (2)->( fieldpos(aFields_[i]) )
			IF aFN_[i] = 0 
				MsgAlert(  "Invalid field name: " + aFields_[i], "Error" )
				DBSELECTAREA( 2 )
				NET_CLOSE( 3, 3, .T.)
				DELETE FILE &cTMP
				aStruc[2] := {}
				AADD(aStruc[2], { "FIELD1",	"C", 1, 0 }) 
				cTMP := cFilepath( cDBF ) + "_" + cFileNoExt( cDBF ) + ".dbf"
				DBCREATE( cTMP, aStruc[2] )
				RETURN(NIL)
			ENDIF
		NEXT
ENDIF

h := FCREATE(cCSV, FC_NORMAL)
IF h = F_ERROR 
		// MsgAlert( "Failed to create CSV file " + cCSV + ": " + cFerror(), "Error" )
		RETURN(NIL)
ENDIF

MsgRun( "Working...", "CSV-Convert", { |oDlg1| DBF_CSV( aFN_, nFields, h ) } )

IF cShow = "Writer"
		IF FILE( cCSV )
			WAITRUN( c_path + "Angelwriter.exe" + " " + cCSV )
		ELSE
			MsgAlert( "Cannot load :" + CRLF + cCSV, "Missing CSV-file" )
		ENDIF
ENDIF

RETURN(NIL)

// --------------------------

FUNCTION DBF_CSV( aFN_, nFields, h )
LOCAL cText, nLines := 0, nRecords := 0, I, F

IF cHeader = "Yes"
		cText := ""
		FOR I := 1 to nFields
			F := aFN_[I]
			IF cFieldsize = "Yes"
				cText += aStruc[2][F, DBS_NAME] + "-" + aStruc[2][F, DBS_TYPE] + ;
												    "-" + ALLTRIM(STR(aStruc[2][F, DBS_LEN])) + ;
												    "-" + ALLTRIM(STR(aStruc[2][F, DBS_DEC]))
			ELSE
				cText += aStruc[2][F, DBS_NAME] 
			ENDIF
			IF I < nFields
				cText += cDELIM // ","
			ENDIF
		NEXT
		FWRITE(h, cText + CRLF)
		nLines++
ENDIF

(2)->( DBGoTop() )
DO WHILE !(2)->( EOF() ) 
		IF INKEY() == K_ESC
			EXIT
		ENDIF
		FOR I := 1 to nFields
			F := aFN_[I]
			cText := ""
			uData := (2)->( FIELDGET(F) )
			DO CASE
				CASE aStruc[2][F, DBS_TYPE] == "C"
					IF cFieldtrim == "Yes"
						cText := RTRIM(uData) 
					ELSE
						cText := uData 
					ENDIF
				CASE aStruc[2][F, DBS_TYPE] == "D"
					IF !EMPTY(uData)
						cText := DTOC(uData)
					ENDIF
				CASE aStruc[2][F, DBS_TYPE] == "L"
					IF cLOGIC = "TRUE"
						cText := IIF(uData, "TRUE", "FALSE")
					ELSEIF cLOGIC = "T"
						cText := IIF(uData, "T", "F")
					ELSEIF cLOGIC = ".T."
						cText := IIF(uData, ".T.", ".F.")
					ENDIF
				CASE aStruc[2][F, DBS_TYPE] == "M"
					IF cMemos = "Yes" .and. !EMPTY(uData)
						ADDMEMO(uData, h, @cText, @nLines)
					ENDIF
				CASE aStruc[2][F, DBS_TYPE] == "N"
					IF cFieldtrim == "Yes"
						cText := LTRIM(str(uData, aStruc[2][F, DBS_LEN], aStruc[2][F, DBS_DEC]))
					ELSE
						cText := STR(uData, aStruc[2][f, DBS_LEN], aStruc[2][F, DBS_DEC] )
					ENDIF
			END CASE
			IF I < nFields
				FWRITE(h, cText + cDELIM ) // ",")
			ELSEIF !EMPTY(cText)
				FWRITE(h, cText)
			ENDIF
		NEXT
		FWRITE(h, CRLF)
		nLines++
		nRecords++
		(2)->( DBSkip() )
ENDDO

FCLOSE(h)

IF LASTKEY() == K_ESC
		MsgAlert( "Cancelled.  Output file is incomplete.", "Attention" )
ELSE
		MsgAlert(  LTRIM(STR(nLines)) + " lines written for " + LTRIM(STR(nRecords)) + " records." + CRLF + ;
		"Using Delimiter : < " + cDELIM + " >", "Attention" )
ENDIF

RETURN(NIL)

// -------------------------

STATIC FUNCTION ADDMEMO( cMemo, h, cText, nLines )
LOCAL I, ILEN, A, Q, C
LOCAL cQUOTE := "" 

cText += cQUOTE

Q := ASC(cQUOTE)
ILEN := LEN(cMemo)

I := 1
DO WHILE I <= ILEN 
		C := SUBSTR(cMemo, I, 1) // 1. Character
		A := ASC(C)
		IF A == Q
			cText += cQUOTE + cQUOTE // Double literal quotes
		ELSEIF A == 13 .or. A == 10
			IF cMemoline = "No" // cEOL == "" 
				FWRITE(h, cText + CRLF)
				nLines++
				cText := "" 
			ELSE
				cText += ALLTRIM(cEOL)
			ENDIF
			IF A == 13 .and. I < ILEN // CRLF?
				IF ASC(SUBSTR(cMemo, I + 1, 1)) == 13 .or. ASC(SUBSTR(cMemo, I + 1, 1))  == 10
					I++
				ENDIF
			ENDIF
		ELSEIF A == 141
			IF I > 1 .and. substr(cMemo, I - 1, 1) <> " "
				cText += " "
			ENDIF
		ELSE
			cText+= C
		ENDIF
		I++
ENDDO

cText += cQUOTE

RETURN(NIL)

// ------------------------

FUNCTION BUILD_IDX()
LOCAL cExpr0, cExpr[3]
LOCAL cNTX := "_" + cFileNoExt( cDBF ) + ".ntx"
LOCAL cCDX := "_" + cFileNoExt( cDBF ) + ".cdx" 

DBSELECTAREA(2)

IF cSort = "Yes"
		IF !EMPTY( cIndex1 ) .and. EMPTY( cIndex2 ) .and. EMPTY( cIndex3 )
			IF VALTYPE( (2)->&cIndex1 ) = "C"
				cExpr0 := "UPPER(" + cIndex1 + ")"
			ENDIF
			IF VALTYPE( (2)->&cIndex1 ) = "N"
				cExpr0 := "STR(" + cIndex1 + ")"
			ENDIF
			IF VALTYPE( (2)->&cIndex1 ) = "D"
				cExpr0 := "DTOS(" + cIndex1 + ")"
			ENDIF
			IF VALTYPE( (2)->&cIndex1 ) = "L"
				cExpr0 := "cVALTOSTR(" + cIndex1 + ")" 
			ENDIF
		ENDIF
		IF !EMPTY( cIndex1 ) .and. !EMPTY( cIndex2 ) .and. EMPTY( cIndex3 )
			IF VALTYPE( (2)->&cIndex1 ) = "C"
				cExpr[1] := "UPPER(" + cIndex1 + ")"
			ENDIF
			IF VALTYPE( (2)->&cIndex1 ) = "N"
				cExpr[1] := "STR(" + cIndex1 + ")"
			ENDIF
			IF VALTYPE( (2)->&cIndex1 ) = "D"
				cExpr[1] := "DTOS(" + cIndex1 + ")"
			ENDIF
			IF VALTYPE( (2)->&cIndex1 ) = "L"
				cExpr[1] := "cVALTOSTR(" + cIndex1 + ")" 
			ENDIF

			IF VALTYPE( (2)->&cIndex2 ) = "C"
				cExpr[2] := "UPPER(" + cIndex2 + ")"
			ENDIF
			IF VALTYPE( (2)->&cIndex2 ) = "N"
				cExpr[2] := "STR(" + cIndex2 + ")"
			ENDIF
			IF VALTYPE( (2)->&cIndex2 ) = "D"
				cExpr[2] := "DTOS(" + cIndex2 + ")"
			ENDIF
			IF VALTYPE( (2)->&cIndex2 ) = "L"
				cExpr[2] := "cVALTOSTR(" + cIndex2 + ")" 
			ENDIF
			cExpr0 := cExpr[1] + "+" + cExpr[2]
		ENDIF
		IF !EMPTY( cIndex1 ) .and. !EMPTY( cIndex2 ) .and. !EMPTY( cIndex3 )
			IF VALTYPE( (2)->&cIndex1 ) = "C"
				cExpr[1] := "UPPER(" + cIndex1 + ")"
			ENDIF
			IF VALTYPE( (2)->&cIndex1 ) = "N"
				cExpr[1] := "STR(" + cIndex1 + ")"
			ENDIF
			IF VALTYPE( (2)->&cIndex1 ) = "D"
				cExpr[1] := "DTOS(" + cIndex1 + ")"
			ENDIF
			IF VALTYPE( (2)->&cIndex1 ) = "L"
				cExpr[1] := "cVALTOSTR(" + cIndex1 + ")" 
			ENDIF

			IF VALTYPE( (2)->&cIndex2 ) = "C"
				cExpr[2] := "UPPER(" + cIndex2 + ")"
			ENDIF
			IF VALTYPE( (2)->&cIndex2 ) = "N"
				cExpr[2] := "STR(" + cIndex2 + ")"
			ENDIF
			IF VALTYPE( (2)->&cIndex2 ) = "D"
				cExpr[2] := "DTOS(" + cIndex2 + ")"
			ENDIF
			IF VALTYPE( (2)->&cIndex2 ) = "L"
				cExpr[2] := "cVALTOSTR(" + cIndex2 + ")"
			ENDIF

			IF VALTYPE( (2)->&cIndex3 ) = "C"
				cExpr[3] := "UPPER(" + cIndex3 + ")"
			ENDIF
			IF VALTYPE( (2)->&cIndex3 ) = "N"
				cExpr[3] := "STR(" + cIndex3 + ")"
			ENDIF
			IF VALTYPE( (2)->&cIndex3 ) = "D"
				cExpr[3] := "DTOS(" + cIndex3 + ")"
			ENDIF
			IF VALTYPE( (2)->&cIndex3 ) = "L"
				cExpr[3] := "cVALTOSTR(" + cIndex3 + ")" 
			ENDIF
			cExpr0 := cExpr[1] + "+" + cExpr[2] + "+" + cExpr[3]
		ENDIF

		IF !EMPTY( cIndex1 ) .or. !EMPTY( cIndex2 ) .or. !EMPTY( cIndex3 )
			IF cDescend = "No"
				IF cRDD = "DBFNTX"
					INDEX ON &cExpr0 TO cNTX 
					SET INDEX TO cNTX 
				ELSE
					INDEX ON &cExpr0 TO cCDX
					SET INDEX TO cCDX
				ENDIF
			ELSE
				IF cRDD = "DBFNTX"
					INDEX ON &cExpr0 TO cNTX  DESCEND
					SET INDEX TO cNTX 
				ELSE
					INDEX ON &cExpr0 TO cCDX  DESCEND
					SET INDEX TO cCDX 
				ENDIF
			ENDIF
		ENDIF
ENDIF

RETURN( NIL )

// ---------- NET - FUNCTIONS ------------------

FUNCTION NET_USE ( cDBName1, cAlias, nTrials, Net)

LOCAL lReturn  := .T.
LOCAL lOpen    := .F.
LOCAL Close := 1

nTrcount   := nTrials
YesNo := .F.

// SHARED    all Users
// EXCLUSIVE  1 User

IF File( cDBName1 )
		nTrials := nTrcount
		DO WHILE !lOpen
			Close := 2
			DO WHILE .T.
				IF !net
					USE &cDBName1 ALIAS &cAlias NEW EXCLUSIVE
				ELSE
					USE &cDBName1 ALIAS &cAlias NEW SHARED
				ENDIF
				IF !NetErr()
					lReturn   := .T.
					lOpen     := .T.
					nTrials := 0
				ELSE
					IF Net = .T.
						Status := "SHARED"
					ELSE
						Status := "EXCLUSIVE"
					ENDIF
					IF nTrcount = nTrials
						xName := WNetGetUser()
						IF MsgYesNo( "Open " + Status + "  of " + upper(cDBName1) + " not possible !" + ;
							       " try again ?", "Network-error -> &xName !" )
							nTrials := nTrcount
							YesNo := .T.
						ELSE
							nTrials := 0
							YesNo := .F.
						ENDIF
					ENDIF
					IF YesNo = .T.
						nTrials --
						IF nTrials > 0 .AND. nTime > 0
							NET_WAIT ( nTrcount, nTrials, nTime)
						ENDIF
						IF nTrials = 0
							nTrials := nTrcount
						ENDIF
					ELSE
						lReturn   := .F.
						lOpen     := .T.
						nTrials := 0
					ENDIF
				ENDIF
				IF nTrials = 0
					lOpen := .T.
					EXIT
				ENDIF
			ENDDO
		ENDDO
ELSE
		nMsgBox ("File -> " + cDBName1 + " is missing !", "Attention !")
		SET RESOURCES TO
		SET _3DLOOK OFF
		FREELIBRARY()
		CLOSE DATABASE
		QUIT
ENDIF

RETURN lReturn

//------------------------------------

FUNCTION NET_RLOCK( nTrials, nTime )

LOCAL   lReturn   := .F.
LOCAL   nTrcount   := 0
LOCAL   nZSek     := 0
nTrcount := nTrials
DO WHILE !lReturn
		DO WHILE nTrials > 0
			IF !RLock()
				nTrials --
				IF nTrials > 0 .AND. nTime > 0
					NET_WAIT ( nTrcount, nTrials, nTime )
				ENDIF
			ELSE
				lReturn := .T.
				EXIT
			ENDIF
		ENDDO
		IF nTrials = 0
			IF MsgYesNo( "Not possible, to lock the record !" + ;
					" Try again ?", "Network Error !" )
				lOpen     :=.T.
				nTrials := nTrcount
			ELSE
				lReturn := .F.
				lOpen   := .F.
				EXIT
			ENDIF
		ENDIF
ENDDO
IF lReturn = .F.
		nMsgBox ("Files are not saved !!!", "Attention !")
ENDIF

RETURN lReturn

//-------------------------------------------------------

FUNCTION NET_ULOCK ()

LOCAL   lReturn   := .F.
LOCAL   nTrcount   := 0
LOCAL   nZSek     := 0

IF LEN(fieldname(1)) > 0  // Open ?
		UNLOCK
ENDIF

RETURN lReturn

// ----------------------

FUNCTION NET_FLOCK ( cDBName, ntrials, ntime )
LOCAL lReturn   := .F.
LOCAL ntrcount   := 0

ntrcount := ntrials
DO WHILE !lReturn
		DO WHILE ntrials > 0
			IF !FLock()
				ntrials --
				IF ntrials > 0 .AND. ntime > 0
					NET_WAIT ( ntrcount, ntrials, ntime)
				ENDIF
			ELSE
				lReturn := .T.
				EXIT
			ENDIF
		ENDDO
		IF ntrials = 0
			IF MsgYesNo( OemToAnsi("File-Lock of ") + upper(cDBName) + OemToAnsi(" not possible !") + ;
					" try again ?", "Network-Error !" )
				ntrials := ntrcount
			ELSE
				lReturn := .F.
				EXIT
			ENDIF
		ENDIF
ENDDO
IF lReturn = .F.
		nMsgBox ("File-Lock not possible !!!", "Attention !")
ENDIF

RETURN lReturn

FUNCTION NET_CLOSE(nTrials, nTime, Net)

LOCAL lReturn  := .T.
LOCAL lOpen    := .F.
LOCAL Close := 1

nTrcount   := nTrials
YesNo    := .F.

cDBName1 := DBF()

DO WHILE !lOpen
		DO WHILE nTrials > 0
			USE
			IF NetErr()
				nTrials --
				IF MsgYesNo( "Close of file : " + upper(cDBName1) + " not possible !" + ;
						" Try again ?", "Network-Error !" )
					lOpen :=.T.
					nTrials := nTrcount
					IF nTrials > 0 .AND. nTime > 0
						NET_WAIT ( nTrcount, nTrials, nTime)
					ENDIF
				ELSE
					lReturn   := .F.
					lOpen     := .T.
					nTrials := 0
				ENDIF
			ELSE
				lReturn   := .T.
				lOpen     := .T.
				nTrials := 0
			ENDIF
		ENDDO
ENDDO

RETURN lReturn

// ------------------------------------

FUNCTION NET_WAIT ( ntrcount, ntrials, ntime )

LOCAL oMeter, oText1

MsgMeter( { | oMeter, oText1 | ;
SHOW_WAIT(ntrcount, nTrials, nTime, oMeter, oText1) } , ;
"Rest Trials : " + ltrim(str(nTrials)) + ". Trial..." )

RETURN NIL

//------------------------------------

STATIC FUNCTION SHOW_WAIT(nTrcount, nTrials, nTime, oMeter, oText1)

oMeter:nTotal = nTrcount
nZSek := Seconds()
oText:SetText( "Rest of trials : " + ltrim(str(ntrials)))
oMeter:Set( nTrials )
SysRefresh()
DO WHILE Seconds() < nZSek + nTime
ENDDO

RETURN NIL

// ---------------------------

FUNCTION NET_ORDER

RETURN INDEXORD ()
