by Keith Fox (1 Submission)
Category: Miscellaneous
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Sat 30th June 2001
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
Want to guarantee a picture, text file, DLL or any other item is available to install from within your application? Save the item in your
VBcoders
' anything loaded as a resource can be extracted this way...
Private Function InstallDLL() As Boolean
Dim DLLbytes() As Byte, byteCounter As Long, fnrI As Integer, desDir As String, iResponse As Integer
' First ensure user agrees to install DLL
iResponse = MsgBox("Required DLL not present. Create it?" & vbCrLf & vbCrLf & "This will take a minute.", vbOKCancel, "Missing File")
If iResponse = vbCancel Then Exit Function
On Error GoTo NoSysDir
' Now get destination folder & install DLL there
Prompt4SystemDirectory:
destDir = InputBox("Enter the system directory below (usually C:\Windows\System, C:\WinNT\System32, etc)", "Where is your System Directory?", sysDir)
If destDir = "" Then Exit Function ' No system folder, no installation
If Len(Dir(destDir)) = 0 Then ' Verify what user gave us is good to go
' Oops, probably a typo - send him back to the prompt
MsgBox "That directory doesn't exist. Try Again.", vbInformation + vbOKOnly
GoTo Prompt4SystemDirectory
End If
End If
Screen.Mousepointer = vbHourglass
' Ok, we have a systems folder now let's see if the DLL already exists - it shouldn't but delete it if it does
If Len(Dir(destDir & [FileName])) > 0 Then Kill destDir & [FileName]
' Now lets open a binary file to write to...
fnrI = FreeFile()
Open destDir & [FileName] For Binary As #fnrI
' Must retrieve the byte by byte contents of the DLL
DLLbytes = LoadResData(101, "Custom")
' For every single byte in the DLL, we write it to the binary file
For byteCounter = 0 To UBound(DLLbytes) ' arrays start at zero, but writing bytes start at 1
Put #fnrI, byteCounter + 1, DLLbytes(byteCounter) ' write the byte
Next
Close #fnrI ' close the DLL file & inform user of success
Screen.MousePointer = vbDefault
MsgBox "DLL installed successfully", vbInformation + vbOKOnly
InstallDLL = True
Exit Function
NoSysDir:
If fnrI <> 0 Then Close #fnrI ' Errored, so let's inform user why & offer to retry
Screen.MousePointer = vbDefault
iResponse = MsgBox("Can't continue..." & vbCrLf & vbCrLf & Err.Description, vbExclamation + vbRetryCancel, "Critical Error")
If iResponse = vbRetry Then Resume Prompt4SystemDirectory
End Function
No comments have been posted about Want to guarantee a picture, text file, DLL or any other item is available to install from within y. Why not be the first to post a comment about Want to guarantee a picture, text file, DLL or any other item is available to install from within y.
