📄 frmexchange.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmExchange
BorderStyle = 3 'Fixed Dialog
Caption = "请选择需要调换的计算机"
ClientHeight = 3840
ClientLeft = 45
ClientTop = 330
ClientWidth = 4860
Icon = "frmExchange.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3840
ScaleWidth = 4860
ShowInTaskbar = 0 'False
Begin VB.CommandButton cmdCancel
Cancel = -1 'True
Height = 420
Left = 3135
Picture = "frmExchange.frx":000C
Style = 1 'Graphical
TabIndex = 2
Top = 945
Width = 1425
End
Begin VB.CommandButton cmdExchange
Default = -1 'True
Height = 420
Left = 3135
Picture = "frmExchange.frx":1778
Style = 1 'Graphical
TabIndex = 1
Top = 420
Width = 1425
End
Begin MSComctlLib.ListView lvSendMessage
Height = 3435
Left = 150
TabIndex = 0
Top = 240
Width = 2685
_ExtentX = 4736
_ExtentY = 6059
View = 3
LabelEdit = 1
LabelWrap = 0 'False
HideSelection = 0 'False
FullRowSelect = -1 'True
GridLines = -1 'True
TextBackground = -1 'True
_Version = 393217
ForeColor = 33023
BackColor = 16777215
Appearance = 1
NumItems = 2
BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Key = "Status"
Text = "状态"
Object.Width = 2206
EndProperty
BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 1
Text = "机号"
Object.Width = 1766
EndProperty
End
Begin MSComctlLib.ImageList ImageList1
Left = 0
Top = 0
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 20
ImageHeight = 20
MaskColor = 12632256
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 2
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmExchange.frx":2EE4
Key = "Run"
EndProperty
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmExchange.frx":33E8
Key = "Stop"
EndProperty
EndProperty
End
Begin VB.Label Label3
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "?"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 210
Left = 4365
TabIndex = 6
Top = 1560
Width = 135
End
Begin VB.Label lbJh
BackStyle = 0 'Transparent
Caption = "01"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 300
Left = 3825
TabIndex = 5
Top = 1920
Width = 480
End
Begin VB.Shape Shape2
BorderColor = &H00000000&
FillColor = &H00C0FFFF&
FillStyle = 0 'Solid
Height = 180
Index = 1
Left = 4215
Shape = 2 'Oval
Top = 1680
Width = 420
End
Begin VB.Shape Shape2
BorderColor = &H00000000&
FillColor = &H00C0FFFF&
FillStyle = 0 'Solid
Height = 270
Index = 0
Left = 3645
Shape = 2 'Oval
Top = 1905
Width = 615
End
Begin VB.Label Label2
BackStyle = 0 'Transparent
Caption = "注意："
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 240
Left = 3120
TabIndex = 4
Top = 2535
Width = 735
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "计算机调换时,将连同其消费、上网时间一起调换。"
ForeColor = &H00000000&
Height = 630
Left = 3120
TabIndex = 3
Top = 2820
Width = 1440
End
Begin VB.Shape Shape1
FillColor = &H00C0FFFF&
FillStyle = 0 'Solid
Height = 1185
Left = 2970
Shape = 4 'Rounded Rectangle
Top = 2370
Width = 1740
End
End
Attribute VB_Name = "frmExchange"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim NS As String
Private Sub cmdCancel_Click()
Unload Me
End Sub
Private Sub cmdExchange_Click()
On Error GoTo Err_exchange
NS = lvSendMessage.SelectedItem.SubItems(1)
NS = left$(NS, 2) '最大机器99台
If NS = "" Or NS = sJH Then
MsgBox "调换计算机号码相同;" & vbCrLf & vbCrLf & "或者没有选择要调换的计算机。 ", vbInformation
Exit Sub
End If
Dim tmpStartJF1 As String, tmpCustomer1 As String
Dim tmpStartJF2 As String, tmpCustomer2 As String
'调换
If lvSendMessage.SelectedItem.Text = "计费" Then
' 对方计算机已经启动计费,启动费用、消费相调、历史记录,双方都计费前面不用更新
tmpStartJF1 = frmServer.lvComputer.ListItems(Val(sJH)).SubItems(2)
tmpCustomer1 = frmServer.lvComputer.ListItems(Val(sJH)).SubItems(7)
tmpStartJF2 = frmServer.lvComputer.ListItems(Val(NS)).SubItems(2)
tmpCustomer2 = frmServer.lvComputer.ListItems(Val(NS)).SubItems(7)
frmServer.lvComputer.ListItems(Val(NS)).SubItems(2) = tmpStartJF1
frmServer.lvComputer.ListItems(Val(NS)).SubItems(7) = tmpCustomer1
frmServer.lvComputer.ListItems(Val(sJH)).SubItems(2) = tmpStartJF2
frmServer.lvComputer.ListItems(Val(sJH)).SubItems(7) = tmpCustomer2
' 更新数据库,有消费记录时
If tmpCustomer1 <> 0 Or tmpCustomer2 <> 0 Then
UpdateRecord sJH, NS, "计费", "Customer"
End If
UpdateIni sJH, tmpStartJF1, tmpCustomer1, NS, tmpStartJF2, tmpCustomer2, "计费"
Else
' 对方计算机未计费,更改上面的项即可,设对方为空闲,须更新空闲与计费
tmpStartJF1 = frmServer.lvComputer.ListItems(Val(sJH)).SubItems(2)
tmpCustomer1 = frmServer.lvComputer.ListItems(Val(sJH)).SubItems(7)
frmServer.lvComputer.ListItems(Val(sJH)).SubItems(2) = ""
frmServer.lvComputer.ListItems(Val(sJH)).SubItems(7) = "0"
frmServer.lvComputer.ListItems(Val(NS)).SubItems(2) = tmpStartJF1
frmServer.lvComputer.ListItems(Val(NS)).SubItems(7) = tmpCustomer1
frmServer.lvComputer.ListItems(Val(sJH)).Text = "空闲"
frmServer.lvComputer.ListItems(Val(NS)).Text = "计费"
frmServer.lvComputer.ListItems(Val(sJH)).SmallIcon = ImageList1.ListImages(1).Key
frmServer.lvComputer.ListItems(Val(NS)).SmallIcon = ImageList1.ListImages(2).Key
UpdateRecord sJH, NS, "空闲", "Customer"
UpdateIni sJH, tmpStartJF1, tmpCustomer1, NS, "", "0", "空闲"
End If
Unload Me
Exit Sub
Err_exchange:
MsgBox "调换机器错误! " & vbCrLf & vbCrLf & Err.Description, vbCritical
End Sub
Private Sub Form_Load()
FE = True
On Error GoTo Err_init
Dim L As Long, T As Long
L = Val(GetSetting(App.EXEName, "Option", "Exchange_L", 2000))
T = Val(GetSetting(App.EXEName, "Option", "Exchange_T", 2000))
Me.left = L
Me.tOp = T
Me.Caption = "请选择需要调换的计算机，原计算机号为 [ " & sJH & " ] "
lbJh = sJH
' 初始化列表
InitListView False
Exit Sub
Err_init:
MsgBox "表单加载错误! " & vbCrLf & vbCrLf & Err.Description, vbCritical
End Sub
Private Sub Form_Unload(Cancel As Integer)
FE = False
SaveSetting App.EXEName, "Option", "Exchange_L", Me.left
SaveSetting App.EXEName, "Option", "Exchange_T", Me.tOp
End Sub
Private Sub InitListView(OnlyDisplay As Boolean)
On Error GoTo Err_View
Dim x As Integer, Item As ListItems, lstItem As ListItem
Set Item = frmServer.lvComputer.ListItems
Set lvSendMessage.SmallIcons = ImageList1 '初始化
For x = 1 To Item.Count
If OnlyDisplay = True Then
If Item(x).Text = "计费" Then '添加仅计费的列表
Set lstItem = lvSendMessage.ListItems.Add(, , Item(x).Text)
lstItem.SmallIcon = ImageList1.ListImages(2).Key
lstItem.SubItems(1) = Item(x).SubItems(1)
' 选择
If Item(x).Selected = True Then
lstItem.Selected = True
End If
End If
Else
Set lstItem = lvSendMessage.ListItems.Add(, , Item(x).Text)
If Item(x).Text = "空闲" Then
lstItem.SmallIcon = ImageList1.ListImages(1).Key
Else
lstItem.SmallIcon = ImageList1.ListImages(2).Key
End If
lstItem.SubItems(1) = Item(x).SubItems(1)
' 选择
If Item(x).Selected = True Then
lstItem.Selected = True
End If
End If
Next
Set Item = Nothing
Set lstItem = Nothing
Exit Sub
Err_View:
MsgBox "计算机列表错误! " & vbCrLf & vbCrLf & Err.Description, vbCritical
End Sub
Private Sub UpdateRecord(sJH1 As String, sJH2 As String, sStates As String, sTable As String)
On Error GoTo Err_update
Dim DB As Database
Dim sEXE As String
Set DB = OpenDatabase(ConData, False, False, ConStr)
'Set DB = OpenConnection(ConData, dbDriverNoPrompt, False, ConStr)
' SQL语言
DBEngine.BeginTrans ' 进行事务操作
If sStates = "空闲" Then '空闲与计费相调时
sEXE = "Update " & sTable & " Set 房号='" & sJH2 & "' Where 房号='" & sJH1 & "'"
DB.Execute sEXE
Else
sEXE = "Update " & sTable & " Set 房号='BB' Where 房号='" & sJH2 & "'"
DB.Execute sEXE
sEXE = "Update " & sTable & " Set 房号='" & sJH2 & "' Where 房号='" & sJH1 & "'"
DB.Execute sEXE
sEXE = "Update " & sTable & " Set 房号='" & sJH1 & "' Where 房号='BB'"
DB.Execute sEXE
End If
DBEngine.CommitTrans
DB.Close
Exit Sub
Err_update:
MsgBox "更新数据错误! " & vbCrLf & vbCrLf & Err.Description, vbCritical
End Sub
Private Sub UpdateIni(sJH1 As String, sStartJF1 As String, sCustomer1 As String, sJH2 As String, sStartJF2 As String, sCustomer2 As String, sStates As String)
On Error GoTo Err_ini
If sStates = "空闲" Then
' 给出 INI 数据
AppName = Val(sJH2)
KeyName = "Start"
Value = sStartJF1
WriteInI
KeyName = "OtherXF"
Value = sCustomer1
WriteInI
AppName = Val(sJH1) '清空
KeyName = "Start"
Value = ""
WriteInI
KeyName = "OtherXF"
Value = 0
WriteInI
Else
AppName = Val(sJH2) '将2的数据换成1的数据
KeyName = "Start"
Value = sStartJF1
WriteInI
KeyName = "OtherXF"
Value = sCustomer1
WriteInI
AppName = Val(sJH1) '将1的数据换成2的数据
KeyName = "Start"
Value = sStartJF2
WriteInI
KeyName = "OtherXF"
Value = sCustomer2
WriteInI
End If
Exit Sub
Err_ini:
MsgBox "Ini更新错误! " & vbCrLf & vbCrLf & Err.Description, vbCritical
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -