主框架已确定好了，为了方便后续布署，选择了VB做前端，Access做数据库的形式。具体思路如下：
1. ADO 连接ACCESS 全部写到模块 Function 里面，如果后面要升级把数据移到Mysql或是云数据库，只要重写这些连接就行了。
2. 考虑到Access的容量和并发有限，软件分多个功能模块，为每个功能模备独立的MDB数据库, 数据交互时要用到比较多的平面合查询，共用全局联接函数需要设计的好一些。
3. 图片，文件类体积较大的全部用加载读到界面，和指定转存到局域网设定的文件夹内，这样数据库内只用来存纯数据。
这样的话，通过多数据库，和文件存文件夹的方式，应该是可以比较有效的缓解了Access的容量和并发的短处了
这两天做好了登陆窗体，和主框架
1. 登陆窗体上有 单选按钮，可以指定程序路径方式，计划设为：单机、局域网、互联网（目有没有做，要买云数据库）
2. TXT做为，登陆窗体的登陆信息的配置文件，登陆时可以加载上次登陆的信息（这里在想能不能把TXT加密转换成乱码，但又怕影响加载时的读入，后面有空时试一下）
3. 主窗体用MID 窗口，左边用treeview 做功能菜单，点击Node 可以在各功能菜单中转换。tree是通过从数据库加载的，所以支持更换名字和图片。
4. 主窗体左边的功能菜单具备往左边滑入隐藏和拉出效果。子窗体同MID窗体无缝同步缩放（为了解决拉动缩放时的闪屏问题花了我一些时间）
下面上图，和部分代码。
（不知怎么做哪种点击演示的Gif动图，也不知论坛是否支持这个功能）
这是几做好的几个界面，下面附上登陆界面的代码，好像前几天看到有人在找这个。
程序代码：
Private Sub Form_Load() '//登陆界面加载
YN = False
Call LoadPath '''加载路径
Call LoadData '''加载预存信息
Call AddIDist '''加载账号list
Rem MeLogo.Picture = LoadPicture(FindPic("\Images\TPIC", "logo001"))'// 用于设计登陆界面加公司logo
End Sub
Private Sub Timer1_Timer()
Unload Me
A0MDIForm1.Show 0
Timer1.Interval = 1000 '开启时钟给予显示登陆成功的提示时间
End Sub
Private Sub Option1_Click() '// 点击后单机路径载入本地数据库
On Error GoTo errmsg
If YN = True Then Exit Sub '如果是由备存记忆带来的触发直接跳转
myPath = App.Path '// 点击后将单机路径赋给变量
Call SavePath '// 路径信息存盘
GoTo 111
errmsg:
MsgBox Err.Description, , "错误报告"
111
End Sub
Private Sub Option2_Click() '// 把共享数据库路径写入本地数据库
On Error GoTo errmsg
If YN = True Then Exit Sub '//如果是由备存记忆带来的触发直接跳转
myPath = C_SelectPath(Me.hwnd, App.Path)
If myPath = "" Then '//如果没有选择文件夹路径回到选择单机路径
Option1.Value = True
End If
Call SavePath '// 路径信息存盘
GoTo 111
errmsg:
MsgBox Err.Description, , "错误报告"
111
End Sub
Private Sub AddIDist() '//账号获取list
On Error GoTo errmsg
StrDB = "\data\1系统设置.accdb"
myTable = "A2账号管理"
SQL = "select 账号 from " & myTable & ""
Opendb (StrDB)
Set RS = CreateObject("adodb.recordset") '//创建一个数据集保存数据
RS.Open SQL, cnn, 1, 3 '//数据集保存数据
For x = 0 To RS.RecordCount - 1
Me.账号.AddItem RS.Fields!账号
RS.MoveNext
Next
GoTo 111
errmsg:
MsgBox Err.Description, , "错误报告"
111
Disconnect
End Sub
Private Sub 登陆_Click(index As Integer)
On Error GoTo errmsg
Static try_times As Byte '设置一个静态变量来保存登错次数
If Me.账号 = "" Or IsNull(Me.账号) = True Then
Msg ("账号不能为空！")
Me.账号.SetFocus
Exit Sub
End If
If Me.密码 = "" Or IsNull(Me.密码) = True Then
Msg ("密码不能为空！")
Me.密码.SetFocus
Exit Sub
End If
StrDB = "\data\1系统设置.accdb"
myTable = "A2账号管理"
SQL = "select 密码 from " & myTable & " where 账号='" & Me.账号 & "'"
Opendb (StrDB)
Set RS = CreateObject("adodb.recordset") '//创建一个数据集保存数据
RS.Open SQL, cnn, 1, 3 '//数据集保存数据
If Me.密码.Text = RS.Fields!密码 Then
Disconnect '//断开数据库，避免给备存账号造成影响
Frame2.Visible = True
Timer1.Interval = 150 '//开启时钟显示登陆成功字标1秒后关闭
Call SaveData '//对登陆信息进行存盘
Call SavePath '//对设置路径进行存盘
Else
try_times = try_times + 1
If try_times >= 5 Then
Msg ("密码错误5次请联系管理员，系统自动退出！")
Unload Me
End
Exit Sub
End If
Msg ("密码不正确，请重新输入")
Me.密码 = ""
Me.密码.SetFocus
Exit Sub
End If
GoTo 111
errmsg:
MsgBox Err.Description, , "错误报告"
111
End Sub
Private Sub SaveData() 'Rem 把保存密码和勾选状态保存到本地
On Error GoTo errmsg
MyId = Me.账号 '//把当前登陆账号赋值给全局
Dim ID, PW, Ck1, Ck2
ID = Me.账号
PW = Me.密码
Ck1 = Check1.Value
Ck2 = Check2.Value
Open App.Path & "\savedata.txt" For Output As #1
Print #1, ID
Print #1, PW
Print #1, Ck1
Print #1, Ck2
GoTo 111
errmsg:
MsgBox Err.Description, , "错误报告"
111
Close #1
End Sub
Private Sub SavePath() 'Rem 把路径数据备份到本地
On Error GoTo errmsg
If Option1.Value = True Then
Ms = "单机"
Else
Ms = "局网"
End If
Dim Path As String, Op1, Op2 As Boolean
Op1 = Option1.Value
Op2 = Option2.Value
Path = myPath
Open App.Path & "\Savepath.txt" For Output As #1
Print #1, Op1
Print #1, Op2
Print #1, Path
GoTo 111
errmsg:
MsgBox Err.Description, , "错误报告"
111
Close #1
End Sub
Sub LoadPath() '// 加载路径
On Error GoTo errmsg
YN = True '// 加入一个标记判断,登陆自加载中不触发单选框事件
Dim str As String
Dim arr(3) As String
Open App.Path & "\Savepath.txt" For Input As #1
For x = 1 To 3
Line Input #1, str
If str = "" Then '//如果没有加载到路径信息视为第1次直接加载为单机路径
myPath = App.Path
Me.Option1 = True
GoTo 111
End If
arr(x) = str '//把读取到的数据3条写入数组
Next
If arr(1) = True Then '//如果加载的是单机
myPath = App.Path
Me.Option1 = True
Else '//如果加载的是局网就把存盘的路径写入并点选标记
myPath = arr(3)
Me.Option2 = True
End If
GoTo 111
errmsg:
MsgBox Err.Description, , "错误报告"
111
Close #1
End Sub
Sub LoadData() '从TXT文件中把登陆备存数据加载进来
On Error GoTo errmsg
YN = True '// 加入一个标记判断,登陆自加载中不触发单选框事件
Dim str As String
Dim arr(4) As String
Open App.Path & "\SaveData.txt" For Input As #1
For x = 1 To 4
Line Input #1, str
If str = "" Then GoTo 111
arr(x) = str '//把读取到的数据3条写入数组
Next
If arr(3) <> 1 Then GoTo 111 '//如果账号是非记录状态直接结束
If arr(3) = 1 Then
Me.账号 = arr(1)
Me.Check1.Value = Checked
End If
If arr(4) = 1 Then '//如密码是记录状态
Me.密码 = arr(2)
Me.Check2.Value = Checked
End If
GoTo 111
errmsg:
MsgBox Err.Description, , "错误报告"
111
YN = False
Close #1
End Sub
Private Sub 退出_Click()
Unload Me
End
End Sub
'*****************************************************************************************
'01函数名： GetPath
'函数功能： 读档取得数据库路径
'*****************************************************************************************
Rem 从本机存盘加载数据库路径
Function GetPath()
Dim str As String
Dim arr(3) As String
Open App.Path & "\Savepath.txt" For Input As #1
For x = 1 To 3
Line Input #1, str
If str = "" Then '//如果没有加载到路径信息视为第1次直接加载为单机路径
myPath = App.Path
GoTo 222
Else
arr(x) = str '//把读取到的数据3条写入数组
End If
Next
myPath = arr(3) '//如果加载的是单机
222
Close #1 '// 关闭加载
GetPath = myPath
End Function
'*****************************************************************************************
'02函数名： Opendb
'函数功能： 连接到指定名称的数据库
'*****************************************************************************************
Public Sub Opendb(StrDB As String) '//输入一个数据库名，连接到数据库，(前面要带/)
If isConnect = True Then Exit Sub '//如果连接为真
myPath = GetPath
Rem 加载路径结束
Set cnn = CreateObject("adodb.connection") '定义CNN为一个数据集
cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & _
myPath + StrDB + ";jet oledb:database password=" & "0745"
If cnn.State <> adStateOpen Then '对连接做出判断,不成功终止
MsgBox "数据库连接失败！", , "系统提示！"
Else
isConnect = True
End If
End Sub
'*****************************************************************************************
'03函数名： Disconnect
'函数功能： 断开数据库连接
'*****************************************************************************************
Public Sub Disconnect() '// 断开连接
If isConnect = False Then Exit Sub '// 如果处于断开状态直接跳转
cnn.Close
Set cnn = Nothing
isConnect = False
End Sub
[此贴子已经被作者于2021-12-8 19:27编辑过]
