vhDEV ;Beheer van DEVICES [ 01/22/2002  3:47 PM ] 
TDIR ;\\NOTES01\SHARED\;K
#define TempPad "C:\SCRATCH"
 
GETFILES(Dir,list,WildCard,Optie)
 ; list via .Local
 ; Optie                          "F"  ->   alleen files
 ;                                "D"  ->   alleen folders
 ;                                "FD" ->   beiden
 ;                                "E"  ->   alleen file/folder naam zonder path
 ;                                "L"  ->   lowercase
 ;                             
 New obj,file,LowerCase
 Kill list
 Set:$G(WildCard)="" WildCard="*"  ;Als WildCard weggelaten is wordt alles geselecteerd
 Set LowerCase=Optie["L"
 Set:LowerCase Optie=$P(Optie,"L",1)_$P(Optie,"L",2)
 Set:$G(Optie)="E" Optie="FDE"     ;Als de optie weggelaten wordt, worden files èn folders geselecteerd
 Set:$G(Optie)="" Optie="FD"
 Set obj=##class(%ResultSet).%New("%Library.File:FileSet")
 Do obj.Execute(Dir,WildCard)
 ; list(Name)=filename\Type\Size\DateTimeCreated\DateTimeModified 
 For  Quit:'obj.Next()  Do
 . s file=$TR(obj.GetData(1),"\","/")
 . s:Optie["E" file=$P(file,"/",$L(file,"/"))
 . s:Optie[obj.GetData(2) list($S(LowerCase:$ZCVT(obj.GetData(1),"L"),1:obj.GetData(1)))=$S(LowerCase:$ZCVT(file,"L"),1:file)_"\"_obj.GetData(2)_"\"_obj.GetData(3)_"\"_obj.GetData(4)_"\"_obj.GetData(5)
 Do obj.%Close()
 Quit
 
BROWSER(start,WildCard,title,optie) ;Browse door de bestanden beginnend bij start                                 
 new list,folder
 s:$G(start)="" start="c:"
 s:start["\." start=$P(start,D,1,$L(start,D)-2)
 s:$G(title)="" title="Selecteer bestand"
 d GETFILES(start_"\",.list,$G(WildCard),"E"_$G(optie))
 s folder=$$WILD^vhPOPUP("C;C","OK2-",title,.list) 
 Quit:folder="" $S((optie["D")&('optie["F"):start,1:"")
 Quit:$P(list(start_D_folder),D,2)="F" start_D_folder
 Quit $$BROWSER(start_D_folder,$G(WildCard),$G(title),$G(optie))
  
DIRUSER() New Key,Dir1,Dir2
 Set Dir1=$P($T(TDIR),";",2)
 Set Key=$G(QU(1))
 Set:Key="" Key=$O(^vhUSER("ID",$$IO^cQ5,""))
 Quit:Key="" ""
 ;Quit "c:\" ; Tijdelijk probleem met wegschijven naar FileServer
 Set Dir2=$P($G(^vhUSER("D",Key)),D,6)
 Quit:Dir2="" "" ; Geen subdirectory gespecifieerd voor de gebruiker
 Quit Dir1_$S($E(Dir1,$L(Dir1))="\"!($E(Dir2)="\")!($E(Dir2)=""):"",1:"\")_Dir2_"\"
 
ASKDIR(DefDir,Help) 
 New Dir
 Set DefDir=$G(DefDir)
 Set:'$L(DefDir) DefDir=$$DIRUSER
 Do STORE^vhTERMINA()
 Set Dir=$$ASK^vhINP("Directory: ",40,DefDir,$G(Help),,,,,,"1",)
 Do REFRESH^vhTERMINA()
 Quit Dir
 
ASKFILE(DefNm,Optie,Help) 
 Set DefNm=$G(DefNm)
 Do STORE^vhTERMINA()
 Set DefNm=$$ASK^vhINP("Bestandsnaam : ",30,DefNm,$G(Help),,,,,,"1",)
 Do REFRESH^vhTERMINA()
 Set:DefNm="-"!(DefNm=".") DefNm=""
 Quit DefNm
 
OPEN(Dir,Nm,RW,Optie,DelDat) 
 ; Optie : "M" ; No terminal I/O (MUET)
 ; Optie : "A" ; Ask FileNaam
 ; Optie : "D" ; Nm is WildCard, filenaam selectie via DISPDIR
 ; Optie : "X" ; De bestanden ouder dan DelDat effectief verwijderen
 ; DelDat : Bestanden ouder dan DelDat (arbeidsdagen) worden verwijderd.
 New File,Timeout
 Set Timeout=10                                  ;Timeout in seconden voordat OPEN met een 0 quit (als het openen niet lukt)
 Set Optie=$G(Optie)
 D $ZUTIL(68,40,1) ; gebruikt $ZEOF in plaats van de <ENDOFFILE> error te genereren 
 Set:$G(Dir)="" Dir=$$DIRUSER
 Set Nm=$S(Optie["D":$$DISPDIR(Dir,Nm,$S(Optie["X":"X",1:""),$G(DelDat)),Optie["A":$$ASKFILE(Nm),1:Nm)
 Quit:"-."[Nm 0
 If $G(Dir)=""!($G(Nm)="") Quit 0
 Set File=$$FULLPAD(Dir,Nm)
 Quit:$$UPTRIMAN^vhRtn1(File)="" 0 ; Geen HFS device, dus terminal
 If Optie["T",RW["W" Do ;Tijdelijk bestand
 . Set %TempFileName=File
 . Set File=$$$TempPad_"\TEMP"_$J_$P($H,",",2)_".txt"
 . Write:Optie'["M" !,%TempFileName," (",$P(File,"\",$L(File,"\")),")",!
 Else  Do
 . Write:Optie'["M" !,File,!
 Open File:RW_"S"_$S(RW="W":"N",1:""):Timeout                         ;R=read, W=write, N=new(delete if excists), S=streaming 
 Quit:'$T 0 ; Geen HFS device, dus terminal   ;werkt enkel in cache als er een timeout gedefineerd is!
 Use File
 //If $ZA=-1 Quit 0 ; Open failed, file not found, access denied
 //If $ZC=1 Quit 0 ; Open failed , device error
 Use:$G(Optie)'["M" 0
 
 Quit File
 
CLOSE(Dev)
	Quit:0[Dev
	Close Dev
	If Dev[$$$TempPad Do ; Move
	. Do MOVEFILE(Dev,"",%TempFileName,"")
	Kill %TempFileName
	Do SCANDIR($$$TempPad,"*.*","x","X",1) ; delete old
	Quit
 
READ(Dir,Nm,Exec,Optie,DevTyp,LijnTerminator)
 ; Optie bevat A : Er wordt naar de filenaam gevraagd
 ;             D : Nm is WildCard, filenaam selectie via DISPDIR
 ;             T : Vertaling van Tab naar standaard delimiter D
 ;             B : Retry bij blanko lijn
 ;             K : Karakter per karakter ipv lijn per lijn, de karakters worden verzameld tot één record door de lijnterminator
 ;             E : Exclusieve toegang
 ;             M : No terminal I/O (MUET)
 ; DevTyp : M = Macintosh, P = PC, A = FlatAscii
 ; Exec : TypeExec`Execcode (bij Do wordt (Rec) als paramter meegegeven)
 New stream,Rec,Vertaal 
 Set:$G(Dir)="" Dir=$$DIRUSER
 Set LijnTerminator=$G(LijnTerminator,$C(13))
 Set Vertaal=0
 If $L($G(DevTyp)) Do
 .Do VANNAAR^vhTERMINA(DevTyp)
 .Set Vertaal=1
 Set Optie=$G(Optie)
 Set Nm=$S(Optie["D":$$DISPDIR(Dir,Nm),Optie["A":$$ASKFILE(Nm),1:Nm)
 Quit:"-."[Nm ""
 Write:Optie'["M" !,Nm,!
 Set stream=##class(%FileCharacterStream).%New()
 Set stream.Filename=$$FULLPAD(Dir,Nm)
 For  Quit:stream.AtEnd  Do
 . Set Rec=$S(Optie["K":$$READLINE(stream,LijnTerminator),1:stream.ReadLine()) 
 . If Optie["B",Rec="" Quit ; retry bij blanko
 . Set:Optie["T" Rec=$TR(Rec,$C(9),D)
 . Set:Vertaal Rec=$TR(Rec,FNAAR,FVAN) ; Omgekeerd want het is import
 . Do EXECS^vhRES(Exec,"","(Rec)")
 Quit Nm ; Return Filenaam zonder pad
    
READLINE(stream,terminator)
 New Inp,K
 Set Inp=""
 For  Quit:stream.AtEnd  Do  Quit:K=terminator 
 . Set K=stream.Read(1)
 . Quit:K=$C(10)  ; Skip LF
 . Set Inp=Inp_K
 Quit Inp
  
FULLPAD(Dir,Nm)
 Quit Dir_$S($E(Dir,$L(Dir))="\"!($E(Nm)="\")!(Nm=""):"",1:"\")_Nm
 
COPYFILE(DirS,NmS,DirD,NmD) 
 ;DirS en DirD kan het ganse pad bevatten,NmS moet dan leeg of undefined zijn.
 ;DirD OF NmD is optioneel
 New FileS,FileD,X
 Set DirD=$G(DirD,DirS)
 Set NmS=$G(NmS)
 Set NmD=$G(NmD,NmS)
 Set FileS=$$FULLPAD(DirS,NmS)
 Set FileD=$$FULLPAD(DirD,NmD)
 S X=$ZF(-1,"copy """_FileS_""" """_FileD_"""")
 Quit X
 
MOVEFILE(DirS,NmS,DirD,NmD) 
 ;DirS en DirD kan het ganse pad bevatten,NmS moet dan leeg of undefined zijn.
 ;DirD OF NmD is optioneel
 New FileS,FileD,Y,X
 Set DirD=$G(DirD,DirS)
 Set NmS=$G(NmS)
 Set NmD=$G(NmD,NmS)
 Set FileS=$$FULLPAD(DirS,NmS)
 Set FileD=$$FULLPAD(DirD,NmD)
 S X=$ZF(-1,"move """_FileS_""" """_FileD_"""")
 Quit X
 
DELFILE(Dir,Nm) 
 ;Dir kan het ganse pad bevatten, Nm moet dan leeg of undefined zijn.
 New File,X
 Set Nm=$G(Nm)
 Set File=$$FULLPAD(Dir,Nm)
 S X=$ZF(-1,"del /Q """_File_"""")
 Quit X
 
RENFILE(Dir,Nm,Nm2) 
 ;Dir kan het ganse pad bevatten, Nm moet dan leeg of undefined zijn.
 New File,X
 Set Nm=$G(Nm)
 Set File=$$FULLPAD(Dir,Nm)
 S X=$ZF(-1,"ren """_File_""" """_Nm2_"""")
 Quit X
 
OPENJQ() ; Openen van het eerst vrije Interproces Queue
 ; De READ queue wordt geopend, er wordt echter ook getest of de WRITE queue ook vrij is
 New JQDev
 For JQDev=224:2:254 Open JQDev+1::0 If $T Open JQDev::0 Close JQDev+1 If $T Quit  ; Eerst vrije interproces 
 Else  Set JQDev=""
 Quit JQDev
 
SCANDIR(Dir,WildCard,RetRef,Optie,DelDat) 
 ;RetRef wordt door gegeven via $NA(GlobalLocalRef)
 ;Optie = "A" : Alfanumeriek sortering door voor de naam een "F" te plaatsen
 ;Optie : "L" ; Namen vertalen naar lowercase
 ;Optie : "X" ; De bestanden ouder dan DelDat allee verwijderen, RetRef wordt NIET ingevuld
 ;DelDat : Bestanden ouder dan DelDat (arbeidsdagen) worden verwijderd.
 ;Pregedefinieerde mounted volume K: \\NOTES01\Shared
 ;vb opkuis directory = D SCANDIR^vhDEV(Dir,"*.*",,"X",$H-356)
 
 New list,rec,X,FileNm,Datum
 Set list=""       
 Set Optie=$G(Optie)
 Set:$G(Dir)="" Dir=$$DIRUSER()
 Do GETFILES(Dir,.list,WildCard,"FE"_$S(Optie["L":"L",1:""))
 Set FileNm=""
 Set:$G(DelDat) DelDat=$$CALCDATE^vhDTyp($H,"A",-DelDat) ; omzetting van arbeidsdagen naar datum
 For  Set FileNm=$O(list(FileNm)) Quit:FileNm=""  Do
 . Set rec=list(FileNm)
 . Set Datum=$TR($P($P(rec,"\",5)," ",1),"-","/")
 . If $G(DelDat),($$INTDATE^vhDTyp(Datum,"DS")<DelDat) Do
 .. S X=$$DELFILE(FileNm)
 .. S:X @RetRef=$G(@RetRef)_"-6;Unable to delete "_FileNm_"~" 
 . Else  Set:Optie'["X" @RetRef@($S(Optie["A":"F",1:"")_$P(rec,"\",1))=$P(rec,"\",3)_"\"_$TR($P(rec,"\",5)," ","\")
 Quit
  
DISPDIR(Dir,WildCard,Optie,DelDat) 
 ;Optie : "X" ; De bestanden ouder dan DelDat effectief verwijderen
 ;DelDat : Bestanden ouder dan DelDat (arbeidsdagen) worden verwijderd.
 New File,Files,Y
 Set Optie=$G(Optie)
 Do SCANDIR(Dir,$G(WildCard),$NA(Files),Optie,$G(DelDat))
 If $D(Files)#10 Do  Quit ""
 .Set Txt(1)="Fout bij lezen map "_Dir
 .Set Txt(2)="Fout : "_Files
 .Set Txt=$$WILD^vhTXTPOP("C;C","Fout","Txt")
 If '$D(Files) Do  Quit ""
 .Set Txt(1)="Geen documenten gevonden die voldoen"
 .Set Txt(2)="aan de opgegeven wildcard "_WildCard
 .Set Txt(3)="in de map "_Dir
 .Set Txt=$$WILD^vhTXTPOP("C;C","Waarschuwing","Txt")
 Set File="",Y=0
 For  Set File=$O(Files(File)) Quit:File=""  Do
 .Set Y=Y+1,Y(Y)=$S(Optie["A":$E(File,2,99),1:File)_"`"_$P(Files(File),"\",2)
 Set File=$$WILD^vhPOPUP("C;C","OK2-","Selecteer bestand",.Y)
 Quit File