@CAD+ - Pour aller +loin avec VB et VBA

Nota :
Par souci de simplification, les explications de ce programme ont été sectionnées en quatre parties. Les sections correspondent aux différentes versions :

La partie 1, le code de la version 1, explique
- Comment choisir un fichier en VB.
- Comment créer les aperçus.
- Comment implémenter les protocoles pour Internet.
La partie 2 explique comment mettre le programme en petite icône, et comment y attacher un menu.
Cette avant-dernière partie, le code de la version 2.2, explique comment avoir des informations sur un fichier et comment mettre un fichier dans la poubelle.
Le code ci-dessous est à rajouté au code des version 1 et 2.

La version 2.2

Cette partie permet d'obtenir des renseignements concernant le fichier sélectionné :

La taille du fichier.
La date de création du fichier.
Attention : Ne pas confondre avec la date de création du dessin qui elle ne peut être obtenue qu'à l'intérieur d'AutoCAD.
La date de dernière modification du fichier.

Une fois ces renseignements obtenus, vous pourrez, d'un simple clic, mettre le fichier dans la poubelle.

Toutes ces fonctions seront obtenues par l'utilisation d'API.

VB5 ou VB6 - Non testé en VB4.

Pour compléter la feuille ExplorAcad

Les contrôles d'informations

Tout comme les contrôles portant les indications 'Taille','Créé le' et 'Modifié le', les contrôles donnant ces valeurs sont également des Labels :

Propriété (Name) : lblTaille pour le premier
Propriété (Name) : lblCreation pour le second
Propriété (Name) : lblModif pour le troisième
Propriété BorderStyle : 1 - Fixed Single pour les trois
Les propriété Caption sont évidemment données par le programme.

Le bouton de commande de la Corbeille

Propriété (Name) : cmdPoubelle
Propriété Picture : Choisir le fichier poubel.ico fourni

Le bouton de commande Réduire en Icône

Le look du bouton a été amélioré ...
Propriété (Name) : cmdIcon inchangé
Propriété Picture : Choisir le fichier ico.bmp fourni

Le code du module ExplorAcad.bas

Le Module1 (ExplorAcad.bas) reste inchangé

Le code à modifier dans Form1

Déclarations des fonctions API

La première fonction existe déjà. :


Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
(ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
 ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

' Fonction permettant d'obtenir le handle du fichier sélectionné
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" _
(ByVal lpFileName As String, ByVal dwDesiredAccess As Long, _
ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, _
ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long

'Constantes pour la fonction CreateFile
'paramètres dwDesiredAccess
Private Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000
'paramètre dwCreationDisposition
Private Const OPEN_EXISTING = 3

' Après utilisation de CreateFile, on libère le handle du fichier
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

' Fonction de transformation des données FILETIME en SYSTEMTIME
Private Declare Function FileTimeToSystemTime Lib "kernel32" (lpFileTime As FILETIME, _
lpSystemTime As SYSTEMTIME) As Long

'Constantes pour la fonction FileTimeToSystemTime
Private Type FILETIME
  dwLowDateTime As Long
  dwHighDateTime As Long
End Type

'Fonction de formatage de l'heure
Private Declare Function GetTimeFormat Lib "kernel32" Alias "GetTimeFormatA" (ByVal Locale As Long, _
ByVal dwFlags As Long, lpTime As SYSTEMTIME, ByVal lpFormat As String, ByVal lpTimeStr As String, _
ByVal cchTime As Long) As Long

'Fonction de formatage de la date
Private Declare Function GetDateFormat Lib "kernel32" Alias "GetDateFormatA" (ByVal Locale As Long, _
ByVal dwFlags As Long, lpDate As SYSTEMTIME, ByVal lpFormat As String, ByVal lpDateStr As String, ByVal cchDate As Long) As Long

'Constantes pour la fonction GetTimeFormat, GetDateFormat
Private Type SYSTEMTIME
  wYear As Integer
  wMonth As Integer
  wDayOfWeek As Integer
  wDay As Integer
  wHour As Integer
  wMinute As Integer
  wSecond As Integer
  wMilliseconds As Integer
End Type

' fonction d'obtention des informations du fichier
Private Declare Function GetFileInformationByHandle Lib "kernel32" (ByVal hndFichier As Long, _
lpFileInformation As BY_HANDLE_FILE_INFORMATION) As Long

'Variables personnalisées pour Fonction GetFileInformationByHandle
Private Type BY_HANDLE_FILE_INFORMATION
  dwFileAttributes As Long          ' Attribut du fichier
  ftCreationTime As FILETIME        ' date et heure de création
  ftLastAccessTime As FILETIME      ' date et heure dernier accès
  ftLastWriteTime As FILETIME       ' date et heure dernière modif
  dwVolumeSerialNumber As Long      ' numéro de série du volume
  nFileSizeHigh As Long             ' poids fort de la taille
  nFileSizeLow As Long              ' poids faible de la taille
  nNumberOfLinks As Long
  nFileIndexHigh As Long
  nFileIndexLow As Long
End Type

'Variables personnalisées pour suppression fichier
Private Type SHFILEOPSTRUCT
        hwnd As Long
        wFunc As Long
        pFrom As String
        pTo As String
        fFlags As Integer
        fAborted As Boolean
        hNameMaps As Long
        sProgress As String
End Type

' Fonction permettant des opérations sur fichier
Private Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long

Private Const FO_DELETE = &H3
Private Const FOF_ALLOWUNDO = &H40
Private Const FOF_SILENT = &H4
Private Const FOF_NOCONFIRMATION = &H10

Public Chemin As String			' << existant
Public Fichier As String		' << existant
Public FichVi$ As String		' << nouveau

Modification de la Procédure filFich1_Click()

Appel de la fonction FichInfo du fichier sélectionné.

Obtention de la taille du fichier par la fonction interne FileLen

Affichage de la taille dans le contrôle Label lblTaille


Public Sub filFich1_Click()
  lblMessage.Caption = " "
  Chemin = dirDisc1.Path
  If Right$(Chemin, 1) <> "\" Then
    Chemin = Chemin + "\"
  End If
  Fichier = filFich1.FileName
  FichVi$ = Chemin + filFich1.FileName
  FichInfo (FichVi$)				' << nouveau
  ' Obtention de la taille du fichier par FileLen
  strTaille = Str(FileLen(FichVi$)) 		' << nouveau
  ' Affichage de la taille dans le contrôle Label
  lblTaille.Caption = Format(strTaille, " ### ### ###") + " octets" '<< nouveau
  On Error GoTo Erreur1
  DwgVignette1.DwgFileName = FichVi$
  lblMessage.Caption = "Cliquez sur l'image pour lancer le dessin"
  DwgVignette1.Refresh
  Exit Sub
Erreur1:
  DwgVignette1.Refresh
  lblMessage.Caption = "Ce fichier n'est pas au format R13 ou R14"
End Sub

La Procédure Sub FichInfo()

Appel de la fonction CreateFile pour obtenir le handle du fichier sélectionné.

Obtention des infos par la fonction GetFileInformationByHandle

Appel de la fonction de formatage

Affichage de la date et l'heure dans le label correspondant.

Appel de la fonction CloseHandle pour fermer le handle du fichier.


Public Sub FichInfo(Fichier)
  Dim hndFichier As Long
  Dim lngRetour As Long
  Dim myFileInfo As BY_HANDLE_FILE_INFORMATION
  
  hndFichier = CreateFile(Fichier, GENERIC_READ Or GENERIC_WRITE, 0, 0, OPEN_EXISTING, 0, 0)
  lngRetour = GetFileInformationByHandle(hndFichier, myFileInfo)
  ' formatage et affichage dans les labels
  With myFileInfo
    lblCreation.Caption = Formatage(.ftCreationTime)
    lblModif.Caption = Formatage(.ftLastWriteTime)
  End With
  lngRetour = CloseHandle(hndFichier)
End Sub

La fonction de formatage du temps

Appel de la fonction FileTimeToSystemTime pour transformer les données.

Obtention de l'heure par la fonction GetTimeFormat

Obtention de la date par la fonction GetDateFormat


Private Function Formatage(DateHeure As FILETIME) As String
  Dim strTemp As String
  Dim strLigne As String
  Dim lngRetour As Long
  Dim Temps As SYSTEMTIME
  
  lngRetour = FileTimeToSystemTime(DateHeure, Temps)
  strTemp = String(255, 0)
  lngRetour = GetTimeFormat(&H800, 0, Temps, vbNullString, strTemp, 254)
  strLigne = Left(strTemp, lngRetour)
  strTemp = String(255, 0)
  lngRetour = GetDateFormat(&H800, 0, Temps, vbNullString, strTemp, 254)
  strLigne = Left(strTemp, lngRetour - 1) & " - " & strLigne
  Formatage = strLigne
End Function

Les procédures d'Effacement du fichier

la procédure Sub cmdPoubelle_Click() est appelée quand on clique sur la corbeille.

Le programme demande une confirmation de la supression. Vous pouvez supprimer cette demande en supprimant la ligne et en indiquant
bolSuppression = True au lieu de bolSuppression = False

Appel de la fonction SuppressFich si confirmation

Rafraichissement des intitulés et de la vignette.


Private Sub cmdPoubelle_Click()
  ' Procédure pour effacer le fichier
  Dim bolSuppression As Boolean
  
  bolSuppression = False
  ' demande de confirmation de l'effacement du fichier
  bolSuppression = (MsgBox("Voulez-vous supprimer" + vbLf + FichVi$ + " ?", 260 + vbQuestion + vbApplicationModal, App.Title) = vbYes)
  ' Supression fichier et rafraichissements
  If bolSuppression Then
    SuppressFich (FichVi$)
    filFich1.Refresh
    DwgVignette1.DwgFileName = ""
    DwgVignette1.Refresh
    lblTaille.Caption = ""
    lblCreation.Caption = ""
    lblModif.Caption = ""
  End If

End Sub

Public Function SuppressFich(sFileNames As String) As Boolean
   Dim IntProv As Integer
   Dim SHFileOp As SHFILEOPSTRUCT

   sFileNames = sFileNames + vbNullChar
   With SHFileOp
      .wFunc = FO_DELETE
      .pFrom = sFileNames
      .fFlags = FOF_ALLOWUNDO + FOF_NOCONFIRMATION
   End With
   ' Appel de l'API pour l'opération Delete
   IntProv = SHFileOperation(SHFileOp)
   SuppressFich = (IntProv = 0)
End Function

Récapitulatif du code

La partie 1 - Comment choisir un fichier en VB, comment créer les aperçus, comment implémenter les protocoles pour Internet.

La partie 2 - Comment placer le programme en 'tite icône', comment attacher un menu à la 'tite icône'.

La partie 3 - Comment récupérer les informations sur un fichier, comment placer un fichier dans la corbeille.

La partie 4 - Comment afficher les clichés AutoCAD en VB, comment lire la liste des clichés d'une bibliothèque.

Le code d'Exploracad - Partie 4

--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------

Le Coin des AutoCADiens