excel封装全过程

[原创]XLS封装成EXE制作全攻略

XLS封装成EXE制作全攻略■ldhyob 2003.12 曾在论坛发表过一张帖，是关于制作动态EXE例子(/cdb/viewthread.php?tid=15781)的，大家对此兴趣颇浓，都建议公开详细制作细节，故决定写出此文以帮助关注那张帖的版友们能完全自已独立完成xls2exe的过程，实现简单的封装。首先申明，将xls做成exe并不是指就能使您的VBA 工程受到坚强的保护，当然您可以通过数种方法来提高xls文档VBA工程防止查看的保护几率，如屏蔽一些系统热键、监控VBE窗口的开启、给文档加上口令保护、加VBA口令、使VBA“不可查看”、利用宏表4.0来禁止用户取消宏来查看文档等等，但“道高一尺，魔高一丈”，所以就没有必要去追求所谓的“完美”加密……关于这些保护方法不属本文叙述范围，请版友在论坛上查看相关帖。假如您手头已有一xls文档等待封装，假如您机子上已安装有VB6开发系统，那么请跟着往下操作：

一、用VB制作EXE文件头部分1、打开VB，“文件”-“新建工程”-“标准EXE”；

2、此时会出现名为Form1的默认窗体编辑窗口，Form1将作为软件启动封面窗体，打开该Form1的属性窗口，对如下属性进行设置：BorderStyle=0，StartUpPosition=2，Icon与Picture 属性设置成你需要的图标（这也将成为你EXE的图标）和设计好准备使用的图片（即软件封面），窗体的大小设置成您需要的合适值即可。

3、往窗体中添加一个时钟控件timer1，并将其InterVal属性设为1000。

4、双击窗体打开代码编辑窗口，录入以下代码：Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long Private Declare Function GetTempFileName Lib "kernel32" Alias "GetTempFileNameA" (ByVal lpszPath As String, ByVal lpPrefixString As String, ByVal wUnique As Long, ByVal lpTempFileName As String) As Long Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long Private Const MAX_PATH = 260 Private Const EXE_SIZE = 81920 '本EXE实际字节大小Private Type FileSection Bytes() As Byte End Type Private Type SectionedFile Files() As FileSection End Type Dim StopTime As Integer Private Sub Form_Activate() If Command() = "" Then Main1 End Sub Private Sub Form_Load() On Error Resume Next If Command() = "" Then Form1.Visible = True SetWindowPos Form1.hwnd, -1, 0, 0, 0, 0, &H2 Or &H1 '将封面置为最顶层窗体Else Form1.Visible = False

Form1.Timer1.Enabled = True End If End Sub Sub Main1() Dim StartXLSByte, I, J As Long Dim AppPath, XlsTmpPath As String Dim myfile As SectionedFile Dim xlApp As Excel.Application '定义EXCEL类Dim xlBook As Excel.Workbook '定义工件簿类Dim xlsheet As Excel.Worksheet '定义工作表类AppPath = App.Path XlsTmpPath = GetTempFile() '取得XLS 临时文件名（带路径）If VBA.Right(App.Path, 1) = "\" Then AppPath = VBA.Left(App.Path, VBA.Len(App.Path) - 1) Open AppPath & "\" & App.EXEName & ".exe" For Binary As #1 ReDim myfile.Files(1) ReDim myfile.Files(1).Bytes(1 To LOF(1) - EXE_SIZE) Open XlsTmpPath For Binary As #2 Get #1, EXE_SIZE + 1, myfile.Files(1).Bytes '此处数字要根据EXE实际头文件大小更改设定Put #2, 1, myfile.Files(1).Bytes Close #1 Close #2 Set xlApp = CreateObject("Excel.Application") '创建EXCEL应用类Set xlBook = xlApp.Workbooks.Open(FileName:=XlsTmpPath, password:="ldhyob") '打开EXCEL工作簿,已知该工作簿已加打开口令为ldhyob，若您的工作簿没有口令，则将此参数去掉'以下星号括起部分代码是往xls里写数据（也可不往工作簿里写数据的方法，而生成txt的方法），作用是保存本exe的绝对路径与临时xls绝对路径，以便于EXE重写更新与临时文件删除'***************************************** Set xlsheet = xlBook.Worksheets("temp") '设置活动工作表xlsheet.Cells(1, 1) = AppPath & "\" & App.EXEName & ".exe" '将该EXE完全路径存在工作表单元格内xlsheet.Cells(2, 1) = XlsTmpPath '将该EXE本次运行产生XLS临时文件路径存在工作表单元格内'**************************************** xlApp.Visible = True '设置EXCEL可见Set xlApp = Nothing '释放xlApp对象StopTime = 0 Me.Timer1.Enabled = True '启动时钟End Sub Private Function GetTempFile() As String '用来产生系统临时文件名Dim lngRet As Long Dim strBuffer As String, strTempPath As String strBuffer = String$(MAX_PATH, 0) lngRet = GetTempPath(Len(strBuffer), strBuffer) If lngRet = 0 Then Exit Function strTempPath = Left$(strBuffer, lngRet) strBuffer = String$(MAX_PATH, 0) lngRet = GetTempFileName(strTempPath, "tmp", 0&, strBuffer) If lngRet = 0 Then Exit Function lngRet = InStr(1, strBuffer, Chr(0)) If lngRet > 0 Then GetTempFile = Left$(strBuffer, lngRet - 1) Else GetTempFile = strBuffer End If End Function Private Sub Timer1_Timer() On Error Resume Next If Command() <> "" Then If VBA.Dir(Command()) <> "" Then Kill Command() '删除本次运行遗留的临时XLS文件Else End End If Else StopTime = StopTime + 1 '计时累加If StopTime = 1 Then Unload Me: End '2秒后自动关闭退出End If End Sub 5、可保存工程，如取名为“工程1”；6、进行编译，“文件”-“生成工程1.exe”，此时也可将生成的EXE另