CPU Usage Pegged at 100%

[deanman]

I am new to VB programming and have written a program for file manipulation. Copy files, Rename files, that sort of thing. It uses a control file for direction on the manipulation and it has compiled fine, installed fine and run fine on a Win98SE machine.

It installs fine on Win2000, the first sub runs and then the system usage pegs at 100%. What could the difference be?

It does use a lot of FSO's for the finding an manipulation of the files. Is this where I went wrong? Is there a better way?

 

[dilettante]

Really hard to tell without more detail. You must be looping somewhere though. Hard to understand where Win2K would make things go awry.

One seldom uses more than one FSO, but maybe you were referring to using multiple FSO objects (such as files or textstreams)? The FSO is more of an "object dispenser" than anything else.

 

[cdidion]

Got some of the code you could show us? That might help, too. -Chris Didion
Matrix Automation, MCP

 

[deanman]

Here is some of the code. (I apologize for it's inefficiencies) It runs the CopyFile sub fine but is pegging right after that. I ran Dependency Walker and there were errors on IsTNT but I can find no details about it. I have also tried some DoEvents but have had no success.



Private Sub go_Click()
Screen.MousePointer = vbHourglass
Dim CopyFromDir
'Add a trailing slash if none
If Right(FTPPath, 1) <> &quot;\&quot; Then
FTPPath = FTPPath & &quot;\&quot;
End If

'Add a trailing slash if none
If Right(NewFilePath, 1) <> &quot;\&quot; Then
NewFilePath = NewFilePath & &quot;\&quot;
End If

'Add a trailing slash if none
If Right(TimeFilePath, 1) <> &quot;\&quot; Then
TimeFilePath = TimeFilePath & &quot;\&quot;
End If

CopyFromDir = FTPPath
CopyFile (CopyFromDir)

Set fs = CreateObject(&quot;Scripting.FileSystemObject&quot
Set fd = fs.GetFolder(NewFilePath)
Set f = fd.Files
For Each f1 In f
WorkFile = f1
cmdReadFile_Click
'Kill WorkFile
Next
'Set fs = Nothing
'Set fd = Nothing
ZipDir (MailBoxPath)

Screen.MousePointer = vbDefault
End Sub

Sub CopyFile(folderspec)
Dim MyStamp
Dim fso, txtfile, fil1, fil2, f, f1, fc, fs, s
Dim CopyTo, TimeFile
CopyTo = NewFilePath
TimeFile = TimeFilePath
Set fso = CreateObject(&quot;Scripting.FileSystemObject&quot
Set fs = CreateObject(&quot;Scripting.FileSystemObject&quot
Set f = fs.GetFolder(folderspec)
Set fc = f.Files
For Each f1 In fc
If UseLog Then Open App.EXEName & &quot;.log&quot; For Append As #10
If FileDateTime(f1) > FileDateTime(TimeFile & &quot;timefile.txt&quot Then
f1.Copy CopyTo
End If
If UseLog Then Print #10, Date & &quot; &quot; & Time & &quot; &quot; & &quot;New file: &quot; & f1 & &quot; copied to &quot; & CopyTo
Close #10
Next
For Each f1 In fc
If FileDateTime(f1) > FileDateTime(TimeFile & &quot;timefile.txt&quot Then
f1.Copy (TimeFile & &quot;timefile.txt&quot
End If
Next
'Set fso = Nothing
'Set fs = Nothing
'Set f = Nothing
'Set fc = Nothing

End Sub

Sub cmdReadFile_Click()
Set fs = CreateObject(&quot;Scripting.FileSystemObject&quot
Set f = fs.GetFile(&quot;c:\spool\time\control.txt&quot

fileNum = FreeFile

Open f For Input As #2
I = 0
Do While Not EOF(2)
Input #2, cntSP, cntSF, cntCF, cntDP, cntDP2, cntDP3, cntDF, cntCMP, cntFD, cntRT
filName = NewFilePath & cntSF

If f1 Like filName And cntCF = 0 And cntRT = 0 Then 'DataBakup and No remove tails


If cntDP <> &quot;&quot; Then
If Right(cntDP, 1) <> &quot;\&quot; Then
cntDP = cntDP & &quot;\&quot;
End If
CreatePath (cntDP)
File1 = cntDP & cntDF
f1.Copy (File1)
End If
If cntDP2 <> &quot;&quot; Then
If Right(cntDP2, 1) <> &quot;\&quot; Then
cntDP2 = cntDP2 & &quot;\&quot;
End If
CreatePath (cntDP2)
File2 = cntDP2 & cntDF
f1.Copy (File2)
End If
If cntDP3 <> &quot;&quot; Then
If Right(cntDP3, 1) <> &quot;\&quot; Then
cntDP3 = cntDP3 & &quot;\&quot;
End If
CreatePath (cntDP3)
File3 = cntDP3 & cntDF
f1.Copy (File3)
End If
GoTo isdone


ElseIf f1 Like filName And cntCF = 0 And cntRT = 1 Then 'DataBakup and remove tails
If cntDP <> &quot;&quot; Then
If Right(cntDP, 1) <> &quot;\&quot; Then
cntDP = cntDP & &quot;\&quot;
End If
CreatePath (cntDP)
End If
File1 = cntDP & cntDF
File2 = cntDP2 & cntDF
File3 = cntDP3 & cntDF

RemoveTail (f1 & &quot; &quot; & File1)
GoTo isdone

ElseIf f1 Like filName And cntCF = 1 And cntRT = 0 Then 'lasrview and No remove tails

Dim MyString, BucketSet, DateSet
MyString = f1 ' Create text string.
BucketSet = Mid(MyString, 23, 3) ' Returns bucket #.
DateSet = Mid(MyString, 17, 5) ' Returns Date.
NewSet = cntDF & BucketSet & &quot;.&quot; & DateSet


If cntDP <> &quot;&quot; Then
If Right(cntDP, 1) <> &quot;\&quot; Then
cntDP = cntDP & &quot;\&quot;
End If
CreatePath (cntDP)
File1 = cntDP & NewSet
f1.Copy (File1)
End If
If cntDP2 <> &quot;&quot; Then
If Right(cntDP2, 1) <> &quot;\&quot; Then
cntDP2 = cntDP2 & &quot;\&quot;
End If
CreatePath (cntDP2)
File2 = cntDP2 & NewSet
f1.Copy (File2)
End If
If cntDP3 <> &quot;&quot; Then
If Right(cntDP3, 1) <> &quot;\&quot; Then
cntDP3 = cntDP3 & &quot;\&quot;
End If
CreatePath (cntDP3)
File3 = cntDP3 & NewSet
f1.Copy (File3)
End If
GoTo isdone

ElseIf f1 Like filName And cntCF = 1 And cntRT = 1 Then

MyString = f1 ' Create text string.
BucketSet = Mid(MyString, 23, 3) ' Returns bucket #.
DateSet = Mid(MyString, 17, 5) ' Returns Date.
NewSet = cntDF & BucketSet & &quot;.&quot; & DateSet
If cntDP <> &quot;&quot; Then
If Right(cntDP, 1) <> &quot;\&quot; Then
cntDP = cntDP & &quot;\&quot;
End If
CreatePath (cntDP)
End If

File1 = cntDP & NewSet
File2 = cntDP2 & cntDF
File3 = cntDP3 & cntDF

RemoveTail (f1 & &quot; &quot; & File1)

GoTo isdone
End If
Loop
Close 2
Exit Sub
isdone:
Kill WorkFile
Close 2

Set fs = Nothing
Set f = Nothing

End Sub

 

[deanman]

I have found the problem. It was actually with NTFS. I was conmparing files to control file using the full path and the directory was created on the Win2K machine &quot;spool&quot;. I was using &quot;Spool&quot; and it did not like that. I changed the directory to &quot;Spool&quot; and all is well.

Thank you.