Page Date 2004-05-18 DD-Software |
|
|
|
MyWbtHelp current version |
|
||||
udfDelBackslash (str)
|
||||
;------------------------------------------------------------------------------------------------------------------------------------------ #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 ;------------------------------------------------------------------------------------------------------------------------------------------ |
||||
|
||||
udfDelEmptyTree (dir)
|
||||
;---------------------------------------------------------------------------------------------------------------------- ; 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 ;---------------------------------------------------------------------------------------------------------------------- |
||||
|
||||
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 |
||||
|
||||
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 |
||||
|
||||
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 |
||||
|
||||
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 |
||||
|
||||
udfIsUnusedDrive (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 |
||||
|
||||
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 ;------------------------------------------------------------------------------------------------------------------------------------------ |
||||
|
||||
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 |
||||
|
||||
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 |
||||
|
||||
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 |
||||
|
||||
udfFileCopyFlat (sSourceFolder, sFileMask, sTargetFolder, iAlign, iSubMask)
|
||||
;------------------------------------------------------------------------------------------------------------------------------------------ ; 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* |
||||
|
||||
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* |
||||
|
||||
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* |
||||
|
||||
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 |
|
|
|
MyWbtHelp current version |