LOOP - COMSUMINDO MUITO CPU E MEMORIA

USUARIO.EXCLUIDOS 12/07/2005 10:04:00
#93578
Srs, venho pedir-lhes uma preciosa ajuda. Escrevi um código em VB que têm a simples função de verificar em um determinado dir se existe arq com a ext. .QAN ( que são gerados pelo um ap. de Raio-X). A princípio o cód está funcionando, porém como têm que ficar em Loop constante, pois pode acontecer do Raio-X emitir várias análise no mesmo minuto e o software do Raio-X nesta situação sobrescreve as anteriores. Antes este cód era roda em Clipper e não ocasionava isto ( consumo de muita CPU e memória ), mas não consegui rodá-lo com sucesso em VB. Tentei em Access (VBA) e também acontece o mesmo problema. Se alguém tiver uma sugestão ou mesmo algo parecido que possa me ajudar, fico muito grato. Segue abaixo o cód em VB.

Dim arquivo As File
Dim subdiretorio As Folder
Dim TipoArquivo As String
Dim nArq As String
Dim cMes As String
Dim cDia As String
Dim cPath As String
Dim nSeq As Integer
Dim nDiaIni As String
Dim nMesIni As String
Dim nDiaMes As String
Dim cMesDia As String
Dim cNewFile As String
Private Sub Command1_Click()
'Código desenvolvido por Jaime Dias
'Data: 11/07/05
'Objetivo: Renomear arquivos gerados pelo X40 e movê-los para uma determinada pasta.

Dim fso As New FileSystemObject
Set fso = CreateObject("Scripting.FileSystemObject")

cMes = Month(Date)
cDia = Day(Date)

If CByte(Month(Date)) <= 9 Then
cMes = "0" & cMes
End If

If CByte(Day(Date)) <= 9 Then
cDia = "0" & cDia
End If

nDiaIni = CByte(cDia)
nMesIni = CByte(cMes)
'nSegini = Second()
cMesDia = cMes & cDia
nSeq = 1

'Definir o próx nSeq para o Mes/dia correntes
cPath = "C:\D\X40\Exportado\"
TipoArquivo = "Documento de texto"
Call procuraArquivos1(fso.GetFolder(cPath))

cPath = "C:\D\X40\"
TipoArquivo = "Documento de texto"
Call procuraArquivos2(fso.GetFolder(cPath))

cPath = "C:\D\"
nLoop = True
Do While nLoop = True
cMes = Month(Date)
cDia = Day(Date)
If CByte(Month(Date)) <= 9 Then
cMes = "0" & cMes
End If

If CByte(Day(Date)) <= 9 Then
cDia = "0" & cDia
End If
If cMes & cDia <> cMesDia Then
If nMesIni <> CByte(cMes) Then
nDiaIni = nDiaIni - 30
nMesIni = CByte(cMes)
End If
nSeq = 1
cMesDia = cMes & cDia
End If
TipoArquivo = "Arquivo QAN"
Call procuraArquivos3(fso.GetFolder(cPath))
Loop


End Sub
Private Sub procuraArquivos1(diretorio As Folder)

For Each arquivo In diretorio.Files
If arquivo.Type = TipoArquivo Then
nArq = arquivo.Name
If Left(nArq, 4) = cMesDia And CInt(Mid(nArq, 5, 4)) <= nSeq Then
nSeq = CInt((Mid(nArq, 5, 4)) + 1)
End If
End If
Next

End Sub

Private Sub procuraArquivos2(diretorio As Folder)

For Each arquivo In diretorio.Files
If arquivo.Type = TipoArquivo Then
nArq = arquivo.Name
If Left(nArq, 4) = cMesDia And CInt(Mid(nArq, 5, 4)) <= nSeq Then
nSeq = CInt((Mid(nArq, 5, 4)) + 1)
End If
End If
Next

End Sub
Private Sub procuraArquivos3(diretorio As Folder)

For Each arquivo In diretorio.Files

If arquivo.Type = TipoArquivo Then
nArq = arquivo.Name
cNewFile = cMes & cDia + Right("0000" & CStr(nSeq), 4) & ".TXT"
nSeq = nSeq + 1
Name cPath & Right(nArq, 12) As cPath & "X40\" & cNewFile
End If
Next

End Sub
USUARIO.EXCLUIDOS 13/07/2005 20:24:06
#94016
Um programa como o seu num loop infinito sempre irá consumir CPU... Insira um DoEvents seguido de um Sleep em cada iteração do loop.
Public Declare Sub Sleep Lib "kernel32" Alias "Sleep" (ByVal dwMilliseconds As Long)

   Do While True
        ........
        DoEvents 
        Sleep 5000   ' Aguarda por 5 segundos.
    Loop


1) Tente não usar o Scripting.FileSystemObject pois você esta varrendo todos os arquivos sem necesidade, aproveite os 4 primeiros bytes que formam o nome do arquivo e que são de seu conhecimento e use função Dir.
2) Obtenha o mes e dia numa única vez com a função Format.

Exemplo:

Dim MesDia  As String
Dim NumSequencia as Integer

   MesDia = Format(Date, "mmdd")
   NumSequencia =  Proximo("C:    emp", MesDia & "????.txt")


Private Function Proximo(Diretorio As String, Coringa As String) As Integer
   Dim Arquivo As String
   Dim NumMaximo As Integer

   Arquivo = Dir(Diretorio & "\" & Coringa, vbNormal Or vbHidden)
   Do While Arquivo <> ""
      If NumMaximo <= CInt(Mid(Arquivo, 5, 4)) Then _
         NumMaximo = CInt(Mid(Arquivo, 5, 4))

      Arquivo = Dir   ' Obtem próximo arquivo
   Loop

   Proximo = NumMaximo + 1
End Function
Tópico encerrado , respostas não são mais permitidas
Voltar