Attribute VB_Name = "modChapCuttor"
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
'列表框
Public Const LB_SETHORIZONTALEXTENT = &H194

'修改EXE资源
Private Declare Function EndUpdateResource Lib "kernel32" Alias "EndUpdateResourceA" (ByVal hUpdate As Long, ByVal fDiscard As Long) As Long
Private Declare Function UpdateResource Lib "kernel32" Alias "UpdateResourceA" (ByVal hUpdate As Long, ByVal lpType As Long, ByVal lpName As String, ByVal wLanguage As Long, ByVal lpData As String, ByVal cbData As Long) As Long
Private Declare Function BeginUpdateResource Lib "kernel32" Alias "BeginUpdateResourceA" (ByVal pFileName As String, ByVal bDeleteExistingResources As Long) As Long
'Public Const RT_ICON = 3&
Private Const RT_STRING = 6&
'Private Const CREATEPROCESS_MANIFEST_RESOURCE_ID = 3002

'打开文件/浏览目录
Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long

Private Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type

Private Type BROWSEINFOTYPE
  hOwner            As Long
  pidlRoot          As Long
  pszDisplayName    As String
  lpszTitle         As String
  ulFlags           As Long
  lpfn              As Long
  lParam            As Long
  iImage            As Long
End Type

Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBROWSEINFOTYPE As BROWSEINFOTYPE) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal dwLength As Long)

Private Const WM_USER = &H400

Private Const BFFM_SETSELECTIONA       As Long = (WM_USER + 102)
Private Const BFFM_SETSELECTIONW       As Long = (WM_USER + 103)
Private Declare Function LocalAlloc Lib "kernel32" (ByVal uFlags As Long, ByVal uBytes As Long) As Long
Private Declare Function LocalFree Lib "kernel32" (ByVal hMem As Long) As Long
Private Const LPTR = (&H0 Or &H40)
Private Const NEWFOLDER = 64

Public Function BrowseCallbackProcStr(ByVal hwnd As Long, ByVal uMsg As Long, ByVal lParam As Long, ByVal lpData As Long) As Long
  If uMsg = 1 Then
    Call SendMessage(hwnd, BFFM_SETSELECTIONA, True, ByVal lpData)
  End If
End Function
Public Function FunctionPointer(FunctionAddress As Long) As Long
  FunctionPointer = FunctionAddress
End Function

Public Function sBrowseForFolder(hwnd As Long, selectedPath As String) As String
  Dim Browse_for_folder     As BROWSEINFOTYPE
  Dim itemID                As Long
  Dim selectedPathPointer   As Long
  Dim tmpPath               As String * 256

  If Not Right$(selectedPath, 1) <> "\" Then
    selectedPath = Left$(selectedPath, Len(selectedPath) - 1) '如果用户加了"\" 则删除
  End If

  With Browse_for_folder
    .hOwner = hwnd       '   所有都窗口之句柄
    .lpszTitle = "浏览文件夹"       '   对话框的标题
    .lpfn = FunctionPointer(AddressOf BrowseCallbackProcStr)         '用于设置预设文件夹的回调函数
    selectedPathPointer = LocalAlloc(LPTR, Len(selectedPath) + 1)             '   分配一个字符串内存
    CopyMemory ByVal selectedPathPointer, ByVal selectedPath, Len(selectedPath) + 1                 '   拷贝那个路径到内存
    .lParam = selectedPathPointer       '   预设的文件夹
    .ulFlags = NEWFOLDER
  End With
  itemID = SHBrowseForFolder(Browse_for_folder)       '   执行API函数：   BrowseForFolder
  If itemID Then
    If SHGetPathFromIDList(itemID, tmpPath) Then         '取得选定的文件夹
      sBrowseForFolder = Left$(tmpPath, InStr(tmpPath, vbNullChar) - 1)               '去掉多余的   null   字符
    End If
    Call CoTaskMemFree(itemID)     '释放内存
  End If
  Call LocalFree(selectedPathPointer)     ''释放内存
End Function

'打开文件的函数
Public Function sOpenFile(hwnd As Long) As String
Dim ofn As OPENFILENAME
Dim rtn As String
ofn.lStructSize = Len(ofn)
ofn.hwndOwner = hwnd
ofn.hInstance = App.hInstance
ofn.lpstrFilter = "文本文件(*.txt)" & vbNullChar & "*.txt" & _
                  vbNullChar & "所有文件" & vbNullChar & "*.*"
ofn.lpstrFile = Space(254)
ofn.nMaxFile = 255
ofn.lpstrFileTitle = Space(254)
ofn.nMaxFileTitle = 255
ofn.lpstrInitialDir = App.Path
ofn.lpstrTitle = "打开文件"
ofn.flags = 6148
rtn = GetOpenFileName(ofn)
If rtn >= 1 Then
  sOpenFile = Left$(ofn.lpstrFile, InStr(ofn.lpstrFile, vbNullChar) - 1)
' sOpenFile = Trim$(ofn.lpstrFile)
Else
  sOpenFile = ""
End If
End Function

Public Sub UpdateSetup(sName As String, ByVal sData As String)
On Error GoTo err
Dim hRes As Long, sApp As String
sApp = App.EXEName
If Len(sApp) = 0 Then Exit Sub
If Right$(sApp, 4) <> ".exe" Then sApp = sApp & ".exe"
hRes = BeginUpdateResource(sApp, 0)
UpdateResource hRes, RT_STRING, sName, 0, ByVal sData, Len(sData)
EndUpdateResource hRes, 0
Exit Sub

err:
  MsgBox "更新Exe资源时出现错误！" & vbCrLf & err.Number & ":" & err.Description, vbCritical, "错误"
End Sub
