软件开发 英语学习播放器2010

“英语学习播放器2010”的开发过程
这个软件的开发,源于我学外语的时候,遇到的困难:
1:学外语,最大的问题是什么?是听力!但是常规的磁带、mp3、电影都有个问题,要想反反复复听某一句,不好定位。
2:练听力,有磁带,mp3,电影,那个最好?是电影!复读机可以不断重复,但是又不是影像的,不容易坚持。
我当年看电影《功夫熊猫》(中英双语)的时候,有些句子很快,使用暴风影音播放的时候,不断拉动进度条,因为一句话说得快的时候,就是几秒钟的功夫,在一个几十分钟的电影里,不容易定位,所以就开发了这个工具。
先介绍一下功能:
“打开”:打开英语电影,如“功夫熊猫.rmvb”(也可以右键选中“功夫熊猫.rmvb”,点“英语学习播放器2010”)

“清空”:删除“播放列表”全部的时间段
“删除”:删除“播放列表”当前的时间段
“播放”:循环播放“播放列表”当前的时间段

“向前”:倒退3秒播放
“向后”:快进3秒播放
“右键”:将“英语学习播放器”加到右键菜单

如播放英语电影至第5至8秒:
1:“开始”输入5
2:“结束”输入8
3:点“循环”,循环播放5-8秒内容
4:点“继续”,不循环播放了
5:点“保存”,将“5,8”保存至ini文件,下次播放时,可以自动播放这个时间段,无需重新输入这个时间段,对英语电影部分听不清楚的地方,尤其有用
 
下面是VB6源代码:
 
Option Explicit
Option Base 1
Dim T1 As Date
Dim VScroll1Value As Long
Dim nFileNo As Long
Dim strFileName As String
Dim strFileNameini As String
Dim i As Long
Dim Combo3_Text As String
Dim bCombo3 As Boolean
Dim strpath As String
Const HKEY_CLASSES_ROOT = &H80000000
Const ERROR_SUCCESS = 0&
Const REG_SZ = 1
Const SW_SHOW = 5
Private Declare Function GetCommandLine Lib "kernel32" Alias "GetCommandLineA" () As String
Private Declare Function GetCurrentTime Lib "kernel32" Alias "GetTickCount" () As Long
Private Declare Function OSRegCreateKey Lib "Advapi32" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpszSubKey As String, phkResult As Long) As Long
Private Declare Function OSRegSetValueEx Lib "Advapi32" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpszValueName As String, ByVal dwReserved As Long, ByVal fdwType As Long, lpbData As Any, ByVal cbData As Long) As Long
Private Declare Function ShellExecute Lib "Shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
 
Private Sub cmdPlay_Click() '播放
   Dim tmpPos1 As Long
   tmpPos1 = InStr(1, Combo3.Text, ",")
   If tmpPos1 > 1 Then
       Text1.Text = Left(Combo3.Text, tmpPos1 - 1)
       Text2.Text = Mid(Combo3.Text, tmpPos1 + 1)
       Call Command6_Click
   End If
   'MsgBox Combo3.Text
End Sub
Private Sub cmdSave_Click()
Dim tmpStr1 As String
Dim tmpStr2 As String
bCombo3 = False
If Not IsNumeric(Trim(Text1.Text)) Or Not IsNumeric(Trim(Text2.Text)) Then
   Exit Sub
End If
For i = 0 To Combo3.ListCount - 1
   Combo3.ListIndex = i
   If Combo3.Text = Trim(Text1.Text) & "," & Trim(Text2.Text) Then
      Exit Sub
   End If
Next
'Combo3.AddItem Trim(Text1.Text) & "," & Trim(Text2.Text)
tmpStr1 = Space(6 - Len(Trim(Text1.Text))) + Trim(Text1.Text)
tmpStr2 = Space(6 - Len(Trim(Text2.Text))) + Trim(Text2.Text)
Combo4.AddItem Replace(tmpStr1 + "," + tmpStr2, " ", "0")
Timer2.Enabled = True
End Sub
Private Sub Combo1_Click()
'  MsgBox Combo1.Text
End Sub
 
 
Private Sub Combo3_Click()
If Not bCombo3 Then Exit Sub
'MsgBox "Combo3_Click"
   If Combo3_Text <> Combo3.Text Then
       Call cmdPlay_Click
   End If
   bCombo3 = False
End Sub
Private Sub Combo3_DropDown()
'MsgBox "Combo3_DropDown"
    bCombo3 = True
    Combo3_Text = Combo3.Text
'MsgBox "Combo3_DropDown"
End Sub
Private Sub Command1_Click() '向前
'WindowsMediaPlayer1.Controls
'WindowsMediaPlayer1.Controls.currentPosition = CDate(Text1.Text) - CDate(Text2.Text) '
    WindowsMediaPlayer1.Controls.currentPosition = WindowsMediaPlayer1.Controls.currentPosition - Val(Combo1.Text)
End Sub
 
 
Private Sub Command10_Click()
   
    If Text3.Visible Then
       Text3.Text = ""
       Timer3.Enabled = False
       Text3.Visible = False
      
    Else
       Timer3.Enabled = True
       Text3.Visible = True
    End If
End Sub
Private Sub Command2_Click() '向后
    WindowsMediaPlayer1.Controls.currentPosition = WindowsMediaPlayer1.Controls.currentPosition + Val(Combo2.Text)
End Sub
Private Sub Command3_Click()
CommonDialog1.Filter = "所有文件 (*.*)|*.*|rmvb(*.rmvb)|*.rmvb|rm(*.rm)|*.rm|wmv(*.wmv)|*.wmv|avi(*.avi)|*.avi|mp3(*.mp3)|*.mp3|asf(*.asf)|*.asf"
            '指定缺省过滤器。
            CommonDialog1.FilterIndex = 1
            '显示“打开”对话框。
            CommonDialog1.ShowOpen
            '调用打开文件的过程。
            'MsgBox CommonDialog1.FileName & vbCrLf & strFileName
           
            If strFileName = CommonDialog1.FileName Then '防止打开现在播放中的电影
               Exit Sub
            End If
            strFileName = CommonDialog1.FileName
            'Me.Caption = strFileName
       Call GetININame
End Sub
Private Sub Command4_Click()
    Timer1.Enabled = False
    'Text1.Text = "开始"
    'Text2.Text = "结尾"
End Sub
Private Sub Command5_Click() '清空
If MsgBox("真的要删除播放列表?", vbCritical, "提示") = vbOK Then
    Combo3.Clear
    'Call SaveCombo3
End If
End Sub
Private Sub Command6_Click()
    'If Command6.Caption = "循环" Then
      ' Command6.Caption = "不循环"
       'Timer1.Enabled = False
       'Text1.Text = "开始"
       'Text2.Text = "结尾"
    'ElseIf Command6.Caption = "不循环" Then
       'Command6.Caption = "循环"
       If Trim(Text1.Text) = "" And Trim(Text2.Text) = "" Or Trim(Text1.Text) = "0" And Trim(Text2.Text) = "0" Then
           Text1.Text = "0"
           Text2.Text = WindowsMediaPlayer1.currentMedia.duration - 0.3
       End If
       WindowsMediaPlayer1.Controls.currentPosition = Val(Text1.Text)
       Timer1.Enabled = True
       WindowsMediaPlayer1.Controls.play
       'Text1.Text = "Click here to get the time for starting play"
       'Text2.Text = "Click here to get the time for endding play"
    'End If
End Sub

Private Sub xzPaiXu(a() As Double, sheng As Boolean)
    'a为需要排序的数组,sheng为True则为升序排列,为False,则为降序排列。
    Dim i As Integer, j As Integer
    Dim temp As Double
    Dim m As Integer
    For i = LBound(a) To UBound(a) - 1 '进行数组大小-1轮比较
    m = i '在第i轮比较时,假定第
    'i个元素为最值元素
    For j = i + 1 To UBound(a) '在剩下的元素中找出最
    '值元素的下标并记录在m中
    If sheng Then '若为升序,则m记录最小元素
    '下标,否则记录最大元素下标
    If a(j) < a(m) Then m = j
    Else
    If a(j) > a(m) Then m = j
    End If
    Next j '将最值元素与第i个元素交换
    temp = a(i)
    a(i) = a(m)
    a(m) = temp
    Next i
    End Sub
'调用该过程示例:
    '
    Private Sub Command7_Click0()
    'Text3.Text = ""
    Dim b(6) As Double
    b(1) = 8
    b(2) = 6
    b(3) = 6
    b(4) = 3
    b(5) = 2
    b(6) = 7
    'Call xzPaiXu(b, True)
    Call Quicksort(b, 1, 6)
    For i = 1 To UBound(b)
   
       ' Text3.Text = Text3.Text & b(i) & vbCrLf
    Next
    End Sub

Sub Quicksort(List() As Double, min As Integer, max As Integer)
Dim med_value As Long
Dim hi As Integer
Dim lo As Integer
Dim i As Integer
    ' If the list has no more than 1 element, it's sorted.
    If min >= max Then Exit Sub
    ' Pick a dividing item.
    i = Int((max - min + 1) * Rnd + min)
    med_value = List(i)
    ' Swap it to the front so we can find it easily.
    List(i) = List(min)
    ' Move the items smaller than this into the left
    ' half of the list. Move the others into the right.
    lo = min
    hi = max
    Do
        ' Look down from hi for a value < med_value.
        Do While List(hi) >= med_value
            hi = hi - 1
            If hi <= lo Then Exit Do
        Loop
        If hi <= lo Then
            List(lo) = med_value
            Exit Do
        End If
        ' Swap the lo and hi values.
        List(lo) = List(hi)
       
        ' Look up from lo for a value >= med_value.
        lo = lo + 1
        Do While List(lo) < med_value
            lo = lo + 1
            If lo >= hi Then Exit Do
        Loop
        If lo >= hi Then
            lo = hi
            List(hi) = med_value
            Exit Do
        End If
        ' Swap the lo and hi values.
        List(hi) = List(lo)
    Loop
    ' Sort the two sublists
    Quicksort List(), min, lo - 1
    Quicksort List(), lo + 1, max
End Sub
 
 
 
 
 
 
 

Private Sub Command7_Click()
   Call RegMedia
End Sub
 
 

Private Sub Command9_Click() '删除
Dim tmpStr As String
Dim tmpStr1 As String
Dim tmpStr2 As String
Dim Combo3_ListIndex As Long
Dim tmpPos1 As Long
Dim tmpPos2 As Long

Combo3_ListIndex = Combo3.ListIndex
If Combo3_ListIndex > -1 And Combo3_ListIndex < Combo3.ListCount Then
    tmpStr = Trim(Combo3.Text)
    tmpPos1 = InStr(1, tmpStr, ",")
    If tmpPos1 > 0 Then
       tmpStr1 = Left(tmpStr, tmpPos1 - 1)
       tmpStr2 = Mid(tmpStr, tmpPos1 + 1)
       tmpStr1 = Space(6 - Len(tmpStr1)) + tmpStr1
       tmpStr2 = Space(6 - Len(tmpStr2)) + tmpStr2
       tmpStr = Replace(tmpStr1 + "," + tmpStr2, " ", "0")
       For i = 0 To Combo4.ListCount - 1
            Combo4.ListIndex = i
            If Combo4.Text = tmpStr Then
               Combo4.RemoveItem (i)
               Exit For
            End If
       Next
   
   
       Combo3.RemoveItem (Combo3.ListIndex)
    End If
End If
If Combo3_ListIndex > (Combo3.ListCount - 1) Then
   Combo3.ListIndex = Combo3.ListCount - 1
Else
   Combo3.ListIndex = Combo3_ListIndex
End If
'写入到ini文件
Call SaveCombo3
End Sub
Private Sub Form_Load()
   
    Combo3_Text = ""
    Combo4.Visible = False
    Text1.Text = "开始"
    Text2.Text = "结尾"
T1 = Now()
Dim tmpCommand As String
'tmpStr = GetCommandLine()
strFileName = Command  '这个就是使得exe可以打开一个媒体文件
'MsgBox strFileName
'If strFileName <> "" Then
If Trim(strFileName) = "" Then Exit Sub
 '去除文件名两边的双引号(如果存在的话)
If (Left$(strFileName, 1) = """") And (Right$(strFileName, 1) = """") Then
        strFileName = Mid$(strFileName, 2, Len(strFileName) - 2)
End If
WindowsMediaPlayer1.URL = strFileName
 WindowsMediaPlayer1.Controls.play
Timer1.Enabled = False
Call GetCombo1
 Text3.ForeColor = vbRed

strFileName = Command$()
'MsgBox strFileName ': End
'Me.Caption = strFileName
If strFileName <> "" Then
   Call GetININame
End If
End Sub
Private Sub Form_Resize()
   'FormResize
  ' Command1.Height = Me.Height - 500
  ' Command1.Width = Me.Width
   WindowsMediaPlayer1.Left = 0
   WindowsMediaPlayer1.Top = 0
   WindowsMediaPlayer1.Height = Me.Height - 450
   WindowsMediaPlayer1.Width = Me.Width
   Frame1.Top = WindowsMediaPlayer1.Height - (Frame1.Height + 80)
   Frame1.Left = Me.Width - (Frame1.Width + 200)
  
   Text3.Top = Frame1.Top - Text3.Height - 300
   Text3.Left = WindowsMediaPlayer1.Left + WindowsMediaPlayer1.Width - Text3.Width - 200
  
End Sub
 
Private Sub Text1_Click()
Text1.Text = Int(WindowsMediaPlayer1.Controls.currentPosition)
End Sub
Private Sub Text2_Click()
Text2.Text = Int(WindowsMediaPlayer1.Controls.currentPosition)
End Sub
Private Sub Timer1_Timer()
'Text1.Text = WindowsMediaPlayer1.Controls.currentPositionString
'Text1.Text = WindowsMediaPlayer1.Controls.currentPosition
If Val(Trim(Text2.Text)) = 0 Then Exit Sub
If Val(Trim(Text1.Text)) > Val(Trim(Text2.Text)) Then Exit Sub
If WindowsMediaPlayer1.Controls.currentPosition > Val(Text2.Text) Then
   WindowsMediaPlayer1.Controls.stop
   WindowsMediaPlayer1.Controls.currentPosition = Val(Text1.Text)
   WindowsMediaPlayer1.Controls.play
End If
End Sub
Private Sub VScroll1_Change()
   'If Val(Text2.Text) - 'VScroll1.Value > 0 Then
     
      'If 'VScroll1.Value = 0 Then
      '   'VScroll1.Value = 1
      '   VScroll1Value = 'VScroll1.Value
      'End If Val(Text2.Text) - VScroll1Value +
      'Text2.Text = 'VScroll1.Value
     ' Text2.Text = 'VScroll1.Value
   'End If
End Sub

Private Sub GetCombo1()
  Combo1.AddItem "3"
  Combo1.AddItem "5"
  Combo1.AddItem "8"
  Combo1.AddItem "10"
  Combo1.AddItem "15"
  Combo1.AddItem "20"
  Combo1.AddItem "25"
  Combo1.AddItem "30"
  Combo1.AddItem "35"
  Combo1.AddItem "40"
  Combo1.AddItem "45"
  Combo1.AddItem "50"
  Combo1.AddItem "55"
  Combo1.AddItem "60"
  Combo1.ListIndex = 0
 
  Combo2.AddItem "3"
  Combo2.AddItem "5"
  Combo2.AddItem "8"
  Combo2.AddItem "10"
  Combo2.AddItem "15"
  Combo2.AddItem "20"
  Combo2.AddItem "25"
  Combo2.AddItem "30"
  Combo2.AddItem "35"
  Combo2.AddItem "40"
  Combo2.AddItem "45"
  Combo2.AddItem "50"
  Combo2.AddItem "55"
  Combo2.AddItem "60"
  Combo2.ListIndex = 0
End Sub
 

Private Sub FormResize()
   'Me.MaxButton.Click
   WindowsMediaPlayer1.Top = Form1.Top
   WindowsMediaPlayer1.Left = Me.Left
   WindowsMediaPlayer1.Height = Me.Height - 500
   WindowsMediaPlayer1.Width = Me.Width
  
   Command1.Top = WindowsMediaPlayer1.Height - 500
   Command1.Left = WindowsMediaPlayer1.Width - 5500
  
   Command2.Top = Command1.Top
   Command2.Left = Command1.Left + Command1.Width + 100
  
   Command3.Top = Command1.Top
   Command3.Left = Command1.Left - Command3.Width - 100
  
   Combo1.Top = Command1.Top + 80
   Combo1.Left = Command1.Left + 500
  
   Combo2.Top = Command2.Top + 80
   Combo2.Left = Command2.Left + 500
End Sub
Private Sub GetCombo300()
   Dim tmpStr As String
   Dim tmpPos1 As Long
   nFileNo = FreeFile
   Open strFileNameini For Input As #nFileNo
      Do While Not EOF(nFileNo)
         Line Input #nFileNo, tmpStr
         If Len(Trim(tmpStr)) > 2 Then
            tmpPos1 = InStr(1, tmpStr, ",")
            If tmpPos1 > 1 Then
               If IsNumeric(Left(tmpStr, tmpPos1 - 1)) Then
                  If IsNumeric(Mid(tmpStr, tmpPos1 + 1)) Then
                      Combo3.AddItem Trim(Replace(tmpStr, ",", ","))
                  End If
               End If
            End If
         End If
         DoEvents
      Loop
   Close #nFileNo
   If Combo3.ListCount > 0 Then
       Combo3.ListIndex = 0
   End If
End Sub
Private Sub GetCombo3()
   Dim tmpStr As String
   Dim tmpStr1 As String
   Dim tmpStr2 As String
  
   Dim tmpPos1 As Long
   Dim tmpPos2 As Long
   Timer2.Enabled = False
   If Combo4.ListCount > 0 Then
       Combo3.Clear
       Combo3.Refresh
       For i = 0 To Combo4.ListCount - 1
           'i = 0
          
           Combo4.ListIndex = i
           tmpStr = Trim(Combo4.Text)
           'MsgBox tmpStr
           tmpPos1 = InStr(1, tmpStr, ",")
           'MsgBox tmpPos1
           If tmpPos1 > 0 Then
              tmpStr1 = Trim(Str(Val(Left(tmpStr, tmpPos1 - 1))))
              tmpStr2 = Trim(Str(Val(Mid(tmpStr, tmpPos1 + 1))))
              'Combo5.AddItem tmpStr1 + "," + tmpStr2
              Combo3.AddItem tmpStr1 + "," + tmpStr2
           End If
       Next
       If Combo3.ListCount > 0 Then
          Combo3.ListIndex = 0
       End If
       'If Combo5.ListCount > 0 Then
       '   Combo5.ListIndex = 0
       'End If
       Call SaveCombo3
   End If
End Sub
Private Sub GetCombo4()
   Dim tmpStr As String
   Dim tmpStr1 As String
   Dim tmpStr2 As String
  
   Dim tmpPos1 As Long
   Dim tmpPos2 As Long
   Dim bCombo4 As Boolean
  
   nFileNo = FreeFile
   Open strFileNameini For Input As #nFileNo
      Combo4.Clear
      Do While Not EOF(nFileNo)
         Line Input #nFileNo, tmpStr
         bCombo4 = False
         If Len(Trim(tmpStr)) > 2 Then
            tmpPos1 = InStr(1, tmpStr, ",")
            If tmpPos1 > 1 Then
               tmpStr1 = Left(tmpStr, tmpPos1 - 1)
               tmpStr2 = Mid(tmpStr, tmpPos1 + 1)
               If IsNumeric(tmpStr1) Then
                  If IsNumeric(tmpStr2) Then
                      tmpStr1 = Space(6 - Len(tmpStr1)) + tmpStr1
                      tmpStr2 = Space(6 - Len(tmpStr2)) + tmpStr2
                      tmpStr = Replace(tmpStr1 + "," + tmpStr2, " ", "0")
                      'For i = 0 To Combo4.ListCount - 1
                      '     Combo4.ListIndex = i
                      '     If Combo4.Text = tmpStr Then
                      '        bCombo4 = True
                      '        Exit For
                      '     End If
                      'Next
                      'If Not bCombo4 Then
                         Combo4.AddItem tmpStr
                      'End If
                  End If
               End If
            End If
         End If
         DoEvents
      Loop
   Close #nFileNo
   If Combo4.ListCount > 0 Then
       Combo4.ListIndex = 0
   End If
   Timer2.Enabled = True
End Sub
Private Sub SaveCombo3()
nFileNo = FreeFile
Open strFileNameini For Output As #nFileNo
   If Combo3.ListCount > 0 Then
       For i = 0 To Combo3.ListCount - 1
           Combo3.ListIndex = i
           Print #nFileNo, Combo3.Text
       Next
       Combo3.ListIndex = 0
   Else
       Print #nFileNo, ""
   End If
Close #nFileNo
End Sub

Private Sub Timer2_Timer()
Call GetCombo3
End Sub
Public Sub RegMedia()
    On Error Resume Next
   
    Dim ret1 As Long, hKey As Long, hkey1 As Long, strdata As String
    Dim tmpFileNo As Long
   
    Kill "c:\1.reg"
   
    tmpFileNo = FreeFile
    Open "c:\1.reg" For Output As tmpFileNo
       Print #tmpFileNo, "Windows Registry Editor Version 5.00"
       Print #tmpFileNo, ""
       Print #tmpFileNo, "[HKEY_CLASSES_ROOT\*\shell\英语学习播放器2010\command]"
       Print #tmpFileNo, "@=""" & Replace(App.Path, "\", "\\") & "\\英语学习播放器2010.exe %1"""
    Close #tmpFileNo
   
   
   
    strdata = "英语学习播放器2010"
    ret1 = OSRegCreateKey(HKEY_CLASSES_ROOT, ".swf", hKey)
    ret1 = OSRegSetValueEx(hKey, "", 0&, REG_SZ, ByVal strdata, LenB(StrConv(strdata, vbFromUnicode)) + 1)
   
    ret1 = OSRegCreateKey(HKEY_CLASSES_ROOT, "英语学习播放器2010", hKey)
    strdata = "英语学习播放器2010"
    ret1 = OSRegSetValueEx(hKey, "", 0&, REG_SZ, ByVal strdata, LenB(StrConv(strdata, vbFromUnicode)) + 1)
    ret1 = OSRegCreateKey(hKey, "DefaultIcon", hkey1)
    strdata = App.Path & "\英语学习播放器2010.exe, 0" '应根据具体情况更改路径
    ret1 = OSRegSetValueEx(hkey1, "", 0&, REG_SZ, ByVal strdata, LenB(StrConv(strdata, vbFromUnicode)) + 1)
    ret1 = OSRegCreateKey(hKey, "shell", hKey)
    ret1 = OSRegCreateKey(hKey, "open", hKey)
    ret1 = OSRegCreateKey(hKey, "command", hkey1)
    strdata = App.Path & "\英语学习播放器2010.exe" & Chr(34) & "%1" & Chr(34)
    ret1 = OSRegSetValueEx(hkey1, "", 0&, REG_SZ, ByVal strdata, LenB(StrConv(strdata, vbFromUnicode)) + 1)
    'Debug.Print hKey
   
    ret1 = OSRegCreateKey(HKEY_CLASSES_ROOT, ".rm", hKey)
    ret1 = OSRegSetValueEx(hKey, "", 0&, REG_SZ, ByVal strdata, LenB(StrConv(strdata, vbFromUnicode)) + 1)
   
    ret1 = OSRegCreateKey(HKEY_CLASSES_ROOT, "英语学习播放器2010", hKey)
    strdata = "英语学习播放器2010"
    ret1 = OSRegSetValueEx(hKey, "", 0&, REG_SZ, ByVal strdata, LenB(StrConv(strdata, vbFromUnicode)) + 1)
    ret1 = OSRegCreateKey(hKey, "DefaultIcon", hkey1)
    strdata = App.Path & "\英语学习播放器2010.exe, 0" '应根据具体情况更改路径
    ret1 = OSRegSetValueEx(hkey1, "", 0&, REG_SZ, ByVal strdata, LenB(StrConv(strdata, vbFromUnicode)) + 1)
    ret1 = OSRegCreateKey(hKey, "shell", hKey)
    ret1 = OSRegCreateKey(hKey, "open", hKey)
    ret1 = OSRegCreateKey(hKey, "command", hkey1)
    strdata = App.Path & "\英语学习播放器2010.exe" & Chr(34) & "%1" & Chr(34)
    ret1 = OSRegSetValueEx(hkey1, "", 0&, REG_SZ, ByVal strdata, LenB(StrConv(strdata, vbFromUnicode)) + 1)
    'Debug.Print hKey
   
   
    ret1 = OSRegCreateKey(HKEY_CLASSES_ROOT, ".rmvb", hKey)
    ret1 = OSRegSetValueEx(hKey, "", 0&, REG_SZ, ByVal strdata, LenB(StrConv(strdata, vbFromUnicode)) + 1)
   
    ret1 = OSRegCreateKey(HKEY_CLASSES_ROOT, "英语学习播放器2010", hKey)
    strdata = "英语学习播放器2010"
    ret1 = OSRegSetValueEx(hKey, "", 0&, REG_SZ, ByVal strdata, LenB(StrConv(strdata, vbFromUnicode)) + 1)
    ret1 = OSRegCreateKey(hKey, "DefaultIcon", hkey1)
    strdata = App.Path & "\英语学习播放器2010.exe, 0" '应根据具体情况更改路径
    ret1 = OSRegSetValueEx(hkey1, "", 0&, REG_SZ, ByVal strdata, LenB(StrConv(strdata, vbFromUnicode)) + 1)
    ret1 = OSRegCreateKey(hKey, "shell", hKey)
    ret1 = OSRegCreateKey(hKey, "open", hKey)
    ret1 = OSRegCreateKey(hKey, "command", hkey1)
    strdata = App.Path & "\英语学习播放器2010.exe" & Chr(34) & "%1" & Chr(34)
    ret1 = OSRegSetValueEx(hkey1, "", 0&, REG_SZ, ByVal strdata, LenB(StrConv(strdata, vbFromUnicode)) + 1)
    'Debug.Print hKey
   
    ret1 = OSRegCreateKey(HKEY_CLASSES_ROOT, ".wmv", hKey)
    ret1 = OSRegSetValueEx(hKey, "", 0&, REG_SZ, ByVal strdata, LenB(StrConv(strdata, vbFromUnicode)) + 1)
   
    ret1 = OSRegCreateKey(HKEY_CLASSES_ROOT, "英语学习播放器2010", hKey)
    strdata = "英语学习播放器2010"
    ret1 = OSRegSetValueEx(hKey, "", 0&, REG_SZ, ByVal strdata, LenB(StrConv(strdata, vbFromUnicode)) + 1)
    ret1 = OSRegCreateKey(hKey, "DefaultIcon", hkey1)
    strdata = App.Path & "\英语学习播放器2010.exe, 0" '应根据具体情况更改路径
    ret1 = OSRegSetValueEx(hkey1, "", 0&, REG_SZ, ByVal strdata, LenB(StrConv(strdata, vbFromUnicode)) + 1)
    ret1 = OSRegCreateKey(hKey, "shell", hKey)
    ret1 = OSRegCreateKey(hKey, "open", hKey)
    ret1 = OSRegCreateKey(hKey, "command", hkey1)
    strdata = App.Path & "\英语学习播放器2010.exe" & Chr(34) & "%1" & Chr(34)
    ret1 = OSRegSetValueEx(hkey1, "", 0&, REG_SZ, ByVal strdata, LenB(StrConv(strdata, vbFromUnicode)) + 1)
    'Debug.Print hKey
   
   
    ret1 = OSRegCreateKey(HKEY_CLASSES_ROOT, ".asf", hKey)
    ret1 = OSRegSetValueEx(hKey, "", 0&, REG_SZ, ByVal strdata, LenB(StrConv(strdata, vbFromUnicode)) + 1)
   
    ret1 = OSRegCreateKey(HKEY_CLASSES_ROOT, "英语学习播放器2010", hKey)
    strdata = "英语学习播放器2010"
    ret1 = OSRegSetValueEx(hKey, "", 0&, REG_SZ, ByVal strdata, LenB(StrConv(strdata, vbFromUnicode)) + 1)
    ret1 = OSRegCreateKey(hKey, "DefaultIcon", hkey1)
    strdata = App.Path & "\英语学习播放器2010.exe, 0" '应根据具体情况更改路径
    ret1 = OSRegSetValueEx(hkey1, "", 0&, REG_SZ, ByVal strdata, LenB(StrConv(strdata, vbFromUnicode)) + 1)
    ret1 = OSRegCreateKey(hKey, "shell", hKey)
    ret1 = OSRegCreateKey(hKey, "open", hKey)
    ret1 = OSRegCreateKey(hKey, "command", hkey1)
    strdata = App.Path & "\英语学习播放器2010.exe" & Chr(34) & "%1" & Chr(34)
    ret1 = OSRegSetValueEx(hkey1, "", 0&, REG_SZ, ByVal strdata, LenB(StrConv(strdata, vbFromUnicode)) + 1)
    'Debug.Print hKey
   
    ret1 = OSRegCreateKey(HKEY_CLASSES_ROOT, ".mp3", hKey)
    ret1 = OSRegSetValueEx(hKey, "", 0&, REG_SZ, ByVal strdata, LenB(StrConv(strdata, vbFromUnicode)) + 1)
   
    ret1 = OSRegCreateKey(HKEY_CLASSES_ROOT, "英语学习播放器2010", hKey)
    strdata = "英语学习播放器2010"
    ret1 = OSRegSetValueEx(hKey, "", 0&, REG_SZ, ByVal strdata, LenB(StrConv(strdata, vbFromUnicode)) + 1)
    ret1 = OSRegCreateKey(hKey, "DefaultIcon", hkey1)
    strdata = App.Path & "\英语学习播放器2010.exe, 0" '应根据具体情况更改路径
    ret1 = OSRegSetValueEx(hkey1, "", 0&, REG_SZ, ByVal strdata, LenB(StrConv(strdata, vbFromUnicode)) + 1)
    ret1 = OSRegCreateKey(hKey, "shell", hKey)
    ret1 = OSRegCreateKey(hKey, "open", hKey)
    ret1 = OSRegCreateKey(hKey, "command", hkey1)
    strdata = App.Path & "\英语学习播放器2010.exe" & Chr(34) & "%1" & Chr(34)
    ret1 = OSRegSetValueEx(hkey1, "", 0&, REG_SZ, ByVal strdata, LenB(StrConv(strdata, vbFromUnicode)) + 1)
    'Debug.Print hKey
   
   
    ret1 = OSRegCreateKey(HKEY_CLASSES_ROOT, ".avi", hKey)
    ret1 = OSRegSetValueEx(hKey, "", 0&, REG_SZ, ByVal strdata, LenB(StrConv(strdata, vbFromUnicode)) + 1)
   
    ret1 = OSRegCreateKey(HKEY_CLASSES_ROOT, "英语学习播放器2010", hKey)
    strdata = "英语学习播放器2010"
    ret1 = OSRegSetValueEx(hKey, "", 0&, REG_SZ, ByVal strdata, LenB(StrConv(strdata, vbFromUnicode)) + 1)
    ret1 = OSRegCreateKey(hKey, "DefaultIcon", hkey1)
    strdata = App.Path & "\英语学习播放器2010.exe, 0" '应根据具体情况更改路径
    ret1 = OSRegSetValueEx(hkey1, "", 0&, REG_SZ, ByVal strdata, LenB(StrConv(strdata, vbFromUnicode)) + 1)
    ret1 = OSRegCreateKey(hKey, "shell", hKey)
    ret1 = OSRegCreateKey(hKey, "open", hKey)
    ret1 = OSRegCreateKey(hKey, "command", hkey1)
    strdata = App.Path & "\英语学习播放器2010.exe" & Chr(34) & "%1" & Chr(34)
    ret1 = OSRegSetValueEx(hkey1, "", 0&, REG_SZ, ByVal strdata, LenB(StrConv(strdata, vbFromUnicode)) + 1)
    'Debug.Print hKey
    Shell "regedit.exe /s c:\1.reg"
    Kill "c:\1.reg"
End Sub
Private Sub Timer3_Timer()
   Text3.Text = Val(Trim(Text3.Text)) + 1
End Sub
Public Sub GetININame()
           
            If strFileName <> "" Then
                Dim tmpPos1 As Long
                Text1.Text = ""
                Text2.Text = ""
                Combo3.Clear
                Combo3.Refresh
                tmpPos1 = InStrRev(strFileName, ".")
                strFileNameini = Left(strFileName, tmpPos1) + "ini"
                If Dir(strFileNameini) <> "" Then
                   'Call GetCombo3
                   Call GetCombo4
                Else
                   Combo4.Clear
                   Combo4.Refresh
                End If
                WindowsMediaPlayer1.URL = strFileName
                WindowsMediaPlayer1.Controls.play
            End If
End Sub

你可能感兴趣的:(播放器,源代码,软件开发,vb,英语学习播放器)