|
| |
Visual-Basic Einsteiger| Re: Z-Up Maker | |  | | Autor: Atlan | | Datum: 20.01.02 12:44 |
| Hi Thorsten,
falls dein Setup Programm das nicht machen sollte, versuchdoch
mal einfach dieses Programm.
Nennt sich Setup Generator und den findest du als Freeware
und als Shareware unter: http://www.gentee.com
Das Programm startet auf jeden Fall eine .exe nach der
Installation.
Zum Registrieren der .dll erstellst du folgendes:
'Wenn die Installation fertig ist, soll dein Setup Programm diese
'Exe, den Namen kannst du dir aussuchen, starten!
'In List1 schreibst du den exakten Namen der DLL, (OCX) rein.
'Mal als Beispiel: Oleaut32.dll, aber bitte ohne Pfadangabe !!!
'Vorraussetzung ist, das du deinem "Setup Programm" sagst,
'das er die ganzen DLL in das Systemverzeichniss installieren soll.
'Erstelle eine Form, Name: Wie du willst
'Erstelle eine ListBox mit dem Namen: List1
Code-Inhalt:
Private Sub Form_Load()
On Error Resume Next
Dim System
System = GetSystemDir
For i = 0 To List1.ListCount
If Trim(List1.List(i)) <> "" Then _
RegisterFile System & List1.List(i), True
Next i
End
End Sub
'*************************************************************
'Erstelle ein Modul mit dem Namen: DllRegistrierung
Code-Inhalt:
Private Declare Function LoadLibrary Lib "kernel32" Alias _
"LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare Function FreeLibrary Lib "kernel32" _
(ByVal hLibModule As Long) As Long
Private Declare Function GetProcAddress Lib "kernel32" _
(ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Function CreateThread Lib "kernel32" _
(lpThreadAttributes As Any, ByVal dwStackSize As Long, _
ByVal lpStartAddress As Long, ByVal lParameter As Long, _
ByVal dwCreationFlags As Long, lpThreadID As Long) As Long
Private Declare Sub ExitThread Lib "kernel32" _
(ByVal dwExitCode As Long)
Private Declare Function WaitForSingleObject Lib "kernel32" _
(ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function GetExitCodeThread Lib "kernel32" _
(ByVal hThread As Long, lpExitCode As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" _
(ByVal hObject As Long) As Long
Public Function RegisterFile(ByVal sFile As String, _
Register As Boolean) As Boolean
Dim Result As Boolean
Dim Lib As Long
Dim sProc As String
Dim r1 As Long
Dim r2 As Long
Dim Thread As Long
On Local Error GoTo RegError
Result = False
Lib = LoadLibrary(sFile)
If Lib Then
sProc = IIf(Register, "DllRegisterServer", _
"DllUnregisterServer")
r1 = GetProcAddress(Lib, sProc)
If r1 Then
Thread = CreateThread(ByVal 0, 0, ByVal r1, _
ByVal 0, 0, r2)
If Thread Then
r2 = WaitForSingleObject(Thread, 10000)
If r2 Then
FreeLibrary Lib
r2 = GetExitCodeThread(Thread, r2)
ExitThread r2
Exit Function
End If
CloseHandle Thread
Result = True
End If
End If
FreeLibrary Lib
End If
RegError:
RegisterFile = Result
Exit Function
End Function
'*************************************************************
'Erstelle ein Modul mit dem Namen: WindowsDir
Code-Inhalt:
Option Explicit
'Zunächst die benötigten API-Deklarationen
Declare Function GetSystemDirectory Lib "kernel32" Alias _
"GetSystemDirectoryA" (ByVal lpBuffer As String, _
ByVal nSize As Long) As Long
Declare Function GetWindowsDirectory Lib "kernel32" Alias _
"GetWindowsDirectoryA" (ByVal lpBuffer As String, _
ByVal nSize As Long) As Long
Public Enum SpecialFolderIDs
sfidDESKTOP = &H0
sfidPROGRAMS = &H2
sfidPERSONAL = &H5
sfidFAVORITES = &H6
sfidSTARTUP = &H7
sfidRECENT = &H8
sfidSENDTO = &H9
sfidSTARTMENU = &HB
sfidDESKTOPDIRECTORY = &H10
sfidNETHOOD = &H13
sfidFONTS = &H14
sfidTEMPLATES = &H15
sfidCOMMON_STARTMENU = &H16
sfidCOMMON_PROGRAMS = &H17
sfidCOMMON_STARTUP = &H18
sfidCOMMON_DESKTOPDIRECTORY = &H19
sfidAPPDATA = &H1A
sfidPRINTHOOD = &H1B
sfidProgramFiles = &H10000
sfidCommonFiles = &H10001
End Enum
Private Type SHITEMID
cb As Long
abID As Byte
End Type
Private Type ITEMIDLIST
mkid As SHITEMID
End Type
Private Declare Function SHGetSpecialFolderLocation Lib _
"shell32.dll" (ByVal hwndOwner As Long, _
ByVal nFolder As Long, pidl As ITEMIDLIST) As Long
Private Declare Function SHGetPathFromIDList Lib _
"shell32.dll" Alias "SHGetPathFromIDListA" _
(ByVal pidl As Long, ByVal pszPath As String) As Long
' Standard Systemordner ermitteln
Public Function GetSpecialFolder(CSIDL As _
SpecialFolderIDs) As String
Dim lResult As Long
Dim IDL As ITEMIDLIST
Dim sPath As String
lResult = SHGetSpecialFolderLocation(100, CSIDL, IDL)
If lResult = 0 Then
sPath = Space$(512)
lResult = SHGetPathFromIDList(ByVal IDL.mkid.cb, _
ByVal sPath)
GetSpecialFolder = Left$(sPath, InStr(sPath, _
Chr$(0)) - 1)
End If
End Function
'Windows-Verzeichnis ermitteln
Public Function GetWindowsDir() As String
Dim Temp As String
Dim lResult As Integer
Temp = Space$(256)
lResult = GetWindowsDirectory(Temp, Len(Temp))
Temp = Left$(Temp, lResult)
If Right$(Temp, 1) <> "\" Then Temp = Temp + "\"
GetWindowsDir = Temp
End Function
'Windows-System-Verzeichnis ermitteln
Public Function GetSystemDir() As String
Dim Temp As String
Dim lResult As Long
Temp = Space$(256)
lResult = GetSystemDirectory(Temp, Len(Temp))
Temp = Left$(Temp, lResult)
If Right$(Temp, 1) <> "\" Then Temp = Temp + "\"
GetSystemDir = Temp
End Function
'*******************************************************
gruß
Atlan | |
 | Sie sind nicht angemeldet!
Um auf diesen Beitrag zu antworten oder neue Beiträge schreiben zu können, müssen Sie sich zunächst anmelden.
 Einloggen | Neu registrieren |
 |
|
Neu! sevCommand 4.0 
Professionelle Schaltflächen im modernen Design!
Mit nur wenigen Mausklicks statten auch Sie Ihre Anwendungen ab sofort mit grafischen Schaltflächen im modernen Look & Feel aus (WinXP, Office, Vista oder auch Windows 8), inkl. große Symbolbibliothek. Weitere InfosTipp des Monats Access-Tools Vol.1 
Über 400 MByte Inhalt
Mehr als 250 Access-Beispiele, 25 Add-Ins und ActiveX-Komponenten, 16 VB-Projekt inkl. Source, mehr als 320 Tipps & Tricks für Access und VB
Nur 24,95 EURWeitere Infos
|
November 2025
Sie sind aktuell nicht angemeldet.
