• Home
 · 
• Miscellaneous
 · 
• Want to guarantee a picture, text file, DLL or any other item is available to install from within y

Want to guarantee a picture, text file, DLL or any other item is available to install from within y

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

Rate Want to guarantee a picture, text file, DLL or any other item is available to install from within y

• 1
• 2
• 3
• 4
• 5

(1(1 Vote))

' 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