module1.bas

电子书 一个很不错的程序 电子书童(110KB) 希望大家有用的下

Attribute VB_Name = "Module1"
'Declare Sub DragAcceptFiles Lib "shell32.dll" (ByVal hWnd As Long, ByVal fAccept As Long)
Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
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
Public gFindString, TempFile As String           ' 保存搜索文本
Public gFindCase As Long             ' 区分大小写标志
Public gFindDirection As Integer        ' 搜索方向标志
Public gCurPos As Long               ' 保存当前光标位置
Public gFirstTime As Integer            ' 起始位置
'Public gToolsHidden As Boolean          ' 保存工具栏状态
Public Type SHFILEOPSTRUCT
hwnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Long
hNameMappings As Long
lpszProgressTitle As Long
End Type
Public Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
'wFunc 常数
'FO_COPY   把 pFrom 文件拷贝到 pTo。
Public Const FO_COPY = &H2
'FO_DELETE 删除 pFrom 中的文件（pTo 忽略）。
Public Const FO_DELETE = &H3
'FO_MOVE   把 pFrom 文件移动到 pTo。
Public Const FO_MOVE = &H1

'fFlag 常数
'FOF_ALLOWUNDO 允许 Undo 。
Public Const FOF_ALLOWUNDO = &H40
'FOF_NOCONFIRMATION 不显示系统确认对话框。
Public Const FOF_NOCONFIRMATION = &H10
'FOF_NOCONFIRMMKDIR 不提示是否新建目录。
Public Const FOF_NOCONFIRMMKDIR = &H200
'FOF_SILENT 不显示进度对话框
Public Const FOF_SILENT = &H4

Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, lpSecurityAttributes As SECURITY_ATTRIBUTES, phkResult As Long, lpdwDisposition As Long) As Long
Declare Function GetDesktopWindow Lib "user32" () As Long
Declare Function RegSetValue Lib "advapi32.dll" Alias "RegSetValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long
Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
'Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long

'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
Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
Public Const REG_SZ = 1
Public Const REG_CREATED_NEW_KEY = &H1
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_LOCAL_MACHINE = &H80000002
Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long
Public Const READ_CONTROL = &H20000
Public Const KEY_QUERY_VALUE = &H1
Public Const KEY_SET_VALUE = &H2
Public Const KEY_CREATE_SUB_KEY = &H4
Public Const KEY_ENUMERATE_SUB_KEYS = &H8
Public Const KEY_NOTIFY = &H10
Public Const KEY_CREATE_LINK = &H20
Public Const SYNCHRONIZE = &H100000
Public Const STANDARD_RIGHTS_ALL = &H1F0000
Public Const STANDARD_RIGHTS_READ = (READ_CONTROL)
Public Const STANDARD_RIGHTS_WRITE = (READ_CONTROL)
Public Const KEY_READ = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
Public Const KEY_WRITE = ((STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE))
Public Const KEY_EXECUTE = (KEY_READ)
Public Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or KEY_QUERY_VALUE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or KEY_CREATE_LINK) And (Not SYNCHRONIZE))
'Const KEY_EXECUTE = ((KEY_READ) And (Not SYNCHRONIZE))
Public Type SECURITY_ATTRIBUTES
    nLength As Long
    lpSecurityDescriptor As Long
    bInheritHandle As Long
End Type
Type onshow
 n As Long
 fn As String
 conn As String
End Type


Sub Main()
Load frmBook
frmBook.Show
End Sub
Sub FindIt()
    Dim intStart As Long
    Dim intPos As Long
    Dim strFindString As String
    Dim strSourceString As String
    Dim strMsg As String
    Dim intResponse As Long
    Dim intOffset As Long
    
    ' 根据当前光标位置设置偏移量变量
    If (gCurPos = frmBook.txtMain.SelStart) Then
        intOffset = 1
    Else
        intOffset = 0
    End If

    ' 为起始位置读全局变量
    If gFirstTime Then intOffset = 0
    ' 给搜索起始位置赋值
    intStart = frmBook.txtMain.SelStart + intOffset
        
    ' 如果不匹配大小写，将字符串转换成大写
    If gFindCase Then
        strFindString = gFindString
        strSourceString = frmBook.txtMain.Text
    Else
        strFindString = UCase(gFindString)
        strSourceString = UCase(frmBook.txtMain.Text)
    End If
            
    ' 搜索字符串
    If gFindDirection = 1 Then
        intPos = InStr(intStart + 1, UCase(frmBook.txtMain.Text), strFindString)
    Else
        For intPos = intStart - 1 To 0 Step -1
            If intPos = 0 Then Exit For
            If Mid(strSourceString, intPos, Len(strFindString)) = strFindString Then Exit For
        Next
    End If

    ' 如果找到了字符串...
    If intPos > 0 Then
        frmBook.txtMain.SelStart = intPos - 1
        frmBook.txtMain.SelLength = Len(strFindString)
        DoEvents
    Else
        strMsg = "找不到 " & Chr(34) & gFindString & Chr(34)
        intResponse = MsgBox(strMsg, 0, App.Title)
    End If
    
    ' 重新设置全局变量
    gCurPos = frmBook.txtMain.SelStart
    gFirstTime = False
End Sub

Sub outputtext(FileName As String)
 Dim total, i, is_tag As Long
 Dim t, write2file, tp As String
 
 Open FileName For Input As 1
 tp = String(260, " ")
 Open TempFile For Output As 2
      
    total = LOF(1)
    Do While Not EOF(1)
    
      Line Input #1, t
        write2file = ""
         For i = 1 To Len(t)
            Select Case Mid$(t, i, 1)
               Case "<"
                  is_tag = True
               Case ">"
                  is_tag = False
               Case Else
                  If Not is_tag Then write2file = write2file & Mid$(t, i, 1)
            End Select
         Next
         Print #2, write2file
      Loop
    Close 1
    Close 2
End Sub