vcd.frm

一个用vb和usb通信的一个实例,大家可以下载看看!

   End
   Begin VB.Menu iu 
      Caption         =   "曲目"
      Visible         =   0   'False
      Begin VB.Menu Mnu001 
         Caption         =   ""
         Index           =   0
      End
      Begin VB.Menu Mnu001 
         Caption         =   ""
         Index           =   1
         Visible         =   0   'False
      End
      Begin VB.Menu Mnu001 
         Caption         =   ""
         Index           =   2
         Visible         =   0   'False
      End
      Begin VB.Menu Mnu001 
         Caption         =   ""
         Index           =   3
         Visible         =   0   'False
      End
      Begin VB.Menu Mnu001 
         Caption         =   ""
         Index           =   4
         Visible         =   0   'False
      End
      Begin VB.Menu Mnu001 
         Caption         =   ""
         Index           =   5
         Visible         =   0   'False
      End
      Begin VB.Menu Mnu001 
         Caption         =   ""
         Index           =   6
         Visible         =   0   'False
      End
      Begin VB.Menu Mnu001 
         Caption         =   ""
         Index           =   7
         Visible         =   0   'False
      End
      Begin VB.Menu Mnu001 
         Caption         =   ""
         Index           =   8
         Visible         =   0   'False
      End
      Begin VB.Menu Mnu001 
         Caption         =   ""
         Index           =   9
         Visible         =   0   'False
      End
      Begin VB.Menu Mnu001 
         Caption         =   ""
         Index           =   10
         Visible         =   0   'False
      End
      Begin VB.Menu Mnu001 
         Caption         =   ""
         Index           =   11
         Visible         =   0   'False
      End
      Begin VB.Menu Mnu001 
         Caption         =   ""
         Index           =   12
         Visible         =   0   'False
      End
      Begin VB.Menu Mnu001 
         Caption         =   ""
         Index           =   13
         Visible         =   0   'False
      End
      Begin VB.Menu Mnu001 
         Caption         =   ""
         Index           =   14
         Visible         =   0   'False
      End
      Begin VB.Menu Mnu001 
         Caption         =   ""
         Index           =   15
         Visible         =   0   'False
      End
      Begin VB.Menu Mnu001 
         Caption         =   ""
         Index           =   16
         Visible         =   0   'False
      End
      Begin VB.Menu Mnu001 
         Caption         =   ""
         Index           =   17
         Visible         =   0   'False
      End
      Begin VB.Menu Mnu001 
         Caption         =   ""
         Index           =   18
         Visible         =   0   'False
      End
      Begin VB.Menu Mnu001 
         Caption         =   ""
         Index           =   19
         Visible         =   0   'False
      End
      Begin VB.Menu Mnu001 
         Caption         =   ""
         Index           =   20
         Visible         =   0   'False
      End
   End
End
Attribute VB_Name = "Form2"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

    

Option Explicit
Private Const NIM_ADD = &H0
Private Const NIM_MODIFY = &H1
Private Const NIM_DELETE = &H2
Dim A_Name As String
Dim S_Name As String
Const MaxRFiles = 4
Private Const NIF_MESSAGE = &H1
Private Const NIF_ICON = &H2
Private Const NIF_TIP = &H4
Private Const WM_MOUSEMOVE = &H200
         
Private Const WM_LBUTTONDBLCLK = &H203
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTONUP = &H202
Private Const WM_RBUTTONDBLCLK = &H206
Private Const WM_RBUTTONDOWN = &H204
Private Const WM_RBUTTONUP = &H205
Private Type NOTIFYICONDATA
    cbSize     As Long
    hWnd     As Long
    uID      As Long
    uFlags    As Long
    uCallbackMessage    As Long
    hIcon    As Long
    szTip    As String * 64
End Type
Dim mtIconData   As NOTIFYICONDATA
Dim mnCard      As Integer
Dim aa11, bbb, ccc


Private Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Long
Private Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
Private Const EWX_FORCE = 4
Private Const EWX_REBOOT = 2
Private Const EWX_SHUTDOWN = 1

Public LastState As Integer

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const WM_SYSCOMMAND = &H112
Private Const SC_MOVE = &HF010&
Private Const SC_RESTORE = &HF120&
Private Const SC_SIZE = &HF000&

Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long

Private Const DRIVE_REMOVABLE = 2
Private Const DRIVE_FIXED = 3
Private Const DRIVE_REMOTE = 4
Private Const DRIVE_CDROM = 5
Private Const DRIVE_RAMDISK = 6
Dim Snow(1000, 2), Amounty As Integer
Const MMSYSERR_NOERROR = 0
Const SND_ASYNC = &H1
Const SND_NODEFAULT = &H2
Const SND_PURGE = &H40
Const SND_FILENAME = &H20000
Dim MyVolume As clsVolume
'
'Play a wave file.
Private Declare Function PlaySound Lib "Winmm.dll" _
    Alias "PlaySoundA" (ByVal lpszName As String, _
    ByVal hModule As Long, ByVal dwFlags As Long) As Long


Const HWND_TOP = 0
Const HWND_BOTTOM = 1
Const HWND_TOPMOST = -1
Const HWND_NOTOPMOST = -2

Const SWP_NOSIZE = &H1
Const SWP_NOMOVE = &H2
Const SWP_NOZORDER = &H4
Const SWP_NOREDRAW = &H8
Const SWP_NOACTIVATE = &H10
Const SWP_FRAMECHANGED = &H20
Const SWP_SHOWWINDOW = &H40
Const SWP_HIDEWINDOW = &H80
Const SWP_NOCOPYBITS = &H100
Const SWP_NOOWNERZORDER = &H200

Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal Cx As Long, ByVal Cy As Long, ByVal wFlags As Long) As Long


Dim sF As String


Public Function TestCard() As Boolean
Dim Y As Long
Dim Find As String
Find = "Find Sound Blaster Card"
Y = waveOutGetNumDevs()
If Y > 0 Then
TestCard = True
MsgBox "Test OK!,I can found Sound Blaster Card!", Mb_OK, Find
Else
TestCard = False
MsgBox "No found device", Mb_OK, Find
End If
End Function
Public Function Listwaveformat(Aboutwave As Long) As String
Dim Waveformat As String
Select Case Aboutwave
    Case Wave_Format_1m08
        Waveformat = "11.025Khz,Mono,8bit,11Kb/Ps"
    Case Wave_Format_1m16
        Waveformat = "11.025Khz,Mono,16bit,22Kb/Ps"
    Case Wave_Format_1s08
        Waveformat = "11.025Khz,Stereo,8bit,22Kb/Ps"
    Case Wave_Format_1s16
        Waveformat = "11.025Khz,Stereo,16bit,43Kb/Ps"
    Case Wave_Format_2m08
        Waveformat = "22.05Khz,Mono,8bit,22Kb/Ps"
    Case Wave_Format_2m16
        Waveformat = "22.05Khz,Mono,16bit,43Kb/Ps"
    Case Wave_Format_2s08
        Waveformat = "22.05Khz,Stereo,8bit,43Kb/Ps"
    Case Wave_Format_2s16
        Waveformat = "22.05Khz,Stereo,16bit,86Kb/Ps"
    Case Wave_Format_4m08
        Waveformat = "44.1Khz,Mono,8bit,43Kb/Ps"
    Case Wave_Format_4m16
        Waveformat = "44.1Khz,Mono,16bit,86Kb/Ps"
    Case Wave_Format_4s08
        Waveformat = "44.1Khz,Stereo,8bit,86Kb/Ps"
    Case Wave_Format_4s16
        Waveformat = "44.1Khz,Stereo,16bit,172Kb/Ps"
End Select
Listwaveformat = Waveformat
End Function
Public Function Listwavesupport(Aboutwave As Long) As String
Dim Wavefun As String
Select Case Aboutwave
    Case Wavecaps_Pitch
        Wavefun = "Support Pitch"
    Case Wavecaps_Playbackrate
        Wavefun = "Support Playback"
    Case Wavecaps_Volume
        Wavefun = "Support Volume Control"
    Case Wavecaps_Lrvolume
        Wavefun = "Support Left-Right Channals"
    Case Wavecaps_Sync
        Wavefun = "Support Synchronization"
End Select
Listwavesupport = Wavefun
End Function

Function StripNulls(startStrg$) As String

'Take a string separated by Chr$(0)'s, and split off 1 item, and
'shorten the string so that the next item is ready for removal.

  Dim c%, item$
  c% = 1
  
  Do

    If Mid$(startStrg$, c%, 1) = Chr$(0) Then
      
      item$ = Mid$(startStrg$, 1, c% - 1)
      startStrg$ = Mid$(startStrg$, c% + 1, Len(startStrg$))
      StripNulls$ = item$
      Exit Function
    
    End If

    c% = c% + 1

  Loop

End Function


Private Sub add_Click()
Dim DlgInfo As DlgFileInfo
    Dim i As Integer
    
    On Error GoTo ErrHandle
    
   
      MMControl1.TimeFormat = 2
    
   
    With CommonDialog1
        .CancelError = True
         .MaxFileSize = 32767
        .Flags = cdlOFNHideReadOnly Or cdlOFNAllowMultiselect Or cdlOFNExplorer Or cdlOFNNoDereferenceLinks
        .DialogTitle = "选择文件"
         .Filter = "影视文件(*.Dat,*.Mpg,*.Avi,*.mov)|*.Dat;*.Mpg;*.Avi;*.mov|音频文件(*.wav,*.mp3,*.mid)|*.wav;*.MP3;*.mid|ALL File (*.*)|*.*"

      .ShowOpen
        DlgInfo = GetDlgSelectFileInfo(.FileName)
        .FileName = ""
    End With
    
    For i = 1 To DlgInfo.iCount
      List2.AddItem DlgInfo.sPath & DlgInfo.sFile(i)
    Next i
    
    Exit Sub

ErrHandle:

End Sub

Private Sub Check1_Click()
If Check1.Value = 1 Then
   f29.Checked = True
   MMControl1.Silent = True
   ElseIf Check1.Value = 0 Then
   f29.Checked = False
   MMControl1.Silent = False
End If
End Sub



Private Sub Check2_Click()
On Error Resume Next
If Check2.Value = 1 Then
   f28.Checked = True
   Timer1.Enabled = True
  ' eeeee.Checked = True
   ElseIf Check2.Value = 0 Then
  f28.Checked = False
  Timer1.Enabled = False
  'eeeee.Checked = False
  
End If

   
End Sub

Private Sub Dir1_Change()


End Sub

Private Sub Command11_Click()
MMControl1.DeviceType = "sequencer"
MMControl1.DeviceType = "cd audio"
MMControl1.DeviceType = "waveaudio"
On Error Resume Next
MMControl1.DeviceType = "MpegVideo"
End Sub

Private Sub Command12_Click()
End

End Sub




















Private Sub Command2_Click()
If List2.ListCount = 0 Then Exit Sub
On Error GoTo filerr
Dim b
Dim txtemp As String
CommonDialog2.ShowSave
If CommonDialog2.FileName <> "" Then
   Open CommonDialog2.FileName For Output As #1
   For i = 1 To b
       txtemp$ = txtemp$ + musicname(i) + Chr(10) + sfc(i) + Chr(1)
   Next i
   Print #1, txtemp$
   Close #1
End If
filerr:
End Sub




Private Sub doiu_Click()
SetWindowPos Me.hWnd, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOSIZE + SWP_NOMOVE
 SetWindowPos Form4.hWnd, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOSIZE + SWP_NOMOVE
 
 first.Enabled = True
 doiu.Enabled = False
End Sub

Private Sub eeret_Click()
mciSendString "Set CDAudio Door Open Wait", 0&, 0&, 0&
eeret.Enabled = False
jfsfhjhhl.Enabled = True
End Sub

Private Sub f11_Click()
Dim DlgInfo As DlgFileInfo
    Dim i As Integer
   
    On Error GoTo ErrHandle
    
   '  MMControl1.TimeFormat = 2
    List1.Clear
      
 
    With CommonDialog1
        .CancelError = True
       .MaxFileSize = 32767 '被打开的文件名尺寸设置为最大，即32K
        .Flags = cdlOFNHideReadOnly Or cdlOFNAllowMultiselect Or cdlOFNExplorer Or cdlOFNNoDereferenceLinks
        .DialogTitle = "选择文件"
        .Filter = "影视文件(*.Dat,*.Mpg,*.Avi,*.mov)|*.Dat;*.Mpg;*.Avi;*.mov|音频文件(*.wav,*.mp3,*.mid)|*.wav;*.MP3;*.mid|ALL File (*.*)|*.*"

        .ShowOpen
        DlgInfo = GetDlgSelectFileInfo(.FileName)
        .FileName = ""
    End With
   

    For i = 1 To DlgInfo.iCount
   List2.AddItem DlgInfo.sPath & DlgInfo.sFile(i)
    Next i
   List2.Selected(0) = True
 MMControl1.TimeFormat = 2
  MMControl1.DeviceType = "MpegVideo"
   MMControl1.Command = "play"
  MMControl1.FileName = List2.List(List2.ListIndex)
   On Error Resume Next
MMControl1.Command = "close"
MMControl1.DeviceType = "MpegVideo"
'MMControl1.FileName = List1.List(List1.Selected)
Form4.Show
MMControl1.hWndDisplay = Form4.Picture1.hWnd

MMControl1.Command = "open"