PROCEDURE Main LOCAL i, j, t LOCAL aTage := {"3","","4"} LOCAL cNetver := "C:\Platte_M\HDBE\" LOCAL aTFiles := { "tbest.dbf", "tvv.dbf", "tauftr.dbf", "tvers.dbf", "tvbest.dbf", ; "tbest.dbt", "tvbest.dbt" } //von Hand: // aFiles vom alten auf den neuen Server // aTFiles vom alten auf den neuen Server (mssten leer sein?) // T_SIC\3 vom alten auf den neuen Server als T_SIC\3 (also berschreiben) // dann auf dem neuen Server: // der Stand von Mittwoch-1:40 ... kopieren ins T_SIC_X // der Stand von Dienstag-1:40 ... kopieren ins T_SIC_X // Master-T-Dateien in das Zielverzeichnis T_SIC_Y FOR i := 1 TO 7 COPY FILE (cNetver+"T_SIC\4" + aTFiles[i]) TO (cNetver + "T_SIC_X\4" + aTFiles[i]) COPY FILE (cNetver+"T_SIC\3" + aTFiles[i]) TO (cNetver + "T_SIC_X\3" + aTFiles[i]) COPY FILE (cNetver + aTFiles[i]) TO (cNetver + "T_SIC_X\" + aTFiles[i]) // msste sowieso leer sein...??? COPY FILE (cNetver+"Master\" + aTFiles[i]) to (cNetver + "T_SIC_Y\" + aTFiles[i] ) NEXT // die St„nde von aTage im Verzeichnis T_SIC_X werden zusammenkopiert // ins Verzeichnis T_SIC_Y: // (auf dort platzierte Master-T-Dateien) FOR i := 1 TO 7 IF i>5 ; LOOP ; ENDIF cDatei := ( cNetver+"T_SIC_Y\" + aTFiles[i] ) USE &cDatei EXCLUSIVE FOR j := 1 TO Len(aTage) t := aTage[j] IF FExists( cNetver+"T_SIC_X\" + t + aTFiles[i] ) APPEND FROM ( cNetver+"T_SIC_X\" + t + aTFiles[i] ) ENDIF NEXT USE NEXT // von Hand: // die Dateien in T_SIC_Y verteilen auf die Filialen RETURN *** *** *** *dbupges *GESamtes UnterProgramm fr DatenBanken im Netz *zum Ausfhren von USE, Recordlock, Recorddelete, Append ***hpar.prg - erkl§rt die Netzwerk-Variablen procedure hpar *********** public clipper public upfehl public vnetz public schalt public vara upfehl=0 if clipper vnetz="J" else vnetz="N" endif schalt=" " vara=".F." return *********** FUNCTION Satzdelete upfehl:=0 // If rlock() IF DbRlock( Recno() ) //+17.11.2018 17:59 dbdelete() else dbdelete() endif RETURN upfehl FUNCTION Satzrecall upfehl:=0 // If rlock() IF DbRlock( Recno() ) //+17.11.2018 18:00 dbrecall() else dbrecall() endif RETURN upfehl * dbupro Unterprog Datenbanken lesen und Verarbeiten *set procedure to dbupro //procedure dbupro //parameters dat,ind,upfehl,schalt,upfunk //if vnetz = 'J' && netz j,n ************************************************************************ //*FUNCTION DBaufmachen(cDat, cInd, cSchalt) //*dat:=cDat ; ind:=cInd ; schalt:=cSchalt FUNCTION DBaufmachen parameters dat,ind,schalt //* IF upper(dat) == "MWSTDAT" dat := "C:\HDBE\MWSTDAT" ELSEIF Substr(dat,2,1) ==":" ELSE dat := cDatver+dat // erg§nzen um das Datenverzeichnis ENDIF *// if ind # NIL IIf( SUBSTR( ind,2,1 ) == ":", ind, ind := cDatver+ind ) endif // if upfunk = 1 && 1 = use,2=Satzsperren,3=append if Schalt = 'E' && E= exclusive (z.B. bei reorg wenn upfunk=1) stor .T. to vara else stor .F. to vara endif stor 0 to upfehl stor '1' to schleife do while schleife = '1' // if net_use("&dat",vara,.5) if net_use("&dat",vara,5) // 14.09.2006 if ind # NIL set index to &ind endif stor '2' to schleife else IF ConfirmBox( SetAppWindow(), "Nochmal versuchen=JA - Programmabbruch=NEIN", ; //+09.05.2018 17:21 "Datei "+dat+" kann nicht ge”ffnet werden!", ; //+09.05.2018 17:20 XBPMB_YESNO, ; XBPMB_QUESTION ) == XBPMB_RET_YES LOOP ELSE QUIT ENDIF save screen clear @ 3,8 to 13,65 double @ 5,10 say "Die Datenbank wird zur Zeit von einem anderen Benutzer" @ 6,10 say "des Netzwerkes ge„ndert." @ 7,10 say "Die Benutzung ist daher zur Zeit nicht m”glich." @ 9,10 say "Drcken Sie bitte auf die '1'-Taste," @10,10 say "wenn der Zugriff erneut versucht werden soll." @11,10 say "Die '#'-Taste bricht das Programm ab !!" @15,10 say "Datenbankname = " + dat SET CONS OFF WAIT to schleife SET CONS ON if schleife <> "#" schleife = "1" // "1" in der Netzwerkversion ///////// endif if schleife # '1' stor 1 to upfehl @ 20,10 say "Das Programm wurde durch Sie abgebrochen." @ 21,10 say "Sie k”nnen es sofort wieder starten." exit endif **--> clear stor 0 to upfehl restore screen endif enddo // endif if upfehl <>0 // einmal fr alle // quit endif RETURN upfehl ********************************************************************* FUNCTION Satzsperren // if upfunk = 2 && 2 = Satzsperren stor 0 to upfehl stor '1' to schleife do while schleife = '1' // if REC_LOCK(.5) if REC_LOCK(5) // 14.09.2006 stor 0 to upfehl stor '2' to schleife else IF ConfirmBox( SetAppWindow(), "Weitermachen?", ; "Datensatz ist schon gesperrt", ; XBPMB_YESNO, ; XBPMB_QUESTION ) == XBPMB_RET_YES LOOP ELSE QUIT ENDIF save screen clear @ 3,8 to 13,65 double @ 5,10 say "Der angeforderte Datensatz wird zur Zeit " @ 6,10 say "von einem anderen Benutzer des Netzwerkes ge„ndert." @ 7,10 say "Die Benutzung ist daher z. Zt. fr Sie nicht m”glich." @ 9,10 say "Drcken Sie bitte auf die '1'-Taste," @10,10 say "wenn der Zugriff erneut versucht werden soll." @11,10 say "Die '#'-Taste bricht das Programm ab !!" @15,10 say "Datensatz = " + str(recno()) SET CONS OFF WAIT to schleife SET CONS ON if schleife <> "#" schleife = "1" // "1" in der Netzwerkversion ///////// endif if schleife # '1' stor 1 to upfehl @ 20,10 say "Das Programm wurde durch Sie abgebrochen." @ 21,10 say "Sie k”nnen es sofort wieder starten." exit endif *--> clear stor 0 to upfehl restore screen endif enddo // endif if upfehl <>0 // einmal fr alle // quit endif RETURN upfehl ************************************************************************ FUNCTION Satzentsperren Dbunlock() RETURN (.T.) ************************************************************************ FUNCTION Satzappend // if upfunk = 3 && 3 = einfgen stor 0 to upfehl stor '1' to schleife do while schleife = '1' // if ADD_REC(.5) if ADD_REC(5) // 14.09.2006 stor 0 to upfehl stor '2' to schleife else IF ConfirmBox( SetAppWindow(), "Weitermachen?", ; "Datensatz ist schon gesperrt", ; XBPMB_YESNO, ; XBPMB_QUESTION ) == XBPMB_RET_YES LOOP ELSE QUIT ENDIF save screen clear @ 3,8 to 13,65 double @ 5,10 say "Der angeforderte Datensatz wird zur Zeit " @ 6,10 say "von einem anderen Benutzer des Netzwerkes eingefgt." @ 7,10 say "Eine Einfgung ist daher z. Zt. fr Sie nicht m”glich." @ 9,10 say "Drcken Sie bitte auf die '1'-Taste," @10,10 say "wenn der Zugriff erneut versucht werden soll." @11,10 say "Die '#'-Taste bricht das Programm ab !!" @15,10 say "Datensatz = " + str(recno()) SET CONS OFF WAIT to schleife SET CONS ON if schleife <> "#" schleife = "1" // "1" in der Netzwerkversion ///////// endif if schleife # '1' stor 1 to upfehl @ 20,10 say "Das Programm wurde durch Sie abgebrochen." @ 21,10 say "Sie k”nnen es sofort wieder starten." exit endif *--> clear stor 0 to upfehl restore screen endif enddo // endif //endif if upfehl <>0 // einmal fr alle // quit endif RETURN upfehl ****--------------------------------- FUNCTION Net_use PARAMETERS file, ex_use, wait PRIVATE forever forever = (wait = 0) DO WHILE (forever .OR. wait > 0) IF ex_use && exclusive dbUseArea(,, file,,.F.) ELSE dbUseArea(,, file ) && shared ENDIF IF .NOT. NETERR() && USE succeeds RETURN (.T.) ENDIF INKEY(1) && wait 1 second wait = wait - 1 ENDDO RETURN (.F.) && USE fails //////FUNCTION Net_use( file, ex_use, WAIT) ////// LOCAL bError := ErrorBlock( {|e| Break(e) } ) //+09.05.2018 14:12 ////// LOCAL lReturn := .F. ////// PRIVATE forever ////// ////// forever = (wait = 0) ////// DO WHILE (forever .OR. wait > 0) ////// ////// BEGIN SEQUENCE ////// dbUseArea(,, file,,!ex_use) ////// WAIT := 0 ////// lReturn := .T. ////// RECOVER ////// Sleep(100) ////// WAIT = WAIT - 1 ////// IF wait==0 .AND. ConfirmBox( SetAppWindow(), "Nochmal probieren?", ; ////// "Datei "+FILE+" kann nicht ge”ffnet werden.", ; ////// XBPMB_YESNO, ; ////// XBPMB_QUESTION ) == XBPMB_RET_YES ////// WAIT := 5 ////// LOOP ////// ELSEIF WAIT == 0 ////// EXIT ////// ENDIF ////// LOOP ////// END SEQUENCE ////// ENDDO ////// ErrorBlock( bError ) //+09.05.2018 14:13 Fehler-Codeblock zurcksetzen //////RETURN lReturn *****------------------ FUNCTION REC_LOCK PARAMETERS wait PRIVATE forever IF RLOCK() RETURN (.T.) && locked ENDIF forever = (wait = 0) DO WHILE (forever .OR. wait > 0) IF RLOCK() RETURN (.T.) && locked ENDIF INKEY(.5) && wait 1/2 second wait = wait - .5 ENDDO RETURN (.F.) && not locked * End - REC_LOCK ******--------------------------------- * ADD_REC function * * Returns true if record appended. The new record is current * and locked. * Pass the following parameter * 1. Numeric - seconds to wait (0 = wait forever) * FUNCTION ADD_REC PARAMETERS wait PRIVATE forever DbAppend(1) //+17.11.2018 20:53 1, damit alle anderen Satzsperren so bleiben IF .NOT. NETERR() RETURN (.T.) ENDIF forever = (wait = 0) DO WHILE (forever .OR. wait > 0) DBAPPEND(1) //+17.11.2018 20:53 1, damit alle anderen Satzsperren so bleiben IF .NOT. NETERR() RETURN .T. ENDIF INKEY(.5) && wait 1/2 second wait = wait - .5 ENDDO RETURN (.F.) && not locked FUNCTION Sage( nRow, nCol, cSay ) LOCAL aPenPos IF cLPTSCR = "S" .OR. cLPT != "LPTA" DevPos( nRow, nCol ) DevOut( cSay ) ELSE nZei := nRow nSpa := nCol cText := IIf( ValType(cSay)="C", cSay, IIf(ValType(cSay)="N",Str(cSay), IIf(ValType(cSay)="D",DtoC(cSay),))) // nPOffX := nPOffY := 0 //02.09.2025 20:58 aPenPos := FdrG( oPrinterPS, oFont, cText, 1, aFonts ) lSeiteLeer := .F. // 04.08.200 es steht was auf der Seite ENDIF RETURN aPenPos