Friday, December 23, 2011

VBScript : pathIsBusy()

Sometimes i need a function that checks if a file is busy or not. Instead of two seperate functions folderIsBusy and fileIsBusy i made a pathIsBusy that can check for both.
It uses old technique of attempting to rename the file or folder. If the path is busy you cannot rename it, so the result is simply based on the succes of the renaming process.

If anyone got a better way of doing this, i'd be happy to learn about it.

Function pathIsBusy(thePath)
 Dim fso : set fso = CreateObject("Scripting.FileSystemObject")
 Dim tempPath
 Dim wasError
 Dim isAFolder
 Dim fPath : fPath = Trim(thePath)
 
 if fso.FolderExists(fPath) = True Then
  ' Remove last "\" if it exists
  if Right(fPath,1) = "\" Then fPath = Left(fPath,Len(fPath)-1) 
  isAFolder = True
 ElseIf fso.FileExists(fPath) = True Then
  isAFolder = false
 Else
  Exit Function
 End If
 
 ' Make temporary filepath
 tempPath = fPath & "_rnmtmp_" & int(Rnd*10) & int(Rnd*10) & int(Rnd*10) & int(Rnd*10)
 
 On Error Resume Next
  Err.Clear
  if isAFolder = True Then
   fso.MoveFolder fPath, tempPath  
  Else  
   fso.MoveFile fPath, tempPath
  End If
  
 if  Err.Number <> 0  then   
  wasError = True
 Else
  wasError = False
  if isAFolder = True Then
   fso.MoveFolder tempPath, fPath   
  Else
   fso.MoveFile tempPath, fPath
  End If
 End If
 
 fso = nothing
 pathIsBusy = wasError
End Function


'==EXAMPLE==
wscript.echo "c:\windows\ is busy: " & pathIsBusy("c:\windows\")
wscript.echo "c:\pagefile.sys is busy: " & pathIsBusy("c:\pagefile.sys")
wscript.echo "c:\windows\system.ini is busy: " & pathIsBusy("c:\windows\system.ini")


'

Thursday, December 22, 2011

VBScript : loadTextUnicode()

This function loads unicode text from textfiles. The vital part is the arguments we set when calling the fso.OpenTextFile function

EDIT: Just discovered a small bonus. If you set the fourth argument to "-2", you will be able to read both Unicode and ANSI files. When reading Microsoft's documentation it says that the value represents "System default".

I wonder..am i the only one that think MS's documentation on this seems incorrect?, look at the format values,..it says 2,1,0 it should it not have been -2,-1,0.?

Function loadTextUnicode(filePath)
 Dim fso, fto, resstr
 resstr = ""
 Set fso = CreateObject("Scripting.fileSystemObject")
 If fso.FileExists(filePath) Then
  if fso.GetFile(filePath).size > 0 Then 
   Set fto = fso.OpenTextFile(filePath, 1, 0, -2)
   resstr = fto.ReadAll
   fto.close()
  End If 
 Else
  wscript.echo(filePath + " did not exist")
 End If 
 set fso = nothing
 loadTextUnicode = resstr
End Function

'== EXAMPLE ==
myString = loadTextUnicode("myFile.txt")
wscript.echo myString

'

VBScript : writeTextUnicode()

This function writes string containing unicode to a file
Function writeTextUnicode(filePath,str)
 Dim fso : Set fso = CreateObject("Scripting.fileSystemObject")
 'fso.CreateTextFile( path | allowOverwrite | writeUnicode )
 Dim fileObj : Set fileObj = fso.CreateTextFile(filePath,-1,-1)
 fileObj.Write str
 fileObj.close()
 set fso = nothing
End Function


'== EXAMPLE ==

myFile = "c:\myUnicodeFile.txt"

myString = ""
myString = myString & "Arabic: " & ChrW(1730)&ChrW(1731)&ChrW(1732)&ChrW(1733)&ChrW(1734)
myString = myString & " - Cyrillic: " & ChrW(1035)&ChrW(1036)&ChrW(1037)&ChrW(1038)&ChrW(1040)
myString = myString & " - Latin Extended: " &ChrW(535)&ChrW(536)&ChrW(537)&ChrW(538)&ChrW(540) 

wscript.echo "myString: " & myString '-> Arabic: ۂۃۄۅۆ - Cyrillic: ЋЌЍЎА - Latin Extended: ȗȘșȚȜ

call writeTextUnicode(myFile,myString)

'

VBScript : removeExtraSpaces()

This function uses VBScript RegExp to find and remove unwanted/superflous spaces in a string.
Function removeExtraSpaces(str)
 Dim res
 Dim re : set re = New RegExp
 re.Global = True
 re.Pattern = "\s+"
 removeExtraSpaces = re.Replace(str," ")
End Function

'== EXAMPLE ==
myString = " A   lot of   space"
wscript.echo removeExtraSpaces(myString) '-> A lot of space

'

VBScript : unQuoteString()

This small function removes the quotes from a quoted string (or any two identical characters that "wraps" a string)
Function unQuoteString(str, quot)
 Dim res : res = Trim(str)
 if Left(res,1) & Right(res,1) = quot & quot Then res = MID(res,2, LEN(res)-2)
 unQuoteString = res
End Function

'== EXAMPLE ==
myString = """" & "Hello World!" & """"
wscript.echo "Before: " & myString '-> Before: "Hello World"
wscript.echo "After: " & unQuoteString(myString,"""") '-> After: Hello World

'