夕阳醉了's Blog

Option Explicit
Dim a As Double, b As Double, c As Double
'a是最终结果,b是优先级结果,c是录入变量
Dim idx As Integer
Dim PreMode As String, JustMode As String, CurMode As String

Private Sub ComAC_Click() '清空按钮
   a = 0
   b = 0
   c = 0
   Text1.Text = "0"
   idx = 1
   PreMode = ""
   JustMode = ""
   CurMode = ""
End Sub

Private Sub ComAdd_Click() '加法
   On Error GoTo er
   c = Val(Text1.Text)
   CurMode = "+"
   If PreMode = "" Then
       If JustMode = "" Then
           a = c
       ElseIf JustMode = "+" Then
           a = a + c
       ElseIf JustMode = "-" Then
           a = a - c
       ElseIf JustMode = "*" Then
           a = a * c
       ElseIf JustMode = "/" Then
           a = a / c
       End If
   ElseIf PreMode = "+" Then
       If JustMode = "*" Then
           a = a + b * c
       ElseIf JustMode = "/" Then
           a = a + b / c
       End If
   ElseIf PreMode = "-" Then
       If JustMode = "*" Then
           a = a - b * c
       ElseIf JustMode = "/" Then
           a = a - b / c
       End If
   End If

   Text1.Text = CStr(a)
   PreMode = ""
   JustMode = CurMode
   idx = 2
   Exit Sub
er:
   MsgBox Err.Description, vbCritical, "Error", vbCritical, "Error"
   Call ComAC_Click
   Exit Sub
End Sub

Private Sub ComBak_Click() '退格
   Text1.Text = Left(Text1.Text, Len(Text1.Text) - 1)
   If Len(Text1.Text) = 0 Then
       Text1.Text = "0"
   End If
End Sub

Private Sub ComDiv_Click() '除法
   On Error GoTo er
   c = Val(Text1.Text)
   CurMode = "/"
   If PreMode = "" Then
       If JustMode = "" Then
           a = c
           Text1.Text = CStr(a)
       ElseIf JustMode = "+" Or JustMode = "-" Then
           b = c
           PreMode = JustMode
       ElseIf JustMode = "*" Then
           a = a * c
           Text1.Text = CStr(a)
       ElseIf JustMode = "/" Then
           a = a / c
           Text1.Text = CStr(a)
       End If
   ElseIf PreMode = "+" Then
       If JustMode = "*" Then
           b = b * c
       ElseIf JustMode = "/" Then
           b = b / c
       End If
   ElseIf PreMode = "-" Then
       If JustMode = "*" Then
           b = b * c
       ElseIf JustMode = "/" Then
           b = b / c
       End If
   End If
   
   JustMode = CurMode
   idx = 2
   Exit Sub
er:
   MsgBox Err.Description, vbCritical, "Error"
   Call ComAC_Click
   Exit Sub
End Sub

Private Sub ComDot_Click() '小数点
   If idx = 1 Then
       If InStr(1, Text1.Text, ".") = 0 Then
           Text1.Text = Text1.Text + "."
       End If
   Else
       Text1.Text = "0."
   End If
   idx = 1
End Sub

Private Sub ComEqu_Click() '等号
   On Error GoTo er
   c = Val(Text1.Text)
   If PreMode = "" Then
       If JustMode = "+" Then
           a = a + c
       ElseIf JustMode = "-" Then
           a = a - c
       ElseIf JustMode = "*" Then
           a = a * c
       ElseIf JustMode = "/" Then
           a = a / c
       End If
   ElseIf PreMode = "+" Then
       If JustMode = "*" Then
           a = a + b * c
       ElseIf JustMode = "/" Then
           a = a + b / c
       End If
   ElseIf PreMode = "-" Then
       If JustMode = "*" Then
           a = a - b * c
       ElseIf JustMode = "/" Then
           a = a - b / c
       End If
   End If
   
   Text1.Text = CStr(a)
   a = 0
   b = 0
   c = 0
   PreMode = ""
   JustMode = ""
   CurMode = ""
   
   idx = 2
   Exit Sub
er:
   MsgBox Err.Description, vbCritical, "Error"
   Call ComAC_Click
   Exit Sub
End Sub

Private Sub ComMul_Click() '乘号
   On Error GoTo er
   c = Val(Text1.Text)
   CurMode = "*"
   If PreMode = "" Then
       If JustMode = "" Then
           a = c
           Text1.Text = CStr(a)
       ElseIf JustMode = "+" Or JustMode = "-" Then
           b = c
           PreMode = JustMode
       ElseIf JustMode = "*" Then
           a = a * c
           Text1.Text = CStr(a)
       ElseIf JustMode = "/" Then
           a = a / c
           Text1.Text = CStr(a)
       End If
   ElseIf PreMode = "+" Then
       If JustMode = "*" Then
           b = b * c
       ElseIf JustMode = "/" Then
           b = b / c
       End If
   ElseIf PreMode = "-" Then
       If JustMode = "*" Then
           b = b * c
       ElseIf JustMode = "/" Then
           b = b / c
       End If
   End If
   
   
   JustMode = CurMode
   idx = 2
   Exit Sub
er:
   MsgBox Err.Description, vbCritical, "Error"
   Call ComAC_Click
   Exit Sub
End Sub

Private Sub ComNum_Click(Index As Integer) '数字键入
   If idx = 1 Then
       If Text1.Text = "0" Then
           Text1.Text = CStr(Index)
       Else
           Text1.Text = Text1.Text + CStr(Index)
       End If
   Else
       Text1.Text = CStr(Index)
   End If
   idx = 1
End Sub

Private Sub ComOff_Click()
   Unload Me
End Sub

Private Sub ComPN_Click() '正负号
   If Text1.Text = "0" Then
       Text1.Text = "-"
   Else
       If InStr(1, Text1.Text, "-") = 0 Then
           Text1.Text = "-" + Text1.Text
       Else
           Text1.Text = Right(Text1.Text, Len(Text1.Text) - 1)
       End If
   End If
   idx = 1
End Sub

Private Sub ComSub_Click() '减法
   On Error GoTo er
   c = Val(Text1.Text)
   CurMode = "-"
   If PreMode = "" Then
       If JustMode = "" Then
           a = c
       ElseIf JustMode = "+" Then
           a = a + c
       ElseIf JustMode = "-" Then
           a = a - c
       ElseIf JustMode = "*" Then
           a = a * c
       ElseIf JustMode = "/" Then
           a = a / c
       End If
   ElseIf PreMode = "+" Then
       If JustMode = "*" Then
           a = a + b * c
       ElseIf JustMode = "/" Then
           a = a + b / c
       End If
   ElseIf PreMode = "-" Then
       If JustMode = "*" Then
           a = a - b * c
       ElseIf JustMode = "/" Then
           a = a - b / c
       End If
   End If

   Text1.Text = CStr(a)
   PreMode = ""
   JustMode = CurMode
   idx = 2
   Exit Sub
er:
   MsgBox Err.Description, vbCritical, "Error"
   Call ComAC_Click
   Exit Sub
End Sub

Private Sub Form_Load()
   '赋上初值
   PreMode = ""
   JustMode = ""
   CurMode = ""
   a = 0
   b = 0
   c = 0
   idx = 1
End Sub
Private Sub Text1_Change()
   If Val(Text1.Text) < 1 And Val(Text1.Text) > 0 And Left(Text1.Text, 1) <> "0" Then
       Text1.Text = "0" & Text1.Text
   End If
End Sub

Option Explicit

'===========用于查找进程和终止进程的API函数常数定义================

Private Declare Function CreateToolhelpSnapshot Lib "kernel32" Alias "CreateToolhelp32Snapshot" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long
Private Declare Function ProcessFirst Lib "kernel32" Alias "Process32First" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function ProcessNext Lib "kernel32" Alias "Process32Next" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Const MAX_PATH As Integer = 260
Private Type PROCESSENTRY32
dwSize As Long
cntUsage As Long
th32ProcessID As Long
th32DefaultHeapID As Long
th32ModuleID As Long
cntThreads As Long
th32ParentProcessID As Long
pcPriClassBase As Long
dwFlags As Long
szExeFile As String * MAX_PATH
End Type
Const TH32CS_SNAPheaplist = &H1
Const TH32CS_SNAPPROCESS = &H2
Const TH32CS_SNAPthread = &H4
Const TH32CS_SNAPmodule = &H8
Const TH32CS_SNAPall = TH32CS_SNAPPROCESS + TH32CS_SNAPheaplist + TH32CS_SNAPthread + TH32CS_SNAPmodule


'=========在WIN2000下提升本进程权限的API函数常数定义'=========

Const STANDARD_RIGHTS_REQUIRED = &HF0000
Const TOKEN_ASSIGN_PRIMARY = &H1
Const TOKEN_DUPLICATE = (&H2)
Const TOKEN_IMPERSONATE = (&H4)
Const TOKEN_QUERY = (&H8)
Const TOKEN_QUERY_SOURCE = (&H10)
Const TOKEN_ADJUST_PRIVILEGES = (&H20)
Const TOKEN_ADJUST_GROUPS = (&H40)
Const TOKEN_ADJUST_DEFAULT = (&H80)
Const TOKEN_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or TOKEN_ASSIGN_PRIMARY Or _
TOKEN_DUPLICATE Or TOKEN_IMPERSONATE Or TOKEN_QUERY Or TOKEN_QUERY_SOURCE Or _
TOKEN_ADJUST_PRIVILEGES Or TOKEN_ADJUST_GROUPS Or TOKEN_ADJUST_DEFAULT)
Const SE_PRIVILEGE_ENABLED = &H2
Const ANYSIZE_ARRAY = 1
Private Type LUID
lowpart As Long
highpart As Long
End Type
Private Type LUID_AND_ATTRIBUTES
pLuid As LUID
Attributes As Long
End Type
Private Type TOKEN_PRIVILEGES
PrivilegeCount As Long
Privileges(ANYSIZE_ARRAY) As LUID_AND_ATTRIBUTES
End Type
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Declare Function LookupPrivilegeValue Lib "advapi32.dll" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLuid As LUID) As Long
Private Declare Function AdjustTokenPrivileges Lib "advapi32.dll" (ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long, NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, PreviousState As TOKEN_PRIVILEGES, ReturnLength As Long) As Long
Private Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long


'程序加载
Private Sub Form_Load()
AdjustTokenPrivileges2000
Me.Caption = "WINDOWS 进程管理器"
Command1.Caption = "刷新"
Command2.Caption = "终止进程"
Command3.Caption = "退出"
ListView1.ColumnHeaders.Clear
ListView1.ColumnHeaders.Add , "a", "进程ID", 800
ListView1.ColumnHeaders.Add , "b", "进程名", 4900
ListView1.View = lvwReport
Command1_Click '刷新进程列表
End Sub


'显示当前系统中全部进程
Private Sub Command1_Click()
Dim i As Long, lPid As Long
Dim Proc As PROCESSENTRY32
Dim hSnapShot As Long
ListView1.ListItems.Clear '清空ListView
hSnapShot = CreateToolhelpSnapshot(TH32CS_SNAPall, 0) '获得进程“快照”的句柄
Proc.dwSize = Len(Proc)
lPid = ProcessFirst(hSnapShot, Proc) '获取第一个进程的PROCESSENTRY32结构信息数据
i = 0
Do While lPid <> 0 '当返回值非零时继续获取下一个进程
ListView1.ListItems.Add , "a" & i, Proc.th32ProcessID & "(&H" & Hex(Proc.th32ProcessID) & ")" '将进程ID添加到ListView1第一列
ListView1.ListItems("a" & i).SubItems(1) = Proc.szExeFile '将进程名添加到ListView1第二列
i = i + 1
lPid = ProcessNext(hSnapShot, Proc) '循环获取下一个进程的PROCESSENTRY32结构信息数据
Loop
CloseHandle hSnapShot '关闭进程“快照”句柄
End Sub


'终止指定进程
Private Sub Command2_Click()
Dim lPHand As Long, TMBack As Long
If ListView1.SelectedItem.Text <> "" Then
If MsgBox("确实要结束进程[" & ListView1.SelectedItem.SubItems(1) & "]吗？", vbYesNo) = vbYes Then
lPHand = Val(ListView1.SelectedItem.Text)
lPHand = OpenProcess(1&, True, lPHand) '获取进程句柄
TMBack = TerminateProcess(lPHand, 0&) '关闭进程
If TMBack <> 0 Then
MsgBox ListView1.SelectedItem.SubItems(1) & "已经被终止！"
Else
MsgBox ListView1.SelectedItem.SubItems(1) & "不能被终止！"
End If
CloseHandle lPHand
Command1_Click '刷新进程列表
End If
End If
End Sub


'退出本程序
Private Sub Command3_Click()
Unload Me
End Sub


'这个函数用于在WIN2000系统中，本进程提升权限
Sub AdjustTokenPrivileges2000()
Dim hdlProcessHandle As Long
Dim hdlTokenHandle As Long
Dim tmpLuid As LUID
Dim tkp As TOKEN_PRIVILEGES
Dim tkpNewButIgnored As TOKEN_PRIVILEGES
Dim lBufferNeeded As Long
Dim lP As Long
hdlProcessHandle = GetCurrentProcess()
lP = OpenProcessToken(hdlProcessHandle, TOKEN_ALL_ACCESS, hdlTokenHandle)
lP = LookupPrivilegeValue("", "SeDebugPrivilege", tmpLuid)
tkp.PrivilegeCount = 1
tkp.Privileges(0).pLuid = tmpLuid
tkp.Privileges(0).Attributes = SE_PRIVILEGE_ENABLED
lP = AdjustTokenPrivileges(hdlTokenHandle, False, tkp, Len(tkpNewButIgnored), tkpNewButIgnored, lBufferNeeded)
End Sub

Private Sub Command1_Click()
             label1.Text = ""
             label1.Text = GetChinaMoney(Text1.Text)
End Sub

Private Sub Form_Load()
          Text1.MaxLength = 16
           Text1.Text = ""
           label1.Text = ""
         Text1.Text = "987654321"

End Sub


-----------------------------Module1.bas---------------------------------------------------------




Public Function GetChinaMoney(ByVal strNumber) As String
Dim a() As String
Dim s1 As String, s2 As String
Dim l1 As String
Dim s3 As String
Dim strEng As String


strEng2Ch = "零壹贰叁肆伍陆柒捌玖"


If Not IsNumeric(strNumber) Then
If Trim(strNumber) <> "" Then MsgBox "无效的数字"
GetChinaMoney = ""

Exit Function
End If

l1 = InStr(strNumber, ".")
If l1 <> 0 Then
s1 = Left(strNumber, l1 - 1)
s2 = Mid(strNumber, l1 + 1)
Else
s1 = strNumber
s2 = "0"
End If

s1 = Dig2Chinese_pb(s1)

s3 = ""
If s2 <> 0 Then
For i = 1 To Len(s2)
If i = 1 Then s3 = s3 & Mid(strEng2Ch, Val(Mid(s2, i, 1)) + 1, 1) & "角"
If i = 2 Then s3 = s3 & Mid(strEng2Ch, Val(Mid(s2, i, 1)) + 1, 1) & "分"
If i = 3 Then s3 = s3 & Mid(strEng2Ch, Val(Mid(s2, i, 1)) + 1, 1) & "厘"
If i = 4 Then s3 = s3 & Mid(strEng2Ch, Val(Mid(s2, i, 1)) + 1, 1) & "毫"
Next
End If

GetChinaMoney = s1 & "圆" & s3


End Function


Public Function Dig2Chinese_pb(strEng As String) As String

Dim intLen As Integer, intCounter As Integer
Dim strCh As String, strtempCh As String
Dim strSeqCh1 As String, strSeqCh2 As String
Dim strEng2Ch As String
Dim sTemp As String
Dim i As Integer


Dim iWanBit As Integer
Dim iYiBit As Integer
Dim iWanYiBit As Integer


Dim sFoward As String


iWanBit = 0: iYiBit = 0: iWanYiBit = 0
sFoward = StrReverse(strEng)


For i = 1 To Len(sFoward)
Dim val1 As Long

val1 = Val(Mid(sFoward, i, 1))
If i >= 5 And i <= 8 Then
If iWanBit = 0 Then
If val1 <> 0 Then iWanBit = i
End If
End If


If i >= 9 And i <= 12 Then
If iYiBit = 0 Then
If val1 <> 0 Then iYiBit = i
End If
End If


If i >= 13 And i <= 16 Then
If iWanYiBit = 0 Then
If val1 <> 0 Then iWanYiBit = i
End If
End If


Next


If Not IsNumeric(strEng) Then
If Trim(strEng) <> "" Then MsgBox "无效的数字"
Dig2Chinese_pb = ""

Exit Function
End If

If Len(strEng) > 15 Then
MsgBox "数字位数太长"
Dig2Chinese_pb = ""

Exit Function

End If

strEng2Ch = "零壹贰叁肆伍陆柒捌玖"
strSeqCh1 = " 拾佰仟 拾佰仟 拾佰仟 拾佰仟"
strSeqCh2 = " 万亿兆"

'转换为表示数值的字符串
strEng = CStr(CDec(strEng))

'len
intLen = Len(strEng)

'change to chinese
For intCounter = 1 To intLen
strtempCh = Mid(strEng2Ch, Val(Mid(strEng, intCounter, 1)) + 1, 1)


If strtempCh = "零" And intLen <> 1 Then
' If Mid(strEng, intCounter + 1, 1) = "0" Or (intLen - intCounter + 1) Mod 4 = 1 Then


'若之后一个也是零，或在最后，则不显示"零"
If Mid(strEng, intCounter + 1, 1) = "0" Or intCounter = intLen Then
strtempCh = ""
End If
Else
'添加位 拾佰仟
If strtempCh <> "零" Then strtempCh = strtempCh & Trim(Mid(strSeqCh1, intLen - intCounter + 1, 1))

End If



'添加位 "万"(5-8),"亿"(9-12),"万亿"(13-16)
' iWanBit = 0: iYiBit = 0: iWanYiBit = 0
If intCounter = Len(strEng) + 1 - iWanBit Then strtempCh = strtempCh & "万"
If intCounter = Len(strEng) + 1 - iYiBit Then strtempCh = strtempCh & "亿"
If intCounter = Len(strEng) + 1 - iWanYiBit Then strtempCh = strtempCh & "万亿"


'组成汉字
strCh = strCh & Trim(strtempCh)

Next

Dig2Chinese_pb = strCh
End Function