Inclure les dll et les ocx dans vos programmes (sauf vb6fr.dll)

Télécharger le projet
Commenter

Description

C'est une source de Draluorg que j'ai amélioré (http://www.vbfrance.com/code.aspx?id=29078)
car la sienne extrayait dans le repertoire de l'application, alors que la mienne extrait dans le repertoire systeme de windows.

Source / Exemple : 


'code du module :
Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Dim repsysteme As String 'variable qui sert a stoquer le sysdir

Option Explicit
Dim b1() As Byte
Dim b2() As Byte

Sub Main()  'Attention, il est nécessaire de mettre _
dans les options du projet qu'il faut demarrer par Sub Main()
    'fonction de recup du system directory
    Dim Ret As Long
    repsysteme = Space(255) ' creer un espace reservé
    Ret = GetSystemDirectory(repsysteme, 255) 'stocke dans ret le repertoire, avec des espaces en bout de string
    repsysteme = Left$(repsysteme, Ret) 'enleve les espaces qui servent a rien et stoque le rep dans repsysteme
    'fin de la fonction
Extrait ' on extrait les ocx ou dll sur le disk et on les enregistre
DoEvents
Form1.Show ' on lance le form "de demarrage"
End Sub

Sub Extrait() 'fonction pour extraire les ocx sur le disk (dans le repertoire systeme)
    Dim cc1, cc2
        cc2 = repsysteme & "\dialogg.ocx"
        cc1 = repsysteme & "\Basics.ocx"
        b1 = LoadResData(101, "CUSTOM") ' contient basics.ocx (reyXP_Basic.ocx)

If FileExist("" & cc1) Then GoTo 2 ' si le fichier existe deja on pass

    Open cc1 For Binary As #1 ' on extrait l'ocx
        Put #1, , b1
    Close #1
    DoEvents
2
If FileExist("" & cc2) Then GoTo Fin ' si le fichier existe deja on pass

b2 = LoadResData(102, "CUSTOM") ' contient dialogg.ocx (ComDlg32.ocx)

    Open cc2 For Binary As #1 'on extrait l' ocx
        Put #1, , b2
        DoEvents
    Close #1

DoEvents
    Shell "regsvr32 /s basics.ocx"  'et la on enregistre les dll
    Shell "regsvr32 /s dialogg.ocx"   'le /s met regsvr32 en mode silentieux
Fin:
DoEvents
End Sub

'fonction pour verifier l'existance d'un fichier
Private Function FileExist(file As String) As Boolean
Dim L As Long
    On Error GoTo FExErr
        L = FileLen(file)
            FileExist = True
        Exit Function
FExErr: FileExist = False
Exit Function
End Function

Conclusion :


Merci a Draluorg qui a inventé cette source !!
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (cs_gagou9)