- '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
'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