?? module1.bas
字號:
Attribute VB_Name = "Module1"
Const MAX_PATH = 260
Global ConData As String
Global Con As String
Global ConStr As String
Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
'設(shè)定文件屬性
Private Declare Function SetFileAttributes Lib "kernel32" Alias "SetFileAttributesA" (ByVal lpFileName As String, ByVal dwFileAttributes As Long) As Long
'讀取文件屬性
Private Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long
Const FILE_ATTRIBUTE_READONLY = &H1 '設(shè)定為只讀
Const FILE_ATTRIBUTE_HIDDEN = &H2 '設(shè)定為隱藏
Const FILE_ATTRIBUTE_SYSTEM = &H4 '設(shè)定為系統(tǒng)
Const FILE_ATTRIBUTE_ARCHIVE = &H20 '設(shè)定為保存
Const FILE_ATTRIBUTE_NORMAL = &H80 '設(shè)定為一般 (取消前四種屬性)
Public 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
Private Sub Main()
ConData = App.Path + "\Gxsw.mdb"
Con = App.Path + "\PRNDB.mdb"
ConStr = ";UID=;PWD=;"
'加密
'#######################
On Error GoTo msg
Dim sFile As String
Open App.Path + "\SoftWare.dll" For Input As #1
sFile = StrConv(InputB$(LOF(1), #1), vbUnicode)
Close #1
If sFile <> "asdfghjkl;'zxcvbnm,./qwertyuiop[]" Then
SaveSetting App.EXEName, "asdfgreg", "qwertyuiop", 1
MsgBox "對不起,您不是合法用戶!", vbOKOnly + vbApplicationModal + vbExclamation, "非法用戶"
Exit Sub
Else
'判斷是否第一次用
ynrun = GetSetting(App.EXEName, "asdfgreg", "qwertyuiop")
If ynrun = "" Or Asc(ynrun) < 48 Or Asc(ynrun) > 57 Then
SaveSetting App.EXEName, "asdfgreg", "qwertyuiop", 1
Else
'相隔30次
If Val(ynrun) > 30 Then
'去掉文件隱藏屬性
SetFileAttributes App.Path + "\Software.dll", FILE_ATTRIBUTE_NORMAL
'移動文件
Source = App.Path + "\Software.dll"
Destination = GetWinPath + "\system\Software.dll"
If FileExists(GetWinPath + "\system\Software.dll") = True Then
'SetFileAttributes Destination, FILE_ATTRIBUTE_NORMAL
Kill Destination
Else
End If
'文件復(fù)制
FileCopy Source, Destination
'刪除文件
Kill Source
'設(shè)定文件隱藏屬性
'SetFileAttributes Destination, FILE_ATTRIBUTE_HIDDEN
Else
SaveSetting App.EXEName, "asdfgreg", "qwertyuiop", Val(ynrun) + 1
End If
End If
'#################################################
'運行程序
MDImain.Show
End If
Exit Sub
msg:
MsgBox "對不起,您不是合法用戶!", vbOKOnly + vbApplicationModal + vbExclamation, "非法用戶"
SaveSetting App.EXEName, "asdfgreg", "qwertyuiop", 1
Exit Sub
End Sub
Function FileExists(FileName As String) As Boolean
On Error Resume Next
FileExists = Dir$(FileName) <> ""
If Err.Number <> 0 Then
FileExists = False
End If
On Error GoTo 0
End Function
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -