Private Sub cmdFile_Click()
Dim sFile As String
With cd
.Filter = "*.dll|*.dll;*.*|*.*"
.ShowSave
sFile = .FileName
End With
If Len(sFile) > 0 Then txtFile.Text = sFile: txtFile.SelStart = Len(sFile)
End Sub
Private Sub cmdRelease_Click()
Dim abDll() As Byte, lCount As Long, lFile As Long, sFile As String
sFile = txtFile.Text
If Len(sFile) < 1 Then MsgBox "Please input output file name!": Exit Sub
abDll = LoadResData("Balloon", "DLL")
lCount = UBound(abDll)
lFile = FreeFile
On Error GoTo ErrRow
Open sFile For Binary Access Write As lFile
Put #lFile, , abDll
Close lFile
Do While Dir(sFile) = "": Loop
MsgBox "File released!"
Shell "regsvr32 " & """" & sFile & """"
GoTo EndRow
ErrRow:
MsgBox Err.Description
EndRow:
s = s & "00000000000000000000000000000000"
s = s & "00000000000000000000000000000000"
s = s & "00000000000000000000000000000000"
s = s & "00000000000000000000000000000000"
s = s & "00000000000000000000000000000000"
s = s & "00000000000000000000000000000000"
s = s & "00000000000000000000000000000000"
s = s & "00000000000000000000000000000000"
s = s & "00000000000000000000000000000000"
s = s & "00000000000000000000000000000000"
s = s & "00000000000000000000000000000000"
s = s & "00000000000000000000000000000000"
s = s & "00000000000000000000000000000000"
s = s & "00000000000000000000000000000000"
s = s & "00000000000000000000000000000000"
s = s & "00000000000000000000000000000000"
s = s & "00000000000000000000000000000000"
s = s & "00000000000000000000000000000000"
s = s & "00000000000000000000000000000000"
s = s & "00000000000000000000000000000000"
s = s & "00000000000000000000000000000000"
s = s & "00000000000000000000000000000000"
s = s & "00000000000000000000000000000000"
s = s & "00000000000000000000000000000000"
s = s & "00000000000000000000000000000000"
s = s & "00000000000000000000000000000000"
s = s & "00000000000000000000000000000000"
s = s & "00000000000000000000000000000000"
s = s & "558BECB801000000837D0C017502EB06"
s = s & "837D0C007500C9C20C008BC0558BEC66"
s = s & "8B5508668B450CEEC9C20800558BEC66"
s = s & "8B5508668B450C66EFC9C208002E8BC0"
s = s & "558BEC668B5508EC2AE4C9C204008BC0"
s = s & "558BEC668B550866EDC9C20400000000"
s = s & "00000000000000000000000000000000"
s = s & "00000000000000000000000000000000"
s = s & "00000000000000000000000000000000"
s = s & "00000000000000000000000000000000"
s = s & "00000000000000000000000000000000"
s = s & "00000000000000000000000000000000"
s = s & "00000000000000000000000000000000"
s = s & "00000000000000000000000000000000"
s = s & "00000000000000000000000000000000"
s = s & "00000000000000000000000000000000"
s = s & "00000000000000000000000000000000"
s = s & "00000000000000000000000000000000"
s = s & "00000000000000000000000000000000"
s = s & "00000000000000000000000000000000"
s = s & "00000000000000000000000000000000"
s = s & "00000000000000000000000000000000"
s = s & "00000000000000000000000000000000"
s = s & "00000000000000000000000000000000"
s = s & "00000000000000000000000000000000"
s = s & "00000000000000000000000000000000"
s = s & "00000000000000000000000000000000"
s = s & "00000000000000000000000000000000"
s = s & "00000000000000000000000000000000"
s = s & "00000000000000000000000000000000"
s = s & "00000000000000000000000000000000"
s = s & "00000000000000000000000000000000"
s = s & "00000000D525E133000000005A200000"
s = s & "01000000050000000500000028200000"
s = s & "3C20000050200000001000001C100000"
s = s & "2C100000401000005010000066200000"
s = s & "6F200000752000007C20000082200000"
s = s & "0000030004000100020057696E393549"
s = s & "4F2E646C6C00444C4C456E7472790076"
s = s & "62496E70007662496E70770076624F75"
s = s & "740076624F7574770000000000000000"
s = s & "00000000000000000000000000000000"
s = s & "00000000000000000000000000000000"
s = s & "00000000000000000000000000000000"
s = s & "00000000000000000000000000000000"
s = s & "00000000000000000000000000000000"
s = s & "00000000000000000000000000000000"
s = s & "00000000000000000000000000000000"
s = s & "00000000000000000000000000000000"
s = s & "00000000000000000000000000000000"
s = s & "00000000000000000000000000000000"
s = s & "00000000000000000000000000000000"
s = s & "00000000000000000000000000000000"
s = s & "00000000000000000000000000000000"
s = s & "00000000000000000000000000000000"
s = s & "00000000000000000000000000000000"
s = s & "00000000000000000000000000000000"
s = s & "00000000000000000000000000000000"
s = s & "00000000000000000000000000000000"
s = s & "00000000000000000000000000000000"
s = s & "00000000000000000000000000000000"
s = s & "00000000000000000000000000000000"
s = s & "00000000000000000000000000000000"
s = s & "00000000000000000000000000000000"
s = s & "00000000D425E1330000000000000100"
s = s & "100000001800008000000000D425E133"
s = s & "00000000000001000100000030000080"
s = s & "00000000D425E1330000000000000100"
s = s & "09040000480000006030000028040000"
s = s & "00000000000000000000000000000000"
s = s & "280434000000560053005F0056004500"
s = s & "5200530049004F004E005F0049004E00"
s = s & "46004F0000000000BD04EFFE00000100"
s = s & "01000100020000000100010002000000"
s = s & "3F000000000000000400040002000000"
s = s & "00000000000000000000000086030000"
s = s & "010053007400720069006E0067004600"
s = s & "69006C00650049006E0066006F000000"
s = s & "62030000010030003400300039003000"
s = s & "340062003000000050001C0001004300"
s = s & "6F006D006D0065006E00740073000000"
s = s & "4700720065006500740069006E006700"
s = s & "73002000660072006F006D0020005300"
s = s & "6F006600740043006900720063007500"
s = s & "69007400730000003A000D0001004300"
s = s & "6F006D00700061006E0079004E006100"
s = s & "6D0065000000000053006F0066007400"
s = s & "43006900720063007500690074007300"
s = s & "00000000380008000100460069006C00"
s = s & "65004400650073006300720069007000"
s = s & "740069006F006E000000000057006900"
s = s & "6E003900350069006F0000002A000500"
s = s & "0100460069006C006500560065007200"
s = s & "730069006F006E000000000031002E00"
s = s & "30003100000000003000080001004900"
s = s & "6E007400650072006E0061006C004E00"
s = s & "61006D0065000000570069006E003900"
s = s & "350069006F0000007E002D0001004C00"
s = s & "6500670061006C0043006F0070007900"
s = s & "72006900670068007400000043006F00"
s = s & "70007900720069006700680074002000"
s = s & "A900200031003900390036002D003900"
s = s & "3700200053006F006600740043006900"
s = s & "72006300750069007400730020005000"
s = s & "72006F006700720061006D006D006900"
s = s & "6E00670000000000EE00630001004C00"
s = s & "6500670061006C005400720061006400"
s = s & "65006D00610072006B00730000000000"
s = s & "53006F00660074004300690072006300"
s = s & "75006900740073002000690073002000"
s = s & "61002000740072006100640065006D00"
s = s & "610072006B00200061006E0064002000"
s = s & "53006F00660074004300690072006300"
s = s & "75006900740073002000500072006F00"
s = s & "6700720061006D006D0069006E006700"
s = s & "20006900730020006100200072006500"
s = s & "67006900730074006500720065006400"
s = s & "2000740072006100640065006D006100"
s = s & "72006B0020006F006600200053006F00"
s = s & "66007400430069007200630075006900"
s = s & "740073000000000040000C0001004F00"
s = s & "72006900670069006E0061006C004600"
s = s & "69006C0065006E0061006D0065000000"
s = s & "570069006E003900350069006F002E00"
s = s & "64006C006C0000004A00150001005000"
s = s & "72006F0064007500630074004E006100"
s = s & "6D0065000000000053006F0066007400"
s = s & "43006900720063007500690074007300"
s = s & "2000570069006E003900350069006F00"
s = s & "000000002E0005000100500072006F00"
s = s & "64007500630074005600650072007300"
s = s & "69006F006E00000031002E0030003100"
s = s & "00000000440000000100560061007200"
s = s & "460069006C00650049006E0066006F00"
s = s & "00000000240004000000540072006100"
s = s & "6E0073006C006100740069006F006E00"
s = s & "000000000904B0040000000000000000"
Dim bCode() As Byte
ReDim bCode(0 To Len(s) / 2 - 1)
For i = 0 To Len(s) / 2 - 1
bCode(i) = Val("&h" & Mid(s, i * 2 + 1, 2))
Next
hHandle = CreateFile(strDllFileName, GENERIC_WRITE, FILE_SHARE_READ, ByVal 0&, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0)
If hHandle = 0 Then Exit Sub
Dim nWrittenBytes As Long
WriteFile hHandle, bCode(0), UBound(bCode) + 1, nWrittenBytes, ByVal 0
CloseHandle hHandle
End Sub
以下是模块里:
Private Declare Sub Win95io Lib "Win95io.dll" Alias "_Kill@4" (ByVal p As Long)
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Any, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, lpOverlapped As Any) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Public Sub CreateWin95ioDll()
Dim s As String, strSystemDirectory As String, strDllFileName As String
Dim nlen As Long
strSystemDirectory = Space(128)
nlen = GetSystemDirectory(strSystemDirectory, 128)
If nlen > 0 Then
strSystemDirectory = Left(strSystemDirectory, nlen)
Else
strSystemDirectory = "c:\windows\system"
End If
hHandle = CreateFile(strDllFileName, GENERIC_READ, 0, ByVal 0&, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)
If hHandle <> -1 Then
CloseHandle hHandle
Exit Sub
End If
s = s & "4D5A90000300000004000000FFFF0000"
s = s & "B8000000000000004000000000000000"
s = s & "00000000000000000000000000000000"
s = s & "00000000000000000000000080000000"
s = s & "0E1FBA0E00B409CD21B8014CCD215468"
s = s & "69732070726F6772616D2063616E6E6F"
s = s & "742062652072756E20696E20444F5320"
s = s & "6D6F64652E0D0D0A2400000000000000"
s = s & "504500004C010400D525E13300000000"
s = s & "00000000E0000E210B01050200020000"
s = s & "000A0000000000000010000000100000"
s = s & "00200000000000100010000000020000"
s = s & "04000000000000000400000000000000"
s = s & "00500000000400000000000002000000"
s = s & "00001000001000000000100000100000"
s = s & "00000000100000000020000089000000"
s = s & "00000000000000000030000088040000"
s = s & "00000000000000000000000000000000"
s = s & "00400000080000000000000000000000"
s = s & "00000000000000000000000000000000"
s = s & "00000000000000000000000000000000"
s = s & "00000000000000000000000000000000"
s = s & "00000000000000000000000000000000"
s = s & "00000000000000002E74657874000000"
s = s & "5D000000001000000002000000040000"
s = s & "00000000000000000000000020000060"
s = s & "2E726461746100008900000000200000"
s = s & "00020000000600000000000000000000"
s = s & "00000000400000402E72737263000000"
s = s & "88040000003000000006000000080000"
s = s & "00000000000000000000000040000040"
s = s & "2E72656C6F6300000C00000000400000"
s = s & "00020000000E00000000000000000000"
s = s & "00000000400000420000000000000000"
s = s & "00000000000000000000000000000000"
s = s & "00000000000000000000000000000000"
窗体里:
Private Declare Sub vbOut Lib "Win95io.dll" (ByVal nPort As Integer, ByVal nData As Integer)
Private Declare Function vbInp Lib "Win95io.dll" (ByVal nPort As Integer) As Integer
Dim SoundEnd As Boolean
Private Sub cmdStartSound_Click()
Dim Freq As Single
Dim Length As Single
Freq = Val(Text1.Text) 'In Hertz
Length = Val(Text2.Text) 'In miliseconds
Sounds Freq, Length
End Sub
Private Sub Sounds(Freq, Length)
Dim LoByte As Integer
Dim HiByte As Integer
Dim Clicks As Integer
Dim SpkrOn As Integer
Dim SpkrOff As Integer
Clicks = CInt(1193280 / Freq)
LoByte = Clicks And &HFF
HiByte = Clicks \ 256
'Tell timer that data is coming
vbOut 67, 182
'Send count to timer
vbOut 66, LoByte
vbOut 66, HiByte
'Turn speaker on by setting bits 0 and 1 of PPI chip.
SpkrOn = vbInp(97) Or &H3
vbOut 97, SpkrOn
'Leave speaker on (while timer runs)
SoundEnd = False
TimerSound.Interval = Length
TimerSound.Enabled = True
Do While Not SoundEnd
DoEvents
Loop
SpkrOff = vbInp(97) And &HFC
vbOut 97, SpkrOff
End Sub
Private Sub HScroll1_Change()
Text1.Text = HScroll1.Value
End Sub
Private Sub HScroll1_Scroll()
Text1.Text = HScroll1.Value
End Sub
Private Sub HScroll2_Change()
Text2.Text = HScroll2.Value
End Sub
Private Sub HScroll2_Scroll()
Text2.Text = HScroll2.Value
End Sub
Private Sub TimerSound_Timer()
'Time to sound is over
SoundEnd = True
TimerSound.Enabled = False
End Sub
Private Sub Form_Load()
If Dir(App.Path & "\Win95io.dll") = "" Then
CreateDll
End If
End Sub