vhDEV ;Device voor transert [ 01/22/2002  3:47 PM ]
TDIR ;\\NOTES01\SHARED\;K
 
GETFILES(Dir,list,WildCard,Optie)
 ; Optie                      "F"  ->   alleen files
 ;                                "D"  ->   alleen folders
 ;                                "FD" ->   beiden
 ;                                "E"  ->   alleen file/folder naam zonder path
 New obj,file
 Kill list
 s:$G(WildCard)="" WildCard="*"  ;Als WildCard weggelaten is wordt alles geselecteerd
 s:$G(Optie)="E" Optie="FDE"     ;Als de optie weggelaten wordt, worden files čn folders geselecteerd
 s:$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),D,"/")
 . s:Optie["E" file=$P(file,"/",$L(file,"/"))
 . s:Optie[obj.GetData(2) list($ZCVT(obj.GetData(1),"L"))=$ZCVT(file,"L")_D_obj.GetData(2)_D_obj.GetData(3)_D_obj.GetData(4)_D_obj.GetData(5)
 Do obj.%Close()
 Quit
 
BROWSER(start,WildCard,title,optie)                                  
 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_D,.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=$O(^vhUSER("ID",$$IO^cQ5,""))
 Quit:Key="" ""
 ;Quit "c:\" ; Tijdelijk probleem met wegschijven naar FileServer
 Set Dir2=$P(^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))
 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))
 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)
 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=Dir_$S($E(Dir,$L(Dir))="\"!($E(Nm)="\"):"",1:"\")_Nm
 Quit:$$UPTRIMAN^vhRtn1(File)="" 0 ; Geen HFS device, dus terminal
 Write:Optie'["M" !,File,!
 Open File:RW: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
 
READ(Dir,Nm,Exec,Optie,DevTyp) 
 New Rec,Vertaal
 ; 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
 ; DevTyp : M = Macintosh, P = PC, A = FlatAscii
 ; Exec : TypeExec`Execcode (bij Do wordt (Rec) als paramter meegegeven)
 Set:$G(Dir)="" Dir=$$DIRUSER
 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
 Set Dev=$$OPEN(Dir,Nm,"RS")                             ;Read New Streaming
 Quit:Dev=0
 For  Set Rec=$$READL(Dev,Optie) Quit:Rec=""  Do
 .;use 0 w Rec,! use Dev
 .Set:Optie["T" Rec=$TR(Rec,$C(9),D)
 .Set:Vertaal Rec=$TR(Rec,FNAAR,FVAN) ; Omgekeerd want het is import
 .;use 0 w Rec,! use Dev
 .Do EXECS^vhRES(Exec,"","(Rec)")
 Close Dev
 Quit
 
READL(Dev,Optie) 
 New Inp
 New Cnt
 Set Cnt=0
 Use Dev
 d $ZUTIL(68,40,1)                                                                 ; gebruikt $ZEOF in plaats van de <ENDOFFILE> error te genereren 
 For  Do  Quit:Inp'=""!(Optie'["B")  Set Cnt=Cnt+1 Quit:Cnt>10
 .Use Dev
 .Set Inp=""
 .For  Read *K:30 Quit:(K=13)!('K)!($ZEOF=-1)  Do  ; Lijn einde bij CariageReturn
 ..Set Cnt=0
 ..Quit:K=10  ; Skip LF
 ..Set Inp=Inp_$C(K)
 Use 0 
 Quit Inp
 ;Set:$ZA'=0 Inp="",K=13                   ; Als $ZA verschillend is van 0, is er een fout opgetreden 
 
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
 Set DirD=$G(DirD,DirS)
 Set NmS=$G(NmS)
 Set NmD=$G(NmD,NmS)
 Set FileS=DirS_$S($E(DirS,$L(DirS))="\"!($E(NmS)="\")!(NmS=""):"",1:"\")_NmS
 Set FileD=DirD_$S($E(DirD,$L(DirD))="\"!($E(NmD)="\")!(NmD=""):"",1:"\")_NmD
 if $ZV["Cache" Do  set X=##class(%File).CopyFile(FileS,FileD)
 Else  S X=$$JOBWAIT^cHOSTCMD("copy """_FileS_""" """_FileD_"""","hide")
 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
 Set DirD=$G(DirD,DirS)
 Set NmS=$G(NmS)
 Set NmD=$G(NmD,NmS)
 Set FileS=DirS_$S($E(DirS,$L(DirS))="\"!($E(NmS)="\")!(NmS=""):"",1:"\")_NmS
 Set FileD=DirD_$S($E(DirD,$L(DirD))="\"!($E(NmD)="\")!(NmD=""):"",1:"\")_NmD
 if $ZV["Cache" Do  
 . set X=##class(%File).CopyFile(FileS,FileD)
 . If X  set X=##class(%File).Delete(FileS)  Else  set Y=##class(%File).Delete(FileD) 
 Else  S X=$$JOBWAIT^cHOSTCMD("move """_FileS_""" """_FileD_"""","hide")
 Quit X
 
DELFILE(Dir,Nm) 
 ;Dir kan het ganse pad bevatten, Nm moet dan leeg of undefined zijn.
 New File
 Set Nm=$G(Nm)
 Set File=Dir_$S($E(Dir,$L(Dir))="\"!($E(Nm)="\")!(Nm=""):"",1:"\")_Nm
 if $ZV["Cache" Do  set X=##class(%File).Delete(File)
 Else  S X=$$JOBWAIT^cHOSTCMD("del /Q """_File_"""","hide")
 Quit X
 
RENFILE(Dir,Nm,Nm2) 
 ;Dir kan het ganse pad bevatten, Nm moet dan leeg of undefined zijn.
 New File
 Set Nm=$G(Nm)
 Set File=Dir_$S($E(Dir,$L(Dir))="\"!($E(Nm)="\")!(Nm=""):"",1:"\")_Nm
 if $ZV["Cache" Do  set X=##class(%File).Rename(File,Nm2)
 Else  S X=$$JOBWAIT^cHOSTCMD("ren """_File_""" """_Nm2_"""","hide")
 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
 
cSCANDIR(Dir,WildCard,RetRef,Optie,DelDat) 
 New list,rec,X
 Set list=""       
 Set Optie=$G(Optie)
 Do GETFILES(Dir,.list,WildCard,"FE")
 Set FileNm=""
 Set DelDat=$$CALCDATE^vhDTyp($H,"A",-DelDat)
 For  Set FileNm=$O(list(FileNm)) Quit:FileNm=""  Do
 . Set rec=list(FileNm)
 . Set Datum=$TR($P($P(rec,D,5)," ",1),"-","/")
 . If $G(DelDat)&($$INTDATE^vhDTyp(Datum,"DS")>DelDat) Do
 .. s X=$$DELFILE(FileNm)
 .. s:'X @RetRef="-6;Unable to delete "_FileNm
 . Else  Set @RetRef@($P(rec,D,1))=$P(rec,D,3)_D_$TR($P(rec,D,5)," ",D)
 Quit
 
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 : "X" ; De bestanden ouder dan DelDat effectief verwijderen
 ;DelDat : Bestanden ouder dan DelDat (arbeidsdagen) worden verwijderd.
 ;Pregedefinieerde mounted volume K: \\IISERVER\Shared
 ;
 Do:$ZV["Cache" cSCANDIR(Dir,WildCard,RetRef,Optie,DelDat) Quit
 
 New NetUse,%K,%J,%A,%B,%C,%D,%E,Size,Uur,Datum,X      
 Lock +DirScan
 Set Optie=$G(Optie)
 Set Dir=$TR(Dir,"/","\")
 Kill @RetRef
 If Dir?1A1":\".E Do
 .Set Drive=$E(Dir)
 .Set $E(Dir,1,2)=""
 Else  If $E($$UPCASE^vhRtn1(Dir),1,$L($P($T(TDIR),";",2)))=$P($T(TDIR),";",2) Do  ; Pregedefinieerd
 .Set Drive=$P($T(TDIR),";",3)
 .Set $E(Dir,1,$L($P($T(TDIR),";",2)))=""
 Else  If $E(Dir,1,2)="\\" Do  ; Net Use drive
 .S X=$$JOBWAIT^cHOSTCMD("net use Y: "_$P(Dir,"\",1,4))
 .Set:X @RetRef="-1;Net Use create"
 .S NetUse=1
 .Set Drive="Y"
 .Set Dir="\"_$P(Dir,5,99)
 Else  Set @RetRef="-2;No Drive"
 Quit:$D(@RetRef)
 Set R=$ZOS(1,Drive)
 Set:R<0 @RetRef="-3;No Drive set"
 Quit:$D(@RetRef)
 Set R=$ZOS(8,Dir)
 Set:R'="" @RetRef="-4;No directory set"
 Quit:$D(@RetRef)
 Set SelDir=$ZOS(12,WildCard,0)
 Set FileNm=$P(SelDir,"^")
 For  Quit:$L(SelDir)<40  Do 
 .Set %J=$P(SelDir,"^",2,999)
 .Set %K=$ZASCII(%J,22)
 .If $ZB(%K,16,1) Set Size="<DIR>"
 .Else  Set Size=$ZASCII(%J,27)+($ZASCII(%J,28)*256)+($ZASCII(%J,29)*256*256)+($ZASCII(%J,30)*256*256*256)
 .Set %A=$ZASCII(%J,25),%B=$ZASCII(%J,26),%C=256*%B+%A,%D=%C#32,%C=%C\32,%E=%C#16,%C=%C\16,%C=%C+1980
 .Set Datum=$E("00",1,2-$L(%D))_%D_"-"_$E("00",1,2-$L(%E))_%E_"-"_%C
 .Set %A=$ZASCII(%J,23),%B=$ZASCII(%J,24),%C=%B*256+%A,%D=%C#32*2,%C=%C\32,%E=%C#64,%C=%C\64,%A=%C\12,%B=%C#12 S:%B=0 %B=12
 .Set Uur=$S(%A:12,1:0)+%B_":"_$E("00",1,2-$L(%E))_%E
 .Set @RetRef@($S(Optie["A":"F",1:"")_FileNm)=Size_"\"_Datum_"\"_Uur ; Opslag voor alfanumerieke sortering
 .Set SelDir=$ZOS(13,SelDir)
 .Set FileNm=$P(SelDir,"^")
 ; Verwijderen van oude bestanden
 If $G(DelDat) Do
 .Set DelDat=$$CALCDATE^vhDTyp($H,"A",-DelDat)
 .Set FileNm=""
 .For  Set FileNm=$O(@RetRef@(FileNm)) Quit:FileNm=""  Do
 ..Set Datum=$P(@RetRef@(FileNm),"\",2)
 ..Quit:$$INTDATE^vhDTyp(Datum)>DelDat
 ..Set:Optie["X" X=$$DELFILE(Dir,$E(FileNm,$S(Optie["A":2,1:1),99))
 ..Kill @RetRef@(FileNm)
 ; Verwijderen van USE
 If $G(NetUse) Do
 .Set R=$ZOS(1,"C")
 .Set X=$$JOBWAIT^cHOSTCMD("net use Y: /delete")
 .Set:X @RetRef="-5;Release net use"
 Lock -DirScan
 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