Coding a Custom Object with WSC - Adding code for the object methods
(Page 2 of 5 )
Continuing on, I wrote the functions that correspond to the exposed methods.
Sub Open(strFile)
FullName = strFile
End Sub
Sub Create(strFile)
If objFso.FileExists(strFile) Then objFso.DeleteFile(strFile)
FullName = strFile
NewCompressedFolder2 FullName
End Sub
Sub Add(strFile, blnKeepOriginal)
AddFile FullName, strFile, blnKeepOriginal
End Sub
Sub AddMultiple(varSource, blnKeepOriginal)
AddFiles FullName, varSource, blnKeepOriginal
End Sub
Sub Extract(strFolder)
ExtractAll FullName, strFolder
End Sub
Essentially, these are the public functions that are exposed by my object. Rather than placing all of the relevant code inside of these functions, I prefer to pass it to other internal functions. I do this because (as you’ll see) my functions require several parameters. Most of these are predetermined by the various properties, so creating these intermediate functions allows me to expose functions with a much simpler syntax to my users.
Sub NewCompressedFolder(strPath)
With CreateObject("ADODB.Stream")
.Open
.Type = adTypeText
.WriteText ChrB(&h50) & ChrB(&h4B) & ChrB(&h5) & ChrB(&h6)
For i = 1 To 18
.WriteText ChrB(&h0)
Next
.SaveToFile strPath, adSaveCreateNotExist
.Close
.Open
.Type = adTypeBinary
.LoadFromFile strPath
.Position = 2
arrBytes = .Read
.Position = 0
.SetEOS
.Write arrBytes
.SaveToFile strPath, adSaveCreateOverwrite
.Close
End With
End Sub
Function AddFile(strFolder, strFile, blnKeepOriginal)
Set objFolder = objShell.NameSpace(strFolder)
intCount = objFolder.Items.Count
Select Case CBool(blnKeepOriginal)
Case True
objFolder.CopyHere strFile, 1548
Case False
objFolder.MoveHere strFile, 1548
End Select
Do Until objFolder.Items.Count = intCount + 1
Sleep 200
If Not ShellBusy Then Exit Do
Loop
End Function
Function AddFiles(strFolder, varSource, blnKeepOriginal)
If IsArray(varSource) Then
For Each strPath In varSource
AddFile strFolder, strPath, blnKeepOriginal
Next
Else
Set colItems = objShell.NameSpace(strSource).Items
intCount = .Items.Count
Select Case CBool(blnKeepOriginal)
Case True
objShell.NameSpace(strFolder).CopyHere colItems, 1548
Case False
objShell.NameSpace(strFolder).MoveHere colItems, 1548
End Select
Do Until objShell.NameSpace(strFolder).Items.Count = intCount + colItems.Count
Sleep 200
If Not ShellBusy Then Exit Do
Loop
End If
End Function
Function ExtractAll(strZipFile, strFolder)
If Not objFso.FolderExists(strFolder) Then objFso.CreateFolder(strFolder)
intCount = objShell.NameSpace(strFolder).Items.Count
Set colItems = objShell.NameSpace(strZipFile).Items
objShell.NameSpace(strFolder).CopyHere colItems, 1548
Do Until objShell.NameSpace(strFolder).Items.Count = intCount + colItems.Count
Sleep 200
If Not ShellBusy Then Exit Do
Loop
End Function
Function GetItemCount(strZipFile)
GetItemCount = objShell.NameSpace(strZipFile).Items.Count
End Function
Function ShellBusy()
intStartSize = objFso.GetFile(FullName).Size
Sleep 200
ShellBusy = objFso.GetFile(FullName).Size > intStartSize
End Function
Sub Sleep(intDuration)
dblSeconds = intDuration / 1000
If dblSeconds < 1 Then dblSeconds = 1
dteStart = Now()
dteEnd = DateAdd("s", dblSeconds, dteStart)
While dteEnd > Now()
DoNothing
Wend
End Sub
Sub DoNothing
'While/Wend has quirks when it is empty
End Sub
This is the remaining code for my ZipFolder object. If you look closely you’ll notice that I’m using the FileSystemObject (objFso) and the Shell Automation Object (objShell) quite frequently throughout my code, but that I haven’t instantiated them anywhere. No, this isn’t a mistake.
Since these objects are being used globally, I could have easily instantiated them when I created my global variables earlier. That works perfectly fine. However, since WSCs provide some more advanced options, I wanted a chance to demonstrate them to you.
Let’s take a look at some ways you can improve the functionality of your component by adding to the XML file.
Next: Adding objects and resources >>
More Code Examples Articles
More By Nilpo