■模块代码
Public cmnu, re
■主界面代码
▲窗体加载
Private Sub Form_Load()
Form1.Caption = "用户信息系统(" & "未登录" & ")"
End Sub
▲进入变数管理
Private Sub mnubs_Click()
Dim msg
If re = 0 Then msg = MsgBox("你还未登录,无法查看变数。", 0 + 64, "无法查看变数"):
Exit Sub
Dialog4.Show 1
End Sub
▲进入好友列表管理
Private Sub mnudialog3_Click()
Dim msg
If re = 0 Then msg = MsgBox("你还未登录,无法查看好友列表。", 0 + 64, "无法查看好友列表"):
Exit Sub
Dialog3.Show 1
End Sub
▲登录
Private Sub mnulog_Click()
Dim msg, f, i, s
If re <> 0 Then msg = MsgBox("用户正在使用本系统，请注销后再登录。", 0 + 64,
"无法登录系统"): Exit Sub
cmnu = 1: Dialog2.Show 1
If re > 0 Then f = fileline(App.Path & "\log.txt", re):
Form1.Caption = "用户信息系统(" & dtxt(f, " ", 1) & ")"
End Sub
▲注册
Private Sub mnuvuce_Click()
cmnu = 2: Dialog2.Show 1
End Sub
▲注销
Private Sub mnuvuxk_Click()
Dim i, s, f
re = 0: Form1.Caption = "用户信息系统(" & "未登录" & ")"
End Sub
▲修改密码
Private Sub mnuxngsmima_Click()
Dim msg
If re = 0 Then msg = MsgBox("你还未登录,无法修改密码。", 0 + 64, "无法修改密码"):
Exit Sub
cmnu = 3: Dialog2.Show 1
End Sub
▲退出系统
Private Sub mnuend_Click()
End
End Sub
■用户密码管理
▲推出系统
Private Sub CancelButton_Click()
Unload Me
End Sub
▲号码列表单击
Private Sub Combo1_Click()
Dim i, s
For i = 0 To Combo1.ListCount - 1
If Combo1.Text = Combo1.List(i) Then Exit
For
Next i
i = i + 1: s = fileline(App.Path & "\log.txt", i): Check1.Value
= Val(dtxt(s, " ", 3)): Label4_Click
If Val(dtxt(s, " ", 3)) = 1 Then
Text1.Text = dtxt(s, " ", 2)
Else
Text1.Text = "":
End If
End Sub
▲窗体加载
Private Sub Form_Load()
Dim i, s
If cmnu = 1 Then
For i = 0 To Frame1.Count - 1
Frame1(i).Visible = IIf(Int(i) = 0, True,
False)
Frame1(i).BorderStyle = 0
Next i
For i = 1 To filecount(App.Path &
"\log.txt")
s = fileline(App.Path & "\log.txt", i):
Combo1.AddItem dtxt(s, " ", 1)
Next i
Combo1.Text = Combo1.List(IIf(re = 0, 0, re -
1)): Combo1_Click
OKButton.Caption = "登录": Dialog2.Caption =
"登录系统": Text5.Text = "": Label4_Click
End If
If cmnu = 2 Then
For i = 0 To Frame1.Count - 1
Frame1(i).Visible = IIf(Int(i) = 1, True,
False)
Frame1(i).BorderStyle = 0
Next i
For i = 0 To Label3.Count - 1
Label3(i).Caption = Choose(i + 1, "号码", "密码",
"确认密码")
Next i
OKButton.Caption = "注册": Dialog2.Caption =
"注册用户"
Text2.Text = "": Text3.Text = "": Text4.Text =
""
End If
If cmnu = 3 Then
For i = 0 To Frame1.Count - 1
Frame1(i).Visible = IIf(Int(i) = 1, True,
False)
Frame1(i).BorderStyle = 0
Next i
For i = 0 To Label3.Count - 1
Label3(i).Caption = Choose(i + 1, "旧密码", "新密码",
"确认密码")
Next i
OKButton.Caption = "修改": Dialog2.Caption =
"修改密码"
Text2.Text = "": Text3.Text = "": Text4.Text =
"": Text2.PasswordChar = "*"
End If
End Sub
▲删除用户
Private Sub Label5_Click()
Dim i, s, a, msg
If filecount(App.Path & "\log.txt") = 0 Or Combo1.Text = ""
Then Exit Sub
For i = 1 To filecount(App.Path & "\log.txt")
s = fileline(App.Path & "\log.txt", i)
If dtxt(s, " ", 1) = Combo1.Text Then Exit
For
Next i
If i <= filecount(App.Path & "\log.txt") Then
msg = MsgBox("是否要删除此用户?", 4 + 32, "确认删除用户")
If msg = vbYes Then
Call filerem(App.Path & "\log.txt", i): Kill
App.Path & "\friend\" & dtxt(s, " ", 1) & ".txt"
Kill App.Path & "\user\" & dtxt(s, " ",
1) & ".txt": a = i: a = IIf(a = 1, 1, a - 1):
Combo1.Clear
For i = 1 To filecount(App.Path &
"\log.txt")
s = fileline(App.Path &
"\log.txt", i): Combo1.AddItem dtxt(s, " ", 1)
Next i
Combo1.Text = Combo1.List(a - 1):
Combo1_Click
End If
Else
msg = MsgBox("此用户不存在，无法删除此用户!", 0 + 16,
"此用户不存在")
End If
End Sub
▲确定按钮单击
Private Sub OKButton_Click()
Dim i, msg, j, s: j = 0
If cmnu = 1 Then
For i = 1 To filecount(App.Path &
"\log.txt")
s = fileline(App.Path & "\log.txt", i)
If dtxt(s, " ", 1) = Combo1.Text Then Exit
For
Next i
If Text1.Text = "" Then msg = MsgBox("请输入密码", 0 +
16, "密码为空"): Exit Sub
If dtxt(s, " ", 2) = Text1.Text And i <=
filecount(App.Path & "\log.txt") Then
Form1.Caption = dtxt(s, " ", 1): re = i
s = ctxt(" ", Left(s, defc(s, " ", 2) - 1),
Check1.Value): Call Module1.filelist(App.Path & "\log.txt", i,
s): Unload Me
Else
If dtxt(s, " ", 2) <> Text1.Text
Then
msg = MsgBox("密码错误，请重新输入", 0 +
16, "密码错误"): Text1.Text = "": Label4_Click
ElseIf UCase(Text5.Text) <>
UCase(Label4.Caption) Then
msg = MsgBox("验证码错误，请重新输入", 0
+ 16, "验证码错误"): Text5.Text = "": Label4_Click
Else
End If
End If
End If
If cmnu = 2 Then
If Text2.Text = "" Then msg = MsgBox("请输入用户名", 0
+ 16, "用户名为空"): Exit Sub
If Text3.Text = "" Then msg = MsgBox("请输入密码", 0 +
16, "密码为空"): Exit Sub
If Text4.Text = "" Then msg = MsgBox("请输入确认密码", 0
+ 16, "确认密码为空"): Exit Sub
j = 0
For i = 1 To filecount(App.Path &
"\log.txt")
s = fileline(App.Path & "\log.txt", i)
If dtxt(s, " ", 1) = Text2.Text Then j = j +
1
Next i
If j = 0 And Text3.Text = Text4.Text Then
s = ctxt(" ", Text2.Text, Text3.Text, 0): Call
Module1.fileadd(App.Path & "\log.txt", 0, s):
Call fileclear(App.Path & "\user\" &
Text2.Text & ".txt"): Call fileclear(App.Path & "\friend\"
& Text2.Text & ".txt")
msg = MsgBox("恭喜你，注册成功", 0 + 64, "注册成功"): Unload
Me
Else
If j <> 0 Then msg =
MsgBox("用户名已存在，请重新输入", 0 + 16, "用户名已存在"): Text2.Text = "": Exit
Sub
If Text3.Text <> Text4.Text Then msg =
MsgBox("密码输入不一致，请重新输入", 0 + 16, "密码输入不一致"): Text3.Text = "":
Text4.Text = "": Exit Sub
End If
End If
If cmnu = 3 Then
If Text2.Text = "" Then msg = MsgBox("请输入旧密码 ", 0
+ 16, "旧密码为空"): Exit Sub
If Text3.Text = "" Then msg = MsgBox("请输入新密码", 0
+ 16, "新密码为空"): Exit Sub
If Text4.Text = "" Then msg = MsgBox("请输入确认新密码",
0 + 16, "确认新密码为空"): Exit Sub
s = fileline(App.Path & "\log.txt", re)
If dtxt(s, " ", 2) = Text2.Text And Text3.Text =
Text4.Text Then
s = ctxt(" ", Left(s, defc(s, " ", 1) - 1),
Text3.Text, 0): Call Module1.filelist(App.Path & "\log.txt",
re, s)
msg = MsgBox("恭喜你，修改密码成功", 0 + 64, "修改密码成功"):
Unload Me
Else
If Text2.Text <> dtxt(s, " ", 2) Then msg
= MsgBox("旧密码错误，请重新输入", 0 + 16, "旧密码错误"): Text2.Text = "": Exit
Sub
If Text3.Text <> Text4.Text Then msg =
MsgBox("新密码与确认新密码输入不一致，请重新输入", 0 + 16, "新密码与确认新密码输入不一致"):
Text3.Text = "": Text4.Text = "": Exit Sub
End If
End If
End Sub
■变数管理
▲定义窗体变量f(f表示用户变数所在的文件)
Option Explicit: Dim f
▲单击取消按钮
Private Sub CancelButton_Click()
Unload Me
End Sub
▲移动变数
Private Sub Cmdmove_Click(Index As Integer)
Dim i, s, a
If List1.SelCount <> 0 Then
For i = 0 To List1.ListCount - 1
If List1.Selected(i) = True Then Exit For
Next i
i = i + 1: a = i: s = fileline(f, i)
If Index = 0 Then
If i > 1 Then
Call Module1.filerem(f, i): i
= i - 1
Call Module1.fileadd(f, i,
s):
End If
End If
If Index = 1 Then
If i < filecount(f) Then
Call Module1.filerem(f, i): i
= i + 1
Call Module1.fileadd(f, i,
s):
End If
End If
Call file: List1.Selected(i - 1) = True: Call
cmd
End If
End Sub
▲添加修改变数
Private Sub Cmdok_Click()
Dim i, s, a, re1:
If re = 0 Then Exit Sub
For i = 1 To filecount(f)
s = fileline(f, i)
If dtxt(s, "=", 1) = Text1.Text Then Exit
For
Next i
re1 = i
If List1.SelCount <> 0 Then
For i = 0 To List1.ListCount - 1
If List1.Selected(i) = True Then Exit For
Next i
a = i + 1
If Text1.Text = "" Then Call Label2_Click(2):
Exit Sub
If re1 <= filecount(f) And re1 <> a
Then
s = fileline(f, a): i = MsgBox("变数名已存在，请重新输入",
16, "变数名已存在")
Text1.SetFocus: Text1.Text = dtxt(s, "=", 1):
Exit Sub
Else
s = ctxt("=", Text1.Text, IIf(Text2.Text = "",
0, Text2.Text)): Call filelist(f, a, s)
End If
Else
If Text1.Text = "" Then i = MsgBox("请输入变数名", 16,
"变数名为空"): Exit Sub
If re1 <= filecount(f) Then i =
MsgBox("变数名已存在，请重新输入", 16, "变数名已存在"): Text1.SetFocus: Text1.Text =
"": Exit Sub
s = ctxt("=", Text1.Text, IIf(Text2.Text = "", 0,
Text2.Text))
Call Module1.fileadd(f, 0, s): a =
filecount(f)
End If
Call file: If List1.ListCount > 0 Then List1.Selected(a - 1) =
True
End Sub
▲窗体加载
Private Sub Form_Load()
Dim s
s = fileline(App.Path & "\log.txt", re): Me.Caption = "查看变数("
& dtxt(s, " ", 1) & ")"
f = ctxt("", App.Path, "\user\", dtxt(s, " ", 1), ".txt"): Call
cmd
Call file: If List1.ListCount > 0 Then List1.Selected(0) = True
Else Label3.Caption = "": Text1.Text = "": Text2.Text = ""
End Sub
▲操作变数
Private Sub Label2_Click(Index As Integer)
Dim i, s, b, a, j, msg
If Index = 0 Then
a = InputBox("请输入变数名称", "查找变数")
If a = "" Then co 1: Exit Sub
For i = 1 To filecount(f)
s = fileline(f, i)
If dtxt(s, "=", 1) = a Then Exit For
Next i
If i <= filecount(f) Then
List1.Selected(i - 1) = True
Else
For i = 0 To List1.ListCount - 1
If List1.Selected(i) = True
Then List1.Selected(i) = False: Exit For
Next i
Label3.Caption = "": Text1.Text = a: Text2.Text
= ""
End If
co 1: Text2.SetFocus: Call cmd
ElseIf Index = 1 Then
For i = 0 To List1.ListCount - 1
If List1.Selected(i) = True Then
List1.Selected(i) = False: Exit For
Next i
Label3.Caption = "": Text1.Text = "": Text2.Text
= "": Text1.SetFocus: Call cmd
ElseIf Index = 2 Then
If List1.SelCount > 0 Then
For i = 0 To List1.ListCount - 1
If List1.Selected(i) = True
Then Exit For
Next i
msg = MsgBox("是否要删除此变数?", 4 + 32, "确认删除变数"): co
1
If msg = vbYes Then
i = i + 1: Call filerem(f, i):
a = IIf(i = 1, 1, i - 1): Call file
If List1.ListCount > 0 Then
List1.Selected(a - 1) = True Else Call List1_Click
End If
End If
ElseIf Index = 3 Then
msg = MsgBox("是否要清空变数?", 4 + 32, "确认清空变数"): co
1
If msg = vbYes Then Call fileclear(f): Call file:
Call List1_Click
Else
End If
End Sub
▲列表框单击
Private Sub List1_Click()
Dim i, s
If List1.SelCount > 0 Then
For i = 0 To List1.ListCount - 1
If List1.Selected(i) = True Then Exit For
Next i
s = fileline(f, i + 1)
If s = "" Then Exit Sub
Label3.Caption = ctxt("", "变数", dtxt(s, "=", 1),
"的值为:", dtxt(s, "=", 2))
Text1.Text = dtxt(s, "=", 1): Text2.Text =
dtxt(s, "=", 2)
Else
Label3.Caption = "": Text1.Text = "": Text2.Text
= "":
End If
Call cmd
End Sub
▲单击确定按钮
Private Sub OKButton_Click()
Unload Me
End Sub
▲变数文本框操作①
Private Sub Text1_KeyDown(KeyCode As Integer, Shift As
Integer)
If KeyCode = 13 Then Cmdok.Value = True
If KeyCode = vbKeyF1 Then Call List1_Click
If KeyCode = vbKeyF2 Then Call Label2_Click(1)
If KeyCode = vbKeyDown And Shift = 2 Then
Cmdmove(1).Value = True
ElseIf KeyCode = vbKeyUp And Shift = 2 Then
Cmdmove(0).Value = True
ElseIf KeyCode = vbKeyUp Or KeyCode = vbKeyDown Then
Dim i, y
If List1.ListCount = 0 Then Exit Sub
If List1.SelCount = 0 Then
If KeyCode = vbKeyDown Then List1.Selected(0) =
True
If KeyCode = vbKeyUp Then
List1.Selected(List1.ListCount - 1) = True
Else
For i = 0 To List1.ListCount - 1
If List1.Selected(i) = True
Then Exit For
Next i
If KeyCode = vbKeyDown Then i = fmod(i + 1,
List1.ListCount): List1.Selected(i) = True
If KeyCode = vbKeyUp Then i = fmod(i - 1,
List1.ListCount): List1.Selected(i) = True
End If
Else
End If
End Sub
▲变数文本框操作②
Private Sub Text2_KeyDown(KeyCode As Integer, Shift As
Integer)
Call Text1_KeyDown(KeyCode, Shift)
End Sub
▲把文件添加到列表框
Public Sub file()
Dim i, s: List1.Clear
For i = 1 To filecount(f)
s = fileline(f, i): List1.AddItem dtxt(s, "=",
1)
Next i
End Sub
▲移动按钮状态
Public Sub cmd()
Dim i
If List1.SelCount > 0 And List1.ListCount > 1 Then
For i = 0 To List1.ListCount - 1
If List1.Selected(i) = True Then Exit For
Next i
If i = 0 Then
Cmdmove(0).Enabled = False: Cmdmove(1).Enabled =
True
ElseIf i = List1.ListCount - 1 Then
Cmdmove(0).Enabled = True: Cmdmove(1).Enabled =
False
Else
Cmdmove(0).Enabled = True: Cmdmove(1).Enabled =
True
End If
Else
Cmdmove(0).Enabled = False: Cmdmove(1).Enabled =
False
End If
End Sub
■好友管理
▲定义窗体变量z(z表示用户好友列表所在的文件)
Option Explicit: Dim z
▲添加好友
Private Sub Cmdadd1_Click()
Dim i, re1, re2, msg, s, c, s1, j, a
For i = 1 To filecount(z)
If fileline(z, i) = Combo2.Text Then Exit
For
Next i
re1 = i: s = fileline(z, re1)
For i = 0 To List1.ListCount - 1
If List1.Selected(i) = True Then Exit For
Next i
If i > List1.ListCount - 1 Then msg = MsgBox("你还没有选择好友，请选择好友", 0
+ 64, "请选择好友"): Exit Sub
c = i + 1: j = 0
If Option1(0).Value = True Then
For i = 1 To filecount(App.Path &
"\friendlist.txt")
s1 = fileline(App.Path & "\friendlist.txt",
i)
If dtxt(s1, " ", 2) = Text2.Text Then j = j +
1
If j = c Then Exit For
Next i
ElseIf Option1(1).Value = True Then
For i = 1 To filecount(App.Path &
"\friendlist.txt")
s1 = fileline(App.Path & "\friendlist.txt",
i)
If dtxt(s1, " ", 1) = Text2.Text Then j = j +
1
If j = c Then Exit For
Next i
Else
End If
For i = 1 To filecount(z)
s = fileline(z, i)
If midij(s, 2, Len(s)) = dtxt(s1, " ", 1) Then
Exit For
Next i
If i <= filecount(z) Then
msg = MsgBox("该好友已经存在你的好友列表中，不需要添加", 0 + 16,
"该好友已存在")
Else
Call fileadd(z, re1 + pc(Combo2.Text) + 1,
ctxt("", " ", dtxt(s1, " ", 1))): Call tree: TreeView1.Nodes(re1 +
pc(Combo2.Text)).Selected = True
End If
End Sub
▲查找好友①
Private Sub Cmdfind_Click()
Me.Width = IIf(Me.Width = 8910, 5030, 8910)
If Me.Width = 8910 Then Text2.Text = "": Call item(1):
Label2.Caption = "": List1.Clear: Option1(0).Value = True
End Sub
▲查找好友②
Private Sub Cmdfind1_Click()
Dim i, a, s, j: List1.Clear: j = 0
If Option1(0).Value = True Then
For i = 1 To filecount(App.Path &
"\friendlist.txt")
s = fileline(App.Path & "\friendlist.txt",
i)
If dtxt(s, " ", 2) = Text2.Text Then
List1.AddItem dtxt(s, " ", 1) & "[" & dtxt(s, " ", 2) &
"]": j = j + 1
Next i
ElseIf Option1(1).Value = True Then
For i = 1 To filecount(App.Path &
"\friendlist.txt")
s = fileline(App.Path & "\friendlist.txt",
i)
If dtxt(s, " ", 1) = Text2.Text Then Exit
For
Next i
If i <= filecount(App.Path &
"\friendlist.txt") Then List1.AddItem dtxt(s, " ", 1) & "["
& dtxt(s, " ", 2) & "]": j = j + 1
Else
End If
Label2.Caption = "共找到" & j & "位好友"
End Sub
▲移动好友
Private Sub Cmdmc_Click()
Dim i, s, msg, r, re1, re2
If Combo1(1).ListCount = 0 Then Exit Sub
For i = 1 To TreeView1.Nodes.Count
If TreeView1.Nodes(i).Selected Then Exit
For
Next i
If i > TreeView1.Nodes.Count Then Exit Sub
r = fileline(z, i)
If i <= filecount(z) And midia(r, 1, 1) = " " Then
Call filerem(z, i):
For i = 1 To filecount(z)
If fileline(z, i) = Combo1(1).Text Then Exit
For
Next i
re1 = i
For i = re1 To filecount(z)
If fileline(z, i) <> Combo1(1).Text And
midia(fileline(z, i), 1, 1) <> " " Then Exit For
Next i
re2 = i
Call fileadd(z, re2, r): Call tree:
TreeView1.Nodes(re2).Selected = True
End If
Call cmd
End Sub
▲移动好友和分组
Private Sub Cmdmove_Click(Index As Integer)
Dim i, s, msg, a, m, s1, j:
For i = 1 To TreeView1.Nodes.Count
If TreeView1.Nodes(i).Selected Then Exit
For
Next i
If i > TreeView1.Nodes.Count Then Exit Sub
s = fileline(z, i)
If midia(s, 1, 1) <> " " Then
a = i
If Index = 0 Then
If a = 1 Then Exit Sub
For i = a - 1 To 1 Step -1
If midia(fileline(z, i), 1, 1)
<> " " Then Exit For
Next i
m = i:
For i = 1 To pc(s) + 1
s1 = fileline(z, a + i - 1):
Call filerem(z, a + i - 1): Call fileadd(z, m + i - 1, s1)
Next i
Call tree: Call item(1):
TreeView1.Nodes(m).Selected = True
s = TreeView1.Nodes(m).Text
End If
If Index = 1 Then
If a = cp Then Exit Sub
j = 0
For i = a + 1 To filecount(z)
If midia(fileline(z, i), 1, 1)
<> " " Then j = j + 1
If j = 2 Then Exit For
Next i
m = i:
For i = 1 To pc(s) + 1
s1 = fileline(z, a): Call
filerem(z, a): Call fileadd(z, m - 1, s1):
Next i
Call tree: Call item(1): TreeView1.Nodes(m -
pc(s) - 1).Selected = True
s = TreeView1.Nodes(m - pc(s) - 1).Text
End If
Combo1(0).Text = Left(s, defc(s, "(", 1) - 1):
Combo1(1).Text = Left(s, defc(s, "(", 1) - 1)
Else
a = i
If Index = 0 Then
If a > 2 Then Call filerem(z, a): a = a - 1:
Call fileadd(z, a, s)
End If
If Index = 1 Then
If a < filecount(z) Then Call filerem(z, a):
a = a + 1: Call fileadd(z, a, s)
End If
Call tree: TreeView1.Nodes(a).Selected =
True
End If
Call cmd
End Sub
▲删除好友和好友分组
Private Sub Cmdrem_Click()
Dim i, s, msg, re1, re2, r, a, m
For i = 1 To TreeView1.Nodes.Count
If TreeView1.Nodes(i).Selected Then Exit
For
Next i
If i > TreeView1.Nodes.Count Then Exit Sub
a = fileline(z, i): m = i
If midia(a, 1, 1) <> " " Then
msg = MsgBox("是否要删除此类别下所有项目?", 4 + 32,
"确认删除类别")
If msg = vbYes Then
For i = m + pc(a) To m Step -1
Call filerem(z, i)
Next i
Call tree: Call item(1)
End If
Else
msg = MsgBox("是否要删除此项目?", 4 + 32, "确认删除项目")
If msg = vbYes Then Call filerem(z, m): Call
tree
End If
Call cmd
End Sub
▲窗体加载
Private Sub Form_Load()
Dim f
f = fileline(App.Path & "\log.txt", re): Me.Caption = "好友列表("
& dtxt(f, " ", 1) & ")": f = ctxt("", App.Path, "\friend\",
dtxt(f, " ", 1), ".txt")
z = f: Call tree: Call item(1): Call cmd: Cmdfind.Value =
True:
If TreeView1.Nodes.Count > 0 Then TreeView1.Nodes(1).Selected =
True Else Call TreeView1_Click
End Sub
▲从文件中添加好友列表
Public Sub tree()
Dim x1, x2, i, s, nodx, i1, s1, j: x1 = 0: x2 = 0: j = 0:
TreeView1.Nodes.Clear
For i = 1 To filecount(z)
s = fileline(z, i):
If midia(s, 1, 1) <> " " Then
x1 = x1 + 1: Set nodx = TreeView1.Nodes.add(, ,
"1-" & x1, s & "(" & pc(s) & ")"):
Else
For i1 = 1 To filecount(App.Path &
"\friendlist.txt")
s1 = fileline(App.Path &
"\friendlist.txt", i1)
If dtxt(s1, " ", 1) = midij(s,
2, Len(s)) Then Exit For
Next i1
x2 = x2 + 1: Set nodx = TreeView1.Nodes.add("1-"
& x1, tvwChild, "2-" & x2, dtxt(s1, " ", 2))
End If
Next i
End Sub
▲从文件中添加好友分组
Public Sub item(y)
Dim s, i, j, x, a: x = 1
If y = 1 Then
Combo1(0).Clear: Combo1(1).Clear:
Combo1(0).AddItem "类别": Combo2.Clear
While x <= filecount(z)
j = 0: s = fileline(z, x):
If midia(s, 1, 1) <> " " Then
Combo1(0).AddItem s: Combo1(1).AddItem s: Combo2.AddItem s
x = x + 1
Wend
If Combo1(0).ListCount > 0 Then Combo1(0).Text
= Combo1(0).List(0):
If Combo1(1).ListCount > 0 Then Combo1(1).Text
= Combo1(1).List(0):: Combo2.Text = Combo2.List(0)
End If
End Sub
▲添加好友和好友分组
Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Dim i, re1, re2, msg, s
If Combo1(0).ListCount = 0 Then Exit Sub
If Combo1(0).Text <> "类别" Then
For i = 1 To filecount(z)
If fileline(z, i) =
Combo1(0).Text Then Exit For
Next i
re1 = i
If Text1.Text = "" Then msg = MsgBox("请输入项目名", 0
+ 16, "项目名为空"): Exit Sub
For i = re1 To filecount(z)
If fileline(z, i) <>
Combo1(0).Text And midia(fileline(z, i), 1, 1) <> " " Then
Exit For
Next i
re2 = i
Call fileadd(z, re2, ctxt("", " ", Text1.Text)):
Call tree: TreeView1.Nodes(re2).Selected = True
Else
For i = 1 To filecount(z)
s = fileline(z, i):
If s = Text1.Text Then Exit
For
Next i
If Text1.Text = "" Then msg = MsgBox("请输入类别名", 0
+ 16, "类别名为空"): Exit Sub
re1 = i
If re1 <= filecount(z) Then
msg = MsgBox("该类别已存在,请重新输入", 0
+ 16, "该类别已存在"): Text1.Text = ""
Else
Call fileadd(z, 0,
Text1.Text): Call tree: Call item(1)
End If
End If
Call cmd
End If
End Sub
▲查找好友文本框按键
Private Sub Text2_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then Cmdfind1.Value = True
End Sub
▲修改好友和好友分组
Private Sub Text3_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Dim i, s, msg, re, a
For i = 1 To TreeView1.Nodes.Count
If TreeView1.Nodes(i).Selected Then Exit
For
Next i
If i > TreeView1.Nodes.Count Then Exit
Sub
s = fileline(z, i): a = i
If midia(s, 1, 1) <> " " Then
For i = 1 To filecount(z)
s = fileline(z, i):
If s = Text3.Text Then Exit
For
Next i
re = i
If Text3.Text = "" Then msg = MsgBox("请输入类别名", 0
+ 16, "类别名为空"): Exit Sub
For i = 1 To filecount(z)
s = fileline(z, i):
If s = fileline(z, a) Then
Exit For
Next i
If re <= filecount(z) And re <> i
Then
msg = MsgBox("该类别已存在,请重新输入", 0
+ 16, "该类别已存在"): Text3.Text = ""
Else
Call filelist(z, i,
Text3.Text): Call tree: Call item(1): TreeView1.Nodes(i).Selected =
True
End If
Else
If Text3.Text = "" Then msg = MsgBox("请输入项目名", 0
+ 16, "项目名为空"): Exit Sub
If i <= filecount(z) Then
Call filelist(z, a, ctxt("", "
", Text3.Text)): Call tree
TreeView1.Nodes(i).Selected =
True
End If
End If
Call cmd
End If
End Sub
▲求分组的好友数
Public Function pc(a)
Dim i, s, re1, re2
For i = 1 To filecount(z)
s = fileline(z, i):
If s = a Then Exit For
Next i
re1 = i
For i = re1 To filecount(z)
s = fileline(z, i):
If s <> a And midia(s, 1, 1) <> " "
Then Exit For
Next i
re2 = i - 1: pc = re2 - re1
End Function
▲求最大分组的在文件的行数
Public Function cp()
Dim i, j, s, a
For i = 1 To filecount(z)
s = fileline(z, i):
If midia(s, 1, 1) <> " " Then j = j +
1
Next i
a = j: j = 0
For i = 1 To filecount(z)
s = fileline(z, i):
If midia(s, 1, 1) <> " " Then j = j +
1
If j = a Then Exit For
Next i
cp = i
End Function
▲好友列表单击
Private Sub TreeView1_Click()
Dim i, s, re1
For i = 1 To TreeView1.Nodes.Count
If TreeView1.Nodes(i).Selected Then Exit
For
Next i
If i <= TreeView1.Nodes.Count Then
s = fileline(z, i): Call cmd: re1 = i
If midia(s, 1, 1) <> " " Then
Combo1(0).Text = s
Else
For i = re1 To 1 Step -1
s = fileline(z, i)
If midia(s, 1, 1) <> " "
Then Exit For
Next i
Combo1(0).Text = s
End If
End If
Call cmd
End Sub
▲移动按钮状态
Public Sub cmd()
Dim i, s, c, j: j = 0
For i = 1 To filecount(z)
If midia(fileline(z, i), 1, 1) <> " " Then
j = j + 1
Next i
c = j
For i = 1 To TreeView1.Nodes.Count
If TreeView1.Nodes(i).Selected Then Exit
For
Next i
If i <= TreeView1.Nodes.Count And TreeView1.Nodes.Count > 1
Then
s = fileline(z, i)
If midia(s, 1, 1) = " " Then
If i = 2 Then
Cmdmove(0).Enabled = False:
Cmdmove(1).Enabled = True
ElseIf i = TreeView1.Nodes.Count Then
Cmdmove(0).Enabled = True:
Cmdmove(1).Enabled = False
Else
Cmdmove(0).Enabled = True:
Cmdmove(1).Enabled = True
End If
Else
If i = 1 Then
Cmdmove(0).Enabled = False:
Cmdmove(1).Enabled = True
ElseIf i = cp Then
Cmdmove(0).Enabled = True:
Cmdmove(1).Enabled = False
Else
Cmdmove(0).Enabled = True:
Cmdmove(1).Enabled = True
End If
End If
Else
Cmdmove(0).Enabled = False: Cmdmove(1).Enabled =
False
End If
End Sub
1037
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
