Clear VB6 Memroy

[Shane4DaBears]

Hello,
I am working on a VB application that looks for a file in a network DIR. When it finds the file, it moves it to a backup DIR and then parses the file and does some transactional work. Then it will go back and look in the DIR for another file. It works great except for then the date changes. So every might at midnight it errors looking for the file in the Timer Interval loop. I believe if I could clear the memory of the application and direct it to the startup module it would be fine.
Any help would be appreciated!
Thanks

 

[HughLerwill]

Shane,

Why not just stop looping (stop and restart the timer too) for a few seconds/ minutes before/ after midnight.

regards Hugh,

 

[Shane4DaBears]

The problem really isnt in the timer. That is just the first sub that it is on when it fails. It is strange because the application will fail on anything. It acts like it is completely lost. It completely fails on every aspect. The application runs as a service and right now I stop and start the service after midnight every day. So it is bandaided but I need to find a permanent solution. In the error handler, If I try to take it to the startup module it gets reference errors. That is why I was wanting to clear the memory and point it towards the startup module and it will run non-stop. Another reason that I do not want to stop and start before midnight is because it will still fail after midnight. It is on the change of date. If I point it to the date time sub, it will still fail. They run all day and night long so it can be processing during this time. Thanks for the post and any more info would help. Looking for something like flush function or clear function.

 

[koala15]

Hmmmm....

Sounds strange.

Can you advise what the error is?

Even though it may error in different locations, is there any common theme?

I just did a little research and there seems to be some techy chatter about the time control and possible midnight problems.

From another forum the following was posted:

You can use the windows API to pause your program. The command you want is called 'sleep' and you put it in general declarations of your form code:

Declare Sub Sleep Lib "kernel32" Alias "Sleep" (ByVal dwMilliseconds as Long)


Then, to use it, pass the command the number of milliseconds to delay the program for, so for five seconds:

Sleep 5000

Would achieve this. It is also a good idea to set the form's autoredraw property to true, because the sleep command can stop the window from redrawing whilst pausing otherwise.

Helpful????

"Life is full of learning, and then there is wisdom"

 

[strongm]

Do you still get the problems if you run the application normally, rather than as a service? I ask because, whilst you can use VB programs as services you have to be very careful because there are a number of limitations and gotchas, any one of which might be the cause of your problem(s).

 

[Shane4DaBears]

Yes, I fI run this program in debug mode I will still get the errors. These are some of the errors that I get. The error 0 is what I get when I try and just log the message. With different error handlers, I have received the other messages. Hope this can shed some light.
12:00:38 Error# 0 Source: Desc:
12:00:53 Error# 457 Source: LmbrGrdr Desc: This key is already associated with an element of this collection
12:00:58 A Error has occured while loading the ini file.
12:01:06 Error# 1023 Source: MainModule.Main Desc: Fail to load the Ini File
12:01:40 Error# 0 Source: Desc:
00:00:26 Error# 0 Source: Desc:
16:44:35 Error# 424 Source: LmbrGrdr Desc: Object required

 

[strongm]

I think we're going to need to see some of your code, frankly

 

[Shane4DaBears]

So, I am assuming there is no Flush memory function in vb6.
Here is the code of the timer interval.
If you need more I can supply it but this project is very large

Dim newFile As String
newFile = Dir(FileWorker.GetIncomingDir, vbDirectory)

Do While newFile <> "" ' Start the loop.
If newFile <> "." And newFile <> ".." Then
If UCase(newFile) = PACKS_FILE_NAME Then
If FileWorker.ProcessFile(newFile) Then
logger.WriteString "File: " & FileWorker.NewFileName & " has been processed successfully", logger.PROD_LOGGING
Else
logger.WriteString newFile & " has not complete successfully: ", logger.PROD_LOGGING
End If
Else
FileWorker.ArchiveFile (newFile)
End If
End If
newFile = Dir ' Get next entry.
Loop

 

[koala15]

Shane4DaBears,

Looking at your 2nd last post, it seems to error at random times (eg 16:44). That leads to the question "If you start the service/app at say 12:01am has it ever errored within the next 23 hours and 59 minutes?"

If it has not, then can you post the code directly associated with your timer/sleep activation.

If it has, then the problem may have nothing to do with the passing of midnight.

&quot;Life is full of learning, and then there is wisdom&quot;

 

[strongm]

ANother question: what is the interval on your Timer?

 

[Shane4DaBears]

Koala, To answer your question....no it does not die for another 23:59.59. The timer is set to a 1 second interval.
Are you suggesting that I put a sleep function in the application when it hits 11:59.55 or something close and then let it sleep for 10 seconds and then start back up and process.
I will try this but I am not sure this will work. sometimes it is in the timer and other times it is processing a file. In my forth post is the timer interval code.
Here is the sleep code that I am using in other areas of the project. I can set the sleep interval from an ini file setting.
Sleep (Val(IniSettings.GetIniValue("WriteInterval")) * 1000)

 

[koala15]

No, I am not suggesting using the "sleep" function to somehow transverse the midnight barrier.

I have this feeling that there is a more fundamental problem.

Despite what you said about the app being large, I think StrongM is on the money when he asked for the code, but I would like to see the majority of the code.

&quot;Life is full of learning, and then there is wisdom&quot;

 

[strongm]

>The timer is set to a 1 second interval

Might I suggest then that you investigate reentrancy issues...

 

[chiph]

strongm has a point. If your tasks take longer than 1 second to run, the timer will fire again before it's done.

Chip H.


____________________________________________________________________
If you want to get the best response to a question, please read FAQ222-2244 first

 

[koala15]

I would have assumed (that word will bite you every time) that the logic flow would be (since this is a service):

Sub Main()

(Do Startup Work)
(Do File Work)
Timer1.Enabled = True

End Sub

Sub Timer1_Timer()

Timer1.Enabled = False
(Do File Work)
Timer1.Enabled = True

End Sub

&quot;Life is full of learning, and then there is wisdom&quot;

 

[Shane4DaBears]

Here is how it goes...It opens the form Service at startup:
Private Sub Form_Load()
'Set the parameters for the sys tray icon
With nid
.cbSize = Len(nid)
.hWnd = Me.hWnd
.uId = vbNull
.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
.uCallBackMessage = WM_MOUSEMOVE
.hIcon = Me.Icon
.szTip = "LmbrGrdr Service Running" & vbNullChar
End With
Shell_NotifyIcon NIM_ADD, nid
MainModule.Main
End Sub

Private Sub NTService1_Continue(Success As Boolean)
logger.WriteString "LmbrGrdr has resumed...", logger.PROD_LOGGING
timApplication.Interval = Val(IniSettings.GetIniValue("PollInterval")) * 1000
Success = True
End Sub

Private Sub NTService1_Pause(Success As Boolean)
logger.WriteString "LmbrGrdr has been paused...", logger.PROD_LOGGING
timApplication.Interval = 0
Success = True
End Sub

Private Sub NTService1_Start(Success As Boolean)
logger.WriteString "Starting the LmbrGrdr Service", logger.DEBUG_LOGGING
timApplication.Interval = Val(IniSettings.GetIniValue("PollInterval")) * 1000
'*** tell the servicemanager which control commands we accept
NTService1.ControlsAccepted = svcCtrlPauseContinue
NTService1.StartService




Success = True
End Sub

Private Sub NTService1_Stop()
logger.WriteString "Stopping the LmbrGrdr Service", logger.DEBUG_LOGGING
Shell_NotifyIcon NIM_DELETE, nid
'*** cleanup time
timApplication.Interval = 0
If MainModule.IsRunning Then
MainModule.Shutdown
End If

End Sub

Private Sub timApplication_Timer()
'On Error GoTo ErrorHandler:
Dim newFile As String
newFile = ""
newFile = Dir(FileWorker.GetIncomingDir, vbDirectory)

Do While newFile <> "" ' Start the loop.
If newFile <> "." And newFile <> ".." Then
If UCase(newFile) = PACKS_FILE_NAME Then
If FileWorker.ProcessFile(newFile) Then
logger.WriteString "File: " & FileWorker.NewFileName & " has been processed successfully", logger.PROD_LOGGING
'Next two lines of code were added to resolve the issue of the the
'application failing after midnight. RDS 12-01-04
newFile = ""
newFile = Dir(FileWorker.GetIncomingDir, vbDirectory)
Else
logger.WriteString newFile & " has not complete successfully: ", logger.PROD_LOGGING
'Next two lines of code were added to resolve the issue of the the
'application failing after midnight. RDS 12-01-04
newFile = ""
newFile = Dir(FileWorker.GetIncomingDir, vbDirectory)
End If
Else
FileWorker.ArchiveFile (newFile)
End If
End If
newFile = Dir ' Get next entry.
Loop


'ErrorHandler:
' logger.WriteError logger.PROD_LOGGING
' Unload frmService
' 'frmService = Nothing
' MainModule.Shutdown
' Load frmService
'Cannot code error handlers in an application that will run as a service.
End Sub

 

[Shane4DaBears]

It then calls the main module. From here it does a number of things:
Sub Main()

On Error GoTo ErrorHandler

'Load the Ini File Settings
If Not IniSettings.LoadIni(IniSettings.GetIniFileName) Then
logger.WriteString IniSettings.GetErrorMsg, logger.PROD_LOGGING
Err.Raise 1023, "MainModule.Main", "Fail to load the Ini File"
End If
'Start up the Logger
If Not logger.Init(IniSettings.GetIniValue("DaysToLog"), IniSettings.GetIniValue("LogLevel")) Then
Err.Raise 1010, "MainModule.Main", " Logger Initialization failed due to: " & logger.GetErrorMessage
Else
logger.WriteString "Logger has been sucessfully started.", logger.DEBUG_LOGGING
End If

'initialize the file processor
FileWorker.Init
'connect to the databases
If Not DCLinkDBWorker.Init(IniSettings.GetIniValue("DCLinkConnectString")) Then
Err.Raise 1030, "MainModule.Main", " Database object failed to initialize due to:" & DCLinkDBWorker.GetErrMsg
Else
logger.WriteString "Database connection To dcLINK had been established.", logger.DEBUG_LOGGING
End If

If IniSettings.GetIniValue("TurnErrorDatabaseOn") = "1" Then
If Not ErrorDBWorker.Init(IniSettings.GetIniValue("ErrorDBConnectString")) Then
Err.Raise 1030, "MainModule.Main", " Database object failed to initialize due to:" & ErrorDBWorker.GetErrMsg
Else
logger.WriteString "Database connection to Error DB had been established.", logger.DEBUG_LOGGING
End If
logger.WriteString "Lumber Grader system has been started.", logger.PROD_LOGGING
End If

'Start the Service
'frmService.timApplication.Interval = Val(IniSettings.GetIniValue("PollInterval")) * 1000
frmService.NTService1.StartService

IsRunning = True
Exit Sub

 

[Shane4DaBears]

After starting the service it loops through the timer and looks for a file in the Incoming DIR that is specified in the ini file. When one appears it processes the file:
Public Function Init() As Boolean

LocalDir = IniSettings.GetIniValue("ArchiveFileDir") 'App.Path & "\ArchivedFiles\"
If Right(LocalDir, 1) <> "\" Then
LocalDir = LocalDir & "\"
End If
' If Dir(LocalDir, vbDirectory) = "" Then
' MkDir LocalDir
' End If
FPath = IniSettings.GetIniValue("IncomingFileDir")
If Right(FPath, 1) <> "\" Then
FPath = FPath & "\"
End If
End Function
Public Sub ArchiveFile(Name As String)
On Error GoTo ErrorHandler:
Dim fso As New FileSystemObject
Dim temp As String
temp = Name & "." & Format(Date, "mmddyy") & "_" & Format(Time, "hhnnss")
logger.WriteString "Archiving File from: " & FPath & Name & " to: " & LocalDir & temp, logger.DEBUG_LOGGING
fso.MoveFile FPath & Name, LocalDir & temp & "\" '& Name.ShortName 'added &"\" to the end to try and prevent Error 53 - rds 11-4-04
'Next File 'code that was suggested to correct Error 53
Set fso = Nothing
Exit Sub
ErrorHandler:
'added select case for errors 53 and 76; rds 11-12-04
Select Case Err.Number
Case 53
logger.WriteError logger.PROD_LOGGING
Resume Next
Case 76
logger.WriteError logger.PROD_LOGGING
Resume Next
Case Else
logger.WriteError logger.PROD_LOGGING
Err.Raise 1082, "FileProcessor.ArchiveFile", "MoveFile failed."
Set fso = Nothing
End Select

End Sub
Public Function ProcessFile(FileName As String) As Boolean
On Error GoTo ErrorHandler
ResetObject
FName = FileName
UFName = "Packs" & Format(Date, "mm-dd-yy") & Format(Time, "-hh_nn") & ".dat"
Status = True
logger.WriteString "Processing File: " & FileName & " as " & UFName, logger.DEBUG_LOGGING
PurgeLocalDir
MoveFile
ParseFile
ProcessFile = True
Status = False
Exit Function
ErrorHandler:
logger.LogFatalError Err.Source, Err.Description
logger.WriteError logger.PROD_LOGGING
ProcessFile = False
Status = False
End Function
Private Sub ParseFile()
On Error GoTo ErrorHandler
logger.WriteString "Parsing file: " & FPath & FName, logger.DEBUG_LOGGING
Dim temp As String
fHandle = FreeFile()

Open LocalDir & UFName For Input As #fHandle
While Not EOF(fHandle)
Line Input #fHandle, temp

If Left(temp, 1) = "H" Then
If BatchData.TotalNumberOfRecords > 0 Then
WriteDCLinkTrans
End If
BatchData.ResetGradeData
HeaderData = Split(temp, ",")



Else
While Left(temp, 1) <> "R"
DetailData = Split(temp, ",")
If Not BatchData.AddRecord(DetailData(DGRADE), DetailData(DLENGTH), DetailData(DWIDTH), DetailData(DBOARDFEET), DetailData(DPIECES)) Then
Err.Raise 1104, "FileProcessor.ParseFile", "A failure occured while addding a detail record"
End If
Line Input #fHandle, temp
If Left(temp, 1) = "R" Then
DetailData = Split(temp, ",")
LPRNumber = DetailData(LPR)
If PrevLPRNumber = "" Then
PrevLPRNumber = LPRNumber
PrevSpecies = HeaderData(HSPECIES)
PrevThick = HeaderData(HTHICKNESS)
PrevCondition = HeaderData(HCONDITION)
PrevLayers = HeaderData(HLAYERS)
End If

If PrevLPRNumber <> LPRNumber And cacheLPRNumber <> LPRNumber Then
If REJFlag = False Then
Call CloseLPR
cacheLPRNumber = LPRNumber
PrevSpecies = HeaderData(HSPECIES)
PrevThick = HeaderData(HTHICKNESS)
PrevCondition = HeaderData(HCONDITION)
PrevLayers = HeaderData(HLAYERS)
End If
REJFlag = False
End If
End If
Wend
End If
PrevLPRNumber = LPRNumber
Wend
WriteDCLinkTrans
'WriteRejTrans

Close
BatchData.ResetGradeData
BatchData.TotalRejectAmount = 0
Exit Sub
ErrorHandler:
logger.LogFatalError Err.Source, Err.Description
Err.Raise 1082, "FileProcessor.ParseFile", "ParseFile failed."


End Sub
Private Sub MoveFile()
On Error GoTo ErrorHandler:
Dim fso As New FileSystemObject


logger.WriteString "Moving File from: " & FPath & FName & " to: " & LocalDir & UFName, logger.DEBUG_LOGGING
fso.MoveFile FPath & FName, LocalDir & UFName '& "\" '& FPath.ShortName 'added &"\" to the end to try and prevent Error 53 - rds 11-4-04
'Next File 'code that was suggested to correct Error 53
Set fso = Nothing
Exit Sub
ErrorHandler:
logger.WriteError logger.PROD_LOGGING
Err.Raise 1082, "FileProcessor.MoveFile", "MoveFile failed."
Set fso = Nothing
Resume 'added for error
End Sub

Private Sub PurgeLocalDir()
On Error GoTo ErrorHandler:
logger.WriteString "Purging Directiory: " & LocalDir, logger.DEBUG_LOGGING
Dim oFileSystem As New FileSystemObject
Dim sTemp As String
Dim FileCreateDate As Date
Dim oFolder As Folder
Dim oCurrentFile As File
Dim oFileColl As Files
Set oFolder = oFileSystem.GetFolder(LocalDir)
Set oFileColl = oFolder.Files
If oFileColl.Count > 0 Then
For Each oCurrentFile In oFileColl

FileCreateDate = oCurrentFile.DateCreated
If FileCreateDate < GetStartDate Then
logger.WriteString "Purging File: " & LocalDir & oCurrentFile.Name, logger.DEBUG_LOGGING
Kill LocalDir & oCurrentFile.Name
End If
Next
End If

CloseObjects:
Set oFileSystem = Nothing
Set oFolder = Nothing
Set oFileColl = Nothing
Set oCurrentFile = Nothing
Exit Sub
ErrorHandler:
logger.WriteError logger.PROD_LOGGING
Err.Raise 1116, "FileProcessor.PurgeLocalDir", "PurgeLocalDir failed."
Resume CloseObjects

End Sub
Private Sub ResetObject()
logger.WriteString "Resetting object after processing file: " & UFName, logger.DEBUG_LOGGING
FName = ""
UFName = ""

End Sub

Private Function GetStartDate() As Date
Dim tmp As Integer
tmp = Val(IniSettings.GetIniValue("DaysToArchieve"))
GetStartDate = DateAdd("d", -tmp, Now)

End Function
Private Function ComputerName() As String
Dim dwLen As Long
Dim strString As String

dwLen = MAX_COMPUTERNAME_LENGTH + 1
strString = String(dwLen, "X")
GetComputerName strString, dwLen
strString = Left(strString, dwLen)
ComputerName = strString
End Function
Public Function Sleeper(in_Val As Integer)
Dim icount As Integer
Do While icount < in_Val
DoEvents
icount = icount + 1
Sleep (1)
Loop
End Function





There is also some code in the app that writes a async record to our ERP system but that is very lengthy and not pertanent.

 

[Shane4DaBears]

During the file processor, it writes to our erp system and then comes back to the timer. Everything works fine except for midnight of every night
Hope the code can help in getting this problem resovled.
What you said about the timer and every one second. It will go through the interval loop and then wait 1 second before going through the loop again.

 

[mattKnight]

Are you re-reading the INI file at midnight. If you are, are you sure that you are clearing the old values held in inisettings?

Perhaps posting the code for that class may be helpful

Take Care

Matt
If at first you don't succeed, skydiving is not for you.