Bonjour a toutes et a tous !
je suis dans une impasse, une belle galère....
je suis actuellement en formation et après avoir réussi a faire l'appli que mon superieur me demandait en VB6 au bout de 4 mois (j'avais rarement touché un pc avant d'etre ici), celui ci desire maintenant que je la transcrive en java et la je nage dans un ocean....
est ce que quelqu'un aurait un peu de temps a me consacrer
si oui voila les sources de mon appli en VB6 composée uniquement de deux modules de classes:
1er module "Netsend"
----------------------------------------------------------------
Public Function GetParameter(ByVal sFile As String, _
ByVal sTopic As String, _
ByVal sItem As String, _
ByRef vValue As Variant, _
ByRef lReturn As Long, _
ByRef sMsg As String, _
Optional vDefault As Variant) As Long
On Error GoTo ERR_GetParameter
Dim sBuffer As String * 256 ' Buffer pour GetPrivateProfileString
Dim sValue As String
Dim iValRetour As Integer ' Valeur retour des fonctions
'-----------------------------------------------------------------------
lReturn = ERROR_SUCCESS
iValRetour = GetPrivateProfileString(sTopic, sItem, vbNullString, sBuffer, 256, sFile)
If iValRetour = 0 Then
If Not IsMissing(vDefault) Then
vValue = vDefault
Else
lReturn = FM_MISS_ITEM
sMsg = "File:" & sFile & "|Topic:" & sTopic & "|Item:" & sItem & "|"
End If
Else
sValue = Left$(sBuffer, iValRetour)
'cast
vValue = sValue
End If
'-----------------------------------------------------------------------
EXIT_GetParameter:
'-----------------------------------------------------------------------
GetParameter = lReturn
Exit Function
'-----------------------------------------------------------------------
ERR_GetParameter:
'-----------------------------------------------------------------------
lReturn = Err.Number
sMsg = "Topic:" & sTopic & "|Item:" & sItem & "|" & Err.Description
Resume EXIT_GetParameter
End Function
Public Function Lecture_INI(ByVal strKey As String, ByVal StrITEM As String) As String
Dim LngResult As Long
Dim sValue As String
Dim LngReturn As Long
Dim sMsg As String
On Error Resume Next
LngReturn = GetParameter(App.Path + "\renan.ini", strKey, StrITEM, sValue, LngReturn, sMsg)
'appel la fonction GetParameter
Lecture_INI = CStr(sValue)*
End Function
----------------------------------------------------------------------
Public Sub Mail()
Dim Session As Object
Dim db As Object
Dim doc As Object
Dim Fichier As Object
Dim UserList As String
Dim user_list As String
Dim NetSend As String
Dim temp() As String
Dim i As Integer
UserList = Lecture_INI("NetSend", "user_list")
'on appelle la fonction Lecture_INI pour récupérer la liste des destinataires
temp = Split(UserList, ", ")
'on stocke chaque destinataire séparé par une virgule dans une variable différente => (tableau)
For i = 0 To UBound(temp)
'Début boucle For, la fonction ubound(temp) renvoie le dernier index
du tableau temp
UserList = temp(i) 'on charge la valeur prise pour le destinataire
Set Session = CreateObject("Notes.NotesSession")
'creation d'un objet Session Notes
Set db = Session.GETDATABASE("", UserList)
'incorpore la liste des destinataires à la session
Call db.OPENMAIL 'appel l'ouverture du mail
Set doc = db.CREATEDOCUMENT() 'création du mail
With doc
.Form = "Memo"
.SendTo = UserList 'destinataire
.Subject = "nom fichier existant + chemin" 'sujet du mail
.body = strFolder & strFile 'corps du mail = chemin du fichier
.From = Session.COMMONUSERNAME 'affichage expéditeur
.PostedDate = Now() 'date d'envoi
.SAVEMESSAGEONSEND = True 'sauvegarde le mail
End With
'Envoyer mail
doc.SEND (True)
Next i 'Fin boucle For
Set Session = Nothing
Set db = Nothing
Set doc = Nothing
End Sub
--------------------------------------------------------------------
2ème module "RechFile" (module principal)
------------------------------------------------------------------
Public Declare Function GetPrivateProfileString Lib "kernel32" _
Alias "GetPrivateProfileStringA" ( _
ByVal AppName As String, _
ByVal KeyName As String, _
ByVal keydefault As String, _
ByVal ReturnString As String, _
ByVal NumBytes As Long, _
ByVal FileName As String) As Long
Public strFile As String
Public strFolder As String
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Const WAIT_OBJECT_0& = 0
Private Const INFINITE = &HFFFF
Private Const ERROR_ALREADY_EXISTS = 183&
Private Const QS_HOTKEY& = &H80
Private Const QS_KEY& = &H1
Private Const QS_MOUSEBUTTON& = &H4
Private Const QS_MOUSEMOVE& = &H2
Private Const QS_PAINT& = &H20
Private Const QS_POSTMESSAGE& = &H8
Private Const QS_SENDMESSAGE& = &H40
Private Const QS_TIMER& = &H10
Private Const QS_MOUSE& = (QS_MOUSEMOVE _
Or QS_MOUSEBUTTON)
Private Const QS_INPUT& = (QS_MOUSE _
Or QS_KEY)
Private Const QS_ALLEVENTS& = (QS_INPUT _
Or QS_POSTMESSAGE _
Or QS_TIMER _
Or QS_PAINT _
Or QS_HOTKEY)
Private Const QS_ALLINPUT& = (QS_SENDMESSAGE _
Or QS_PAINT _
Or QS_TIMER _
Or QS_POSTMESSAGE _
Or QS_MOUSEBUTTON _
Or QS_MOUSEMOVE _
Or QS_HOTKEY _
Or QS_KEY)
Private Declare Function CreateWaitableTimer Lib "kernel32" _
Alias "CreateWaitableTimerA" ( _
ByVal lpSemaphoreAttributes As Long, _
ByVal bManualReset As Long, _
ByVal lpName As String) As Long
Private Declare Function SetWaitableTimer Lib "kernel32" ( _
ByVal hTimer As Long, _
lpDueTime As FILETIME, _
ByVal lPeriod As Long, _
ByVal pfnCompletionRoutine As Long, _
ByVal lpArgToCompletionRoutine As Long, _
ByVal fResume As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" ( _
ByVal hObject As Long) As Long
Private Declare Function MsgWaitForMultipleObjects Lib "user32" ( _
ByVal nCount As Long, _
pHandles As Long, _
ByVal fWaitAll As Long, _
ByVal dwMilliseconds As Long, _
ByVal dwWakeMask As Long) As Long
'---------------------------------------------------------------------
Public Sub Wait(lNumberOfSeconds As Long)
Dim ft As FILETIME
Dim lBusy As Long
Dim lRet As Long
Dim dblDelay As Double
Dim dblDelayLow As Double
Dim dblUnits As Double
Dim hTimer As Long
hTimer = CreateWaitableTimer(0, True, App.EXEName & "Timer")
If Err.LastDllError = ERROR_ALREADY_EXISTS Then
' si le timer existe déjà il ne provoque pas d'erreur quand on veut l'ouvrir
' si la personne qui essaye de l'ouvrir dispose des droits d'accès nécessaires.
Else
ft.dwLowDateTime = -1
ft.dwHighDateTime = -1
lRet = SetWaitableTimer(hTimer, ft, 0, 0, 0, 0)
End If
dblUnits = CDbl(&H10000) * CDbl(&H10000)
dblDelay = CDbl(lNumberOfSeconds) * 1000 * 10000
ft.dwHighDateTime = -CLng(dblDelay / dblUnits) - 1
dblDelayLow = -dblUnits * (dblDelay / dblUnits - Fix(dblDelay / dblUnits))
If dblDelayLow < CDbl(&H80000000) Then
dblDelayLow = dblUnits + dblDelayLow
End If
ft.dwLowDateTime = CLng(dblDelayLow)
lRet = SetWaitableTimer(hTimer, ft, 0, 0, 0, False)
Do
lBusy = MsgWaitForMultipleObjects(1, hTimer, False, INFINITE, QS_ALLINPUT&)
DoEvents
Loop Until lBusy = WAIT_OBJECT_0
CloseHandle hTimer
End Sub
'---------------------------------------------------------------------
Public Sub Time()
Dim diff As String
Dim min As String
Dim max As String
min = Lecture_INI("Timer", "debut_app")
'appel la fonction Lecture_INI pour connaitre l'heure de debut de l'API
max = Lecture_INI("Timer", "fin_app")
'appel la fonction Lecture_INI pour connaitre l'heure ou l'api doit s'arrêter
diff = Format(Now(), "Short Time") 'heure actuelle
If diff < min Or diff >= max Then End
'si l'heure actuelle est < min ou >= max alors arreter l'API
End Sub
'---------------------------------------------------------------------
Public Sub Main()
CProg 'appel la procédure CProg
End Sub
'---------------------------------------------------------------------
Public Sub CProg()
While (True) 'boucle tant que (VRAI) on effectue le corps de la boucle
Time 'appel la procédure Time afin de vérifier si la tranche horaire d'exécution est valide
strFile = "" 'on initialise strfile en le déclarant vide
While (strFile = "") 'tant que strFile est vide on effectue le corps de la boucle
CorpProg 'appel la procédure CorpProg
Wait 1 'permet de relacher le cpu en indiquant au prog de scanner le dossier une seule fois/seconde
Wend 'fin de la boucle tant que
Wait 600 'appel la procédure wait et rend actif le compteur (Wait x x: secondes ici 10 min)
Scan (strFile) 'appel la fonction scan
Wend 'fin de la boucle tant que
End Sub
'---------------------------------------------------------------------
Public Sub CorpProg()
Dim sFileIni As String
Dim Dossier As String
Dim appli_renan As String
Dim tempo As String
sFileIni = App.Path & "\renan.ini"
'le chemin du fichier INI est identique à celui de l'application (app.path)
If sFileIni <> "" Then ' si le fichier INI existe alors
strFolder = Lecture_INI("Dossier", "appli_renan")
'lire le fichier INI (appel de la fonction Lecture_INI)
If Right$(strFolder, 1) <> "\" Then strFolder = strFolder & "\"
'ajoute un "\" à droite si il manque
strFile = Dir(strFolder) 'nom du fichier
End If
End Sub
'---------------------------------------------------------------------
Public Sub Scan(strFile As String)
Dim sNewFile As String
sNewFile = Dir(strFolder) 'on effectue un scan de celui-ci
If sNewFile = strFile Then
'on vérifie si le fichier n'est plus dans le dossier après le délai
Mail 'appel la procédure Mail
End If
End Sub
----------------------------------------------------------------------
voila voila
j'espere sincerement que quelqun pourra m'aider car il la veut pour la fin Aout et franchement j'ai beau lire et relire les cours et les tutos que j'ai en java je vois pas comment faire!!!
;(
COCO RI CO
COCO RI CO