当前位置:编程学习 > C#/ASP.NET >>

用VB6.0自制压缩与解压缩程序(三)

答案:用记事本打开modMain.bas文件,copy以下内容到其中:



Attribute VB_Name = "modMain"



' ==============================================

' 信息打包与展开 (启动模块)

'

' 功能 :利用系统所存在的资源自作压缩与解压缩程序

'

' 作 者 :谢家峰

' 整理日期 :2004-08-08

' Email :douhapy@sina.com

'

' ==============================================

'

Option Explicit



Public WindowsPath As String

Public WindowsSysPath As String



Sub Main()

Dim BootTrapPath As String

Dim SetupFilePath As String

Dim regExeFilePath As String



Dim regInfo() As String

Dim regStr() As String

Dim regFileName As String

Dim str As String



Dim resultat As Long

Dim resultat2 As Long

Dim res As Double

Dim startinfo As STARTUPINFO

Dim procinfo As PROCESS_INFORMATION

Dim secu As SECURITY_ATTRIBUTES



Dim i As Integer



If App.PrevInstance Then MsgBox "系统已启动!", , App.EXEName: End

'获得系统安装目录

WindowsPath = GetWindowsDir

WindowsSysPath = GetWindowsSysDir



Load frmMain

frmMain.Show

End Sub



用记事本打开modAPI.bas文件,copy以下内容到其中:



Attribute VB_Name = "modAPI"



' ==============================================

' 信息打包与展开 (所调用的API及通用函数模块)

'

' 功能 :利用系统所存在的资源自作压缩与解压缩程序

'

' 作 者 :谢家峰

' 整理日期 :2004-08-08

' Email :douhapy@sina.com

'

' ==============================================

'

Option Explicit



Public Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long

Public Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long



Public Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessA" (ByVal lpApplicationName As String, ByVal lpCommandLine As String, lpProcessAttributes As SECURITY_ATTRIBUTES, lpThreadAttributes As SECURITY_ATTRIBUTES, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, lpEnvironment As Any, ByVal lpCurrentDriectory As String, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long

Public Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long

Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long



Public Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long

Public Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpbuffer As String, ByVal nSize As Long) As Long

Public Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpbuffer As String, ByVal nSize As Long) As Long



Public Const gstrSEP_DIR$ = "\"

Public Const gstrSEP_URLDIR$ = "/"

Public Const gintMAX_SIZE% = 255



Public Const INFINITE = &HFFFF



Public Type STARTUPINFO

cb As Long

lpReserved As String

lpDesktop As String

lpTitle As String

dwX As Long

dwY As Long

dwXSize As Long

dwYSize As Long

dwXCountChars As Long

dwYCountChars As Long

dwFillAttribute As Long

dwFlags As Long

wShowWindow As Integer

cbReserved2 As Integer

lpReserved2 As Long

hStdInput As Long

hStdOutput As Long

hStdError As Long

End Type



Public Type PROCESS_INFORMATION

hProcess As Long

hThread As Long

dwProcessId As Long

dwThreadId As Long

End Type



Public Type SECURITY_ATTRIBUTES

nLength As Long

lpSecurityDescriptor As Long

bInheritHandle As Long

End Type





Function StripTerminator(ByVal strString As String) As String

Dim intZeroPos As Integer



intZeroPos = InStr(strString, Chr$(0))

If intZeroPos > 0 Then

StripTerminator = Left$(strString, intZeroPos - 1)

Else

StripTerminator = strString

End If

End Function



' -----------------------------------------------------------

' 给目录添加分割线

'

' -----------------------------------------------------------

'

Sub AddDirSep(strPathName As String)

If Right(Trim(strPathName), Len(gstrSEP_URLDIR)) <> gstrSEP_URLDIR And _

Right(Trim(strPathName), Len(gstrSEP_DIR)) <> gstrSEP_DIR Then

strPathName = RTrim$(strPathName) & gstrSEP_DIR

End If

End Sub



' -----------------------------------------------------------

' 调用API函数获得Windows的系统目录

'

' -----------------------------------------------------------

'

Function GetWindowsSysDir() As String

Dim strBuf As String



strBuf = Space$(gintMAX_SIZE)

If GetSystemDirectory(strBuf, gintMAX_SIZE) > 0 Then

strBuf = StripTerminator(strBuf)

AddDirSep strBuf



GetWindowsSysDir = strBuf

Else

GetWindowsSysDir = vbNullString

End If

End Function



' -----------------------------------------------------------

' 调用API函数获取Windows目录

'

' -----------------------------------------------------------

'

Function GetWindowsDir() As String

Dim strBuf As String



strBuf = Space$(gintMAX_SIZE)



If GetWindowsDirectory(strBuf, gintMAX_SIZE) > 0 Then

strBuf = StripTerminator$(strBuf)

AddDirSep strBuf



GetWindowsDir = strBuf

Else

GetWindowsDir = vbNullString

End If

End Function



' --------------------------------------

' 测试目录是否存在

'

' --------------------------------------

'

Public Function DirExists(Path As String) As Boolean

On Error Resume Next



'对于网络地址采用*.*形式

If InStr(Path, "\\") Then

DirExists = (Dir$(Path & "\*.*") <> "")

Else

DirExists = (Dir$(Path & "\nul") <> "")

End If

End Function



' --------------------------------------

' 建立文件夹(含多层结构)

'

' --------------------------------------

'

Public Sub CreateFloder(floder As String)

Dim i As Integer

Dim Path As String

Dim FloderStr() As String



On Error Resume Next

FloderStr = Split(floder, "\")

Path = FloderStr(0)

For i = 1 To UBound(FloderStr) - 1
<

上一个:如何用VB.NET编写XML文档
下一个:用VB6.0自制压缩与解压缩程序(二)

CopyRight © 2012 站长网 编程知识问答 www.zzzyk.com All Rights Reserved
部份技术文章来自网络,