rsp zip - intercetta processo [vb6]

[giano118]

ciao ragazzi sto realizzando una applicazione che legge continuamente in una cartella, appena trova un file .zip lo esplode in una nuova cartella, e cancella in file compresso.
fin qui tutto bene, non ho problemi, funziona tutto a meraviglia, almeno finchè lo faccio girare in debug.
quando lancio l'applicazione, invece, succede che per qualche strano motivo (e credo di aver capito perchè), succede che decomprime soltanto il primo file, non decomprimendo i successivi ma continuando a cancellare gli altri.
ora pensavo di intercettare il processo di decompressione file in modo da andare avanti con l'esecuzione del codice soltanto se il processo è stato ammazzato (e quindi avere la certezza sulla avvenuta decompressione del file.
attualmente, ho fatto un ciclo di do e inserito 2 timer per la gestione della cosa, funziona, ma ho notato che il tutto dipende dalla velocità della machcina nell'elaborare la decompressione, per qui, anche avendo dato del tempo utile per finite il lavoro prima di cancellare il file, credo di aver soltanto aggirato il problema e di non averlo risolto.
per chi di voi conosce rsp zip, ho notato questaa cosa:

pippo= GetTickCount

sbaglio o proprio così intercetto il processo aperto?
e se fosse così come posso accertarmi che questo sia stato ammazzato?
spero di essere stato chiaro.
per delucidazioni, posso postare del codice...

ciao a tutti e grazie

[LMondi]

Perchè non cambi la funzione che determina la fine del processo di decompressione? Io ad esempio uso la segente funzione:

'Shell per il Backup - programma VB resta in attesa che
'il programma lanciato termini:
    Declare Function OpenProcess Lib "kernel32" _
    (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
    Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hprocess As Long, lpExitCode As Long) As Long
    Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
    Const STILL_ACTIVE = &H103
    Const PROCESS_QUERY_INFORMATION = &H400

'Funzione per la copia ed il Backup:
Function RikShell(exe As String, Optional WinStyle) As Integer
    
    Dim processid As Long
    Dim hprocess As Long
    Dim exitcode As Long
    Dim parm As Integer

    'Controllo il parametro opzionale finestra:
    Select Case VarType(WinStyle)
        Case vbEmpty, vbNull, vbError
            parm = vbHide
        Case vbLong, vbInteger, vbSingle, vbDouble
            parm = WinStyle
        Case Else
            parm = vbHide
    End Select

    'Prelevo l'ID del processo lanciato:
    processid = Shell(exe, parm)

    'Creo un Handle per quel processo:
    hprocess = OpenProcess(PROCESS_QUERY_INFORMATION, False, processid)
    Do
    'Controlla ripetutamente che termini la copia o il backup:
    Call GetExitCodeProcess(hprocess, exitcode)
    'Lascio libero il sistema di processare le altre applicazioni:
        DoEvents
    Loop While (exitcode = STILL_ACTIVE)

    CloseHandle (hprocess)
End Function

'Funzione per continuare con il programma  al termine del backup - Modulo Connessione :
        RikShell   "C:\Windows\system32\ntbackup.exe backup " & Chr$(34) & FolOrig & Chr$(34) & " /M copy /V:yes /F " & Chr$(34) & ValoreDir & Chr$(34)

In questo modo il controllo viene restituito al programma solo quando è finito il ciclo di decompressione.
Mi interesserebbe comunque il tuo codice, forse posso migliorare quello esposto.

[giano118]

il mio codice è il seguente:

Dim fso As New FileSystemObject
Public patharrivi As String
Public pathdestinazione As String
Public pathVerifica As String
Private Declare Function GetTickCount Lib "kernel32" () As Long
Dim i As Integer
Dim Nomefile As String
Dim Pathcfilecopiato As String
Public Pathfilecopiato As String

Private Const AddIcon = &H0
Private Const ModifyIcon = &H1
Private Const DeleteIcon = &H2

Private Const WM_MOUSEMOVE = &H200
Private Const WM_LBUTTONDBLCLK = &H203
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTONUP = &H202

Private Const WM_RBUTTONDBLCLK = &H206
Private Const WM_RBUTTONDOWN = &H204
Private Const WM_RBUTTONUP = &H205

Private Const MessageFlag = &H1
Private Const IconFlag = &H2
Private Const TipFlag = &H4

Private Declare Function Shell_NotifyIcon _
  Lib "shell32" Alias "Shell_NotifyIconA" ( _
  ByVal Message As Long, Data As NotifyIconData) As Boolean

Private Data As NotifyIconData

' FormMain.frm - Add an icon to the system tray.

' Type passed to Shell_NotifyIcon
Private Type NotifyIconData
  Size As Long
  Handle As Long
  ID As Long
  Flags As Long
  CallBackMessage As Long
  Icon As Long
  Tip As String * 64
End Type

Private Sub Arresta_Click()

End Sub

Private Sub Command1_Click()
Call Form_Load
End Sub

Private Sub Command2_Click()
End
End Sub

Private Sub Form_Load()

  AddIconToTray
  Visible = False

'rendo la form invisibile
'Form1.Visible = False

    Timer1.Interval = 15000
    
End Sub

Private Function decompresso()

    Dim Comando As String
    Dim MyString As String
    MyString = patharrivi
    MyString = Trim(MyString)

    'aggiungi <zipfile> alla variabile commando
    
    
    If Len(MyString) Then
        Comando = Comando & "<zipfile=" & MyString & ">"
    End If
    
    'aggiungi <files-selection> alla variabile commando
    MyString = "*.*"
    MyString = Trim(MyString)
    If Len(MyString) Then
        Comando = Comando & "<files-selection=" & MyString & ">"
    End If
    
    'aggiungi <zipfile><destination-path> alla variabile commando
    MyString = pathdestinazione
    MyString = Trim(MyString)
    If Len(MyString) Then
        Comando = Comando & "<destination-path=" & MyString & ">"
    End If
    
    'modo di scrittura
    'aggiungi <file-extraction-mode>  alla variabile commando
    Comando = Comando & "<file-extraction-mode=overwrite>"

    'profile di coda
    First = GetTickCount 
    
    'tipo di processo nella decompressione
    'Valori per definire ProcessorPriority
    '1 = IDLE
    '2 = LOWEST
    '3 = BELOW_NORMAL
    '4 = NORMAL
    '5 = ABOVE_NORMAL
    '6 = HIGHEST
    '7 = TIME_CRITICAL
    RSPZip1.SetProcessorPriority 4
    
    Pathfilecopiato = pathdestinazione & "\" & Mid(Nomefile, 1, Len(Nomefile) - 4) & ".txt"
    
    'dai il via all' UNZIP
    Do
    RSPZip1.RSPZipUncompress (Comando)
    Loop Until Dir(Pathfilecopiato) <> ""
    

    
    'verifico che sia stato scritto il file nella cartella destinazione
'
'    Pathcfilecopiato = Pathcfilecopiato
'
'
'
End Function

Private Sub Timer1_Timer()

    pathdestinazione = "c:\destinazione"
'assegna la path all'oggetto File1
    File1.Path = "c:\arrivi"
    File1.Refresh
    Dim contatore As Integer
contatore = File1.ListCount

If contatore <> 0 Then
    Timer1.Enabled = False
    Timer2.Interval = 5000
    Timer2.Enabled = True
End If

End Sub

Private Sub Timer2_Timer()
    
    'conto il numero dei file con estenzione .zip presenti nella cartella

    'restituisci il nome del file corristondente al contatore
    'e se presente anche il fole.t procedi all'UNZIP del  file
'    For i = 0 To contatore
         If Trim(pathVerifica) <> "" And fso.FileExists(pathVerifica) Then
         fso.DeleteFile (pathVerifica)
         If Trim(patharrivi) <> "" Then fso.DeleteFile (patharrivi)
         End If
         File1.Refresh
         Nomefile = File1.List(0)
        If Trim(Nomefile) = "" Then
            patharrivi = ""
            pathVerifica = ""
            Timer2.Enabled = False
            Timer1.Enabled = True
            Exit Sub
        End If
        
        patharrivi = "c:\arrivi\" & Nomefile & ""
        pathVerifica = Mid(patharrivi, 1, (Len(patharrivi) - 4))
        pathVerifica = pathVerifica & ".t"
    If fso.FileExists(pathVerifica) Then
        Call decompresso
    Else
    
        'ora ha già creato il file decpmpresso nella cartella destinazione
        'e quindi posso cancellare il file zippato e il relativo .t nella cartella arrivi
'         fso.DeleteFile (pathVerifica)
'         fso.DeleteFile (patharrivi)
        Timer2.Enabled = False
        Timer1.Enabled = True

    End If
    
    File1.Refresh
''    Timer2.Enabled = False
'''    Timer1.Interval = 15000
''    Timer1.Enabled = True

End Sub

ho escluso alcuni accorgimenti, ma in sostanza è questo.
voglio farti notare la parte bold 'Fist' credo sia quello il processo.

attendo ancora tue notizie.
vorrei lavorare ancora su questo codice, e cmq resto in attesa di una tua risposta.
grazie giano

[LMondi]

Come puoi leggere, la funzione in parola svolge altri compiti:

Funzione GetTickCount
Declare Function GetTickCount Lib "kernel32" Alias "GetTickCount" () As Long

La funzione GetTickCount ritorna il numero di millisecondi che sono trascorsi da quando è stato avviato windows.

La funzione non richiede parametri

Il tempo trascorso, viene memorizzato come valore DWORD. Il timer viene azzerato se Windows è in esecuzione continua per 49,7 giorni.

Dword
Porzione di memoria, solitamente una variabile che ha una lunghezza di quattro bytes. Il termine DWORD, letteralmente deriva da double word. dove per WORD, si intende una variabile di due bytes.
Forse ti converrebbe utilizzare quella che ho postato (OpenProcess) ed evitare i Timers.

E' esplicativo questo esempio, che puoi incollare in un modulo della Frm:

Option Explicit
'In general section
Private Declare Function GetTickCount& Lib "kernel32" ()
Private Sub Form_Load()
    Dim ret
    ret = GetTickCount&
    MsgBox Str$(ret / 60000) + " minutes."
End Sub