**BRegieFV.prg - Regie-Zentrum fr Bestattungsverwaltung // Verwaltung der Masken-Files, Schriften, Parameter #include "Gra.ch" #include "Xbp.ch" #include "Appevent.ch" #include "Appedit.ch" #include "Appbrow.ch" #include "Font.ch" #include "Dmlb.ch" #include "Set.ch" #include "Common.ch" #include "Directry.ch" #include "FileIO.ch" #define xbeU_RefreshAnlief xbeP_User + 3 FUNCTION FormularVerwaltung( oDlg1, aPos, ASize ) LOCAL oDlg, nEvent, mp1, mp2, oXbp, oBrowse, oEdit LOCAL oCtrl, oFocus := SetAppFocus(), aEditControls := {} LOCAL aPP := { { XBP_PP_FGCLR , GRA_CLR_BLACK } , ; { XBP_PP_BGCLR , GRA_CLR_WHITE } } LOCAL aPPSle := { { XBP_PP_BGCLR, XBPSYSCLR_ENTRYFIELD } } LOCAL aPPTxt := { { XBP_PP_FGCLR , GRA_CLR_BLACK } , ; { XBP_PP_BGCLR , XBPSYSCLR_DIALOGBACKGROUND } } LOCAL nOldArea := Select(), aName := {}, i LOCAL cRNrApp := "AAAX.EXEMUELLX.EXEKUELLX.EXERUDOX.EXESONNEX.EXESTAPPX.EXELANGEX.EXEDOENNEX.EXEBERGX.EXEMENGX.EXESINZIGX.EXESANDERX.EXEKLEMMX.EXEVELLX.EXESCHIERX.EXEHANELX.EXEDISCHX.EXERAGUSEX.EXERAGUSEY.EXEHANDEL.EXEBUCKX.EXEBLEINX.EXE-KLUCKX.EXE-GUDDX.EXE"+cAc LOCAL nRNr := IIf( Upper(AppName())$cRNrApp, Val(RechnungsNr("9999")), 0 ) LOCAL aF1 := {3,1,2,7,8,9,10} , aF2 := {6,4,5,12,13,14,15} PRIVATE aThrdZwi := AClone(aThrdFenster) //+10.10.2008 15:36 PRIVATE oCB, oFVDA, oSle0, oSle, oPS, cDatei, cNameS, cNameB PRIVATE appObject aPos := IIf(Empty(aPos),{10,30*nV},aPos) ASize:= IIf(Empty(ASize),{770*nH,500*nV},ASize) /*14.04.2008 19:25 nH, nV ver„ndert wegen Resize */ // IF nV < 1 // wenn die Fensterh”he reduziert wurde aPos := {oDlg1:cargo:currentpos()[1]+4,oDlg1:cargo:currentpos()[2]} //14.04.2008 14:28 unten wie Hauptmaske // aPos := {5*IIf(nH<1,1,nH),30*IIf(nV<1,1,nV)} //06.04.2008 19:20 ASize := {oDlg1:cargo:currentsize()[1],oDlg1:cargo:currentsize()[2]} //14.04.2008 14:22 H”he wie Hauptmaske // ENDIF /**/ ////////////////////////////////////////////////////////////////////////////////// IF Val(cRS) < aZugang[8] // 18.10.2007 15:25 =Nickel ConfirmBox( oDlg1, "Sie haben dazu NICHT die Berechtigung!", ; IIf(SET(43)==0,ConvToAnsiCP("Formularverwaltung"), ; "Formularverwaltung"), ; XBPMB_OK, ; XBPMB_WARNING ) RETURN .F. ENDIF /////////////////////////////////////////////////////////////////////////////////// SELECT 22 IF Upper(AppName())$"VELLX.EXE" // 22.01.2022 erstmal nur fr VellX //+10.02.2022 09:20 von MuellX.ineux. kopiert: //+25.08.2009 19:35 testet, ob irgendwo im Netz das Programm l„uft: nHandle := FOpen( "c:\hdbe\drubef.dbf", FO_EXCLUSIVE ) IF nHandle = -1 //+ FormularVerwaltung() l„uft irgendwo im Netz: abbrechen msgbox("Die Formular-Verwaltung l„uft bereits irgendwo im Netz! Sp„ter nochmal versuchen!") RETURN .F. ELSE FClose(nHandle) ENDIF USE c:\hdbe\drubef EXCLUSIVE // wegen c:\hdbe sollte es eigentlich nie eine Kollision geben drfen ... ELSE USE drubef ENDIF IF "EPSON"$Upper(cDruckerName) // 10.04.2006 GO 2 ELSE GO BOTTOM ENDIF IF RecNo() == 1 DbAppend() ENDIF cDatei := "BL_DIR.DBF" IF !FILE(cDatei) RETURN .T. ENDIF cDatei := Left( cDatei, At(".",cDatei)-1 ) SELECT 17 DbUseArea( ,, cDatei, "sd",.F. ) DbGotop() DbSkip(0) oDlg := AKDialog():new( AppDesktop(), oDlg1:cargo ) oDlg:tasklist := .T. oDlg:title := "F O R M U L A R - Verwaltung und P A R A M E T E R - Einstellung" oDlg:title := IIf(SET(43)==0,ConvToAnsiCP(oDlg:title),oDlg:title) //03.12.2006 18:02 oDlg:maxButton := .F. oDlg:border := XBPDLG_RAISEDBORDERTHIN_FIXED oDlg:create(,, aPos, ASize ) SetAppFocus(oDlg) // Fenster muá den Focus haben, damit Parts ihn dann kriegen k”nnen! // lockUpdate ist hier nicht m”glich, weil Browse-Area2 dann nicht angezeigt wird // oDlg:lockUpdate(.T.) // damit der Bildaufbau unsichtbar bleibt // oDlg:drawingArea:setColorBG( GRA_CLR_PINK ) oDlg:drawingArea:setColorBG( XBPSYSCLR_TRANSPARENT ) oCB := oDlg:drawingArea oFVDA := oDlg:drawingArea oFVDA:cargo := oDlg // jetzt folgt die Erzeugung der Eingabefelder oEdit := FormFF():new( oFVDA,oDlg, {330*nH,0}, {440*nH,475*nV},,, nBz, "s_form", -100, 299, 17 ) oEdit:CREATE( oFVDA,oDlg, {330*nH,0}, {440*nH,475*nV},,, nBz, "s_form", -100, 299, 17 ) AEval( oEdit:editControls, {|x| oDlg:addEditControl( x ) } ) // AEval( oEdit:appendControls, {|x| oDlg:addAppendControl( x ) } ) // bis hierhin geht die Erzeugung der Eingabefelder // in die 3.-letzte BEArea: IF Upper(AppName())$cRNrApp oEdit:RNrSpin := XbpSpinButton():new( oEdit:BEArea[oEdit:BENr-2], , {Int(100*nH), Int(130*nV)}, {Int(60*nH), Int(20*nV)} ) oEdit:RNrSpin:CREATE() oEdit:RNrSpin:setNumLimits( 1, 99999 ) oEdit:RNrSpin:dataLink := {|x| IIf( x==NIL, nRNr, nRNr := x ) } oEdit:RNrSpin:endSpin := {|mp1,mp2,oXbp,x| x := oXbp:getData(), LTrim(RechnungsNr(Str(x,5,0))) } oEdit:RNrSpin:killinputfocus := {|mp1,mp2,oXbp,x| x := oXbp:getData(), LTrim(RechnungsNr(Str(x,5,0))) } //+17.01.2011 21:04 ENDIF oEdit:LBox := XbpListbox():new( oEdit:BEArea[oEdit:BENr-2], , {Int(100*nH), Int(10*nV)}, {Int(150*nH), Int(100*nV)} ) oEdit:LBox:markMode := XBPLISTBOX_MM_SINGLE oEdit:LBox:create() FOR i := 1 TO 7 sleep(1) //+07.01.2011 14:58 race - es wirkt wirklich und sofort !!! oEdit:LBox:addItem( 22->(FieldGet( aF1[i] )) ) NEXT oEdit:LBox:setData( {1}, .T. ) oEdit:LBox:ItemSelected := {|mp1, mp2, obj| ; ZeichenSatz( oFVDA, oEdit:LBox, aF1, aF2, ; IIf(!Empty(oEdit:LBox:getData()[1]), oEdit:LBox:getData()[1], 1 ) ) } oDlg:setModalState( XBP_DISP_APPMODAL ) oCtrl := XbpGetController():new( oDlg ) oCtrl:create() oCtrl:READ( 1, .F. ) GO TOP * Shortcuts initialisieren oDlg:InitShortCuts( oDlg ) // oDlg:lockUpdate(.F.) oDlg:invalidateRect() nEvent := xbeP_None DO WHILE nEvent <> xbeP_Close nEvent := AppEvent( @mp1, @mp2, @oXbp ) IF nEvent == xbeP_Close .AND. oXbp:isDerivedFrom( "XbpIWindow" ) LOOP ENDIF IF nEvent == xbeP_Keyboard DO CASE CASE mp1 == xbeK_RETURN // CASE mp1 == xbeK_ESC PostAppEvent( xbeP_Close) CASE mp1 == xbeK_F1 ModalDialog( (cDatver+"f1_FV.rtf"), "Bedienungshinweise", oFVDA, 680*nH, 460*nV ) CASE mp1 == xbeK_CTRL_F1 //+18.01.2011 18:31 COPY FILE "s_.tak" TO "S_F1_BAK.tak" ModalDialog( (cDatver+"s_.tak"), "Bildschirmdatei - speichern mit ALT-W", oFVDA, 780*nH, 560*nV ) CASE mp1 == xbeK_ALT_F1 //+18.01.2011 18:31 COPY FILE "bl_.tak" TO "BL_F1_BAK.tak" ModalDialog( (cDatver+"bl_.tak"), "Ausdruckdatei - speichern mit ALT-W", oFVDA, 780*nH, 560*nV ) CASE mp1 == xbeK_F10 PostAppEvent( xbeP_Activate,,, oEdit:DruckKnopf[oEdit:XbpNummer(oEdit:DruckKnopf,"ENDE")] ) // PostAppEvent( xbeP_Close,,,oDlg) CASE mp1 == xbeK_ALT_D nOld := SELECT() SELECT 24 USE hilfetip SORT on help_id TO hilfeS USE hilfeS nZei := 0 SET DEVICE TO printw DO WHILE !Eof() IF ++nZei > 65 EJECT nZei := 1 ENDIF @ nZei,5 SAY 24->help_id @ nZei,10 SAY SubStr(24->hint,1,60) DbSkip() ENDDO SET DEVICE TO SCREEN USE SELECT (nOld) ENDCASE ENDIF oXbp:handleEvent( nEvent, mp1, mp2 ) ENDDO oDlg:setModalState( XBP_DISP_MODELESS ) DbDeRegisterClient(oEdit) oEdit:destroy() oDlg:destroy() ThreadObject():cargo := oDlg1:cargo //+09.02.2010 18:24 wegen MagicHelp SetAppFocus( oFocus ) 17->(DbCloseArea()) //22.01.2022 zum Abspeichern ge„nderter nPoffX + nPoffY: IF (Upper( cDrucker ) = "HP" .OR. "MI"$Upper(cDruckerName) .OR. "OK"$Upper(cDruckerName) .OR. "BR"$Upper(cDruckerName)) ; .AND. !"EPSON"$Upper(cDruckerName) //29.04.2006 17:05 22->hpres5 := StrZero(nPoffY,3,0) + StrZero(nPoffX,3,0) + SubStr(22->hpres5, 7) ELSE 22->epres5 := StrZero(nPoffY,3,0) + StrZero(nPoffX,3,0) + SubStr(22->epres5, 7) ENDIF 22->(DbCloseArea()) SELECT 17 IF !Empty(cNameS) // wird gefllt mit 16->fname in BRegieFEo mit s_*.dbf // hier entsteht aus allen s_*.dbf die s_.txt USE s_dir DO WHILE !Eof() IF !Empty(17->name) AAdd(aName, Trim(17->name) ) ENDIF SKIP ENDDO USE s_best COPY STRUCTURE TO s_ // damit wird eine leere s_.dbf erzeugt USE s_ EXCLUSIVE FOR i := 1 TO Len(aName) DbImport( aName[i] ) REPLACE ALL 17->fname WITH IIf(Empty(17->fname),Upper(aName[i]),Upper(17->fname)) // 7.2.2005 NEXT INDEX on Upper(17->fname)+StrZero(17->field_pos+1000,4,0) TO xtemp // 7.2.2005 COPY TO s_.tak sdf USE // 7.2.2005: hier statt in DialogFF:create() DbUseArea( ,"SDFNTX", "s_.tak", "sv" ) // (.T., ...bedeutet : NEW Area OrdCreate( "C:\HDBE\xFldPos",, "Upper(fname)+StrZero(field_pos+1000,4,0)" ) DbCloseArea() SELECT 17 // vorsichtshalber! ENDIF IF !Empty(cNameB) // wird gefllt mit 16->fname in BRegieFEo mit bl_*.dbf // hier entsteht aus allen bl_*.dbf die bl_.txt ASize(aName,0) USE bl_dir DO WHILE !Eof() IF !Empty(17->name) AAdd(aName, Trim(17->name) ) ENDIF SKIP ENDDO USE bl_b COPY STRUCTURE TO bl_ // damit wird eine leere bl_.dbf erzeugt USE bl_ EXCLUSIVE FOR i := 1 TO Len(aName) DbImport( aName[i] ) // REPLACE ALL fname WITH aName[i] FOR Empty(17->fname) REPLACE ALL fname WITH IIf(Empty(17->fname),Upper(aName[i]),Upper(17->fname)) NEXT // kein Index!!! // INDEX on 17->fname+Str(17->field_pos,3,0) TO xtemp COPY TO bl_.tak sdf OrdCreate( "xBlFName",, "Upper(fname)" ) USE ENDIF Select &nOldArea IIf(lLogBook,oBest:TLog:write():writeLogFile(),) //16.09.2007 22:32 // IF Upper(AppName())$"MUELLX.EXE" // cV := cVur //+11.10.2008 14:15 fr einen richtigen Refresh // PostAppEvent( xbeU_RefreshAnlief,,,oBest:oOwner) //+11.10.2008 14:15 // ENDIF RETURN .T. FUNCTION FormNeu(oDlg1) 17->(DbAppend()) IF OrdNumber() > 0 17->(DbGotop()) ENDIF 17->(DbSkip(0)) SetAppFocus( oDlg1:setParent():childFromName( 17->(FieldPos( "name" )) ) ) RETURN .T. FUNCTION FormEntf(oDlg1) IF ConfirmBox( oDlg1, IIf(SET(43)==0,ConvToAnsiCP("Soll der Datensatz gel”scht werden?"), ; "Soll der Datensatz gel”scht werden?"), ; IIf(SET(43)==0,ConvToAnsiCP("Datensatz l”schen"),"Datensatz l”schen"), ; XBPMB_YESNO, ; XBPMB_QUESTION ) == XBPMB_RET_YES Satzsp(oCB) 17->(DbDelete()) 17->(DbSkip(0)) RETURN .T. ENDIF RETURN .T. FUNCTION FormSuch( oDlg1, cDatei ) LOCAL oDlg, nEvent, mp1, mp2, oBrowse LOCAL aSizeDesktop := AppDesktop():currentSize() LOCAL nBSb := aSizeDesktop[1] LOCAL nBSh := aSizeDesktop[2] // folgende Zahlen-Werte basieren auf 800x600: // LOCAL nV := nBSb/800 // Korrekturfaktor fr tats„chliche Aufl”sung LOCAL nOldArea := Select(), oFocus := SetAppFocus() LOCAL lFlucht := .F., nRec := RecNo() PRIVATE oCB (nOldArea)->(DbSuspendNotifications()) SELECT 26 USE s_dir LOCATE FOR FIELD_NAME = Trim(cDatei) IF FILE(cDatei+".dbf") .AND. !26->(Eof()) 26->(DbCloseArea()) Select &nOldArea DbUseArea( ,, cDatei, "sd" ) OrdCreate( "dFldPos",, "Str(field_pos,3,0)" ) (nOldArea)->(DbResetNotifications()) (nOldArea)->(DbGobottom()) SetAppFocus( oFocus ) RETURN cDatei ENDIF oDlg := AKDialog():new( AppDesktop(), oDlg1:cargo ) oDlg:tasklist := .T. oDlg:title := "Dateien suchen" oDlg:maxButton := .F. oDlg:border := XBPDLG_RAISEDBORDERTHIN_FIXED oDlg:create(,, {10,30*nV}, {int(330*nH),int(250*nV)} ) oDlg:drawingArea:setColorBG( GRA_CLR_DARKCYAN ) oCB := oDlg:drawingArea oCB:cargo := oDlg // jetzt folgt die Erzeugung der Eingabefelder oBrowse := FilesFF():new( oCB,oDlg, {330*nH,0}, {440*nH,475*nV},,, nBz, "s_files",300,399, 26 ) oBrowse:CREATE( oCB,oDlg, {330*nH,0}, {440*nH,475*nV},,, nBz, "s_files",300,399, 26 ) // bis hierhin geht die Erzeugung der Eingabefelder oDlg:setModalState( XBP_DISP_APPMODAL ) oDlg:show() SetAppFocus( oBrowse:BrowseFeld[1] ) nEvent := xbeP_None DO WHILE nEvent <> xbeP_Close nEvent := AppEvent( @mp1, @mp2, @oXbp ) // IF nEvent == xbeM_LbDblClick .AND. SetAppFocus():isDerivedFrom( "XbpBrowse" ) IF nEvent == xbeBRW_ItemSelected PostAppEvent( xbeP_Close) ENDIF IF nEvent == xbeP_Keyboard DO CASE CASE mp1 == xbeK_RETURN .or. mp1 == xbeK_F10 PostAppEvent( xbeP_Close) CASE mp1 == xbeK_ESC lFlucht := .T. PostAppEvent( xbeP_Close) ENDCASE ENDIF oXbp:handleEvent( nEvent, mp1, mp2 ) ENDDO oDlg:setModalState( XBP_DISP_MODELESS ) oDlg:destroy() /// cDatei := Trim(26->FIELD_NAME) 26->(DbCloseArea()) Select &nOldArea IF lFlucht = .T. (nOldArea)->(DbGoto(nRec)) ELSE DbUseArea( ,, cDatei, "sd" ) OrdCreate( "dFldPos",, "Str(field_pos,3,0)" ) ENDIF SET ORDER TO 1 (nOldArea)->(DbResetNotifications()) (nOldArea)->(DbSkip(0)) SetAppFocus( oFocus ) RETURN cDatei FUNCTION FVSatzEinfg( lDel ) LOCAL nA := SELECT(), i, n LOCAL aBlattSE := {} , aBlattZSE[FCount()] LOCAL nRec := RecNo(), nFP := IIf( IsFieldVar("Field_Pos"), Field_Pos - 1, ) lDel := IIf( lDel<>NIL, lDel, .F. ) DbSuspendNotifications() APPEND BLANK aBlattZSE := FESatzLese() // liest eine leere Zeile GO 1 DO WHILE .NOT. Eof() IF !Deleted() IF nRec = Recno() .AND. !lDel AAdd( aBlattSE, aBlattZSE ) // fgt eine leere Zeile ein AAdd( aBlattSE, FESatzLese() ) ELSEIF nRec = Recno() .AND. lDel // l„át den aktuellen Satz aus ELSE AAdd( aBlattSE, FESatzLese() ) ENDIF ENDIF SKIP ENDDO ZAP // l”scht die Datei ganz FOR i := 1 to Len( aBlattSE ) // baut die Datei neu auf: APPEND BLANK aBlattZSE := aBlattSE[i] For n := 1 to FCount() FieldPut( n, aBlattZSE[n] ) NEXT NEXT GO nRec IF IsFieldVar( "Field_Pos" ) .AND. !lDel REPLACE Field_Pos WITH nFP ENDIF DbResumeNotifications() DbSkip(0) RETURN .T. FUNCTION FVSatzLese() LOCAL aValue := Array( FCount() ), n FOR n := 1 TO FCount() aValue[n] := FieldGet(n) NEXT RETURN aValue FUNCTION Inhalt( cInhalt ) LOCAL aReg := {} cDatei := cInhalt // SELECT 17 aReg := DbClientList() DbUseArea( ,, cDatei, "sd",.F. ) DbGotop() AEval( aReg, {|x,i| DbRegisterClient( aReg[i] ) } ) RETURN DbSkip(0) /*31.03.2008 14:49 jetzt auch zum Ver„ndern der Server-mwstdat geeignet: */ PROCEDURE FVParam( oDlg1, lServer ) //31.03.2008 14:49 LOCAL nOldArea := Select(), nEvent := xbeP_None, mp1, mp2, obj, cFirmaBak := cFirma //31.03.2008 14:49 LOCAL cR := cRS, cBN := cBNr, cB := cBK, cBf := cBfont, aZ := AClone(aZugang) //31.03.2008 16:27 wichtige Parameter LOCAL aPS //31.03.2008 16:34 aParameterSicherungsArray LOCAL nHzwi := nH, nVzwi := nV //+01.02.2011 13:08 DEFAULT lServer TO .F. //31.03.2008 14:49 IF !Empty(Alias(23)) RETURN ENDIF SELECT 23 IF lServer //31.03.2008 13:09 USE ( cDatver + "mwstdat" ) // auf dem Server ELSE USE mwstdat // wie bisher ENDIF /* 31.03.2008 17:24 sichern der nicht zu ver„ndernden Parameter: */ aPS := { IIf( IsFieldVar("PW0"), {PW0,PW1,PW2,PW3,PW4,PW5,PW6,PW7,PW8,PW9}, NIL ), ; IIf( IsFieldVar("RS0"), {RS0,RS1,RS2,RS3,RS4,RS5,RS6,RS7,RS8,RS9}, NIL ), ; IIf( IsFieldVar("BK0"), {BK0,BK1,BK2,BK3,BK4,BK5,BK6,BK7,BK8,BK9}, NIL ) ; } /**/ APPEDIT INTO appParam; PARENT ATail( oDlg1:childList() ) ; POSITION Left ; NOACTION APPACTION_NONAVIGATION + APPACTION_NOINSERT + APPACTION_NODELETE APPDISPLAY appParam MODELESS //31.03.2008 14:37 MODELESS /*31.03.2008 14:36 Event-Schleife ver„ndert, jetzt wirkt auch der ENDE-Knopf */ DO WHILE nEvent <> xbeP_Close // Ereignisse verarbeiten nEvent := AppEvent( @mp1, @mp2, @obj ) IF nEvent == xbeP_Close .AND. !obj:isderivedfrom("AppEdit") nEvent := xbe_None LOOP ENDIF obj:handleEvent( nEvent, mp1, mp2 ) ENDDO /**/ appParam:hide() appParam:destroy() SELECT 23 /*31.03.2008 17:24 rcksichern der nicht zu ver„ndernden Parameter: */ Satzsp(oCB) IIf( IsFieldVar("PW0"), {23->PW0:=aPS[1,1],23->PW1:=aPS[1,2],23->PW2:=aPS[1,3],23->PW3:=aPS[1,4],23->PW4:=aPS[1,5], ; 23->PW5:=aPS[1,6],23->PW6:=aPS[1,7],23->PW7:=aPS[1,8],23->PW8:=aPS[1,9],23->PW9:=aPS[1,10]} ; , ) IIf( IsFieldVar("RS0"), {23->RS0:=aPS[2,1],23->RS1:=aPS[2,2],23->RS2:=aPS[2,3],23->RS3:=aPS[2,4],23->RS4:=aPS[2,5], ; 23->RS5:=aPS[2,6],23->RS6:=aPS[2,7],23->RS7:=aPS[2,8],23->RS8:=aPS[2,9],23->RS9:=aPS[2,10]} ; , ) IIf( IsFieldVar("BK0"), {23->BK0:=aPS[3,1],23->BK1:=aPS[3,2],23->BK2:=aPS[3,3],23->BK3:=aPS[3,4],23->BK4:=aPS[3,5], ; 23->BK5:=aPS[3,6],23->BK6:=aPS[3,7],23->BK7:=aPS[3,8],23->BK8:=aPS[3,9],23->BK9:=aPS[3,10]} ; , ) /**/ 23->(DbCloseArea()) // DO WHILE nEvent <> xbeP_Close // nEvent := AppEvent( @mp1, @mp2, @oXbp ) // damit Parent nicht geschlossen wird!! // ENDDO 22->(DbCloseArea()) EUROV( .T. ) // damit cFV in eurov() nicht leer ist aThrdFenster := AClone(aThrdZwi) // weil zwischendurch EuroV aufgerufen wurde +10.10.2008 15:36 SELECT 22 IF Upper(AppName())$"VELLX.EXE" // 22.01.2022 erstmal nur fr VellX USE c:\hdbe\drubef EXCLUSIVE ELSE USE drubef ENDIF DbGoBottom() SELECT &nOldArea cFirma := cFirmaBak oDlg1:invalidateRect() // ist hier sehr wichtig!! cRS := cR; cBNr := cBN; cBK := cB; cBfont := cBf; aZugang := AClone(aZ) // wichtige Parameter rcksichern 31.03.2008 16:27 nH := nHzwi ; nV := nVzwi //+01.02.2011 13:09 wichtige Rcksicherung ! RETURN PROCEDURE FVParam2( oDlg1 ) LOCAL nOldArea := Select(), nEvent := xbeP_None, mp1, mp2, obj //31.03.2008 14:49 IF 22->(RecNo()) == 1 RETURN ENDIF SELECT 22 IF Upper(AppName())$"VELLX.EXE" // 22.01.2022 erstmal nur fr VellX GO BOTTOM //22.01.2022 ge„ndert, weil so logisch! //GO TOP ELSE GO TOP ENDIF APPEDIT INTO appParam2 ; PARENT ATail( oDlg1:childList() ) ; POSITION Left ; NOACTION APPACTION_NONAVIGATION + APPACTION_NOINSERT + APPACTION_NODELETE APPDISPLAY appParam2 MODELESS //31.03.2008 14:38 MODELESS /*31.03.2008 14:36 Event-Schleife ver„ndert, jetzt wirkt auch der ENDE-Knopf */ DO WHILE nEvent <> xbeP_Close // Ereignisse verarbeiten nEvent := AppEvent( @mp1, @mp2, @obj ) obj:handleEvent( nEvent, mp1, mp2 ) ENDDO /**/ appParam2:hide() appParam2:destroy() GO BOTTOM ////// DO WHILE nEvent = xbeP_Close ////// nEvent := AppEvent( @mp1, @mp2, @oXbp ) ////// ENDDO SELECT &nOldArea oDlg1:invalidateRect() // ist hier sehr wichtig !! RETURN PROCEDURE HilfeTip( oDlg1 ) LOCAL nOldArea := Select(), nEvent := xbeP_None, mp1, mp2, obj //31.03.2008 14:48 SELECT 24 USE hilfetip //EXCLUSIVE GO TOP APPEDIT INTO appParam2 ; PARENT ATail( oDlg1:childList() ) ; POSITION Left ; NOACTION APPACTION_NONAVIGATION //+ APPACTION_NOINSERT + APPACTION_NODELETE APPDISPLAY appParam2 MODELESS //31.03.2008 14:38 MODELESS /*31.03.2008 14:36 Event-Schleife ver„ndert, jetzt wirkt auch der ENDE-Knopf */ DO WHILE nEvent <> xbeP_Close // Ereignisse verarbeiten nEvent := AppEvent( @mp1, @mp2, @obj ) obj:handleEvent( nEvent, mp1, mp2 ) ENDDO /**/ appParam2:hide() appParam2:destroy() ////// DO WHILE nEvent = xbeP_Close ////// nEvent := AppEvent( @mp1, @mp2, @oXbp ) ////// ENDDO USE SELECT &nOldArea oDlg1:invalidateRect() // ist hier sehr wichtig !! RETURN PROCEDURE ZeichenSatz( oDlg1, oListBox, aF1, aF2, nFNr ) LOCAL cFont, oFont, nFam, oFontDlg LOCAL nOldArea := SELECT() LOCAL oScreenPS := NIL LOCAL oPrintPS := PrinterPS() DEFAULT aF1 TO {1,2,3,4,5,6,7}, aF2 TO {1,2,3,4,5,6,7}, nFNr TO 1 //21.07.2006 18:31 cFont := 22->(FieldGet( aF1[nFNr] )) //21.07.2006 18:31 SELECT 22 IF At( "FETT", Upper(cFont) ) > 0 nFam := At( "FETT", Upper(cFont) ) - 5 ELSEIF At( "KURS", Upper(cFont) ) > 0 nFam := At( "KURS", Upper(cFont) ) - 5 ELSE nFam := Len( Trim(cFont) ) - 3 ENDIF oFontDlg := XbpFontDialog():New( oDlg1:cargo, oDlg1:cargo, oScreenPS, oPrintPS ) oFontDlg:familyName := Substr( cFont, 4, nFam ) oFontDlg:nominalPointSize := Val( Substr( cFont, 1, 2 ) ) oFontDlg:viewPrinterFonts := .T. oFontDlg:create() DO WHILE ( oFont := oFontDlg:display( XBP_DISP_APPMODAL ) ) <> NIL Satzsp(oDlg1) 22->(FieldPut( aF1[nFNr], Str(oFont:nominalPointSize,2,0)+"."+oFont:compoundName )) 22->(FieldPut( aF2[nFNr], Str(oFont:nominalPointSize,2,0)+"."+oFont:compoundName )) DbRUnlock(RecNo()) oListBox:clear() FOR i := 1 TO 7 Sleep(1) //+22.02.2011 13:22 Vista-Problem ! oListBox:addItem( 22->(FieldGet( aF1[i] )) ) NEXT oListBox:setData( {nFNr}, .T. ) // Aktuellen Fontnamen // oFontDlg:familyName := oFont:familyName // registrieren oFont:destroy() EXIT ENDDO oFontDlg:destroy() SELECT &nOldArea RETURN //----------------------------------------------------------- ///////////////////////////////////////////////////////////////////// //////// frhere s_.txt und bl_.txt heiáen jetzt *.tak !! //////// TXT_zu_DBF: macht aus der s_.tak die s_*.dbf und aus der bl_.tak die bl_*.dbf: //////// (wenn keine s_dir.dbf und bl_dir.dbf existiert, werden sie roh angelegt) //////FUNCTION TXT_zu_DBF(ind) //////LOCAL aName := {}, i, cAltName := " " //////LOCAL nOldArea := SELECT() ////////10.4.2005 RunShell( "/C COPY bl_*.dbf *.bup" ) // Datensicherung des bl_*-Dateien ////////10.4.2005 RunShell( "/C COPY s_*.dbf *.bup" ) // Datensicherung des s_*-Dateien //////// hier entstehen aus der s_.tak alle s_*.dbf //////IF FExists( cDatver+"s_.tak" ) ////// DbUseArea( .T.,"SDFNTX", "s_","s" ) ////// DO WHILE !Eof() ////// IF Upper(s->fname) == Upper(cAltName) ////// ELSE ////// AAdd( aName, Upper(Trim(s->fname)) ) // 7.2.2005 ////// cAltName := s->fname ////// ENDIF ////// SKIP ////// ENDDO ////// FOR i := 1 TO Len(aName) ////// DbExport(aName[i],,{||Trim(Upper(s->fname))==Trim(Upper(aName[i]))} ) ////// NEXT ////// USE ////// IF !FExists(cDatver+"s_dir.dbf") ////// DbCreate("s_dir",{{"NAME","C",8,0},{"BESCHREIB","C",50,0}},"DBFNTX") ////// USE s_dir ////// FOR i := 1 TO Len(aName) ////// APPEND BLANK ////// REPLACE name WITH aName[i] ////// NEXT ////// USE ////// ENDIF ////// ASize(aName,0) //////ENDIF //////// hier entstehen aus der bl_.txt alle bl_*.dbf //////IF FExists( cDatver+"bl_.tak" ) ////// DbUseArea( .T.,"SDFNTX", "bl_" ) ////// DO WHILE !Eof() ////// IF Upper(fname) == Upper(cAltName) ////// ELSE ////// AAdd( aName, Upper(Trim(fname)) ) // 7.2.2005 ////// cAltName := fname ////// ENDIF ////// SKIP ////// ENDDO ////// FOR i := 1 TO Len(aName) ////// DbExport(aName[i],,{||Trim(Upper(fname))==Trim(Upper(aName[i]))} ) ////// NEXT ////// USE ////// IF !FExists(cDatver+"bl_dir.dbf") ////// DbCreate("bl_dir",{{"NAME","C",8,0},{"BESCHREIB","C",50,0}},"DBFNTX") ////// USE bl_dir ////// FOR i := 1 TO Len(aName) ////// APPEND BLANK ////// REPLACE name WITH aName[i] ////// NEXT ////// USE ////// ENDIF ////// ASize(aName,0) //////ENDIF //////////////////// //////IF ind == "i" // 23.09.2005 Index nach ALT-F11 ////// DbUseArea( ,"SDFNTX", "s_.tak", "sv" ) // 9.2.2005 ////// OrdCreate( "xFldPos",, "Upper(fname)+StrZero(field_pos+1000,4,0)" ) ////// DbUseArea( ,"SDFNTX", "bl_.tak", "bv" ) // 9.2.2005 ////// OrdCreate( "xBlFName",, "Upper(fname)" ) ////// DbCloseArea() //////ENDIF //////SELECT &nOldArea //////RETURN .T. //----------------------------------------------------------- //----------------------------------------------------------- CLASS FormFF FROM DialogFF EXPORTED: VAR VArea VAR LBox // Listbox, damit sie mit-refreshed wird VAR RNrSpin // nur fr Mller: n„chste Rechnungsnummer METHOD INIT METHOD CREATE METHOD notify ENDCLASS METHOD FormFF:INIT( oParent, oOwner, aPos, ASize, aPP, lVisible, nBz, cFF, nAnf, nEnd, nA ) ::DialogFF:INIT( oParent, oOwner, aPos, ASize, aPP, lVisible, nBz, cFF, nAnf, nEnd, nA ) ::VArea := nA ::BEArea := {} AAdd( ::BEArea, oParent ) ::BENr := Len( ::BEArea ) ::Fancy := "0" RETURN self METHOD FormFF:CREATE( oParent, oOwner, aPos, ASize, aPP, lVisible, nBz, cFF, nAnf, nEnd, nA ) ::DialogFF:CREATE( oParent, oOwner, aPos, ASize, aPP, lVisible, nBz, cFF, nAnf, nEnd, nA ) (nA)->(DbRegisterClient(self)) // reicht es, wenn das Fenster als Ganzes registriert ist?? RETURN self METHOD FormFF:notify( nEvent, mp1, mp2 ) LOCAL nRec, oFocus, i IF nEvent == xbeDBO_Notify // Notify-Ereignis IF mp1 == DBO_MOVE_DONE // Skip ist beendet IF !SetAppFocus():isDerivedFrom( "XbpBrowse" ) .AND. Len(::BrowseFeld) > 0 (::VArea)->(DbSuspendNotifications()) nRec := (::VArea)->(RecNo()) FOR i := 1 TO Len(::BrowseFeld) ::BrowseFeld[i]:refreshAll() NEXT (::VArea)->(DbGoto( nRec )) (::VArea)->(DbResetNotifications()) ENDIF ENDIF ENDIF RETURN self //----------------------------------------------------------- /////////////////////////////////////////////////////////////// FUNCTION Backup_zum_NotServer(cServDrv,cVerz,lTotal) //08.10.2006 17:20 cServDrv = "M" (meistens) LOCAL aName := {}, i, cAltName := " ", nDrive, n := 0, cNetverX, cDatverX //19.11.2006 18:34 DEFAULT cServDrv TO "M:", cVerz TO "\HDBE", lTotal TO .F. //19.11.2006 18:36 cDatverX := IIf("DIENST"$cVerz,cNetver2,cDatver) //19.11.2006 19:28 CLOSE ALL // vorsichtshalber ! //////// IF lTotal //09.11.2006 12:42 IF Upper(AppName())$"MUELLX.EXE" .AND. IsDriveReady(cServDrv) < 0 //+07.12.2008 11:59 mal schauen, ob das wirkt... RunShell( "/C NET USE L: \\Mueller-2\c /PERSISTENT:YES" ) Sleep(100) ENDIF IF IsDriveReady(cServDrv) = 0 .AND. Upper(cServDrv) != "C:" cNetverX := cServDrv+"\HDBE\" IF ConfirmBox( oBEDA, ; "Soll WIRKLICH alles von diesem PC"+CRLF+ ; "aus dem Verzeichnis: "+cDatverX+CRLF+ ; "auf den Server in das Verzeichnis:"+CRLF+ ; cNetverX+" kopiert werden?", ; "Achtung :", ; XBPMB_YESNO, ; XBPMB_WARNING, ; XBPMB_DEFBUTTON2 ) ; = XBPMB_RET_YES ELSE RETURN "Dann eben nicht..." ENDIF ELSE //+05.11.2008 12:10 wenn der Notrechner aus ist, anderes Laufwerk suchen (z.B. Stick) //+05.11.2008 11:57 Netzwerkverzeichnis suchen, oder alternativ: //+ Laufwerk des Sticks, bzw. Verzeichnis auf dem Stick suchen //+ Annnahme: der Stick hat die h”chste lokale Laufwerksbezeichnung FOR nDrive := 90 TO 69 STEP -1 // Chr(nDrive) = "Z" ... "E" IF IsDriveReady(Chr(nDrive)) = 0 // wenn das Laufwerk existiert: cNetverX := Chr(nDrive)+":\HDBE\" IF ConfirmBox( oBEDA, ; "Soll WIRKLICH alles von diesem PC"+CRLF+ ; "aus dem Verzeichnis: "+cDatverX+CRLF+ ; "auf das Laufwerk/Verzeichnis:"+CRLF+ ; cNetverX+" kopiert werden?", ; "Achtung :", ; XBPMB_YESNO, ; XBPMB_WARNING, ; XBPMB_DEFBUTTON2 ) ; = XBPMB_RET_YES EXIT ENDIF ENDIF NEXT IF nDrive = 68 RETURN MsgBox("Kein weiteres Laufwerk verfgbar!","Backup NICHT m”glich!") ELSE cServDrv := Chr(nDrive)+":" ENDIF ENDIF //+//05.11.2008 12:14 bis hierhin geht die Laufwerkssuche/-auswahl // @ 11,5 SAY "kopiere... "+Space(40) // wenn das Laufwerk existiert: IF !FExists( cServDrv+"\HDBE", "D" ) //09.11.2006 12:25 RunShell( "/C MD "+cServDrv+"\HDBE",, .T. ) ENDIF // wenn das Verzeichnis existiert: cNetverX := cServDrv+"\HDBE\" //09.11.2006 12:25 RunShell("/C XCOPY "+cDatverX+"*.* "+cNetverX+"*.* /T /E /Y") RunShell("/C XCOPY "+cDatverX+"*.* "+cNetverX+"*.* /S /E /Y") //ist schon in der Vorzeile enthalten: RunShell("/C XCOPY "+cDatverX+"*.* "+cNetverX+"*.*") ////// aExt := {"*.bat","*.BMP","*.CDX","*.DBF","*.DBT","*.FPT","*.JPG","*.NTX","*.TXT","*.XCH"} ////// FOR j := 1 TO Len(aExt) ////// aDry := Directory(cDatverX+aExt[j]) ////// FOR i := 1 TO Len(aDry) ////// COPY FILE ( cDatverX+aDry[i,F_NAME] ) TO ( cNetverX+aDry[i,F_NAME] ) ////// NEXT ////// NEXT ////// IF !FExists(cDatverX+"PROG","D") ////// RunShell( "/C MD "+cDatverX + "PROG",, .T. ) ////// ENDIF ////// RunShell("/C COPY "+cDatverX+"PROG\*.* "+cNetverX+"PROG\*.*") ////// RunShell("/C COPY "+cDatverX+"PROG\*.* "+cNetverX+"*.*") IF Upper(AppName())$"MUELLX.EXE-BLEINX.EXE" IF !FExists("C:\HDBDIENST","D") RunShell( "/C MD "+cServdrv+"\HDBDIENST",, .T. ) ENDIF RunShell("/C XCOPY C:\HDBDIENST\*.* "+cServdrv+"\HDBDIENST\*.* /T /E /Y") RunShell("/C XCOPY C:\HDBDIENST\*.* "+cServdrv+"\HDBDIENST\*.* /S /E /Y") ENDIF COPY FILE (cDatverX+"mwstdat.DBF") TO (cNetverX+"mwstNot.DBF") COPY FILE (cDatverX+"mwstdat.DBF") TO (cNetverX+"mwstOrg.DBF") DbUseArea(,, cNetverX+"mwstdat","mdat",.F.) mdat->datver := "M:\HDBE\" mdat->netver := "M:\HDBE\" mdat->netver2 := "M:\HDBDIENST\" DbCloseArea() DbUseArea(,, cNetverX+"mwstNot","mdat",.F.) mdat->datver := "C:\HDBE\" mdat->netver := "C:\HDBE\" mdat->netver2 := "C:\HDBDIENST\" DbCloseArea() DbUseArea(,, cNetverX+"mwstOrg","mdat",.F.) mdat->datver := "M:\HDBE\" mdat->netver := "M:\HDBE\" mdat->netver2 := "M:\HDBDIENST\" DbCloseArea() // ENDIF // ELSE // MsgBox("Server-Verzeichnis ist nicht erreichbar") // RETURN .F. // ENDIF // ELSE // MsgBox("Server ist so nicht erreichbar") // RETURN .F. // ENDIF MsgBox("Kopieren ins Verzeichnis "+cNetverX+" erledigt") RETURN "Alle Dateien und Verzeichnisse kopiert" FUNCTION DATEN_zum_SERVER(cServDrv,cVerz,lTotal) //08.10.2006 17:20 cServDrv = "M" (meistens) LOCAL aName := {}, i, cAltName := " ", nDrive, n := 0, cNetverX, cDatverX //19.11.2006 18:34 LOCAL oProgress //+29.01.2011 22:46 DEFAULT cServDrv TO SubStr(cNetver,1,2), cVerz TO "\HDBE", lTotal TO .F. //+21.11.2010 18:40 IF Upper(AppName())$"GUDDX.EXE-BLEINX.EXE-MUELLX.EXE" //+23.01.2011 12:14 //Netzplatte suchen: FOR nDrive := 90 TO 69 STEP -1 // Chr(nDrive) = "K" ... "E" IF IsDriveReady(Chr(nDrive)) = 0 // wenn das Laufwerk existiert: IF FExists( Chr(nDrive)+":\HDBE_NET", "D" ) // wenn das Verzeichnis existiert: cNetverX := Chr(nDrive)+":\HDBE\" EXIT ENDIF ENDIF NEXT IF nDrive >= 69 cServDrv := SubStr(cNetverX,1,2) ELSE MsgBox("Server kann nicht gefunden werden!","Daten zum Server bertragen:") RETURN .F. ENDIF ENDIF cDatverX := IIf("DIENST"$cVerz,cNetver2,cDatver) //19.11.2006 19:28 CLOSE ALL // vorsichtshalber ! IF lTotal //09.11.2006 12:42 // IF IsDriveReady(cServDrv) = 0 // // wenn das Laufwerk existiert: // IF FExists( cServDrv+"\HDBE", "D" ) //09.11.2006 12:25 // // wenn das Verzeichnis existiert: // cNetverX := cServDrv+"\HDBE\" //09.11.2006 12:25 // IF ConfirmBox( oBEDA, ; // "Soll WIRKLICH alles von diesem PC"+CRLF+ ; // "aus dem Verzeichnis: "+cDatverX+CRLF+ ; // "auf den Server in das Verzeichnis:"+CRLF+ ; // cNetverX+" kopiert werden?", ; // "Achtung :", ; // XBPMB_YESNO, ; // XBPMB_WARNING, ; // XBPMB_DEFBUTTON2 ) ; // = XBPMB_RET_YES // @ 11,5 SAY "kopiere... "+Space(40) // COPY FILE (cDatverX+"*.*") TO (cNetverX+"*.*") // ENDIF // ELSE // MsgBox("Server-Verzeichnis ist nicht erreichbar") // RETURN .F. // ENDIF // ELSE MsgBox("Server ist so nicht erreichbar") // RETURN .F. // ENDIF ELSE IF FExists( cDatverX+"dateien1.tak" ) .AND. ConfirmBox( oBEDA, ; "Sollen WIRKLICH die Daten von diesem PC"+CRLF+ ; "aus dem Verzeichnis: "+cDatverX+CRLF+ ; "auf den Server in das Verzeichnis:"+CRLF+ ; cNetverX+" kopiert werden?", ; "Achtung :", ; XBPMB_YESNO, ; XBPMB_WARNING, ; XBPMB_DEFBUTTON2 ) ; = XBPMB_RET_YES DbUseArea( .T.,"SDFNTX", "dateien1","s" ) // in dateien1.tak sind alle Dateinamen DO WHILE !Eof() IF Upper(s->fname) == Upper(cAltName) ELSE AAdd( aName, Upper(Trim(s->fname)) ) // Dateinamen ins Array aName cAltName := s->fname ENDIF SKIP ENDDO DbCloseArea() // Laufwerk (cServDrv=M) des Servers, bzw. Verzeichnis auf dem Server => M:\HDBE\ IF IsDriveReady(cServDrv[1]) = 0 //19.11.2006 18:37 // wenn das Laufwerk existiert: IF FExists( cServDrv+cVerz, "D" ) //19.11.2006 18:37 // wenn das Verzeichnis existiert: // cNetver2 := cServDrv+":\HDBE\" cNetverX := cServDrv+cVerz+"\" //19.11.2006 18:34 ELSE MsgBox("Server-Verzeichnis ist nicht erreichbar") RETURN .F. ENDIF ELSE MsgBox("Server ist nicht erreichbar") RETURN .F. ENDIF //+29.01.2011 22:46 Fortschrittsanzeige oProgress := ProgressBar():new( AppDeskTop(),, {200,100}, {AppDeskTop():currentsize()[1]-400,24},, .F. ) oProgress:create() oProgress:color := GRA_CLR_GREEN oProgress:minimum := 1 oProgress:maximum := 75 // Original-Server-Daten sichern, aber nur ein Backup pro Tag : IF !FExists(cNetverX+DtoS(DATE()),"D") //19.11.2006 18:38 // Backup-Verzeichnis erzeugen mit heutigem Datum als Name: RunShell( "/C MD "+cNetverX+DtoS(DATE()) ) //19.11.2006 18:38 sleep(100) //+29.01.2011 23:16 // Backup der Dateien: FOR i := 1 TO Len(aName) IF FExists( cNetverX+aName[i] ) oProgress:increment() //+29.01.2011 22:48 @ 11,5 SAY "sichere "+aName[i]+Space(40) COPY FILE (cNetverX+aName[i]) TO (cNetverX+DtoS(DATE())+"\"+aName[i]) ENDIF NEXT ENDIF // vom cDatverX zum Server bzw. in das cNetverX kopieren: FOR i := 1 TO Len(aName) IF FExists( cDatverX+aName[i] ) oProgress:increment() //+29.01.2011 22:48 @ 11,5 SAY "kopiere "+aName[i]+Space(40) COPY FILE (cDatverX+aName[i]) TO (cNetverX+aName[i]) ENDIF NEXT //+03.06.2012 18:28 kopiert auch die neuen Bilder zum Netzlaufwerk IF Upper(AppName())$"MUELLX.EXE-BLEINX.EXE" .AND. FExists( cNetverX+"scans", "D" ) RunShell("/C XCOPY "+cDatverX+"scans\*.* "+cNetverX+"scans\*.* /D /H /R /S /E /Y") RunShell("/C XCOPY "+cDatverX+"scans2\*.* "+cNetverX+"scans2\*.* /D /H /R /S /E /Y") ENDIF oProgress:destroy() //+29.01.2011 22:48 MsgBox("Machen Sie anschlieáend einen Prflauf auf dem Server!") ENDIF ENDIF Tone(1000,9) MsgBox("Kopiervorgang beendet!") //+29.01.2011 22:32 RETURN .T. /////////////////////////////////////////////////////////////// FUNCTION DATEN_vom_SERVER(cServDrv,cVerz,lTotal) LOCAL aName := {}, i, cAltName := " ", nDrive, cNetverX, cDatverX //19.11.2006 18:39 DEFAULT cServDrv TO SubStr(cNetver,1,2), cVerz TO "\HDBE", lTotal TO .F. //+21.11.2010 18:41 IF Upper(AppName())$"GUDDX.EXE-BLEINX.EXE-MUELLX.EXE" //+21.11.2010 19:06 //Netzplatte suchen: FOR nDrive := 90 TO 69 STEP -1 // Chr(nDrive) = "K" ... "E" IF IsDriveReady(Chr(nDrive)) = 0 // wenn das Laufwerk existiert: IF FExists( Chr(nDrive)+":\HDBE_NET", "D" ) // wenn das Verzeichnis existiert: cNetverX := Chr(nDrive)+":\HDBE\" EXIT ENDIF ENDIF NEXT IF nDrive >= 69 cServDrv := SubStr(cNetverX,1,2) ELSE MsgBox("Server kann nicht gefunden werden!","Daten vom Server bertragen:") RETURN .F. ENDIF ENDIF cDatverX := IIf("DIENST"$cVerz,cNetver2,"C"+SubStr(cDatver,2)) //+22.11.2010 16:21 CLOSE ALL // vorsichtshalber ! //+30.01.2011 09:24 Fortschrittsanzeige oProgress := ProgressBar():new( AppDeskTop(),, {200,100}, {AppDeskTop():currentsize()[1]-400,24},, .F. ) oProgress:create() oProgress:color := GRA_CLR_GREEN oProgress:minimum := 1 oProgress:maximum := 75 oProgress:increment(5) //+30.01.2011 09:25 IF lTotal //09.11.2006 12:42 IF IsDriveReady(cServDrv[1]) = 0 // wenn das Laufwerk existiert: IF FExists( cServDrv+cVerz, "D" ) //19.11.2006 18:40 // wenn das Verzeichnis existiert: cNetverX := cServDrv+cVerz+"\" //19.11.2006 18:40 IF ConfirmBox( oBEDA, ; "Soll WIRKLICH alles vom Server "+cNetverX+CRLF+ ; "auf diesen PC in das Verzeichnis:"+CRLF+ ; cDatverX+" kopiert werden?", ; "Achtung :", ; XBPMB_YESNO, ; XBPMB_WARNING, ; XBPMB_DEFBUTTON2 ) ; = XBPMB_RET_YES @ 11,5 SAY "kopiere... "+Space(40) oProgress:increment() //+30.01.2011 09:25 COPY FILE (cNetverX+"*.db?") TO (cDatverX+"*.db?") //19.11.2006 18:45 : oProgress:increment() //+30.01.2011 09:25 COPY FILE (cNetverX+"*.tak") TO (cDatverX+"*.tak") oProgress:increment() //+30.01.2011 09:25 COPY FILE (cNetverX+"*.sdf") TO (cDatverX+"*.sdf") oProgress:increment() //+30.01.2011 09:25 COPY FILE (cNetverX+"*.fpt") TO (cDatverX+"*.fpt") ENDIF ELSE oProgress:destroy() //+30.01.2011 09:28 MsgBox("Server-Verzeichnis ist nicht erreichbar") RETURN .F. ENDIF ELSE oProgress:destroy() //+30.01.2011 09:28 MsgBox("Server ist nicht erreichbar") RETURN .F. ENDIF oProgress:destroy() //+30.01.2011 09:28 Tone(1000,9) MsgBox("Kopiervorgang beendet!") //+29.01.2011 22:32 ELSE IF FExists( cDatverX+"dateien1.tak" ) .AND. ConfirmBox( oBEDA, ; "Sollen WIRKLICH die Daten vom Server"+CRLF+ ; "aus dem Verzeichnis: "+cNetverX+CRLF+ ; "auf diesen PC in das Verzeichnis:"+CRLF+ ; cDatverX+" kopiert werden?", ; "Achtung :", ; XBPMB_YESNO, ; XBPMB_WARNING, ; XBPMB_DEFBUTTON2 ) ; = XBPMB_RET_YES DbUseArea( .T.,"SDFNTX", "dateien1","s" ) // in dateien1.tak sind alle Dateinamen DO WHILE !Eof() IF Upper(s->fname) == Upper(cAltName) ELSE AAdd( aName, Upper(Trim(s->fname)) ) // Dateinamen ins Array aName cAltName := s->fname ENDIF SKIP ENDDO DbCloseArea() // Original-Daten sichern, aber nur ein Backup pro Tag : IF !FExists(cDatverX+DtoS(DATE()),"D") // Backup-Verzeichnis erzeugen mit heutigem Datum als Name: RunShell( "/C MD "+cDatverX+DtoS(DATE()) ) // Backup der Dateien: FOR i := 1 TO Len(aName) IF FExists( cDatverX+aName[i] ) oProgress:increment() //+30.01.2011 09:25 @ 11,5 SAY "sichere "+aName[i]+Space(40) COPY FILE (cDatverX+aName[i]) TO (cDatverX+DtoS(DATE())+"\"+aName[i]) ENDIF NEXT ENDIF // Laufwerk (cServDrv=M) des Servers, bzw. Verzeichnis auf dem Server => M:\HDBE\ IF IsDriveReady(cServDrv[1]) = 0 // wenn das Laufwerk existiert: IF FExists( cServDrv+cVerz, "D" ) //19.11.2006 18:46 // wenn das Verzeichnis existiert: cNetverX := cServDrv+cVerz+"\" //19.11.2006 18:46 ELSE oProgress:destroy() //+30.01.2011 09:28 MsgBox("Server-Verzeichnis ist nicht erreichbar") RETURN .F. ENDIF ELSE oProgress:destroy() //+30.01.2011 09:28 MsgBox("Server ist nicht erreichbar") RETURN .F. ENDIF // vom Server in das cDatverX kopieren: FOR i := 1 TO Len(aName) IF FExists( cNetverX+aName[i] ) oProgress:increment() //+30.01.2011 09:25 @ 11,5 SAY "kopiere "+aName[i]+Space(40) COPY FILE (cNetverX+aName[i]) TO (cDatverX+aName[i]) ENDIF NEXT oProgress:destroy() //+30.01.2011 09:28 Tone(1000,9) MsgBox("Kopiervorgang beendet!") //+29.01.2011 22:32 ELSE oProgress:destroy() //+30.01.2011 09:28 Tone(500,9) MsgBox("Kopieren nicht m”glich!") //+29.01.2011 22:32 ENDIF ENDIF RETURN .T. //+17.01.2011 09:15 jetzt darf cNetverX bergeben werden (wg. Rudox/SYSA.B) FUNCTION DATEN_zum_STICK(cNetverX) LOCAL aName := {}, i, cAltName := " ", nDrive, n := 0, cBakDir //+17.01.2011 09:18 DEFAULT cNetverX TO "C:\HDBE_BAK" //+17.01.2011 09:15 cBakDir := SubStr(cNetverX,2) CLOSE ALL // vorsichtshalber ! IF FExists( cDatver+"dateien1.tak" ) DbUseArea( .T.,"SDFNTX", "dateien1","s" ) // in dateien1.tak sind alle Dateinamen DO WHILE !Eof() IF Upper(s->fname) == Upper(cAltName) ELSE AAdd( aName, Upper(Trim(s->fname)) ) // Dateinamen ins Array aName cAltName := s->fname ENDIF SKIP ENDDO DbCloseArea() // Laufwerk des Sticks, bzw. Verzeichnis auf dem Stick suchen // Annnahme: der Stick hat die h”chste lokale Laufwerksbezeichnung FOR nDrive := 75 TO 69 STEP -1 // Chr(nDrive) = "K" ... "E" IF IsDriveReady(Chr(nDrive)) = 0 // wenn das Laufwerk existiert: IF FExists( Chr(nDrive)+cBakDir, "D" ) //+17.01.2011 09:25 // wenn das Verzeichnis existiert: IF ConfirmBox( oBEDA, ; "Soll in das Verzeichnis:"+CRLF+ ; Chr(nDrive)+cBakDir+" kopiert werden?", ; "Der richtige USB-Stick!?", ; XBPMB_YESNO, ; XBPMB_WARNING, ; XBPMB_DEFBUTTON2 ) ; = XBPMB_RET_YES cNetverX := Chr(nDrive)+cBakDir //+17.01.2011 09:25 EXIT ELSE LOOP ENDIF ELSE //+07.04.2012 10:55 Nachfrage, ob richtiges LW: IF ConfirmBox( oBEDA, ; "Soll im Laufwerk "+Chr(nDrive)+":"+CRLF+ ; Chr(nDrive)+cBakDir+" neu angelegt werden?", ; //+08.04.2012 12:36 "Ist das der USB-Stick!?", ; XBPMB_YESNO, ; XBPMB_WARNING, ; XBPMB_DEFBUTTON2 ) ; = XBPMB_RET_YES // Verzeichnis neu erstellen: RunShell( "/C MD "+Chr(nDrive)+cBakDir,,.F. ) Sleep(100) //13.03.2008 18:37 IF ++n <= 1 // mit demselben Laufwerk noch einmal versuchen nDrive++ //13.03.2008 18:37 ELSE // beim zweiten Mal ein Laufwerk weitergehen n := 0 ENDIF ENDIF LOOP ENDIF ENDIF NEXT // Abfrage, wenn kein USB-Stick gefunden wurde: IF Asc(Upper(cNetverX[1])) < 69 .AND. ConfirmBox( oBEDA, ; "Soll in das Verzeichnis:"+CRLF+ ; cNetverX+" kopiert werden?", ; "Kein USB-Stick!?", ; XBPMB_YESNO, ; XBPMB_WARNING, ; XBPMB_DEFBUTTON2 ) ; = XBPMB_RET_NO RETURN .F. // nichts wird kopiert ELSE IF !"dasi"$cNetverX .AND. ConfirmBox( oBEDA, ; "Soll WIRKLICH in das Verzeichnis:"+CRLF+ ; cNetverX+" kopiert werden?", ; "Achtung :", ; XBPMB_YESNO, ; XBPMB_WARNING, ; XBPMB_DEFBUTTON2 ) ; = XBPMB_RET_NO RETURN .F. // nichts wird kopiert ENDIF IF !FExists(cNetverX,"D") //18.10.2007 17:32 // Verzeichnis neu erstellen: RunShell( "/C MD "+cNetverX,,.F. ) sleep(100) //+17.01.2011 09:13 ENDIF ENDIF // vom cDatver zum Stick bzw. in das cNetverX kopieren: //+30.01.2011 09:24 Fortschrittsanzeige oProgress := ProgressBar():new( AppDeskTop(),, {200,100}, {AppDeskTop():currentsize()[1]-400,24},, .F. ) oProgress:create() oProgress:color := GRA_CLR_GREEN oProgress:minimum := 1 oProgress:maximum := 75 FOR i := 1 TO Len(aName) IF FExists( cDatver+aName[i] ) oProgress:increment() //+30.01.2011 09:25 COPY FILE (cDatver+aName[i]) TO (cNetverX+"\"+aName[i]) //+17.01.2011 10:23 "\" ENDIF NEXT oProgress:destroy() //+30.01.2011 09:25 Tone(1000,9) MsgBox("Kopiervorgang beendet!") //+17.01.2011 09:21 ELSE MsgBox("Die Dateienliste Dateien1.tak fehlt!") //+17.01.2011 09:21 ENDIF RETURN .T. /////////////////////////////////////////////////////////////// //+ 17.01.2011 09:22 jetzt kann cNetverX bergeben werden FUNCTION DATEN_vom_STICK(cNetverX) LOCAL aName := {}, i, cAltName := " ", nDrive, cBakDir //+17.01.2011 09:21 DEFAULT cNetverX TO "C:\HDBE_BAK" //+08.04.2012 12:37 ohne \ am Ende cBakDir := SubStr(cNetverX,2) //+17.01.2011 09:22 CLOSE ALL // vorsichtshalber ! IF FExists( cDatver+"dateien1.tak" ) DbUseArea( .T.,"SDFNTX", "dateien1","s" ) // in dateien1.tak sind alle Dateinamen DO WHILE !Eof() IF Upper(s->fname) == Upper(cAltName) ELSE AAdd( aName, Upper(Trim(s->fname)) ) // Dateinamen ins Array aName cAltName := s->fname ENDIF SKIP ENDDO DbCloseArea() //+30.01.2011 09:24 Fortschrittsanzeige oProgress := ProgressBar():new( AppDeskTop(),, {200,100}, {AppDeskTop():currentsize()[1]-400,24},, .F. ) oProgress:create() oProgress:color := GRA_CLR_GREEN oProgress:minimum := 1 oProgress:maximum := 75 oProgress:increment(5) //+30.01.2011 09:25 // Original-Daten sichern, aber nur ein Backup pro Tag : IF !FExists(cDatver+DtoS(DATE()),"D") // Backup-Verzeichnis erzeugen mit heutigem Datum als Name: RunShell( "/C MD "+cDatver+DtoS(DATE()) ) // Backup der Dateien: @ 10,5 SAY "Daten werden zuerst gesichert..." FOR i := 1 TO Len(aName) IF FExists( cDatver+aName[i] ) oProgress:increment() //+30.01.2011 09:25 COPY FILE (cDatver+aName[i]) TO (cDatver+DtoS(DATE())+"\"+aName[i]) ENDIF NEXT ENDIF // Laufwerk des Sticks, bzw. Verzeichnis auf dem Stick suchen // Annnahme: der Stick hat die h”chste lokale Laufwerksbezeichnung FOR nDrive := 75 TO 69 STEP -1 // Chr(nDrive) = "K" ... "E" IF IsDriveReady(Chr(nDrive)) = 0 // wenn das Laufwerk existiert: IF FExists( Chr(nDrive)+cBakDir, "D" ) //+08.04.2012 12:38 // wenn das Verzeichnis existiert: IF ConfirmBox( oBEDA, ; "Soll vom Verzeichnis:"+CRLF+ ; Chr(nDrive)+cBakDir+" kopiert werden?", ; //+08.04.2012 12:39 "Der richtige USB-Stick!?", ; XBPMB_YESNO, ; XBPMB_WARNING, ; XBPMB_DEFBUTTON2 ) ; = XBPMB_RET_YES cNetverX := Chr(nDrive)+cBakDir //+17.01.2011 09:25 EXIT ELSE LOOP ENDIF ENDIF ENDIF NEXT // Abfrage, wenn kein USB-Stick gefunden wurde: IF Asc(Upper(cNetverX[1])) < 69 .AND. ConfirmBox( oBEDA, ; //+08.04.2012 12:39 vorher 68 "Soll vom Verzeichnis:"+CRLF+ ; cNetverX+" kopiert werden?", ; "Kein USB-Stick!?", ; XBPMB_YESNO, ; XBPMB_WARNING, ; XBPMB_DEFBUTTON2 ) ; = XBPMB_RET_NO oProgress:destroy() //+30.01.2011 09:25 RETURN .F. // nichts wird kopiert ELSE IF !"dasi"$cNetverX .AND. ConfirmBox( oBEDA, ; "Soll WIRKLICH vom Verzeichnis:"+CRLF+ ; cNetverX+" kopiert werden?", ; "Achtung :", ; XBPMB_YESNO, ; XBPMB_WARNING, ; XBPMB_DEFBUTTON2 ) ; = XBPMB_RET_NO oProgress:destroy() //+30.01.2011 09:25 RETURN .F. // nichts wird kopiert ENDIF ENDIF // vom Stick in das cDatver kopieren: @ 10,5 SAY "Daten werden kopiert... " FOR i := 1 TO Len(aName) IF FExists( cNetverX+"\"+aName[i] ) //+08.04.2012 12:40 oProgress:increment() //+30.01.2011 09:25 COPY FILE (cNetverX+"\"+aName[i]) TO (cDatver+aName[i]) ELSE MsgBox("Es existiert kein Verzeichnis "+cNetverX+"!","F E H L E R !") //+08.04.2012 12:46 oProgress:destroy() //+30.01.2011 09:25 RETURN .F. ENDIF NEXT oProgress:destroy() //+30.01.2011 09:25 Tone(1000,9) MsgBox("Kopiervorgang beendet!") //+17.01.2011 09:24 ELSE MsgBox("Die Dateienliste Dateien1.tak fehlt!") //+17.01.2011 09:21 ENDIF RETURN .T. //**26.03.2008 12:33: /////////////////////////////////////////////////////////////// FUNCTION PROGRAMM_zum_STICK() LOCAL aName := {}, i, cAltName := " ", nDrive, n := 0, cNetverX := cDatver+"PROG\" ////// CLOSE ALL // vorsichtshalber ! IF FExists( cDatver+"dateienP.tak" ) DbUseArea( .T.,"SDFNTX", "dateienP","s" ) // in dateienP.tak sind alle Programm-Dateinamen DO WHILE !Eof() IF Upper(s->fname) == Upper(cAltName) ELSE AAdd( aName, Upper(Trim(s->fname)) ) // Dateinamen ins Array aName cAltName := s->fname ENDIF SKIP ENDDO DbCloseArea() // Laufwerk des Sticks, bzw. Verzeichnis auf dem Stick suchen // Annnahme: der Stick hat die h”chste lokale Laufwerksbezeichnung FOR nDrive := 75 TO 69 STEP -1 // Chr(nDrive) = "K" ... "E" IF IsDriveReady(Chr(nDrive)) = 0 // wenn das Laufwerk existiert: IF FExists( Chr(nDrive)+":\HDBE_PROG", "D" ) // wenn das Verzeichnis existiert: cNetverX := Chr(nDrive)+":\HDBE_PROG\" EXIT ELSE // Verzeichnis neu erstellen: RunShell( "/C MD "+Chr(nDrive)+":\HDBE_PROG\" ) Sleep(100) //13.03.2008 18:37 IF ++n <= 1 // mit demselben Laufwerk noch einmal versuchen nDrive++ //13.03.2008 18:37 ELSE // beim zweiten Mal ein Laufwerk weitergehen n := 0 ENDIF LOOP ENDIF ENDIF NEXT // Abfrage, wenn kein USB-Stick gefunden wurde: IF Asc(Upper(cNetverX[1])) < 69 .AND. ConfirmBox( oBEDA, ; "Soll in das Verzeichnis:"+CRLF+ ; cNetverX+" kopiert werden?", ; "Kein USB-Stick!?", ; XBPMB_YESNO, ; XBPMB_WARNING, ; XBPMB_DEFBUTTON2 ) ; = XBPMB_RET_NO RETURN .F. // nichts wird kopiert ELSE IF !"dasi"$cNetverX .AND. ConfirmBox( oBEDA, ; "Soll WIRKLICH in das Verzeichnis:"+CRLF+ ; cNetverX+" kopiert werden?", ; "Achtung :", ; XBPMB_YESNO, ; XBPMB_WARNING, ; XBPMB_DEFBUTTON2 ) ; = XBPMB_RET_NO RETURN .F. // nichts wird kopiert ENDIF IF !FExists(cNetverX,"D") //18.10.2007 17:32 // Verzeichnis neu erstellen: RunShell( "/C MD "+cNetverX ) ENDIF ENDIF // vom cDatver zum Stick bzw. in das cNetverX kopieren: (z.B. auch von c:\hdbe nach c:\hdbe\prog) FOR i := 1 TO Len(aName) IF FExists( cDatver+aName[i] ) COPY FILE (cDatver+aName[i]) TO (cNetverX+aName[i]) ENDIF NEXT ENDIF Tone(1000,9) RETURN .T. //**26.03.2008 12:33: /////////////////////////////////////////////////////////////// FUNCTION PROGRAMM_vom_STICK() LOCAL aName := {}, i, cAltName := " ", nDrive, cNetverX := "C:\HDBE\PROG\" //18.10.2007 17:19 ////// CLOSE ALL // vorsichtshalber ! IF FExists( cDatver+"dateienP.tak" ) DbUseArea( .T.,"SDFNTX", "dateienP","s" ) // in dateien1.tak sind alle Dateinamen DO WHILE !Eof() IF Upper(s->fname) == Upper(cAltName) ELSE AAdd( aName, Upper(Trim(s->fname)) ) // Dateinamen ins Array aName cAltName := s->fname ENDIF SKIP ENDDO DbCloseArea() // Laufwerk des Sticks, bzw. Verzeichnis auf dem Stick suchen // Annnahme: der Stick hat die h”chste lokale Laufwerksbezeichnung FOR nDrive := 75 TO 69 STEP -1 // Chr(nDrive) = "K" ... "E" IF IsDriveReady(Chr(nDrive)) = 0 // wenn das Laufwerk existiert: IF FExists( Chr(nDrive)+":\HDBE_PROG", "D" ) // wenn das Verzeichnis existiert: cNetverX := Chr(nDrive)+":\HDBE_PROG\" EXIT ENDIF ENDIF NEXT // Abfrage, wenn kein USB-Stick gefunden wurde: IF Asc(Upper(cNetverX[1])) < 68 Alert("Kein USB-Stick!?") RETURN .F. // nichts wird kopiert ELSE IF !"dasi"$cNetverX .AND. ConfirmBox( oBEDA, ; "Soll WIRKLICH vom Verzeichnis:"+CRLF+ ; cNetverX+" kopiert werden?", ; "Achtung :", ; XBPMB_YESNO, ; XBPMB_WARNING, ; XBPMB_DEFBUTTON2 ) ; = XBPMB_RET_NO RETURN .F. // nichts wird kopiert ENDIF ENDIF // Verzeichnis erzeugen, wenn noch nicht existent: IF !FExists(cDatver+"PROG\","D") // Verzeichnis neu erstellen: RunShell( "/C MD "+cDatver+"PROG\" ) ENDIF // vom Stick in das cDatver\PROG-Verzeichnis kopieren: @ 10,5 SAY "Daten werden kopiert... " FOR i := 1 TO Len(aName) IF FExists( cNetver+aName[i] ) COPY FILE (cNetverX+aName[i]) TO (cDatver+"PROG\"+aName[i]) // in das PROG-Verzeichnis! ENDIF NEXT ENDIF Tone(1000,9) RETURN .T. ////////----------------------------------------------------------- //////// zun„chst speziell fr Dischleid entworfen: 21.06.2006 11:44 ///////////////////////////////////////////////////////////////////// //////FUNCTION DATEN_zum_STICK() //////LOCAL aName := {}, i, cAltName := " " //////IF FExists( cDatver+"dateien1.tak" ) ////// DbUseArea( .T.,"SDFNTX", "dateien1","s" ) // in dateien1.tak sind alle Dateinamen ////// DO WHILE !Eof() ////// IF Upper(s->fname) == Upper(cAltName) ////// ELSE ////// AAdd( aName, Upper(Trim(s->fname)) ) // Dateinamen ins Array aName ////// cAltName := s->fname ////// ENDIF ////// SKIP ////// ENDDO ////// CLOSE ALL //////// vom cDatver zum Stick in das cNetver2 kopieren: ////// FOR i := 1 TO Len(aName) ////// COPY FILE (cDatver+aName[i]) TO (cNetver2+aName[i]) ////// NEXT //////ENDIF //////RETURN .T. ///////////////////////////////////////////////////////////////////// //////FUNCTION DATEN_vom_STICK() //////LOCAL aName := {}, i, cAltName := " " //////IF FExists( cDatver+"dateien1.tak" ) ////// DbUseArea( .T.,"SDFNTX", "dateien1","s" ) // in dateien1.tak sind alle Dateinamen ////// DO WHILE !Eof() ////// IF Upper(s->fname) == Upper(cAltName) ////// ELSE ////// AAdd( aName, Upper(Trim(s->fname)) ) // Dateinamen ins Array aName ////// cAltName := s->fname ////// ENDIF ////// SKIP ////// ENDDO ////// CLOSE ALL //////// Backup-Verzeichnis erzeugen mit heutigem Datum als Name: ////// RunShell( "/C MD "+cDatver+DtoS(DATE()) ) //////// Backup der Dateien: ////// FOR i := 1 TO Len(aName) ////// COPY FILE (cDatver+aName[i]) TO (cDatver+DtoS(DATE())+"\"+aName[i]) ////// NEXT //////// vom Stick in das cDatver kopieren: ////// FOR i := 1 TO Len(aName) ////// COPY FILE (cNetver2+aName[i]) TO (cDatver+aName[i]) ////// NEXT //////ENDIF //////RETURN .T. ////////------------------------------------------------------------------