* schumach: hauptmenu-bestattungen PUBLIC cDatver //set path to t:\hdbe set excl off set date german //do hpar //do standard use mwstdat cDatver := RTRIM(netver) k1=kto1 k2=kto2 k3=kto3 k4=kto4 k5=kto5 k6=kto6 xxx = "&k1/&k2,&k3/&k4,,,&k5/&k6" set color to &xxx clear //do eroff //wait " Weiter mit ENTER..." //clear *SCHF=1 *do codewort *if schf=1 * clear * @ 5,5 say "CODEWORT FALSCH !!!" * clear all * return *endif antw=" " set bell off set confirm off set delete on set safety off set talk off //set function 2 to "h;" //set function 3 to "h10;" //set function 9 to space(6) //set function 10 to "!;" set century on clear //do hpar //do standard //do termine //clear all //do hpar //do standard do while .t. USE mwstdat cDatver := RTRIM(netver) prog=" " *** *melinks za00=" " za01=" BESTATTUNGSVERWALTUNG - SCHUMACHER " za02=" " za03=" Vestische Straáe 146 " za04=" 46117 Oberhausen " za05=" " za06=" D a t e n a b g l e i c h " za07=" A U S W A H L : " za08=" " za09=" A TT-šbertragung auf den Server " za10=" " za11=" V TT-šbertragung vom Server " za12=" " za13=" " za14=" " za15=" " za16=" " za17=" " za18=" " za19=" " za20=" E ENDE " za21=" " za22=" " za23=" " za24=" " zb00=" " zb01=" " zb02=" " zb03=" " zb04=" " zb05=" " zb06=" " zb07=" " zb08=" " zb09=" " zb10=" " zb11=" " zb12=" " zb13=" " zb14=" " zb15=" " zb16=" " zb17=" " zb18=" " zb19=" " zb20=" " zb21=" " zb22=" " zb23=" " zb24=" " ***************************************************************** * ausgabe links ***************************************************************** //do hpar ***use mwstdat k1=f01 k2=f02 k3="W" k4="N" k5="W" k6="N" xxx = "&k1/&k2,&k3/&k4,,,&k5/&k6" set color to &xxx @ 0,0 say za00 @ 1,0 say za01 @ 2,0 say za02 @ 3,0 say za03 @ 4,0 say za04 @ 5,0 say za05 k1=f03 k2=f04 k3="W" k4="N" k5="W" k6="N" xxx = "&k1/&k2,&k3/&k4,,,&k5/&k6" set color to &xxx @ 6,0 say za06 @ 7,0 say za07 @ 8,0 say za08 @ 9,0 say za09 @ 10,0 say za10 @ 11,0 say za11 @ 12,0 say za12 @ 13,0 say za13 @ 14,0 say za14 @ 15,0 say za15 @ 16,0 say za16 @ 17,0 say za17 @ 18,0 say za18 @ 19,0 say za19 @ 20,0 say za20 @ 21,0 say za21 @ 22,0 say za22 @ 23,0 say za23 @ 24,0 say za24 ****** k1=f01 k2=f02 k3="W" k4="N" k5="W" k6="N" xxx = "&k1/&k2,&k3/&k4,,,&k5/&k6" set color to &xxx @ 0,40 say zb00 datum=dtoc(date()) zeile1=" "+cdow(date()) *zeile3=" "+substr(datum,1,2)+". "+cmonth(date())+" 19"+substr(datum,7,2)+" "+time() zeile3=" "+dtoc(date())+" "+time() @ 1,40 say zeile1+substr(zb01,1,40-len(zeile1)) @ 2,40 say zb02 @ 3,40 say zeile3+substr(zb03,1,40-len(zeile3)) @ 4,40 say zb04 @ 5,40 say zb05 *** k1=f13 k2=f14 k3="W" k4="N" k5="W" k6="N" xxx = "&k1/&k2,&k3/&k4,,,&k5/&k6" set color to &xxx @ 6,40 say zb06 @ 7,40 say zb07 @ 8,40 say zb08 @ 9,40 say zb09 @ 10,40 say zb10 @ 11,40 say zb11 @ 12,40 say zb12 @ 13,40 say zb13 @ 14,40 say zb14 @ 15,40 say zb15 @ 16,40 say zb16 @ 17,40 say zb17 @ 18,40 say zb18 @ 19,40 say zb19 @ 20,40 say zb20 @ 21,40 say zb21 @ 22,40 say zb22 @ 23,40 say zb23 @ 24,40 say zb24 k1=f07 k2=f08 k3=kto3 k4=kto4 k5=kto5 k6=kto6 xxx = "&k1/&k2,&k3/&k4,,,&k5/&k6" set color to &xxx USE @24,4 say "Bitte Programm-Gruppe w„hlen : " get prog read // do hpar // do standard do case case prog="a" do ttpro5cs case prog="v" do ttpro5sc case prog="!" .or. prog="e" use clear antw=" " do while antw=" " @6,15 say "ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿" @7,15 say "³ Wollen Sie Ihre Arbeit beenden ? ³" @7,53 get antw @8,15 say "ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´" @9,15 say "³ E N D E = j ³" @10,15 say "ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ" read if antw="j" .or. antw="J" clear return endif if antw="n" .or. antw="N" clear loop endif antw=" " enddo endcase enddo RETURN FUNCTION TTCzuS ( nAreaC, nAreaCB, nAreaS, nAreaSB, nRecC ) // Die tbest-Datei des Client wird abgearbeitet und die ge„nderten // Felder (ggf. der ganze Satz) der best-Datei des Client auf die // best-Datei des Servers bertragen. // Diese Transaktion wird in der tbest-Datei des Servers erg„nzt. LOCAL aData1 := SatzGet( nAreaC, nRecC ) LOCAL aData2 := SatzGet( nAreaC, nRecC+1 ) LOCAL aDataD := SatzGet( nAreaC, nRecC+2 ) LOCAL nAuftr := 000000 PRIVATE nDiff := 0 , n4 := 0 aDataD := SatzDiff( aData1, aData2 ) aDataD[1] := aData2[1] SKIP -2 cTTFlag := TTFlag IF substr( cTTFlag, VAL( cSystem ), 1 ) = "1" RETURN ( .F. ) ENDIF cAuf := str(aData1[1],6,0) IF aData1[5] == SPACE( 28 ) // wenn es ein neuer Auftrag ist: SELECT &nAreaSB DO WHILE .NOT. Eof() @ ++nZei,10 SAY cAuf+": Neue Auftr-Nr. eingeben : " GET nAuftr read cAuftr := str( nAuftr,6,0 ) FIND &cAuftr ENDDO aData1[1] := aData2[1]:= aDataD[1] := nAuftr // die Best-Datei des Servers erg„nzen: SELECT &nAreaSB APPEND BLANK SatzPut( nAreaSB, RecNo(), aData2 ) // die TT-Datei des Servers erg„nzen: SELECT &nAreaS APPEND BLANK SatzPut( nAreaS, RecNo(), aData1, "1" ) APPEND BLANK SatzPut( nAreaS, RecNo(), aData2, "1" ) APPEND BLANK SatzPut( nAreaS, RecNo(), aDataD, "1" ) // die Best-Datei des Client erg„nzen um NEUE Auftrag-Nr: SELECT &nAreaCB FIND &cAuf IF Found() REPLACE Auftrnr with aData1[1] ENDIF // ELSE // wenn es ein alter Auftrag ist: // die Best-Datei des Servers erg„nzen: // Vorannahme: es gilt immer das vom Client ge„nderte Feld ! SELECT &nAreaSB find &cAuf FeldPut( nAreaSB, RecNo(), aDataD ) // die TT-Datei des Servers erg„nzen: SELECT &nAreaS // wurde dieser Auftrag schon ge„ndert?/ S->C-berspielt? : LOCATE FOR Auftrnr == aData1[1] DO WHILE .NOT. Eof() cTTFlag := TTFlag IF .NOT. "2"$cTTFlag EXIT ENDIF CONTINUE ENDDO IF Eof() // wenn im Server dieser Satz nicht auch schon ge„ndert wurde: APPEND BLANK SatzPut( nAreaS, RecNo(), aData1, "1" ) APPEND BLANK SatzPut( nAreaS, RecNo(), aData2, "1" ) APPEND BLANK SatzPut( nAreaS, RecNo(), aDataD, "1" ) ELSE // wenn im Server auch schon dieser Satz ge„ndert wurde: // (FeldPut erg„nzt automatisch die TTFlag auf "1") SKIP Feldput( nAreaS, RecNo(), aDataD ) SKIP Feldput( nAreaS, RecNo(), aDataD ) ENDIF ENDIF // die TT-Datei des Client erg„nzen um (Auftr-Nr) + TTFlag: SELECT &nAreaC SatzPut( nAreaC, RecNo(), aData1, "1" ) SKIP SatzPut( nAreaC, RecNo(), aData2, "1" ) SKIP SatzPut( nAreaC, RecNo(), aDataD, "1" ) RETURN ( nRecC ) //----------------------------------------------------------- FUNCTION TTSzuC ( nAreaC, nAreaCB, nAreaS, nAreaSB, nRecS ) // Die tbest-Datei des Servers wird abgearbeitet und die // korrespondierenden S„tze der best-Datei auf den Client bertragen. // Die šbertragung wird in der tbest-Datei des Servers vermerkt. // Die zu den bertragenen S„tzen geh”renden S„tze der tbest-Datei // des Client werden gel”scht ( == ALLE !!! ). LOCAL aData1 := SatzGet( nAreaS, nRecS ) LOCAL aData2 := SatzGet( nAreaS, ++nRecS ) LOCAL aDataD := SatzGet( nAreaS, ++nRecS ) PRIVATE nDiff := 0 , n4 := 0 aDataD := SatzDiff( aData1, aData2 ) aDataD[1] := aData2[1] // (das war schon das Lesen des Server-Best-Satzes in aData2) cAuf := str(aData2[1],6,0) SKIP -2 cTTFlag := TTFlag IF substr( cTTFlag, VAL( cSystem ), 1 ) = "2" RETURN ( .F. ) ENDIF // Schreiben des Client-Best-Satzes : SELECT &nAreaCB FIND &cAuf IF Eof() APPEND BLANK ENDIF Satzput( nAreaCB, RecNo(), aData2 ) // L”schen der zu diesem Auftr geh”renden S„tze in der Client-tbest: SELECT &nAreaC LOCATE FOR Auftrnr == aData2[1] DO WHILE .NOT. Eof() cTTFlag := TTFlag IF SUBSTR( cTTFlag, VAL( cSystem ), 1 ) == "1" EXIT ENDIF CONTINUE ENDDO IF .not. Eof() DELETE NEXT 3 ENDIF // ï2ï-Setzen der TT-Flag im Server fr diesen Client und diesen Auftr: SELECT &nAreaS // LOCATE FOR Auftrnr == aData2[1] <--- steht schon da! cTTFlag := TTFlag cTTFlag := STUFF( cTTFlag, VAL( cSystem ), 1, "2" ) REPLACE TTFlag with cTTFlag SKIP REPLACE TTFlag with cTTFlag SKIP REPLACE TTFlag with cTTFlag RETURN ( nRecS ) //---------------------------------------- FUNCTION SatzGet( nArea, nRec ) LOCAL aData[ FCount() ] nOldArea := Select() SELECT &nArea GO nRec For n := 1 to FCount() IF TYPE( FieldName(n) ) == "M" cFieldName := FieldName(n) aData[n] := &cFieldName ELSE aData[n] := FieldGet( n ) ENDIF NEXT SELECT &nOldArea RETURN ( aData ) //----------------------------------------------------------- FUNCTION SatzPut( nArea, nRec, aData, cTTF ) LOCAL cTTFlag := SPACE( 5 ) nOldArea := Select() SELECT &nArea GO nRec IF nArea=1 .or. nArea=3 .or. nArea=11 replace TTDatum with Date() replace TTZeit with Time() replace TTUser with cSystem cTTFlag := TTFlag cTTFlag := STUFF( cTTFlag, VAL( cSystem ), 1 , cTTF ) replace TTFlag with cTTFlag n4 := 4 ELSE n4 := 0 ENDIF For n := 1 to FCount()-n4 FieldPut( n, aData[n] ) NEXT SELECT &nOldArea RETURN ( aData ) //----------------------------------------------------------- FUNCTION SatzDiff( aData1, aData2 ) LOCAL aDataD[ FCount() ] For n := 1 to FCount()-n4 aDataD[n] := IIf( aData1[n] == aData2[n], NIL, aData2[n] ) nDiff := IIf( aDataD[n]==NIL, nDiff, n ) NEXT RETURN ( aDataD ) //----------------------------------------------------------- FUNCTION FeldPut( nArea, nRec, aData ) nOldArea := Select() SELECT &nArea GO nRec DO CASE CASE nArea=1 .or. nArea=3 n4 := 4 cTTFlag := TTFlag IF val( substr( cTTFlag, VAL( cSystem ), 1 ) ) = 0 FOR n := 1 TO FCount()-n4 IF aData[n] == NIL ELSE FieldPut( n, aData[n] ) ENDIF NEXT replace TTDatum with Date() replace TTZeit with Time() replace TTUser with cSystem cTTFlag := STUFF( cTTFlag, VAL( cSystem ), 1 , "1" ) replace TTFlag with cTTFlag ENDIF CASE nArea=2 .or. nArea=4 FOR n := 1 TO FCount() IF aData[n] == NIL ELSE FieldPut( n, aData[n] ) ENDIF NEXT ENDCASE SELECT &nOldArea RETURN ( aData ) PROCEDURE TTPRO5CS * ttpro5CS - Client-Žnderungen auf den Server bertragen nAreaC := 1 nAreaCB := 2 nAreaS := 3 nAreaSB := 4 IF UPPER( cDatver ) == "C:\HDBE\" wait " FEHLER ! Client-Verzeichnis == Server-Verzeichnis " RETURN ENDIF SELECT 11 USE C:\HDBE\mwstdat cSystem := system USE SELECT &nAreaC USE C:\HDBE\tbest EXCLUSIVE ALIAS ct SELECT &nAreaCB USE C:\HDBE\best EXCLUSIVE ALIAS cb SET INDEX TO C:\HDBE\XAUFTRNR SELECT &nAreaS cTbest := cDatver + "tbest" USE &cTbest EXCLUSIVE ALIAS mt // im Default-Verzeichnis SELECT &nAreaSB cBest := cDatver + "best" USE &cBest EXCLUSIVE ALIAS mb // im Default-Verzeichnis cInd := cDatver + "XAUFTRNR" // im Default-Verzeichnis SET INDEX TO &cInd SELECT &nAreaC nRecC := 1 nZei := 2 DO WHILE .T. .AND. .NOT. Eof() TTCzuS ( nAreaC, nAreaCB, nAreaS, nAreaSB, nRecC ) nRecC = nRecC+3 GO nRecC ENDDO CLEAR ALL RETURN PROCEDURE TTPRO5SC * ttprocSC - Server-Žnderungen auf den Client bertragen nAreaC := 1 nAreaCB := 2 nAreaS := 3 nAreaSB := 4 IF UPPER( cDatver ) == "C:\HDBE\" wait " FEHLER ! Client-Verzeichnis == Server-Verzeichnis " RETURN ENDIF SELECT 11 USE C:\HDBE\mwstdat cSystem := system USE SELECT &nAreaC USE C:\HDBE\tbest EXCLUSIVE SELECT &nAreaCB USE C:\HDBE\best EXCLUSIVE SET INDEX TO C:\HDBE\xauftrnr SELECT &nAreaS cTbest := cDatver + "tbest" USE &cTbest EXCLUSIVE // im Default-Verzeichnis SELECT &nAreaSB cBest := cDatver + "best" USE &cBest EXCLUSIVE // im Default-Verzeichnis cInd := cDatver + "XAUFTRNR" // im Default-Verzeichnis SET INDEX TO &cInd SELECT &nAreaS nRecS := 1 DO WHILE .T. .AND. .NOT. Eof() TTSzuC ( nAreaC, nAreaCB, nAreaS, nAreaSB, nRecS ) nRecS = nRecS+3 GO nRecS ENDDO // L”schen aller tbestS-Datens„tze, deren TTFlag komplett auf ï2ï: SELECT &nAreaS GO TOP DO WHILE .NOT. Eof() DELETE FOR TTFlag == "0222222" .OR. TTFlag == " 222222" SKIP ENDDO PACK // Packen aller gel”schten tbestC-S„tze: SELECT &nAreaC PACK // šberprfen, ob die Datei v”llig leer: GO BOTTOM IF RecNo() > 1 wait " FEHLER : Die TT-Datei im Client ist nicht leer ! " ENDIF CLEAR ALL RETURN