- 大学二年级
- 1874968
- 1224
- 0
- 98 朵
- 2135 个
- 837 个
- 940
- 2013-06-03
|
1#
t
T
发表于 2015-04-16 17:36
|
|只看楼主
本帖最后由 118184017 于 2015-5-13 08:52 编辑 [attach]176808[/attach]更新首先要有下载地址 。其次要有压缩包的文件名。然后直接调用函数就能自动下载,解压,然后关闭原小精灵,然后运行新的小精灵,看源码。 - 网页地址="http://bbs.anjian.com/forum.php?mod=attachment&aid=MTY2NzYzfGQ4M2Q0ODMyfDE0MjkxNzY3ODJ8MTg3NDk2OHw1NTE0NTE%3D"
- 压缩文件="把EXCEL的数据录入到任何系统.zip"
- call 软件更新(网页地址,压缩文件)
复制代码回复后查看!未使用任何插件! - Declare Function GetModuleFileName Lib "kernel32" Alias "GetModuleFileNameA" (ByVal hModule As Long, ByVal lpFileName As String, ByVal nSize As Long) As Long
- Sub 软件更新(网页地址,压缩文件)
- Dim 新软件名称,解压路径,VBs代码,目标文件,存放路径,更新文件夹,当前运行软件名,当前运行软件存放路径,i
- 当前运行软件存放路径=获取路径(0)
- 当前运行软件名=获取文件名(获取路径(5))
- 当前运行软件路径=当前运行软件存放路径&"\"&当前运行软件名
- 解压路径="C:\"
- 新软件名称=split(压缩文件,".")(0)&".exe"
- 更新文件夹=解压路径&"软件更新"
- If (判断文件夹或文件是否存在(更新文件夹))then Call 删除文件或文件夹(更新文件夹)
- Call 创建文件夹(更新文件夹)
- call 下载所有(网页地址,更新文件夹&"\"&压缩文件)
- Delay 1000
- call 解压(更新文件夹&"\"&压缩文件,更新文件夹)
- For i = 1 To 60
- Delay 1000
- If (判断文件夹或文件是否存在(更新文件夹 & "\" & 新软件名称)) Then
- Exit For
- End If
- Next
- If (判断文件夹或文件是否存在(更新文件夹&"\"&新软件名称)) Then
- 目标文件=更新文件夹&"\"&新软件名称:存放路径=当前运行软件存放路径&"\"&新软件名称
- VBs代码="Dim fso"&vbcrlf
- VBs代码=VBs代码&"Set fso = CreateObject(""Scripting.FileSystemObject"")"&vbcrlf
- If (InStr(当前运行软件名, "按键精灵") = 0) Then
- VBs代码=VBs代码&"While prod("""&当前运行软件名&""")>0 "&vbcrlf//VBS循环等待软件停止运行
- VBs代码=VBs代码&"wscript.sleep 1000"&vbcrlf//VBS延时
- VBs代码=VBs代码&"Wend"&vbcrlf
- VBs代码=VBs代码&"fso.deletefile """&当前运行软件路径&""""&vbcrlf//VBS删除文件
- End If
- VBs代码=VBs代码&"fso.CopyFile """&目标文件&""","""&存放路径&""",False"&vbcrlf//拷贝文件
- VBs代码=VBs代码&"fso.deletefolder """&更新文件夹&""""&vbcrlf//VBS删除文件夹
- VBs代码=VBs代码&"Set fso = Nothing"&vbcrlf
- VBs代码=VBs代码&VBS代码串判断程序是否在运行函数
- VBs代码=VBs代码&启动VBS程序并返回PID
- VBs代码=VBs代码&"call RunAppRutrunPid("""&存放路径&""")"
- If (判断文件夹或文件是否存在(更新文件夹&"\Log.VBS"))then Call 删除文件或文件夹(更新文件夹&"\Log.VBS")
- Call 写文本内容(更新文件夹&"\Log.VBS",VBs代码)
- RunApp 更新文件夹&"\Log.VBS"
- Else
- MessageBox "自动解压失败,请手动解压"
- RunApp 更新文件夹&"\"&压缩文件
- End If
- If (InStr(当前运行软件名, "按键精灵") = 0) Then Call 结束进程(当前运行软件名)
- End Sub
- Function VBS代码串判断程序是否在运行函数()
- Dim 字符串
- 字符串="public function Prod(byval Val)"&vbcrlf
- 字符串=字符串&"dim prow"&vbcrlf
- 字符串=字符串&"set prow=getobject(""winmgmts:\\""&strcomputer).instancesOf(""win32_process"")"&vbcrlf
- 字符串=字符串&"For Each i In prow"&vbcrlf
- 字符串=字符串&"if lcase(i.name)=lcase(val) then"&vbcrlf
- 字符串=字符串&"prod=prod+1"&vbcrlf
- 字符串=字符串&"end if"&vbcrlf
- 字符串=字符串&"next"&vbcrlf
- 字符串=字符串&"Set prow = Nothing"&vbcrlf
- 字符串=字符串&"end function"&vbcrlf
- VBS代码串判断程序是否在运行函数=字符串
- End Function
- Function 启动VBS程序并返回PID()
- Dim 字符串
- 字符串="Function RunAppRutrunPid(ExePath)"&vbcrlf'启动VBS程序并返回PID
- 字符串=字符串&"Dim Win"&vbcrlf
- 字符串=字符串&"Set Win = GetObject(""winmgmts:\\.\root\cimv2:Win32_Process"")"&vbcrlf
- 字符串=字符串&"Win.create ExePath, Null, Null, Pid"&vbcrlf
- 字符串=字符串&"RunAppRutrunPid = Pid"&vbcrlf
- 字符串=字符串&"Set Win = Nothing"&vbcrlf
- 字符串=字符串&"End Function"&vbcrlf
- 启动VBS程序并返回PID=字符串
- End Function
- Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
- sub 下载所有(网页地址,保存到本地压缩文件和地址)
- Call URLDownloadToFile(0, 网页地址,保存到本地压缩文件和地址, 0, 0)
- End Sub
- Function 判断文件夹或文件是否存在(完整路径)
- Dim fso,strlen
- strlen=len(完整路径)
- Set fso = CreateObject("Scripting.FileSystemObject")
- If (mid(完整路径, strlen - 3, 1) = ".") Then
- 判断文件夹或文件是否存在= fso.fileexists(完整路径)
- Else
- 判断文件夹或文件是否存在= fso.FolderExists(完整路径)
- End If
- Set fso = Nothing
- End Function
- Sub 删除文件或文件夹(完整路径)
- Dim fso,strlen
- strlen=len(完整路径)
- Set fso = CreateObject("Scripting.FileSystemObject")
- If (mid(完整路径, strlen - 3, 1) = ".") Then
- fso.deletefile 完整路径,1
- Else
- fso.deletefolder 完整路径,1
- End If
- Set fso = Nothing
- End Sub
- Sub 创建文件夹(文件夹名)
- Dim fso
- Set fso = CreateObject("Scripting.FileSystemObject")
- fso.CreateFolder 文件夹名
- Set fso = Nothing
- End Sub
- Sub 重命名文件(文件名, 新文件名)
- Dim fso
- Set fso = CreateObject("Scripting.FileSystemObject")
- fso.MoveFile 文件名, 新文件名
- Set fso = Nothing
- End Sub
- Sub 写文本内容(文件名, 写入文本)
- Dim fso,myfile,myfile1
- Set fso = CreateObject("Scripting.FileSystemObject")
- If (fso.FileExists(文件名)=0) Then
- Set myfile1 = fso.CreateTextFile(文件名)
- Set myfile1 = Nothing
- End If
- Set myfile = fso.openTextFile(文件名, 8, True)
- myfile.WriteLine vbcrlf & 写入文本
- myfile.close
- Set myfile = Nothing
- Set fso = Nothing
- End Sub
- Function 获取当前路径()
- Dim wscript
- Set wscript = CreateObject("wscript.shell")
- 获取当前路径 = wscript.CurrentDirectory
- Set ws = Nothing
- End Function
- Sub 结束进程(映像名称)
- Dim strComputer, objWMIService, colProcessList, objProcess
- strComputer = "."
- Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
- Set colProcessList = objWMIService.ExecQuery("Select * from Win32_Process Where Name = '" & 映像名称 & "'")
- For Each objProcess in colProcessList
- objProcess.Terminate
- Next
- Set colProcessList = Nothing
- Set objWMIService = Nothing
- End Sub
- Sub 解压(压缩文件地址,保存地址)//只能解压C盘文件
- Dim Shell,Cmd,文件夹len
- 文件夹len=获取文件夹大小(保存地址)
- set Shell= CreateObject("wscript.shell")
- cmd = "WINRAR x -t -o+ -p- "
- Cmd=cmd&压缩文件地址&" "&保存地址
- Shell.Run Cmd
- Delay 2000
- If (文件夹len=获取文件夹大小(保存地址))
- cmd = "HaoZipC e "
- Cmd=cmd&压缩文件地址&" -o"&保存地址
- Shell.Run Cmd
- End If
- Set Shell = Nothing
- End Sub
- Function 获取文件夹大小(目标文件夹)
- Dim fso
- Set fso = CreateObject("Scripting.FileSystemObject")
- 获取文件夹大小 = fso.getfolder(目标文件夹).size
- Set fso = Nothing
- End Function
- Function 获取路径(ms)'获取路径
- 'ms=0 当前路径:ms=1 自启动路径:ms=2 Windows路径:ms=3 system32路径:ms=4 桌面路径:ms=5 当前软件全路径
- Dim WshShell
- Set WshShell = CreateObject("Wscript.Shell")
- Select Case ms
- Case 0:获取路径= WshShell.CurrentDirectory '当前路径
- Case 1:获取路径= WshShell.SpecialFolders("startup")'自启动路径
- Case 2:获取路径=WshShell.expandenvironmentstrings("%windir%")'Windows路径
- Case 3:获取路径=WshShell.expandenvironmentstrings("%windir%")&"\system32"'system32路径
- Case 4:获取路径= WshShell.SpecialFolders("Desktop")'桌面路径
- Case 5:a0a= space(260):GetModuleFileName NULL,a0a, 260:获取路径=a0a'当前软件全路径
- End Select
- Set WshShell = Nothing
- End Function
- Function 获取文件名(Path)'获取文件名
- Dim fso
- Set fso = CreateObject("Scripting.FileSystemObject")
- 获取文件名= fso.GetFile(Path).name
- Set fso = Nothing
- End Function
复制代码
附件: 您需要登录才可以下载或查看附件。没有帐号? 注册
|