Page Date
2004-05-18
DD-Software
Kapitel zurück / previous Chapter
Main Index
 
Seite zurück / previous page
Backward
Seite vor / next page
Forward
 
Seitenanfang/TopOfPage
Top
Seitenende/EndOfPage
Bottom
MyWbtHelp current version

WinBatch Scripting - Disk and Filesystem



Seitenanfang/TopOfPage Seitenende/EndOfPage
Seitenanfang/TopOfPage Seitenende/EndOfPage

udfAddBackslash (sString)

;------------------------------------------------------------------------------------------------------------------------------------------
#DefineFunction udfAddBackslash_1 (sString)
If (StrSub(sString,StrLen(sString),1)<>"\") Then sString = StrCat(sString,"\")
; Seems to be the fastest, if a trailing backslash already exists.
Return (sString)
#EndFunction
;------------------------------------------------------------------------------------------------------------------------------------------
#DefineFunction udfAddBackslash_2 (sString)
If (StrIndex(sString,"\",0,@BACKSCAN)<>StrLen(sString)) Then sString = StrCat(sString,"\")
Return (sString)
#EndFunction
;------------------------------------------------------------------------------------------------------------------------------------------
#DefineFunction udfAddBackslash_3 (sString)
Return (StrCat(sString,StrSub("\",1,(StrSub(sString,StrLen(sString),1)<>"\"))))
; Seems to be the fastest, if no trailing backslash exists.
; Detlev Dalitz.20010731
#EndFunction
;------------------------------------------------------------------------------------------------------------------------------------------

;--- test ---
a = "D:\TEMP"
b = "D:\TEMP\"
c = "test.txt"
d = StrCat(a,StrSub("\",1,(StrSub(a,StrLen(a),1)<>"\")),c)
e = StrCat(b,StrSub("\",1,(StrSub(b,StrLen(b),1)<>"\")),c)

f = udfAddBackslash_3(a)
g = udfAddBackslash_3(b)


:performancetest
msgtitle = "Demo udfAddBackslash (sString)  Performance Test"

TestStr = "D:\TEMP"
;TestStr = "D:\TEMP\"
TestLoop = 200

MaxTests = 3
For t=1 To MaxTests
   Display(1,msgtitle,"Running Test %t%, please wait ...")
   Exclusive(@ON)
   start = GetTickCount()
   For i=1 To TestLoop
      sString = udfAddBackslash_%t% (TestStr)
   Next
   stop = GetTickCount()
   Exclusive(@OFF)
   Ticks%t% = stop-start
Next

MaxTicks = 0
For t=1 To MaxTests
   MaxTicks = Max(MaxTicks,Ticks%t%)
Next
For t=1 To MaxTests
   Pct%t% = 100*Ticks%t%/MaxTicks
Next
msgtext = ""
For t=1 To MaxTests
   msgtext = StrCat(msgtext,"Test ",t,@TAB,"Ticks = ",@TAB,Ticks%t%,@TAB,Pct%t%," %%",@CRLF)
Next
Message(msgtitle,msgtext)

Exit
;------------------------------------------------------------------------------------------------------------------------------------------


Seitenanfang/TopOfPage Seitenende/EndOfPage
Seitenanfang/TopOfPage Seitenende/EndOfPage

udfDelBackslash (str)
udfDelBackslash (str, mode)

;------------------------------------------------------------------------------------------------------------------------------------------
#DefineFunction udfDelBackslash_1 (str)
len=StrLen(str)
If(StrSub(str,len,1)=="\")Then Return(StrSub(str,1,len-1))
Return(str)
#EndFunction
;------------------------------------------------------------------------------------------------------------------------------------------
#DefineFunction udfDelBackslash_2 (str)
len=StrLen(str)
If(StrIndex(str,"\",0,@BACKSCAN)==len)Then Return(StrSub(str,1,len-1))
Return(str)
#EndFunction
;------------------------------------------------------------------------------------------------------------------------------------------
#DefineFunction udfDelBackslash_3 (str)
Return(StrSub(str,1,StrLen(str)-(StrSub(str,StrLen(str),1)=="\")))
#EndFunction
;------------------------------------------------------------------------------------------------------------------------------------------
#DefineFunction udfDelBackslash_4 (str, mode)
len=StrLen(str)
Select 1
Case(mode==0)
Case(mode==2)
While(StrSub(str,len,1)=="\")
len=len-1
str=StrSub(str,1,len)
EndWhile
If(mode==2)Then str=StrCat(str,"\")
Break
Case(mode==1)
If(StrSub(str,len,1)=="\")
len=len-1
str=StrSub(str,1,len)
EndIf
Break
EndSelect
Return (str)
; mode=0 delete all trailing backslashes
; mode=1 delete one trailing backslash
; mode=2 keep only one backslash
; DD.20010801.20020209
#EndFunction
;------------------------------------------------------------------------------------------------------------------------------------------

;--- test ---
str10 = "D:\TEMP\"
str11 = udfDelBackslash_1(str10)
str12 = udfDelBackslash_2(str10)
str13 = udfDelBackslash_3(str10)

str20 = "D:\TEMP\\"
str21 = udfDelBackslash_1(str20)
str22 = udfDelBackslash_2(str20)
str23 = udfDelBackslash_3(str20)

str30 = "D:\TEMP\\\\\\\\\\\\\\"
While (StrSub(str30,StrLen(str30),1)=="\")
   str30 = udfDelBackslash_3(str30)
EndWhile

str40 = "D:\TEMP\\\\\\\\\\\\\\"
done = @FALSE
While !done
   lenpre = StrLen(str40)
   str40 = udfDelBackslash_3(str40)
   lenpost = StrLen(str40)
   done = (lenpre==lenpost)
EndWhile

str41 = "D:\TEMP\\\\\\\\\\\\\\"
lenpre = 0
lenpost = !lenpre
While (lenpre <> lenpost)
   lenpre = StrLen(str41)
   str41 = udfDelBackslash_3(str41)
   lenpost = StrLen(str41)
EndWhile

str50 = "D:\TEMP\\\\\\\\\\\\\\"
str51 = udfDelBackslash_4(str50,0)
str52 = udfDelBackslash_4(str50,1)
str53 = udfDelBackslash_4(str50,2)


:performancetest
msgtitle = "Demo udfDelBackslash (str)  Performance Test"

;TestStr = "D:\TEMP"
TestStr = "D:\TEMP\"
;TestStr = "D:\TEMP\\\\\\\\\\\\\\"
TestLoop = 400

For t=1 To 3
   Display(1,msgtitle,"Running Test %t%, please wait ...")
   Exclusive(@ON)
   start = GetTickCount()
   For i=1 To TestLoop
      str = udfDelBackslash_%t% (TestStr)
   Next
   stop = GetTickCount()
   Exclusive(@OFF)
   Ticks%t% = stop-start
Next

t=4
For m=0 To 2
   Display(1,msgtitle,"Running Test %t% mode %m%, please wait ...")
   Exclusive(@ON)
   start = GetTickCount()
   For i=1 To TestLoop
      str = udfDelBackslash_%t% (TestStr,%m%)
   Next
   stop = GetTickCount()
   Exclusive(@OFF)
   ti=t+m
   Ticks%ti% = stop-start
Next

MaxTests = 6
MaxTicks = 0
For t=1 To MaxTests
   MaxTicks = Max(MaxTicks,Ticks%t%)
Next
For t=1 To MaxTests
   Pct%t% = 100*Ticks%t%/MaxTicks
Next
msgtext = ""
For t=1 To MaxTests
   msgtext = StrCat(msgtext,"Test ",t,@TAB,"Ticks = ",@TAB,Ticks%t%,@TAB,Pct%t%," %%",@CRLF)
Next

Message(msgtitle,msgtext)

Exit
;------------------------------------------------------------------------------------------------------------------------------------------


Seitenanfang/TopOfPage Seitenende/EndOfPage
Seitenanfang/TopOfPage Seitenende/EndOfPage

udfDelEmptyTree (dir)
udfDelTree (dir)
udfDelTree_2 (dir, mode)

;----------------------------------------------------------------------------------------------------------------------
; udfDelEmptyTree (dir)             
; udfDelTree (dir)                  
; udfDelTree_2 (dir, mode)          
; udfGetTempPath ()                 
;----------------------------------------------------------------------------------------------------------------------

If ItemLocate("udfdelemptytree",IntControl(77,103,0,0,0),@tab) Then Goto skip_udfdelemptytree

#DefineFunction udfDelEmptyTree (dir)
origdir = DirGet()
DirChange(dir)
dirlist = DirItemize("*.*")
dircount = ItemCount(dirlist,@tab)
For d=1 To dircount
   thisdir = ItemExtract(d,dirlist,@tab)
   udfDelEmptyTree(thisdir) ; recursive
Next
filelist = FileItemize("*.*")
empty = (filelist=="") && (dirlist=="")
DirChange("..")
If empty ; maybe not really empty anyway
   oldmode = ErrorMode(@off) ; suppress error message
   DirRemove(dir)
   ErrorMode(oldmode)
EndIf
DirChange(origdir)
Return
; dir = the root dir of the foldertree to be deleted
; note: only empty folders will be deleted
;
; modified by Detlev Dalitz.20020530
#EndFunction

:skip_udfdelemptytree
;----------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfdeltree",IntControl(77,103,0,0,0),@tab) Then Goto skip_udfdeltree

#DefineFunction udfDelTree (dir)
IntControl(5,1,0,0,0) ; System & Hidden files or directories are seen and used
origdir = DirGet()
DirChange(dir)
dirlist = DirItemize("*.*")
DirAttrset(dirlist,"rash")
dircount = ItemCount(dirlist,@tab)
For d=1 To dircount
   thisdir = ItemExtract(d,dirlist,@tab)
   udfDelTree(thisdir) ; recursive
Next
FileAttrSet("*.*","rash")
FileDelete("*.*")
DirChange("..")
DirRemove(dir)
DirChange(origdir)
IntControl(5,0,0,0,0) ; protect System & Hidden files and directories
Return
; dir = the root dir of the foldertree to be deleted.
; Note: This udf can see hidden & system directory attribute by IntControl(5,1,0,0,0).
; The deletion of all files and almost all directories is a hazardous act. 
; Have caution on doing this! Folders and their files will be deleted without permission!
;
; based on Article in WinBatch TechBase
; Article ID:   W14748
; Filename:   DelTree and Xcopy.txt
; File Created: 2001:03:19:15:12:22
;
; modified by Detlev Dalitz.20020530
#EndFunction

:skip_udfdeltree
;----------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfdeltree_2",IntControl(77,103,0,0,0),@tab) Then Goto skip_udfdeltree_2

#DefineFunction udfDelTree_2 (dir, mode)
mode = Min(2,Max(0,mode))
If (mode==2) Then IntControl(5,1,0,0,0) ; System & Hidden files or directories are seen and used
origdir = DirGet()
DirChange(dir)

dirlist = DirItemize("*.*")
dircount = ItemCount(dirlist,@tab)
For d=1 To dircount
   thisdir = ItemExtract(d,dirlist,@tab)
   udfDelTree_2(thisdir, mode) ; recursive
Next

Select mode
Case 0
   filelist = FileItemize("*.*")
   empty = (filelist=="") && (dirlist=="")
   DirChange("..")
   If empty ; maybe not really empty anyway
      oldmode = ErrorMode(@off) ; suppress error message
      DirRemove(dir)
      ErrorMode(oldmode)
   EndIf
   Break
Case 1
   FileAttrSet("*.*","rash")
   oldmode = ErrorMode(@off) ; suppress error message
   FileDelete("*.*")
   ErrorMode(oldmode)
   DirChange("..")
   DirAttrset(dir,"rash")
   oldmode = ErrorMode(@off) ; suppress error message
   DirRemove(dir)
   ErrorMode(oldmode)
   Break
Case 2
   FileAttrSet("*.*","rash")
   FileDelete("*.*")
   DirChange("..")
   DirAttrset(dir,"rash")
   DirRemove(dir)
   Break
EndSelect

DirChange(origdir)
IntControl(5,0,0,0,0) ; protect System & Hidden files and directories
Return
; dir      = the root dir of the foldertree to be deleted
; mode = 0 = Delete empty folders only.
; mode = 1 = Delete all folders, if empty or not, but respect hidden & system attributes.
; mode = 2 = Force deleting all files and folders by IntControl(5,1,0,0,0).
; Note: Hidden folders are not visible for DirItemize.
;
; based on WinBatch TechBase
; Article ID:   W14748
; Filename:   DelTree and Xcopy.txt
; modified by Detlev Dalitz.20020530
#EndFunction

:skip_udfdeltree_2
;----------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfgettemppath",IntControl(77,103,0,0,0),@tab) Then Goto skip_udfgettemppath

#DefineFunction udfGetTempPath ()
ftemp = FileCreateTemp("TMP")
FileDelete(ftemp)
TempPath = FilePath(ftemp)
Terminate(!DirMake(TempPath),"udfGetTempPath",StrCat("Cannot access temporary folder:",@crlf,TempPath))
Return (TempPath)
#EndFunction

:skip_udfgettemppath
;----------------------------------------------------------------------------------------------------------------------

; ---- test ----
pausetitle = "Demo  'Delete Foldertree'  routines"


; create foldertree
pausetext = StrCat(@crlf,"Press OK to continue ...")
pausetext = StrCat("Create test foldertree",@crlf,pausetext)
Pause(pausetitle,pausetext)

tempfolder = udfGetTempPath()
testroot = StrCat(tempfolder,"xxxx\")
maxtop = 5
maxsub = 2
maxfiles = 4
For top=1 To maxtop
   For sub=1 To maxsub
      folder = StrCat(testroot,"top",top,"\","sub",sub,"\")
      DirMake(folder)
      DirChange(folder)
      If (sub mod 2) ; fill odd folders with files
         For i=1 To maxfiles
            file = StrCat("file",i)
            If !FileExist(file) Then FileClose(FileOpen(file,"WRITE")) ; create zero length file
            If (i mod 2) Then FileAttrSet(file,"RASH") ; set attributes to odd files
         Next
      EndIf
      If !(top mod 2) Then DirAttrset(folder,"RASH") ; set attributes to folder
      DirChange(testroot)
   Next
Next


; start explorer to view foldertree
pausetext = StrCat(@crlf,"Press OK to continue ...")
pausetext = StrCat("Start Explorer to view original foldertree",@crlf,pausetext)
Pause(pausetitle,pausetext)

Run("explorer.exe",StrCat("/e, /root, ",testroot))
WinWaitExist("~Explorer",-1)
explorer = WinGetactive()
SendKeysTo(explorer,"{NUMPAD*}")
SendKeysTo(explorer,"{DOWN 2}")
TimeDelay(2)


; test 1
pausetext = StrCat(@crlf,"Press OK to continue ...")
pausetext = StrCat("Test 1: udfDelEmptyTree (dir)  and view result",@crlf,pausetext)
Pause(pausetitle,pausetext)

foldertree = StrCat(testroot,"top1\")
udfDelEmptyTree (foldertree)

WinActivate(explorer)
TimeDelay(1)
SendKeysTo(explorer,"{F5}") ; refresh
TimeDelay(1)


; test 2
pausetext = StrCat(@crlf,"Press OK to continue ...")
pausetext = StrCat("Test 2: udfDelTree (dir)  and view result",@crlf,pausetext)
Pause(pausetitle,pausetext)

foldertree = StrCat(testroot,"top2\")
udfDelTree (foldertree)

WinActivate(explorer)
TimeDelay(1)
SendKeysTo(explorer,"{F5}") ; refresh
TimeDelay(1)


; test 3
pausetext = StrCat(@crlf,"Press OK to continue ...")
pausetext = StrCat("Test 3: udfDelTree_2 (dir, 0)  and view result",@crlf,pausetext)
Pause(pausetitle,pausetext)

foldertree = StrCat(testroot,"top3\")
udfDelTree_2 (foldertree, 0)

WinActivate(explorer)
TimeDelay(1)
SendKeysTo(explorer,"{F5}") ; refresh
TimeDelay(1)


; test 4
pausetext = StrCat(@crlf,"Press OK to continue ...")
pausetext = StrCat("Test 4: udfDelTree_2 (dir, 1)  and view result",@crlf,pausetext)
Pause(pausetitle,pausetext)

foldertree = StrCat(testroot,"top4\")
udfDelTree_2 (foldertree, 1)

WinActivate(explorer)
TimeDelay(1)
SendKeysTo(explorer,"{F5}") ; refresh
TimeDelay(1)


; test 5
pausetext = StrCat(@crlf,"Press OK to continue ...")
pausetext = StrCat("Test 5: udfDelTree_2 (dir, 2)  and view result",@crlf,pausetext)
Pause(pausetitle,pausetext)

foldertree = StrCat(testroot,"top5\")
udfDelTree_2 (foldertree, 2)

WinActivate(explorer)
TimeDelay(1)
SendKeysTo(explorer,"{F5}") ; refresh
TimeDelay(1)


; cleaning
pausetext = StrCat(@crlf,"Press OK to continue ...")
Pause(pausetitle,pausetext)

:cancel
If IsDefined(explorer) Then If WinExist(explorer) Then WinClose(explorer)
If IsDefined(tempfolder) Then DirChange(tempfolder)
If IsDefined(testroot) Then udfDelTree (testroot)

Message(pausetitle,"Done.")
Exit
;----------------------------------------------------------------------------------------------------------------------


Seitenanfang/TopOfPage Seitenende/EndOfPage
Seitenanfang/TopOfPage Seitenende/EndOfPage

udfGetDiskUsagePct (drivelist)

If itemlocate("udfgetdiskusagepct", IntControl(77,103,0,0,0), @tab) then goto skip_udfgetdiskusagepct
#DefineFunction udfGetDiskUsagePct (drivelist)
ds = 0.0 + DiskSize(drivelist)
df = DiskFree(drivelist)
Return (100*(ds-df)/max(1,ds))
; returns disk usage in percent, e.g. 92.34567890
; drivelist is a string, composed of one or more drive letters,
; separated by "|", or the current file delimiter (usually a tab).
; From:  Marty marty@winbatch.com
; Date:  Friday, October 26, 2001 03:40 PM
#EndFunction
:skip_udfgetdiskusagepct

;--- test ---
message("Demo udfGetDiskUsagePct",StrCat("Drive C:",@crlf,"Percent used: ",udfGetDiskUsagePct("c")))
AllLocalDrives = DiskScan(2)
message("Demo udfGetDiskUsagePct",StrCat("All local drives ",@crlf,AllLocalDrives,@crlf,"%% used = ",udfGetDiskUsagePct(AllLocalDrives)))
AllRemoteDrives = DiskScan(4)
message("Demo udfGetDiskUsagePct",StrCat("All remote drives ",@crlf,AllRemoteDrives,@crlf,"%% used = ",udfGetDiskUsagePct(AllRemoteDrives)))
Exit


Seitenanfang/TopOfPage Seitenende/EndOfPage
Seitenanfang/TopOfPage Seitenende/EndOfPage

udfGetNextUnusedDiskID ()

If itemlocate("udfgetnextunuseddiskid", IntControl(77,103,0,0,0), @tab) then goto skip_udfgetnextunuseddiskid
#DefineFunction udfGetNextUnusedDiskId ()
Return (ItemExtract(1,DiskScan(0),@tab))
; DD.20020130
#EndFunction
:skip_udfgetnextunuseddiskid

;--- test ---
DiskId = udfGetNextUnusedDiskId()
If (DiskID=="") then DiskID = "not available."
Message("Demo udfGetUnusedDiskId ()",StrCat("Next unused DiskID is ",DiskID))
Exit


Seitenanfang/TopOfPage Seitenende/EndOfPage
Seitenanfang/TopOfPage Seitenende/EndOfPage

udfGetUNCFromDrive (localdrive)


#DefineFunction udfGetUNCFromDrive(localdrive)
localdrive = StrSub(localdrive,1,2)
dword = BinaryAlloc(4)
bbuff = BinaryAlloc(256)
BinaryPoke4(dword, 0,255)
BinaryPoke(bbuff, 255,0)
dllcall(strcat(dirwindows(1),"MPR.DLL") ,long:"WNetGetConnectionA", lpstr:LocalDrive, lpbinary:bbuff, lpbinary:dword)
unc = BinaryPeekStr(bbuff,0,256)
BinaryFree(dword)
BinaryFree(bbuff)
Return (unc)
; returns the name of the network resource currently connected to a 'local name'.
; If the resource is not mapped a null string will be returned.
; same function like WIL'S extender functions: n3DrivePath, n4DrivePath, w95GetCon, wntGetCon, netGetCon
; Topic: UNC Path from a maped drive
; Conf:  WinBatch
; From:  akreutzer kreutzer@ost.state.or.us
; Date:  Tuesday, July 31, 2001 07:44 AM
#EndFunction

;--- test ---
netrsrc = udfGetUNCFromDrive("W:")
If netrsrc=="" then Message("Drive W: is","not mapped")
   else Message("Drive W: is mapped to",netrsrc)
exit


Seitenanfang/TopOfPage Seitenende/EndOfPage
Seitenanfang/TopOfPage Seitenende/EndOfPage

udfGetZeroDirs (rootdir, mode)

If (ItemLocate("udfgetzerodirs",IntControl(77,103,0,0,0),@tab)>0) Then Goto skip_udfgetzerodirs

#DefineFunction udfGetZeroDirs (dir, mode)
mode = Min(1,Max(0,mode))
If (mode==1) Then IntControl(5,1,0,0,0) ; System & Hidden files or directories are seen and used
origdir = DirGet()
DirChange(dir)
list = ""
dirlist = DirItemize("*.*")
dircount = ItemCount(dirlist,@tab)

For i=1 To dircount
   thisdir = ItemExtract(i,dirlist,@tab)
   ds = DirSize(thisdir,0)
   If (ds==0)
      name = StrCat(DirGet(),thisdir)
      list = ItemInsert(name,-1,list,@tab)
   EndIf
   str = udfGetZeroDirs(thisdir,mode)
   If (str <> "") Then list = ItemInsert(str,-1,list,@tab)
Next
DirChange(origdir)
IntControl(5,0,0,0,0) ; protect System & Hidden files and directories
Return (list)
; Returns a tab delimited itemlist of directorynames.
; mode = 0 = Normal operation, no use of hidden & system attributed folders.
; mode = 1 = Inspect hidden & system attributed folders too.
;
; Detlev Dalitz.20020616
#EndFunction

:skip_udfgetzerodirs


; --- test ---
msgtitle = "Demo  udfGetZeroDirs (dir, filehandle)"
BoxOpen (msgtitle,"... running ...")

root = AskDirectory(StrCat(msgtitle,@crlf,"Select root for search"),"","","Are you sure?",1|2)

dirlist = udfGetZeroDirs(root,1)

tempfile = FileCreateTemp("TMP")
fw = FileOpen(tempfile,"write")
FileWrite(fw,StrReplace(dirlist,@tab,@crlf))
FileClose(fw)

If FileExist(tempfile)
   RunWait("notepad",tempfile)
   FileDelete(tempfile)
EndIf

BoxButtondraw(1,1,"&Ok","20,780,980,950")
BoxText("Done.")
BoxButtonwait()
BoxShut()
Exit


Seitenanfang/TopOfPage Seitenende/EndOfPage
Seitenanfang/TopOfPage Seitenende/EndOfPage

udfIsUnusedDrive (DriveLetter)
udfIsRemovableDrive (DriveLetter)
udfIsLocalDrive (DriveLetter)
udfIsNetDrive (DriveLetter)
udfIsCDROMDrive (DriveLetter)
udfIsRAMDrive (DriveLetter)
IsUnknownDrive (DriveLetter)

;----------------------------------------------------------------------------------------------------
; udfIsUnusedDrive (DriveLetter)                                             ; DD.2002:07:05:09:57:26
; udfIsRemovableDrive (DriveLetter)                                          ; DD.2002:07:05:09:57:26
; udfIsLocalDrive (DriveLetter)                                              ; DD.2002:07:05:09:57:27
; udfIsNetDrive (DriveLetter)                                                ; DD.2002:07:05:09:57:27
; udfIsCDROMDrive (DriveLetter)                                              ; DD.2002:07:05:09:57:27
; udfIsRAMDrive (DriveLetter)                                                ; DD.2002:07:05:09:57:27
; udfIsLocalDrive (DriveLetter)                                              ; DD.2002:07:05:09:57:27
; udfIsUnknownDrive (DriveLetter)                                            ; DD.2002:07:05:09:57:27
;----------------------------------------------------------------------------------------------------

#DefineFunction udfIsUnusedDrive (DriveLetter)
Return (StrScan(DiskScan(0),StrUpper(StrSub(DriveLetter,1,1)),1,@fwdscan)>0)
#EndFunction

#DefineFunction udfIsRemovableDrive (DriveLetter)
Return (StrScan(DiskScan(1),StrUpper(StrSub(DriveLetter,1,1)),1,@fwdscan)>0)
#EndFunction

#DefineFunction udfIsLocalDrive (DriveLetter)
Return (StrScan(DiskScan(2),StrUpper(StrSub(DriveLetter,1,1)),1,@fwdscan)>0)
#EndFunction

#DefineFunction udfIsNetDrive (DriveLetter)
Return (StrScan(DiskScan(4),StrUpper(StrSub(DriveLetter,1,1)),1,@fwdscan)>0)
#EndFunction

#DefineFunction udfIsCDROMDrive (DriveLetter)
Return (StrScan(DiskScan(8),StrUpper(StrSub(DriveLetter,1,1)),1,@fwdscan)>0)
#EndFunction

#DefineFunction udfIsRAMDrive (DriveLetter)
Return (StrScan(DiskScan(16),StrUpper(StrSub(DriveLetter,1,1)),1,@fwdscan)>0)
#EndFunction

#DefineFunction udfIsUnknownDrive (DriveLetter)
DriveLetter = StrUpper(StrSub(DriveLetter,1,1))
If (StrScan(DiskScan( 0),DriveLetter,1,@fwdscan)>0) Then Return (@false)
If (StrScan(DiskScan( 1),DriveLetter,1,@fwdscan)>0) Then Return (@false)
If (StrScan(DiskScan( 2),DriveLetter,1,@fwdscan)>0) Then Return (@false)
If (StrScan(DiskScan( 4),DriveLetter,1,@fwdscan)>0) Then Return (@false)
If (StrScan(DiskScan( 8),DriveLetter,1,@fwdscan)>0) Then Return (@false)
If (StrScan(DiskScan(16),DriveLetter,1,@fwdscan)>0) Then Return (@false)
Return (@true)
#EndFunction


;#DefineFunction udfIsLocalDrive (DriveLetter)
;DriveLetter = StrCat(StrUpper(StrSub(DriveLetter,1,1)),":")
;Drives = DiskScan (2)
;Return (ItemLocate(DriveLetter,Drives,@tab)>0)
;#EndFunction


Info = "n:\notes\data"

IsUnusedDrive    = udfIsUnusedDrive (Info)
IsRemovableDrive = udfIsRemovableDrive (Info)
IsLocalDrive     = udfIsLocalDrive (Info)
IsNetDrive       = udfIsNetDrive (Info)
IsCDROMDrive     = udfIsCDROMDrive (Info)
IsRAMDrive       = udfIsRAMDrive (Info)
IsUnknownDrive   = udfIsUnknownDrive (Info)

Exit


Seitenanfang/TopOfPage Seitenende/EndOfPage
Seitenanfang/TopOfPage Seitenende/EndOfPage

udfIsValidFilename (sFilename, iMode)

;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfisvalidfilename",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfisvalidfilename

#DefineFunction udfIsValidFilename (sFilename, iMode)
Select iMode
Case 0 ; DOS SFN
   sRoot=FileRoot(sFilename)
   iRootLen=StrLen(sRoot)
   If (iRootLen>8) Then Return @FALSE
   If (iRootLen==0) Then Return @FALSE
   sExt=FileExtension(sFilename)
   iExtLen=StrLen(sExt)
   If (iExtLen>3) Then Return @FALSE
   sDOSReservedNamesList="con|nul|prn|lpt1|lpt2|lpt3|com1|com2|com3|com4|aux|clock$"
   If (ItemLocate(sRoot,sDOSReservedNamesList,"|")>0) Then Return @FALSE
   sDosValidCharsList="abcdefghijklmnopqrstuvwxyz0123456789_^$~!%%&#-{}()@'`"
   If (StrClean(sRoot,sDosValidCharsList,"",@FALSE,1)!="") Then Return @FALSE
   If (iExtLen>0)
      If (StrClean(sExt,sDosValidCharsList,"",@FALSE,1)!="") Then Return @FALSE
   EndIf
   Return @TRUE
   Break
Case 1 ; Windows LFN
   sRoot=FileRoot(sFilename)
   iRootLen=StrLen(sRoot)
   iExtLen=StrLen(FileExtension(sFilename))
   If ((iRootLen+iExtLen)==0) Then Return @FALSE
   If ((iRootLen+iExtLen)>=215) Then Return @FALSE
   sDOSReservedNamesList="con|nul|prn|lpt1|lpt2|lpt3|com1|com2|com3|com4|aux|clock$"
   If (ItemLocate(sRoot,sDOSReservedNamesList,"|")>0) Then Return @FALSE
   sWinInvalidCharsList='\/:*?"<>|'
   sWinValidCharsList=""
   For i=1 To 255
      sWinValidCharsList=StrCat(sWinValidCharsList,Num2Char(i))
   Next
   sWinValidCharsList=StrClean(sWinValidCharsList,sWinInvalidCharsList,"",@FALSE,1)
   sFilename=StrClean(sFilename,sWinValidCharsList,"",@FALSE,1)
   sFilename=StrClean(sFilename,".","",@FALSE,1)
   If (sFilename!="") Then Return @FALSE
   Return @TRUE
   Break
EndSelect
Return @FALSE
;..........................................................................................................................................
; This udf validates if given filename is suitable filename for DOS or Windows.
; iMode=0 ... DOS-SFN ShortFileName
; File name check using abcdefghijklmnopqrstuvwxyz0123456789_^$~!%%&#-{}()@'` as per MS-DOS reference manual.
; iMode=1 ... Win95-LFN LongFileName, File name check for a maximum length of 215 characters.
;
; Based on example by Steffen Fraas 20010417 sfraas@zoo.co.uk.
; Published In WinBatch TechDataBase
; Article ID:   W15015
; File Created: 2001:04:18:14:32:25
; Modified by Detlev Dalitz.20010701.20020209
;..........................................................................................................................................
#EndFunction

:skip_udfisvalidfilename
;------------------------------------------------------------------------------------------------------------------------------------------


;--- test ---

sTestList = "validdos.fil|validdoss.fil|validdos.file|valid.|aux|prn.|com1:|.|"
For i=1 To ItemCount(sTestlist,"|")
   sFilename = ItemExtract(i,sTestList,"|")
   Message(sFilename,StrCat(ItemExtract(1+udfIsValidFilename(sFilename,0),"invalid,valid",",")," DOS name."))
Next

sTestList = "valid.win.fil|valid,win.fil|valid?|v.a.l.i.d.w.i.n.f.i.l.e.!|valid.aux.file|aux.tmp|aux|prn.|com1:|.|.test|"
For i=1 To ItemCount(sTestlist,"|")
   sFilename = ItemExtract(i,sTestList,"|")
   Message(sFilename,StrCat(ItemExtract(1+udfIsValidFilename(sFilename,1),"invalid,valid",",")," Windows name."))
Next
Exit
;------------------------------------------------------------------------------------------------------------------------------------------


Seitenanfang/TopOfPage Seitenende/EndOfPage
Seitenanfang/TopOfPage Seitenende/EndOfPage

udfSearchTreeForFile (root, filename)

If ItemLocate("udfsearchtreeforfile", IntControl(77,103,0,0,0), @tab) then goto skip_udfsearchtreeforfile
#DefineFunction udfSearchTreeForFile (root, filename)
MaxLen=262
bb = BinaryAlloc(MaxLen)
bool = DLLCall(StrCat(DirWindows(1), "imagehlp.dll"), long:"SearchTreeForFile", lpstr:root, lpstr:filename, lpbinary:bb)
BinaryEodSet(bb, MaxLen)
PathStr = BinaryPeekstr(bb, 0, MaxLen)
BinaryFree(bb)
Return (PathStr)
; published by Guido sedar@yahoo.com, Wednesday, August 29, 2001 04:30 AM, WinBatch Forum
#EndFunction
:skip_udfsearchtreeforfile

;--- test ---
message("Demo udfSearchTreeForFile (root, filename)", udfSearchTreeForFile(DirWindows(1),"imagehlp.dll"))
Exit


Seitenanfang/TopOfPage Seitenende/EndOfPage
Seitenanfang/TopOfPage Seitenende/EndOfPage

udfXcopy (fromdir, todir)

If (ItemLocate("udfxcopy",IntControl(77,103,0,0,0),@tab)>0) Then Goto skip_udfxcopy

#DefineFunction udfXcopy (fromdir, todir)
result = DirExist(fromdir)
;Terminate(!result, "Error", "From directory does not exist")
If !result Then Return (-1)

;make sure we have a full path or a UNC
result = StrIndex(fromdir,":", 0, @fwdscan) + (StrSub(fromdir, 1, 2)=="\\")
;Terminate(!result, "Error", "Full path must be specified for FromDir")
If !result Then Return (-2)

result = StrIndex(todir  ,":", 0, @fwdscan) + (StrSub(todir  , 1, 2)=="\\")
;Terminate(!result, "Error", "Full path must be specified for ToDir")
If !result Then Return (-3)

fromdir = StrCat(fromdir,StrSub("\",(StrSub(fromdir,StrLen(fromdir),1)!="\"),1))
todir   = StrCat(todir  ,StrSub("\",(StrSub(todir  ,StrLen(todir)  ,1)!="\"),1))
If !DirExist(todir) Then DirMake(todir)
DirChange(fromdir)
FileCopy(StrCat(fromdir,"*.*"), StrCat(todir,"*.*"), 0)

dirlist = DirItemize("*.*") ; get list of subdirectories
dircount = ItemCount(dirlist, @tab)
For d=1 To dircount
   thisdir = ItemExtract(d, dirlist, @tab)
   fulltodir   = StrCat(todir  , thisdir, "\")
   fullfromdir = StrCat(fromdir, thisdir, "\")
   result = udfXcopy(fullfromdir, fulltodir) ; recursive
   If (result<1) Then Break
Next
Return (result)
; base code for this udf was published in WinBatch TechBase
; Article ID:   W14748
; Filename:   DelTree and Xcopy.txt
; File Created: 2001:03:19:15:12:22
; Page Dated: 2001:03:30:15:13:40
#EndFunction

:skip_udfxcopy


; --- test ---

nowdir = DirGet()

DirChange(DirHome()) ; WinBatch system folder
DirChange("..")      ; WinBatch main folder
fromdir = DirGet()
;fromdir = "\\SERVER\VOLUME\FOLDER\"

todir = Environment("temp")
todir = StrCat(todir, StrSub("\", (StrSub(todir, StrLen(todir), 1)!="\"), 1))
todir = StrCat(todir, "xcopydir\")

result = udfXcopy(fromdir, todir)

DirChange(nowdir)
Exit


Seitenanfang/TopOfPage Seitenende/EndOfPage
Seitenanfang/TopOfPage Seitenende/EndOfPage

udfShortenPath (pathstr, width, mode)

If (ItemLocate("udfshortenpath",IntControl(77,103,0,0,0),@tab)>0) Then Goto skip_udfshortenpath

#DefineFunction udfShortenPath (pathstr, width, mode)
len=StrLen(pathstr)
If (len<=width) Then Return (pathstr)
p1=StrScan(pathstr,"\",4,@fwdscan)
m1=p1
w=width-p1-3
p2=len
m2=p2
c=0
While 1
   p2=StrScan(pathstr,"\",p2-1,@backscan)
   If ((len-p2)>=w) Then Break
   c=c+1
   m2=p2
EndWhile
If (c>0)
   p2=m2
   tilde=""
Else
   p1=p1-1-len+p2+w-1
   tilde="~"
EndIf
If (p1<3)
   p1=0
   w=3
Else
   w=width-p1-len+p2-1-StrLen(tilde)
EndIf
If Min(@true,Max(@false,mode))
   If (w>3)
      c=w-3
      w=3
      While 1
         p1=p1+1
         c=c-1
         If (c<1) Then Break
         p2=p2-1
         c=c-1
         If (c<1) Then Break
      EndWhile
   EndIf
EndIf
str1=StrSub(pathstr,1,p1)
str2=StrSub(pathstr,p2,-1)
Return (StrCat(str1,tilde,StrFill(".",w),str2))
;
; mode = 0
; returns a shortened pathname inserted with repeated points (no ellipsis)
; example: ("c:\program files\navigator\programs\bookmark.htm", 45) ==> "c:\program files\......\programs\bookmark.htm"
;
; mode = 1
; returns a shortened pathname inserted with three points (ellipsis)
; example: ("c:\program files\navigator\programs\bookmark.htm", 45) ==> "c:\program files\na...r\programs\bookmark.htm"
;
; Detlev Dalitz.20020222.20020524.20020627
#EndFunction

:skip_udfshortenpath


; --- test ---
msgtitle = "Demo udfShortenPath (pathstr, width, mode)"

:test1
LongStr  = "Any Folder\Any Folder\Any Folder\Any File.any"
Width    = 30
Mode     = 0
ShortStr = udfShortenPath (LongStr, Width, Mode)
msgtext  = StrCat(longstr,@crlf,ShortStr)
Pause(msgtitle,msgtext)

:test2
LongStr  = "\\SERVER\SHARE\WINBATCH\2002\FILE.TXT"
Width    = 30
Mode     = 0
ShortStr = udfShortenPath (LongStr, Width, Mode)
msgtext  = StrCat(longstr,@crlf,ShortStr)
Pause(msgtitle,msgtext)

:test3
LongStr  = "C:\Program Files\Navigator\Programs\Bookmark.htm"
ilen = StrLen(LongStr)
For i=ilen To 1 By -1
   Width = i
   ShortStr0 = udfShortenPath (LongStr, Width, 0)
   ShortStr1 = udfShortenPath (LongStr, Width, 1)
   ShortLen0 = StrLen(ShortStr0)
   ShortLen1 = StrLen(ShortStr1)
   msgtext  = ""
   msgtext  = StrCat(msgtext,Width,@tab,longstr,@crlf)
   msgtext  = StrCat(msgtext,ShortLen0,@tab,ShortStr0,@crlf)
   msgtext  = StrCat(msgtext,ShortLen1,@tab,ShortStr1,@crlf)
   Pause(msgtitle,msgtext)
Next

:cancel
Exit


Seitenanfang/TopOfPage Seitenende/EndOfPage
Seitenanfang/TopOfPage Seitenende/EndOfPage

udfFileCopyFlat (sSourceFolder, sFileMask, sTargetFolder, iAlign, iSubMask)
udfFileCopyFlatR (sSourceFolder, sFileMask, sTargetFolder, iAlign)

;------------------------------------------------------------------------------------------------------------------------------------------
; udfFileCopyFlat  (sSourceFolder, sFileMask, sTargetFolder, iAlign, sSubMask)  ; Copy folder tree to flat folder.
; udfFileCopyFlatR (sSourceFolder, sFileMask, sTargetFolder, iAlign)            ; Copy flat folder to folder tree.
;------------------------------------------------------------------------------------------------------------------------------------------
; Version 2.0  20030103  Detlev Dalitz
; uses 'File Search Extender' ("wsrch34i.dll").
;------------------------------------------------------------------------------------------------------------------------------------------


;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udffilecopyflat",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udffilecopyflat

#DefineFunction udfFileCopyFlat (sSourceFolder, sFileMask, sTargetFolder, iAlign, sSubMask) ; Copy folder tree to flat folder.
If !DirExist(sSourceFolder) Then Return (-1) ; Source Folder does not exist.
sFolderNow = DirGet()
iSourceCount = 0
iTargetCount = 0

AddExtender("wsrch34i.dll")

sSourceFolder = FileNameShort(sSourceFolder)
iHandle = SrchInit(sSourceFolder,sFileMask,"","",8+16) ; 8=include hidden files; 16=recurse subfolders
While @TRUE
   sSrchPath = SrchNext(iHandle)
   If (sSrchPath == "") Then Break
   If (FileNameShort(FilePath(sSrchPath)) == sSourceFolder)
      GoSub ProcessFile
      Continue
   EndIf
   If (sSubMask == "") Then Break
   sFolder = ItemExtract(Max(2,ItemCount(sSrchPath,"\")-1),sSrchPath,"\")
   If (sFolder > "")
      sFolder = StrLower(sFolder)
      sSubMask = StrLower(sSubMask)
      If !StrIndex(sFolder,".",0,@BACKSCAN) Then sFolder = StrCat(sFolder,".")
      If (StrIndexWild(sFolder,sSubMask,1) == 1) Then GoSub ProcessFile
   EndIf
EndWhile
SrchFree(iHandle)

DirChange(sFolderNow)
Return (iSourceCount-iTargetCount)


:ProcessFile
iSourceCount = iSourceCount + 1
sFileLong = FileNameLong(sSrchPath)
sFolderLong = FilePath(sFileLong)

; Build the flattened folder string.
iResult = 0
iLen = 0
Select @TRUE
Case (StrIndexWild(sFolderLong,"?:\",1) == 1) ; DOS drive letter with absolute path "D:\".
   iLen = 3
   Break
Case (StrIndexWild(sFolderLong,"\\?*\?*\",1) == 1) ; UNC "\\SERVER\SHARE\".
   iLen = StrLenWild(sFolderLong,"\\?*\?*\",1)
   Break
EndSelect
sFolderFlat = StrSub(sFolderLong,iLen+1,-1)
iStrLen = StrLen(sFolderFlat)
If (StrSub(sFolderFlat,iStrLen,1) == "\") Then sFolderFlat = StrSub(sFolderFlat,1,iStrLen-1)
sFolderFlat = StrReplace(sFolderFlat,"`",".`")
sFolderFlat = StrReplace(sFolderFlat,"\","`")

; Create target folder.
iStrLen = StrLen(sTargetFolder)
If (StrSub(sTargetFolder,iStrLen,1) == "\") Then sTargetFolder = StrSub(sTargetFolder,1,iStrLen-1)
If !DirExist(sTargetFolder)
   sFolder = ""
   iItemCount = ItemCount(sTargetFolder,"\")
   For iItem=1 To iItemCount
      sFolder = StrCat(sFolder,ItemExtract(iItem,sTargetFolder,"\"),"\")
      If !DirExist(sFolder)
         iLastErrorMode = ErrorMode(@OFF)
         DirMake(sFolder)
         ErrorMode(iLastErrorMode)
      EndIf
   Next
   If !DirExist(sTargetFolder) Then Return (-2) ; Target Folder does not exist.
EndIf

sFile = ItemExtract(-1,sFileLong,"\")
sFileNew = StrReplace(sFile,"`",".`")
Select iAlign
Case -1 ; Left
   sFileNew = StrCat(sFolderFlat,"`",sFileNew)
   Break
Case 1 ; Right
   sFileNew = StrCat(sFileNew,"`",sFolderFlat)
   Break
Case 0 ; Middle
Case iAlign ; Middle
   sFileNew = StrCat(FileRoot(sFileNew),"`",sFolderFlat,".",FileExtension(sFileNew))
   Break
EndSelect
sFileNew = StrCat(sTargetFolder,"\",sFileNew)
FileCopy(sFileLong,sFileNew,0)
iTargetCount = iTargetCount + (FileExist(sFileNew) > 0)

Return ; from GoSub
;..........................................................................................................................................
; This function "udfFileCopyFlat" copies files from a folder tree into one flat folder.
;
; Return values:
;  0 ... Operation may be done successfully.
; -1 ... Source Folder does not exist.
; -2 ... Target Folder does not exist.
; n>0 .. The number of files which have not been copied successfully.
;
; Parameters:
; sSourceFolder ....... Source Folder to start from.
; sFileMask ........... Group of files, e.g. "*.hlp".
; sTargetFolder ....... Destination Folder, e.g. "D:\Temp\FlatFolder\".
; iAlign .............. The position of the source folder path to be inserted into target filename.
; iAlign= -1 .......... Left.
; iAlign= 0 ........... Middle (should be the default use).
; iAlign= 1 ........... Right.
; sSubMask ............ Defines to search in subfolders too.
; sSubMask= "" ........ Only source folder will be used.
; sSubMask= "*.*" ..... Search source folder and all subfolders.
; sSubMask= "TMP*.*" .. Search source folder and in subfolders with foldernames fitting to the mask, e.g. "TMP*.*
;
; Hint:
; This udf makes use of the 'File Search Extender' AddExtender("wsrch34i.dll").
; By default RequestFlag=8 this udf is designed to see hidden files too.
; This makes it obsolete, to code an additional IntControl (5,1,0,0,0) statement before calling this udf.
;
;
; This Function "udfFileCopyFlat" combines the source folder path (Filepath without drive)
; with the source filename to form a long filename which is always unique (and shows where the file is from).
; The source filepath becomes part of the target filename.
;
; Examples:
; 1. The file "D:\Programme\WinBatch\Windows Interface Language.hlp"
; is copied to folder "D:\Flat\" using option iAlign=-1 (source path is combined to the left of the filename):
; "D:\Flat\Programme`WinBatch`Windows Interface Language.hlp"
;
; 2. The file "D:\Programme\WinBatch\Windows Interface Language.hlp"
; is copied to folder "D:\Flat\" using option iAlign=0 (source path is combined into the middle of the filename):
; "D:\Flat\Windows Interface Language`Programme`WinBatch.hlp"
;
; 3. The file "D:\Programme\WinBatch\Windows Interface Language.hlp"
; is copied to folder "D:\Flat\" using option iAlign=1 (source path is combined to the right of the filename):
; "D:\Flat\Windows Interface Language.hlp`Programme`WinBatch"
;
;
; To rebuild the folder tree from "flattened" files simply use the corresponding "udfFileCopyFlatR()" function.
;
; To be always in sync with the original folder tree structure and filenames,
; make sure to use the same iAlign mode in both directions, e.g. flatten and deflatten with iAlign=0.
;
; Be aware of interesting naming effects, if you do interchange the modes on flattening and deflattening.
;
; The idea of 'Flattening' was originally envolved by Kan Yabumoto, mailto:tech@xxcopy.com,
; as one frightening feature of his world's best 'copy and more' command line tool XXCOPY.EXE.
; I heartly say 'Thank You, Kan', especially for your explanations regarding the use of the back-apostrophe "`".
;
; Detlev Dalitz.20030103
;..........................................................................................................................................
#EndFunction

:skip_udffilecopyflat
;------------------------------------------------------------------------------------------------------------------------------------------


;------------------------------------------------------------------------------------------------------------------------------------------
If (ItemLocate("udffilecopyflatr",IntControl(77,103,0,0,0),@TAB)>0) Then Goto skip_udffilecopyflatr

#DefineFunction udfFileCopyFlatR (sSourceFolder, sFileMask, sTargetFolder, iAlign) ; Copy flat folder to folder tree.
If !DirExist(sSourceFolder) Then Return (-1) ; Source Folder does not exist.
sFolderNow = DirGet()
iSourceCount = 0
iTargetCount = 0

AddExtender("wsrch34i.dll")

sTargetFolder = StrCat(sTargetFolder,StrSub("\",1,(StrSub(sTargetFolder,StrLen(sTargetFolder),1)<>"\")))
sSourceFolder = FileNameShort(sSourceFolder)
iHandle = SrchInit(sSourceFolder,sFileMask,"","",8) ;  8=include hidden files
While @TRUE
   sSrchPath = SrchNext(iHandle)
   If (sSrchPath == "") Then Break
   GoSub ProcessFile
EndWhile
SrchFree(iHandle)

DirChange(sFolderNow)
Return (iSourceCount-iTargetCount)


:ProcessFile
iSourceCount = iSourceCount + 1
sFileLong = FileNameLong(sSrchPath)
sFile = ItemExtract(-1,sFileLong,"\")
sFileNew = StrReplace(sFile,".`",@LF) ; Temporary replacement.
sFolderNew = ""

If StrIndex(sFileNew,"`",0,@FWDSCAN)
   Select iAlign
   Case -1 ; Left
      iPosRight  = StrIndex(sFileNew,"`",0,@BACKSCAN)
      sFileNew   = StrReplace(sFileNew,@LF,"`")
      sFolderNew = StrSub(sFileNew,1,iPosRight-1)
      sFileNew   = StrSub(sFileNew,iPosRight+1,-1)
      Break
   Case 1 ; Right
      iPosLeft   = StrIndex(sFileNew,"`",0,@FWDSCAN)
      sFileNew   = StrReplace(sFileNew,@LF,"`")
      sFolderNew = StrSub(sFileNew,iPosLeft+1,-1)
      sFileNew   = StrSub(sFileNew,1,iPosLeft-1)
      Break
   Case 0 ; Middle
   Case iAlign ; Middle
      iPosLeft   = StrIndex(sFileNew,"`",0,@FWDSCAN)
      sFileNew   = StrReplace(sFileNew,@LF,"`")
      sFolderNew = StrSub(FileRoot(sFileNew),iPosLeft+1,-1)
      sFileNew   = StrCat(StrSub(sFileNew,1,iPosLeft-1),".",FileExtension(sFileNew))
      Break
   EndSelect
   sFolderNew = StrReplace(sFolderNew,"`","\")
EndIf
sFolderNew = StrCat(sTargetFolder,sFolderNew)
sFileNew   = ItemInsert(sFileNew,-1,sFolderNew,"\")

If !DirExist(sFolderNew)
   sFolder = ""
   iItemCount = ItemCount(sFolderNew,"\")
   If (StrSub(sFolderNew,StrLen(sFolderNew),1) == "\") Then iItemCount = iItemCount - 1
   For iItem=1 To iItemCount
      sFolder = StrCat(sFolder,ItemExtract(iItem,sFolderNew,"\"),"\")
      If !DirExist(sFolder)
         iLastErrorMode = ErrorMode(@OFF)
         DirMake(sFolder)
         ErrorMode(iLastErrorMode)
      EndIf
   Next
EndIf
If DirExist(sFolderNew) Then FileCopy(sFileLong,sFileNew,0)
iTargetCount = iTargetCount + (FileExist(sFileNew) > 0)

Return ; from GoSub
;..........................................................................................................................................
; This function "udfFileCopyFlatR" copies 'flattened' files from one folder into a tree folder structure.
;
; This function reverses the operation previously done by the function "udfFileCopyFlat".
; See further explanations in description of "udfFileCopyFlat".
;
; Return values:
;  0   ... Operation may be done successfully.
;  n>0 ... The number of files which have not been copied successfully.
;
; Parameter:
; sSourceFolder ... Source Folder containing 'flattened' filenames.
; sFileMask ....... Group of files, e.g. "*.txt"
; sTargetFolder ... Destination Folder, e.g. "D:\NewStructure\"
; iAlign .......... The position of the previously inserted folder path in the 'flattened' filename:
; iAlign = -1 ..... Left
; iAlign = 0 ...... Middle (should be the default use)
; iAlign = 1 ...... Right
;
; Hint:
; This udf makes use of the 'File Search Extender' AddExtender("wsrch34i.dll").
; By default RequestFlag=8 this udf is designed to see hidden files too.
; This makes it obsolete, to code an additional IntControl (5,1,0,0,0) statement before calling this udf.
;
;
; To be always in sync with the original folder tree structure and filenames,
; make sure to use the same iAlign mode in both directions, e.g. flatten and deflatten with iAlign=0.
;
; Be aware of interesting naming effects, if you do interchange the modes on flattening and deflattening.
;
; The idea of 'Flattening' was originally envolved by Kan Yabumoto, mailto:tech@xxcopy.com,
; as one frightening feature of his world's best 'copy and more' command line tool XXCOPY.EXE.
; I heartly say 'Thank You, Kan', especially for your explanations regarding the use of the back-apostrophe "`".
;
; Detlev Dalitz.20030103
;..........................................................................................................................................
#EndFunction

:skip_udffilecopyflatr
;------------------------------------------------------------------------------------------------------------------------------------------



; --- test ---
sFolderNow = DirGet()

sTempFolder = Environment("temp")
sTempFolder = StrCat(sTempFolder,StrSub("\",(StrSub(sTempFolder,StrLen(sTempFolder),1)<>"\"),1))


:test1 ; Folder tree to flat folder.

; Define the base source folder.
; For the test let us start in WinBatch Main folder
DirChange(DirHome()) ; WinBatch system folder
DirChange("..")      ; WinBatch main folder
sFromFolder = DirGet()
;sFromFolder = "\\FSDD1\SYS\TEMP\LONGNAME\"

; Define the Filemask.
; For the test we collect all .hlp files.
sFileMask = "*.hlp"

; Define the flat target folder.
; For the test we create a subfolder in the systems temp folder.
sToFolder = StrCat(sTempFolder, "Flat\")

; Define the flatten alignment. (-1=Left, 0=Middle, 1=Right)
iAlign = 0

; Define SubFolderMask ("" = Don't search; "*.*" = Search all; "WW*.DIR" = Search as specified).
sSubMask = "WW*.*"
;sSubMask = "*.*"
;sSubMask = ""

; Call the 'Flattener'.
iResult = udfFileCopyFlat(sFromFolder,sFileMask,sToFolder,iAlign,sSubMask)

; View the flat folder.
If (iResult == 0) Then Run("explorer",StrCat("/e, /root, ",sToFolder))



:test2 ; Flat folder to folder tree (Rebuild tree).

; We use all flat files from the test flat folder.
sFromFolder = StrCat(sTempFolder, "Flat\")

; Define the Filemask.
; For the test we collect all files.
sFileMask = "*.*"

; For the test we create a subfolder in the system temp folder.
sToFolder = StrCat(sTempFolder, "FlatR\")

; Define the flatten alignment. (-1=Left, 0=Middle, 1=Right)
iAlign = 0

; Call the 'FlatRebuilder'.
iResult = udfFileCopyFlatR(sFromFolder,sFileMask,sToFolder,iAlign)

; View folder tree.
If (iResult == 0) Then Run("explorer",StrCat("/e, /root, ",sToFolder))


DirChange(sFolderNow)
Exit
;------------------------------------------------------------------------------------------------------------------------------------------
*EOF*


Seitenanfang/TopOfPage Seitenende/EndOfPage
Seitenanfang/TopOfPage Seitenende/EndOfPage

udfShortcutCopy (sShortcutSourceFilename, sShortcutTargetFilename)

;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfshortcutcopy",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfshortcutcopy

#DefineFunction udfShortcutCopy (sShortcutSourceFilename, sShortcutTargetFilename)
sInfo        = ShortCutInfo(sShortcutSourceFilename)
sLinkTarget  = ItemExtract(1,sInfo,@TAB)
sParams      = ItemExtract(2,sInfo,@TAB)
sFolderStart = ItemExtract(3,sInfo,@TAB)
iShowMode    = ItemExtract(4,sInfo,@TAB)
sDescription = ItemExtract(5,sInfo,@TAB)
sHotkey      = ItemExtract(6,sInfo,@TAB)
sIconFilename= ItemExtract(7,sInfo,@TAB)
iIconIndex   = ItemExtract(8,sInfo,@TAB)
iResult      = FileDelete(sShortcutTargetFilename) ; Force delete existing shortcut file.
iResult      = ShortCutMake(sShortcutTargetFilename,sLinkTarget,sParams,sFolderStart,iShowMode)
iResult      = ShortCutExtra(sShortcutTargetFilename,sDescription,sHotkey,sIconFilename,iIconIndex)
Return (iResult)
;..........................................................................................................................................
; This Function "udfShortcutCopy" returns a boolean value,
; which indicates if the shortcut manipulation has been done successfully or not.
;
; This Function creates a copy of an existing shortcut ".lnk"-file
; as defined in parameter "sShortcutSourceFilename" into another target folder.
;
; Note:
; If a target shortcut ".lnk"-file with the same name
; as defined in parameter "sShortcutTargetFilename" already exists,
; it will be deleted without permission!
;
; Detlev Dalitz.20030701
;..........................................................................................................................................
#EndFunction

:skip_udfshortcutcopy
;------------------------------------------------------------------------------------------------------------------------------------------


; --- test ---

; Prepare testcase.
sFolderHome    = DirGet()
sFolderDesktop = RegQueryValue(@REGCURRENT,"Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders[Desktop]")
iResult        = DirChange(sFolderDesktop)

sLinkFilename  = StrCat("Testcase.",StrReplace(TimeYmdHms(),":",""),".lnk")
sLinkTarget    = FileLocate("explorer.exe")
sParams        = "/e, /select, C:\"
sFolderStart   = "C:\"
iShowMode      = @NORMAL
iShortcutType  = 0 ; Normal shortcut (default)
sDescription   = "*** Testcase ShortcutCopy ***"
sHotkey        = "!^+a" ; Just for the test, don't know if this works.
sIconFilename  = FileLocate("shell32.dll")
iIconIndex     = 41
iResult        = ShortCutMake(sLinkFilename,sLinkTarget,sParams,sFolderStart,iShowMode,iShortcutType)
iResult        = ShortCutExtra(sLinkFilename,sDescription,sHotkey,sIconFilename,iIconIndex)

; Prepare and perform ShortcutCopy.
; We create a copy in the tempfolder.
sShortcutSource = sLinkFilename
sShortcutTarget = StrCat(Environment("TEMP"),"\Testcase.ShortcutCopy.lnk")

iResult = udfShortcutCopy(sShortcutSource,sShortcutTarget)

; Check the shortcuts.
ShellExecute(sShortcutSource,"","",@NORMAL,"properties")
ShellExecute(sShortcutTarget,"","",@NORMAL,"properties")
WinWaitClose("~Testcase.ShortcutCopy")

; Cleanup
iResult = FileDelete(sShortcutSource)
iResult = FileDelete(sShortcutTarget)
DirChange(sFolderHome)
Exit
;------------------------------------------------------------------------------------------------------------------------------------------
*EOF*


Seitenanfang/TopOfPage Seitenende/EndOfPage
Seitenanfang/TopOfPage Seitenende/EndOfPage

udfFileTimeGetGMT (sFilename, iTimeField)

;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udffiletimegetgmt",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udffiletimegetgmt

#DefineFunction udfFileTimeGetGMT (sFilename, iTimeField)
INVALID_HANDLE_VALUE = -1
sYmdHms = ""
sKernel32 = DllLoad(StrCat(DirWindows(1),"Kernel32.DLL"))
hBBDATA = BinaryAlloc(320) ; Approx. size of struct WIN32_FIND_DATA.
iHandle = DllCall(sKernel32,long:"FindFirstFileA",lpstr:sFilename,lpbinary:hBBDATA)
If (iHandle == INVALID_HANDLE_VALUE) ; File Not Found?
   BinaryFree(hBBDATA)
   DllFree(sKernel32)
   Return (sYmdHms)
EndIf
DllCall(sKernel32,long:"FindClose",long:iHandle)

hBBFILETIME = BinaryAlloc(8) ; Size of struct FILETIME.
Switch Min(Max(iTimeField,1),3)
Case 2
   BinaryCopy(hBBFILETIME,0,hBBDATA,20,8) ; Copy "ftLastWriteTime"  into FILETIME buffer.
   Break
Case 1
   BinaryCopy(hBBFILETIME,0,hBBDATA,04,8) ; Copy "ftCreationTime"   into FILETIME buffer.
   Break
Case 3
   BinaryCopy(hBBFILETIME,0,hBBDATA,12,8) ; Copy "ftLastAccessTime" into FILETIME buffer.
   Break
EndSwitch
; Re-use of hBBDATA buffer for the SYSTEMTIME structure.
DllCall(sKernel32,long:"FileTimeToSystemTime",lpbinary:hBBFILETIME,lpbinary:hBBDATA)
DllFree(sKernel32)
BinaryFree(hBBFILETIME)

iYear   = BinaryPeek2(hBBDATA,0)
sMonth  = StrFixLeft(BinaryPeek2(hBBDATA,2),"0",2)
sDay    = StrFixLeft(BinaryPeek2(hBBDATA,6),"0",2)
sHour   = StrFixLeft(BinaryPeek2(hBBDATA,8),"0",2)
sMinute = StrFixLeft(BinaryPeek2(hBBDATA,10),"0",2)
sSecond = StrFixLeft(BinaryPeek2(hBBDATA,12),"0",2)
BinaryFree(hBBDATA)
sYmdHms = StrCat(iYear,":",sMonth,":",sDay,":",sHour,":",sMinute,":",sSecond)
Return (sYmdHms)
;..........................................................................................................................................
; This Function "udfFileTimeGetGMT" returns a YmdHms DateTime string,
; that represents the "LastWriteTime" in GMT/UTC for a given file.
; If the file is not found, the function returns an empty string.
;
; sFilename .... Can specify a file or directory name.
; iTimeField ... 1=CreationTime, 2=LastWriteTime, 3=LastAccessTime
;------------------------------------------------------------------------------------------------------------------------------------------
;   The WIN32_FIND_DATA structure describes a file found
;   by the FindFirstFile, FindFirstFileEx, or FindNextFile function.
;
;   typedef struct _WIN32_FIND_DATA {
;     DWORD    dwFileAttributes;
;     FILETIME ftCreationTime;
;     FILETIME ftLastAccessTime;
;     FILETIME ftLastWriteTime;
;     DWORD    nFileSizeHigh;
;     DWORD    nFileSizeLow;
;     DWORD    dwReserved0;
;     DWORD    dwReserved1;
;     TCHAR    cFileName[ MAX_PATH ];
;     TCHAR    cAlternateFileName[ 14 ];
;   } WIN32_FIND_DATA, *PWIN32_FIND_DATA;
;------------------------------------------------------------------------------------------------------------------------------------------
;   The FILETIME structure is a 64-bit value representing the number
;   of 100-nanosecond intervals since January 1, 1601 (UTC).
;
;   typedef struct _FILETIME {
;       DWORD dwLowDateTime;
;       DWORD dwHighDateTime;
;   } FILETIME, *PFILETIME;
;------------------------------------------------------------------------------------------------------------------------------------------
;   The SYSTEMTIME structure represents a date and time using individual members
;   for the month, day, year, weekday, hour, minute, second, and millisecond.
;
;   typedef struct _SYSTEMTIME {
;       WORD wYear;
;       WORD wMonth;
;       WORD wDayOfWeek;
;       WORD wDay;
;       WORD wHour;
;       WORD wMinute;
;       WORD wSecond;
;       WORD wMilliseconds;
;   } SYSTEMTIME, *PSYSTEMTIME;
;------------------------------------------------------------------------------------------------------------------------------------------
; Conf:  WinBatch
; From:  akreutzer kreutzer@ost.state.or.us
; Date:  Wednesday, August 07, 2002 11:19 AM
; Slightly modified by Detlev Dalitz.20030701
;..........................................................................................................................................
#EndFunction

:skip_udffiletimegetgmt
;------------------------------------------------------------------------------------------------------------------------------------------


; --- test ---

sFilename = StrCat(DirHome(),"WinBatch.exe")

sFiletime11 = FileTimeGetEx(sFilename,1)        ; CreationTime  
sFiletime12 = FileTimeGetEx(sFilename,2)        ; LastWriteTime 
sFiletime13 = FileTimeGetEx(sFilename,3)        ; LastAccessTime

sFiletimeGMT11 = udfFileTimeGetGMT(sFilename,1) ; CreationTime  
sFiletimeGMT12 = udfFileTimeGetGMT(sFilename,2) ; LastWriteTime
sFiletimeGMT13 = udfFileTimeGetGMT(sFilename,3) ; LastAccessTime 



sFilename = IntControl(1004,0,0,0,0) ; This file as test input.

sFiletime21 = FileTimeGetEx(sFilename,1)        ; CreationTime  
sFiletime22 = FileTimeGetEx(sFilename,2)        ; LastWriteTime 
sFiletime23 = FileTimeGetEx(sFilename,3)        ; LastAccessTime

sFiletimeGMT21 = udfFileTimeGetGMT(sFilename,1) ; CreationTime  
sFiletimeGMT22 = udfFileTimeGetGMT(sFilename,2) ; LastWriteTime
sFiletimeGMT23 = udfFileTimeGetGMT(sFilename,3) ; LastAccessTime 


Exit
;------------------------------------------------------------------------------------------------------------------------------------------
*EOF*


Seitenanfang/TopOfPage Seitenende/EndOfPage
Seitenanfang/TopOfPage Seitenende/EndOfPage

udfDirGetEx ()

;------------------------------------------------------------------------------------------------------------------------------------------
; udfDirGetTrue ()                                                                                                 ; DD.2002:02:10:04:41:46
; udfDirGetLong ()                                                                                                 ; DD.2002:02:10:04:41:46
; udfDirGetEx ()                                                                                                   ; DD.2002:02:10:04:41:46
;------------------------------------------------------------------------------------------------------------------------------------------


;------------------------------------------------------------------------------------------------------------------------------------------
#DefineFunction udfDirGetTrue ()
sFolderLong = ""
sFolder = DirGet()
iCount = ItemCount(sFolder,"\")-1
For ii=iCount To 2 By -1
   sFolderLong = ItemInsert(DirItemize(StrCat("..\",ItemExtract(ii,sFolder,"\"))),0,sFolderLong,"\")
   DirChange("..")
Next
sFolderLong = StrCat(ItemInsert(ItemExtract(1,sFolder,"\"),0,sFolderLong,"\"),"\")
DirChange(sFolder)
Return (sFolderLong)
#EndFunction
;------------------------------------------------------------------------------------------------------------------------------------------


;--- test ---
sFolderPath = "d:\tEmP\tRuEnAmEtEsT\"      ; Just a common name.
iResult = DirMake(sFolderPath)

sFolderPath = StrLower(sFolderPath)        ; Lowercase works.
iResult = DirChange(sFolderPath)

sFolderPath1 = DirGet()                    ; Appears as in last use of DirChange.
sFolderPath2 = udfDirGetTrue()             ; The actually really true name.

sMsgText  = StrCat("DirGet",@TAB,@TAB,sFolderPath1,@CRLF,"udfDirGetTrue",@TAB,sFolderPath2)
sMsgTitle = "udfDirGetTrue ()    Get true path of a folder"
Message(sMsgTitle,sMsgText)

DirChange("..")
iResult = DirRemove(StrUpper(sFolderPath)) ; Uppercase works too.

;------------------------------------------------------------------------------------------------------------------------------------------



;------------------------------------------------------------------------------------------------------------------------------------------
#DefineFunction udfDirGetLong ()
sFolder = DirGet() ; Use WinBatch native function.
iMAXPATH = 262
hBB = BinaryAlloc(iMAXPATH)
iResult = DllCall(StrCat(DirWindows(1),"kernel32.dll"),long:"GetLongPathNameA",lpstr:sFolder,lpbinary:hBB,long:iMAXPATH)
BinaryEodSet(hBB,iResult)
sFolderLong = BinaryPeekStr(hBB,0,iResult)
BinaryFree(hBB)
Return (sFolderLong)
#EndFunction
;------------------------------------------------------------------------------------------------------------------------------------------


;--- test ---
sFolderPath = "d:\tEmP\tRuEnAmEtEsT\"      ; Just a common name.
iResult = DirMake(sFolderPath)

sFolderPath = StrLower(sFolderPath)        ; Lowercase works.
iResult = DirChange(sFolderPath)

sFolderPath1 = DirGet()                    ; Appears as in last use of DirChange.
sFolderPath2 = udfDirGetLong()             ; The actually really true name.

sMsgText  = StrCat("DirGet",@TAB,@TAB,sFolderPath1,@CRLF,"udfDirGetLong",@TAB,sFolderPath2)
sMsgTitle = "udfDirGetLong ()    Get true path of a folder"
Message(sMsgTitle,sMsgText)

DirChange("..")
iResult = DirRemove(StrUpper(sFolderPath)) ; Uppercase does work too.
;------------------------------------------------------------------------------------------------------------------------------------------



;------------------------------------------------------------------------------------------------------------------------------------------
#DefineFunction udfDirGetEx ()
Return (StrCat(FileNameLong(StrCat(DirGet(),".")),"\"))
#EndFunction
;------------------------------------------------------------------------------------------------------------------------------------------


;--- test ---
sFolderPath = "d:\tEmP\tRuEnAmEtEsT\"      ; Just a common name.
iResult = DirMake(sFolderPath)

sFolderPath = StrLower(sFolderPath)        ; Lowercase works.
iResult = DirChange(sFolderPath)

sFolderPath1 = DirGet()                    ; Appears as in last use of DirChange.
sFolderPath2 = udfDirGetEx()               ; The actually really true name.

sMsgText  = StrCat("DirGet",@TAB,@TAB,sFolderPath1,@CRLF,"udfDirGetEx",@TAB,sFolderPath2)
sMsgTitle = "udfDirGetEx ()    Get true path of a folder"
Message(sMsgTitle,sMsgText)

DirChange("..")
iResult = DirRemove(StrUpper(sFolderPath)) ; Uppercase does work too.
;------------------------------------------------------------------------------------------------------------------------------------------



;------------------------------------------------------------------------------------------------------------------------------------------
; Performance Test

sMsgTitle  = "Demo udfDirGetTrue udfDirGetLong udfDirGetEx   Performance Test"
iTestLoop  = 100

iMaxTests = 3
For it=1 To 1
   Display(1,sMsgTitle,"Running Test %it%, please wait ...")
   Exclusive(@ON)
   iStart = GetTickCount()
   For ii=1 To iTestLoop
      sResult = udfDirGetTrue ()
   Next
   Exclusive(@OFF)
   iStop = GetTickCount()
   iTicks%it% = iStop-iStart
Next
For it=2 To 2
   Display(1,sMsgTitle,"Running Test %it%, please wait ...")
   Exclusive(@ON)
   iStart = GetTickCount()
   For ii=1 To iTestLoop
      sResult = udfDirGetLong ()
   Next
   Exclusive(@OFF)
   iStop = GetTickCount()
   iTicks%it% = iStop-iStart
Next
For it=3 To 3
   Display(1,sMsgTitle,"Running Test %it%, please wait ...")
   Exclusive(@ON)
   iStart = GetTickCount()
   For ii=1 To iTestLoop
      sResult = udfDirGetEx ()
   Next
   Exclusive(@OFF)
   iStop = GetTickCount()
   iTicks%it% = iStop-iStart
Next

iMaxTicks = 0
For it=1 To iMaxTests
   iMaxTicks = Max(iMaxTicks,iTicks%it%)
Next
For it=1 To iMaxTests
   iPct%it% = 100*iTicks%it%/iMaxTicks
Next
sMsgText = ""
For it=1 To iMaxTests
   sMsgText = StrCat(sMsgText,"Test ",it,@TAB,"iTicks = ",@TAB,iTicks%it%,@TAB,iPct%it%," %%",@CRLF)
Next
ClipPut(sMsgText)
Message(sMsgTitle,sMsgText)


Exit
;------------------------------------------------------------------------------------------------------------------------------------------
; Performance Test Result
;   Test 1 iTicks =  1353 100 %
;   Test 2 iTicks =  1111  82 %
;   Test 3 iTicks =   621  45 %   <== The winner.
;------------------------------------------------------------------------------------------------------------------------------------------
;*EOF*





Page Date
2004-05-18
DD-Software
Kapitel zurück / previous Chapter
Main Index
 
Seite zurück / previous page
Backward
Seite vor / next page
Forward
 
Seitenanfang/TopOfPage
Top
Seitenende/EndOfPage
Bottom
MyWbtHelp current version