form1.frm

hdl_dump(ps2灌硬盘的软件)的gui 含大量api

       Else
          Combo1.AddItem "local  " & temp
       End If
    Else
    End If
Next i

'添加网络硬盘，多加一空格，统一格式
Combo1.AddItem "LAN    " & Text1(1).Text & " "

'查找本地光驱的代码
For i = 0 To 4
    a = InStr(info, "cd" & i & ": ")
    If a <> 0 Then
       '每个光驱信息
       b = InStr(a, info, Chr$(13))
       Combo1.AddItem "local  " & RTrim(Mid$(info, a, b - a))
    Else
    End If
Next i

'查找SPTI光驱的代码
For i = 97 To 122
    a = InStr(info, Chr$(i) & ": ")
    If a <> 0 Then
       '每个光驱信息
       b = InStr(a, info, Chr$(13))
       Combo1.AddItem "SPTI   " & RTrim(Mid$(info, a, b - a))
    Else
    End If
Next i

'查找ASPI光驱的代码
a = InStr(info, "Unable to initialize ASPI")
  If a <> 0 Then
     MsgBox "ASPI设备没有正确安装！"
     Exit Sub
  Else
    For i = 0 To 3
      For c = 0 To 1
         a = InStr(info, "cd" & i & ":" & c & ":0")
         If a <> 0 Then
            '每个光驱信息
            b = InStr(a, info, Chr$(13))
            Combo1.AddItem "ASPI   " & RTrim(Mid$(info, a, b - a))
         Else
         End If
      Next c
    Next i
  End If
  
End Sub
Private Function src() As String
                 Dim a As Long
                     a = InStr(8, Combo1.Text, " ")
                 src = Mid$(Combo1.Text, 8, a - 8)
End Function



Private Function des() As String
                 Dim a As Long
                     a = InStr(8, Combo3.Text, " ")
                 des = Mid$(Combo3.Text, 8, a - 7)
End Function





Private Function chknet(ByVal info As String) As Long
   If objDOS.ExecuteCommand$("ping " & info & " -w 2500 -n 1") Like "*(100% loss)*" Then
      '设置了ping xxx 一次2.5秒的检查接通时间
      chknet = 0 '无法接通退出
      Exit Function
   ElseIf Len(objDOS.ExecuteCommand$("hdl_dump diag " & info)) > 5 Then
      '判断PS2格式
      chknet = 1 '可接通但不是ps2或损坏
   Else
      chknet = 2 '可接通ps2
   End If
End Function

Private Function getname() As String

    Dim i As Long
    Dim a As Long
    Dim idinfo As String
    Dim temp As String
    Dim tempgetname As String
    
    tempgetname = "*" 'no match
    a = 1
    For i = 1 To 3
        a = InStr(a + 1, Label2, Chr$(34))
    Next i
    idinfo = Replace$(Replace$(Mid$(Label2, a + 1, 11), "_", "-"), ".", "")
    Open "iddata" For Input As #1
      Do While Not EOF(1)
           Line Input #1, temp
         '查找id信息
         If InStr(temp, idinfo) <> 0 Then
            temp = Mid$(temp, 11)
               a = InStr(temp, "NTSC-")
               If a = 0 Then
                  a = InStr(temp, "PAL-")
                  If a = 0 Then
                     MsgBox "未查到版本信息！确认数据的完整性！"
                     tempgetname = "*"
                     Exit Do
                  End If
               End If
            
            tempgetname = InputBox("确定使用这个名字?", "游戏版本: " & Mid$(temp, a), Mid$(temp, 1, a - 1))
            
            Exit Do
         End If
      Loop
    Close #1

If tempgetname = "*" Then
       tempgetname = InputBox("自行输入游戏名称，建议升级数据库！", "未找到有效数据！")

End If


            
            If Len(tempgetname) = 0 Or Len(tempgetname) > 40 Or tempgetname Like "* " Then '判断字符非空，不以空格结尾
               MsgBox "游戏名称介于1-40个字符并且不能以空格结尾！"
               getname = ""
               Exit Function
            End If
            
            '判断字符为字母或数字
            i = 1
            For i = 1 To Len(tempgetname)
            If Not Mid$(tempgetname, i, 1) Like "[A-Za-z0-9 .-]" Then
              tempgetname = Replace$(tempgetname, Mid$(tempgetname, i, 1), ".")
            End If
            Next i
            If MsgBox("过滤后的游戏名称:" & tempgetname, vbYesNo) = 6 Then
               getname = tempgetname
            Else
               getname = ""
            End If
            


End Function







Private Sub iso2PS2()
Dim info As String
Dim a As Long
Dim OFN As OPENFILENAME
   
   '打开镜像
   With OFN
      .nStructSize = Len(OFN)
      .hWndOwner = Me.hwnd
      .sFile = "Image.iso" & Space$(128) & vbNullChar & vbNullChar
      .nMaxFile = Len(.sFile)
      .sDefFileExt = "iso" & vbNullChar & vbNullChar
      .sFileTitle = vbNullChar & Space$(64) & vbNullChar & vbNullChar
      .nMaxTitle = Len(OFN.sFileTitle)
      .sFilter = "镜像文件" & vbNullChar & "*.iso;*.cue" & vbNullChar & vbNullChar
      .sDialogTitle = "打开镜像文件"
      .flags = 3678752
   End With
   
   a = GetOpenFileName(OFN)
         ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
      '''''''''''''''''''''''江路经转会，待改进
      ChDrive (Left(App.Path, 1))
      ChDir (App.Path)
   If a >= 1 Then
      info = objDOS.ExecuteCommand$("hdl_dump.exe cdvd_info2 " & Chr$(34) & OFN.sFile & Chr$(34))

      If info Like "[CD DVD dual-layer]*####KB *" Then
         Label2 = OFN.sFile
         Label2 = Label2 & ">" & info
      Else
         Label2 = "无效的镜像！"
      End If
   Else
      Label2 = "无效的镜像！"
   End If
End Sub







Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If way = 99 And X = 7770 Then
   If MsgBox("终止进程", vbYesNo) = 6 Then way = -1 '传入信号
End If
End Sub

Private Sub Form_Terminate()
    ''''''''''''''''''''''''''''''''''''''''''''''
    '''''''Terminate方法不可撤销关闭窗体的动作
    '''''''''''''''''''''''''''''''''''''''''''''
    Call HideIcon
    Set objDOS = Nothing
    
End Sub



Private Sub objDOS_ReceiveOutputs(CommandOutputs As String)

DoEvents '不独占进程
    Dim info As String
    Dim a As Long
    Dim b As Long
       

       info = CommandOutputs
       '处理字符串

       If Len(info) <> 0 Then   '避免info出现空字
          info = StrReverse$(Trim$(info)) '保证取得最后一个字段
          a = InStr(info, Chr$(13)) '寻找第一个结束点
          If a <> 0 Then
             b = InStr(a + 1, info, Chr$(13)) '寻找第二个结束点
             If b <> 0 Then
                If b - a < 3 Then
                   info = StrReverse$(info)
                Else
                   info = StrReverse$(Mid$(info, a + 1, b - a - 1)) '取得正常字符
                End If
             Else
                info = StrReverse$(info)
             End If
          Else
             info = "正在读取信息"
          End If
          info = Trim$(Replace$(Replace$(info, Chr$(13), ""), Chr$(10), ""))
          Call NewIcon(info)
          lastinfo = info
       Else
       End If

DoEvents '不独占进程，写信息，放在这比较快
End Sub





Private Sub getlist(ByVal info As String)
    Dim a As Long
    Dim b As Long
    Dim z As Long
    '写列表头
    If info = "hdl_dump.exe hdl_toc " Then
       Call view("媒体     大小            选项 启动标示     名称")
    ElseIf info = "hdl_dump.exe toc " Then
       Call view("类型   起始地址   块数  大小 名称")
    Else
       MsgBox "erro"
       End
    End If
    
    '取得相应信息
    info = objDOS.ExecuteCommand$(info & src)
    z = Len(info)
    b = 1

    '添加列表
    Do
      '取开头chr$(10)
      a = InStr(b, info, Chr$(10))
      '取结尾chr$(13)
      b = InStr(a, info, Chr$(13))
      If b = z - 1 Then
        Exit Do
      End If
      Combo3.AddItem RTrim$(Mid$(info, a + 1, b - a - 1))
    Loop
    Label2 = Mid$(info, a + 1, b - a - 1)
End Sub

Private Sub getPS2()
 '查找可用PS2硬盘
   Dim i As Long
   For i = 0 To Combo1.ListCount - 1
       If Combo1.List(i) Like "LAN    #*" Then
          If chknet(Mid$(Combo1.List(i), 8, InStr(8, Combo1.List(i), " ") - 8)) = 2 Then
             Combo3.AddItem Combo1.List(i)
          End If
       ElseIf Combo1.List(i) Like "PS2    hdd*" Then
             Combo3.AddItem Combo1.List(i)
       End If
   Next i
End Sub



Private Sub cd2local()
Dim info As String
Dim a As Long
Dim OFN As OPENFILENAME
   
   '储存镜像
   With OFN
      .nStructSize = Len(OFN)
      .hWndOwner = Me.hwnd
      .sFile = "Image.iso" & Space$(128) & vbNullChar & vbNullChar
      .nMaxFile = Len(.sFile)
      .sDefFileExt = "iso" & vbNullChar & vbNullChar
      .sFileTitle = vbNullChar & Space$(64) & vbNullChar & vbNullChar
      .nMaxTitle = Len(OFN.sFileTitle)
      .sFilter = "镜像文件" & vbNullChar & "*.iso" & vbNullChar & vbNullChar
      .sDialogTitle = "储存镜像文件"
      .flags = 2621478
   End With
   
   a = GetSaveFileName(OFN)
         ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
      '''''''''''''''''''''''江路经转会，待改进
      ChDrive (Left(App.Path, 1))
      ChDir (App.Path)
   If a >= 1 Then
      If Len(Dir(OFN.sFile)) <> 0 Then
         a = MsgBox("确实要删除已存在的镜像:" & OFN.sFile, vbOKCancel)
         Select Case a
                Case 1
                     Kill OFN.sFile
                     Label2 = OFN.sFile
                Case 2
                     Label2 = "无效的镜像！"
                Case Else
                     MsgBox "错误!"
                     End
         End Select
      Else
         Label2 = OFN.sFile
      End If
   Else
      Label2 = "无效的镜像！"
   End If
End Sub



Private Sub Combo1_Click()
'初始化
Label2 = ""
Combo2.Clear
Combo2.Enabled = False
Combo3.Clear
Combo3.Enabled = False
Call noview

If Combo1.Text Like "local  hdd0: *" Then
   Combo2.AddItem "本地镜像到PS2"
ElseIf Combo1.Text Like "local  hdd*" Then
   Combo2.AddItem "本地镜像到PS2"
   Combo2.AddItem "格式化硬盘"
ElseIf Combo1.Text Like "PS2    hdd*" Then
   Combo2.AddItem "释放镜像到本地"
   Combo2.AddItem "删除镜像"
   Combo2.AddItem "删除分区"
   Combo2.AddItem "格式化硬盘"
ElseIf Combo1.Text Like "LAN    #*" Then
   Select Case chknet(src)
          
          Case 2
               Combo2.AddItem "释放镜像到本地"
               Combo2.AddItem "删除镜像"
               Combo2.AddItem "删除分区"
               Combo2.AddItem "格式化硬盘"
               Combo2.AddItem "关闭PS2网络"
          Case 1
               Combo2.AddItem "格式化硬盘"
               MsgBox "不是PS2格式的网络硬盘或数据已损坏！"
          Case Else
               MsgBox "无法接通的网络硬盘！"
               Exit Sub