⭐ 欢迎来到虫虫下载站！ | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站
📤 上传资源

📄 form1.frm

📁 hdl_dump(ps2灌硬盘的软件)的gui 含大量api
💻 FRM
📖 第 1 页 / 共 3 页
字号:
🔍
123 
   End Select
   
ElseIf Combo1.Text Like "[local ASPI SPTI]*" Then
   If Not Combo1.Text Like "*## MB" Then
      MsgBox "光驱不能识别光盘！"
      Exit Sub
   Else
      Dim info As String
      info = objDOS.ExecuteCommand$("hdl_dump.exe cdvd_info2 " & src)

      If info Like "[CD DVD dual-layer]*####KB *" Then
         Label2 = info
         Combo2.AddItem "提取镜像到PS2"
         Combo2.AddItem "提取镜像到本地"
      Else
         MsgBox "不能识别为有效的PS2格式！"
         Exit Sub
      End If
   End If
Else
   MsgBox "错误"
   End
End If
Combo2.Enabled = True
End Sub

Private Sub Combo2_Click()
'初始化
Combo3.Clear
Combo3.Enabled = False
Call noview

Dim i As Long

If Combo2.Text = "本地镜像到PS2" Then
   '查找可用PS2硬盘
   Call getPS2
   
   If Combo3.ListCount = 0 Then
      MsgBox "无可用的PS2资源！"
      Exit Sub
   Else
      Call iso2PS2
      If Label2 = "无效的镜像！" Then
         Exit Sub
      End If
   End If
   
ElseIf Combo2.Text = "格式化硬盘" Then
   Combo3.AddItem "确认要格式化这块硬盘到PS2格式？数据将全部丢失！确认请点我"
ElseIf Combo2.Text = "释放镜像到本地" Or Combo2.Text = "删除镜像" Then
   Call getlist("hdl_dump.exe hdl_toc ")
   If Combo3.ListCount = 0 Then
      MsgBox "没有检测到安装的游戏！"
      Exit Sub
   End If
ElseIf Combo2.Text = "删除分区" Then
   Call getlist("hdl_dump.exe toc ")
   If Combo3.ListCount = 0 Then
      MsgBox "没有检测到分区！"
      Exit Sub
   End If
ElseIf Combo2.Text = "提取镜像到PS2" Then
   '查找可用PS2硬盘
   Call getPS2
   If Combo3.ListCount = 0 Then
      MsgBox "无可用的PS2资源！"
      Exit Sub
   End If
ElseIf Combo2.Text = "提取镜像到本地" Then
   Call cd2local
   If Label2 = "无效的镜像！" Then
      Exit Sub
   Else
      Combo3.AddItem "确认提取镜像到本地？确认请点我"
   End If
ElseIf Combo2.Text = "关闭PS2网络" Then
   Combo3.AddItem "关闭这台PS2主机？确认请点我"
Else
   MsgBox "erro"
   End
End If

Combo3.Enabled = True
End Sub



Private Sub Combo3_Click()
Dim info As String
Dim cmd As String
If Combo2.Text = "本地镜像到PS2" Then
   info = getname
   If Len(info) = 0 Then
      Exit Sub
   Else
      '查找cd/dvd属性
      If Mid$(Label2, InStr(Label2, ">") + 1, 3) = "DVD" Or Mid$(Label2, InStr(Label2, ">") + 1, 10) = "dual-layer" Then
         cmd = "hdl_dump inject_dvd " & des & Chr$(34) & info & Chr$(34) & " " & Chr$(34) & Left$(Label2, InStr(Label2, ">") - 1) & Chr$(34)
      Else
         cmd = "hdl_dump inject_cd " & des & Chr$(34) & info & Chr$(34) & " " & Chr$(34) & Left$(Label2, InStr(Label2, ">") - 1) & Chr$(34)
      End If
      Call install(cmd)
   End If
ElseIf Combo3.Text = "确认要格式化这块硬盘到PS2格式？数据将全部丢失！确认请点我" Then
   objDOS.ExecuteCommand$ ("hdl_dump initialize " & src)
ElseIf Combo2.Text = "释放镜像到本地" Then
   Call cd2local
   If Label2 = "无效的镜像！" Then
      Exit Sub
   Else
      cmd = "hdl_dump extract " & src & " " & Chr$(34) & Mid$(Combo3.Text, 44) & Chr$(34) & " " & Chr$(34) & Label2 & Chr$(34)
      Call install(cmd)
   End If
ElseIf Combo2.Text = "删除镜像" Then
   If MsgBox("删除镜像 " & Mid$(Combo3.Text, 44), vbYesNo) = 6 Then
      objDOS.ExecuteCommand$ ("hdl_dump delete " & src & " " & Chr$(34) & Mid$(Combo3.Text, 44) & Chr$(34))
      '删除本项,不做其他处理
      Combo3.RemoveItem (Combo3.ListIndex)
   End If
   Exit Sub
ElseIf Combo2.Text = "删除分区" Then
   If MsgBox("删除分区 " & Mid$(Combo3.Text, 30), vbYesNo) = 6 Then
      objDOS.ExecuteCommand$ ("hdl_dump delete " & src & " " & Chr$(34) & Mid$(Combo3.Text, 30) & Chr$(34))
      '删除本项,不做其他处理
      Combo3.RemoveItem (Combo3.ListIndex)
   End If
   Exit Sub
ElseIf Combo2.Text = "提取镜像到PS2" Then
   info = getname
   If Len(info) = 0 Then
      Exit Sub
   Else
      '查找cd/dvd属性
      If Left$(Label2, 3) = "DVD" Or Left$(Label2, 10) = "dual-layer" Then
         cmd = "hdl_dump inject_dvd " & des & Chr$(34) & info & Chr$(34) & " " & src
      Else
         cmd = "hdl_dump inject_cd " & des & Chr$(34) & info & Chr$(34) & " " & src
      End If
      Call install(cmd)
   End If
ElseIf Combo3.Text = "确认提取镜像到本地？确认请点我" Then
   cmd = "hdl_dump dump " & src & " " & Chr$(34) & Label2 & Chr$(34)
   Call install(cmd)
ElseIf Combo3.Text = "关闭这台PS2主机？确认请点我" Then
   objDOS.ExecuteCommand$ ("hdl_dump poweroff " & src)
Else
   MsgBox "erro"
   End
End If




'取得硬件基本信息
Call getdrv(objDOS.ExecuteCommand$("hdl_dump.exe query"))

End Sub







Private Sub Command3_Click()
Dim info As String
Dim i As Long

'error
If Text1(1).Text = "未设置" Then
   MsgBox "输入IP信息"
   Exit Sub
ElseIf Text1(2).Text = "未设置" Then
   MsgBox "输入目标速率"
   Exit Sub
End If


'判断ip格式
info = Text1(1).Text
Dim s() As String
s() = Split(info, ".")
If UBound(s) <> 3 Then
   MsgBox "IP格式不正确！" & Chr$(13) & Chr$(10) & "自动设置IP到默认值:192.168.0.10"
   Text1(1).Text = "192.168.0.10"
   Exit Sub
Else
   For i = 0 To 3
       s(i) = Replace$(s(i), " ", ":")
       If Not IsNumeric(s(i)) Then
              MsgBox "IP只能含有数字和 " & Chr$(34) & "." & Chr$(34) & " 字符！" & Chr$(13) & Chr$(10) & "自动设置IP到默认值:192.168.0.10"
              Text1(1).Text = "192.168.0.10"
              Exit Sub
       Else
              If Val(s(i)) > 255 Or Val(s(i)) < 0 Then
                 MsgBox "IP数字溢出,有效值为 0-255" & Chr$(13) & Chr$(10) & "自动设置IP到默认值:192.168.0.10"
                 Text1(1).Text = "192.168.0.10"
                 Exit Sub
              End If
       End If
   Next i
End If


'判断目标速率格式
info = Replace$(Replace$(Text1(2).Text, " ", ":"), ".", ":")
If Not IsNumeric(info) Then
       MsgBox "目标速率只能为整数！" & Chr$(13) & Chr$(10) & "自动设置目标速率到默认值:2300"
       Text1(2).Text = "2300"
       Exit Sub
Else
       If Val(info) > 4000 Then
          MsgBox "目标速率过大！建议4000KB/S以下！" & Chr$(13) & Chr$(10) & "自动设置目标速率到默认值:2300"
          Text1(2).Text = "2300"
          Exit Sub
       End If
End If


'写配置信息


'自动阻塞控制
If Check1(0).Value = 1 Then
   info = Chr$(34) & "auto_throttle" & Chr$(34) & " = " & Chr$(34) & "1" & Chr$(34) & Chr$(10)
Else
   info = Chr$(34) & "auto_throttle" & Chr$(34) & " = " & Chr$(34) & "0" & Chr$(34) & Chr$(10)
End If

'默认disc_database_file路径
info = info & Chr$(34) & "disc_database_file" & Chr$(34) & " = " & Chr$(34) & Replace$(Environ$("appdata"), "\", "\\") & "\\hdl_dump.list" & Chr$(34) & Chr$(10)

'ASPI开关
If Check1(1).Value = 1 Then
   info = info & Chr$(34) & "enable_aspi" & Chr$(34) & " = " & Chr$(34) & "yes" & Chr$(34) & Chr$(10)
Else
   info = info & Chr$(34) & "enable_aspi" & Chr$(34) & " = " & Chr$(34) & "no" & Chr$(34) & Chr$(10)
End If

'默认IP
info = info & Chr$(34) & "last_ip" & Chr$(34) & " = " & Chr$(34) & Text1(1).Text & Chr$(34) & Chr$(10)

'limit_to_28bit设置
If Check1(2).Value = 1 Then
   info = info & Chr$(34) & "limit_to_28bit" & Chr$(34) & " = " & Chr$(34) & "yes" & Chr$(34) & Chr$(10)
Else
   info = info & Chr$(34) & "limit_to_28bit" & Chr$(34) & " = " & Chr$(34) & "no" & Chr$(34) & Chr$(10)
End If

'命名规则
If Check1(3).Value = 1 Then
   info = info & Chr$(34) & "partition_naming" & Chr$(34) & " = " & Chr$(34) & "toxicos" & Chr$(34) & Chr$(10)
Else
   info = info & Chr$(34) & "partition_naming" & Chr$(34) & " = " & Chr$(34) & "standard" & Chr$(34) & Chr$(10)
End If

'目标速率
info = info & Chr$(34) & "target_kbps" & Chr$(34) & " = " & Chr$(34) & Text1(2).Text & Chr$(34) & Chr$(10)

'压缩控制
If Check1(4).Value = 1 Then
   info = info & Chr$(34) & "use_compression" & Chr$(34) & " = " & Chr$(34) & "yes" & Chr$(34)
Else
   info = info & Chr$(34) & "use_compression" & Chr$(34) & " = " & Chr$(34) & "no" & Chr$(34)
End If


'写入文件
Open Environ$("appdata") & "\hdl_dump.conf" For Output As #1
     Print #1, info
Close #1

'取得硬件基本信息
Call getdrv(objDOS.ExecuteCommand$("hdl_dump.exe query"))

'恢复原始
Combo2.Clear
Combo2.Enabled = False
Combo3.Clear
Combo3.Enabled = False

End Sub



Private Sub Form_Load()
Set objDOS = New DOSOutputs
Dim info As String
Dim temp As String
Dim a As Long
Dim b As Long
way = 0
Me.Show

'判断是否根目录
If Right$(App.Path, 1) = "\" Then
   MsgBox "程序不能位于根目录！" & Chr$(13) & Chr$(10) & "请不要将程序放在根目录！程序将关闭！"
   End
'判断是否已经有一个HDL_GUI运行中
ElseIf App.PrevInstance Then
   MsgBox "已经有一个HDL_DUMP GUI运行中，请先关闭它！"
   End
'判断hdl_dump.exe的存在
ElseIf Len(Dir(App.Path & "\hdl_dump.exe")) = 0 Then
   MsgBox "没有找到 hdl_dump.exe" & Chr$(13) & Chr$(10) & "请将hdl_dump.exe与本程序放在一起！"
   End
'判断hdl_dump.conf的存在
ElseIf Len(Dir(Environ$("appdata") & "\hdl_dump.conf")) = 0 Then
   MsgBox "没有找到 hdl_dump.conf" & Chr$(13) & Chr$(10) & "程序将重新创建hdl_dump.conf,请重新启动！" & Chr$(13) & Chr$(10) & objDOS.ExecuteCommand$("hdl_dump.exe")
   End
'判断iddata的存在
ElseIf Len(Dir(App.Path & "\iddata")) = 0 Then
   MsgBox "没有找到 iddata" & Chr$(13) & Chr$(10) & "请将iddata与本程序放在一起！"
   End
'判断hdlsalvage.exe的存在
ElseIf Len(Dir(App.Path & "\hdlsalvage.exe")) = 0 Or Len(Dir(App.Path & "\libhdld2.dll")) = 0 Then
   'MsgBox "请确认hdlsalvage.exe和libhdld2.dll两个文件与本程序放在一起！" & Chr$(13) & Chr$(10) & Chr$(13) & Chr$(10) & "不能使用硬盘修复功能！"
   'Option8.Enabled = False
End If


'读取hdl_dump设置到info

Open Environ$("appdata") & "\hdl_dump.conf" For Input As #1
     info = Replace$(Input(LOF(1), 1), Chr$(13), "")
Close #1
  

'按Chr$(10)为分隔符按“行”读取判断
a = 1
Do
  b = InStr(a, info, Chr$(10))

  '尾端退出
  If b = 0 Then
     Exit Do
  End If
  
  '将(a,b)信息写入temp
  temp = Mid$(info, a, b - a)
  
  'a为b的下一个字符
  a = b + 1


  '判断设置信息
  If temp = Chr$(34) & "auto_throttle" & Chr$(34) & " = " & Chr$(34) & "1" & Chr$(34) Then
     Check1(0).Value = 1
  ElseIf temp = Chr$(34) & "auto_throttle" & Chr$(34) & " = " & Chr$(34) & "0" & Chr$(34) Then
     Check1(0).Value = 0
  ElseIf temp = Chr$(34) & "enable_aspi" & Chr$(34) & " = " & Chr$(34) & "yes" & Chr$(34) Then
     Check1(1).Value = 1
  ElseIf temp = Chr$(34) & "enable_aspi" & Chr$(34) & " = " & Chr$(34) & "no" & Chr$(34) Then
     Check1(1).Value = 0
  ElseIf temp = Chr$(34) & "limit_to_28bit" & Chr$(34) & " = " & Chr$(34) & "yes" & Chr$(34) Then
     Check1(2).Value = 1
  ElseIf temp = Chr$(34) & "limit_to_28bit" & Chr$(34) & " = " & Chr$(34) & "no" & Chr$(34) Then
     Check1(2).Value = 0
  ElseIf temp = Chr$(34) & "partition_naming" & Chr$(34) & " = " & Chr$(34) & "toxicos" & Chr$(34) Then
     Check1(3).Value = 1
  ElseIf temp = Chr$(34) & "partition_naming" & Chr$(34) & " = " & Chr$(34) & "standard" & Chr$(34) Then
     Check1(3).Value = 0
  ElseIf temp = Chr$(34) & "use_compression" & Chr$(34) & " = " & Chr$(34) & "yes" & Chr$(34) Then
     Check1(4).Value = 1
  ElseIf temp = Chr$(34) & "use_compression" & Chr$(34) & " = " & Chr$(34) & "no" & Chr$(34) Then
     Check1(4).Value = 0
  ElseIf temp Like Chr$(34) & "last_ip" & Chr$(34) & " = " & Chr$(34) & "*.*.*.*" & Chr$(34) Then
     Text1(1).Text = Replace$(Mid$(temp, 14, 15), Chr$(34), "")
  ElseIf temp Like Chr$(34) & "target_kbps" & Chr$(34) & " = " & Chr$(34) & "*" & Chr$(34) Then
     Text1(2).Text = Replace$(Mid$(temp, 18, 4), Chr$(34), "")
  ElseIf temp = Chr$(34) & "disc_database_file" & Chr$(34) & " = " & Chr$(34) & Replace$(Environ$("appdata"), "\", "\\") & "\\hdl_dump.list" & Chr$(34) Then
     '默认的disc_database_file路径
  Else
     MsgBox "非法的hdl_dump设置信息"
  End If
  
Loop


'取得硬件基本信息
Call getdrv(objDOS.ExecuteCommand$("hdl_dump.exe query"))


End Sub
123

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -