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
'设定文件属性
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 '设定为只读
Const FILE_ATTRIBUTE_HIDDEN = &H2 '设定为隐藏
Const FILE_ATTRIBUTE_SYSTEM = &H4 '设定为系统
Const FILE_ATTRIBUTE_ARCHIVE = &H20 '设定为保存
Const FILE_ATTRIBUTE_NORMAL = &H80 '设定为一般 (取消前四种属性)

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
'文件复制
FileCopy Source, Destination
'删除文件
Kill Source
'设定文件隐藏属性
'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