vb 取得进程用户名
vb 取得进程地址
Dim lngNumElements As Long
Dim lngProcessIDs() As Long
Public Const PROCESS_QUERY_INFORMATION = 1024
Public Const PROCESS_VM_READ = 16
Public Const MAX_PATH = 260
Public Const STANDARD_RIGHTS_REQUIRED = &HF0000
dwAvailPhys As Long
dwTotalPageFile As Long
dwAvailPageFile As Long
dwTotalVirtual As Long
dwAvailVirtual As Long
dwFlags As Long
szExeFile As String * 260 ' MAX_PATH
End Type
Public Type OSVERSIONINFO
dwOSVersionInfoSize As Long
Dim booResult As Boolean
Dim lngLength As Long
Dim lngProcessID As Long
Dim strProcessName As String
cntThreads As Long
th32ParentProcessID As Long ' This process's parent process
vb_api调用,实现获取窗口信息
VB编程：浅谈API的应用——实现获取目标窗口的信息1.第一部分废话不说，先把几个用到的API声明源码发出来，我是在“模块”里声明的Option ExplicitDeclare Function SetWindowPos Lib "user32" (ByV al hwnd As Long, ByV al hWndInsertAfter As Long, ByV al X As Long, ByV al Y As Long, ByV al cx As Long, ByV al cy As Long, ByV al wFlags As Long) As Long '窗口置顶Declare Function SetCapture Lib "user32" (ByV al hwnd As Long) As Long '捕获鼠标所在窗口信息Declare Function ReleaseCapture Lib "user32" () As Long ' 与setcapture对应Declare Function WindowFromPoint Lib "user32" (ByV al xPoint As Long, ByV al yPoint As Long) As Long '返回鼠标所在窗口的句柄Declare Function ClientToScreen Lib "user32" (ByV al hwnd As Long, lpPoint As POINTAPI) As Long '坐标转化Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByV al hwnd As Long, ByV al lpClassName As String, ByV al nMaxCount As Long) As Long '获取指定窗口类名Public Type POINTAPIX As LongY As LongEnd Type大家看到了，这里我用到了6个API，每个API声明的后面我都把它的功能注释出来了。
VB命令大全
VB命令大全命令Call：调用事件处理器Close关闭用Open命令所打开文件的输入输出。
格式：Close #文件号1,#文件号2……。
若无文件号，则关闭打开的所有活动文件。
Const：声明常量,格式:Const常量名[As类型] =常量值DoEvents：让应用程序提供少量时间处理等待的任务，然后控制权立即返回应用程序。
Dim声明变量，格式：Dim变量名As变量类型Exit sub：中途退出子程序End：结束程序Global：声明全局变量Load：装入窗体MsgBox消息内容：将结果显示在消息框中Open打开或保存文件。
格式：Open文件全名For模式As #文件号[Len =文件长度]其中，模式有：Append、Binary、Input、Output、Random(缺省)；文件号在1到511之间，可用FreeFile函数取得；文件长度在1到32767之间。
例：Open CommonDialog1.FileName For Output As #1Option Base 1：放在声明部分,强制数组从1开始索引,(如果不习惯从0开始的话)Option Explicit：强制声明变量(放在窗体或模块的声明部分)PopupMenu调出弹出式菜单。
格式：常量位置或功能VbPopupMenuLeftAlign指定X位置，确定菜单左边沿（缺省）VbPopupMenuCenterAlign指定X位置，确定弹出菜单xx。
VbPopupMenuRightAlign指定X位置，确定弹出菜单右边沿。
VbPopupMenuLeftButton用户用鼠标左键单击菜单项目时，弹出菜单触发Click事件（缺省）。
VbPopupMenuRightButton用户用左鼠标键或右鼠标键单击菜单项目时，弹出菜单触发Click事件print：显示Public：用以代替Dim,声明变量为公用变量Public Const：用以代替Const,声明为公用常量Set：设置对象变量的值。
库存管理之用户登录及用户列表——VB代码
1、首页，用户登录界面'连接SQL数据库时必写语句Imports System.Data.SqlClientPublic Class Frm_UserloginPrivate Sub Bt_login_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Bt_login.ClickIf Txt_UserId.Text = ""ThenMsgBox("用户名不能为空,请输入用户名!", MsgBoxStyle.OkOnly, "温馨提示") Exit SubEnd IfIf Txt_Paw.Text = ""ThenMsgBox("密码不能为空,请输入密码!", MsgBoxStyle.OkOnly, "温馨提示")Exit SubEnd If'连接数据库Dim conn As New SqlConnection'conn.ConnectionString = "user id=sa;password=;database=test;data source=."连接SQL2000数据库的方法'连接SQL Server2005数据库的方法conn.ConnectionString = "server=.;integrated security=sspi;database=NO.4"conn.Open()Dim constr As String'判断输入的数据是否正确Dim UserName, password As StringUserName = Trim(Txt_UserId.Text)password = Trim(Txt_Paw.Text)constr = "select * from t1 where id='" & UserName & " 'and Psd='" & password & "'"Dim da As New SqlDataAdapter(constr, conn)Dim ds As New DataSetda.Fill(ds)If ds.Tables(0).Rows.Count >= 1 ThenMDIParent1.ShowDialog()Me.Hide()ElseMsgBox("用户名或密码错误", MsgBoxStyle.OkOnly, "温馨提示")Txt_UserId.Text = ""Txt_Paw.Text = ""Txt_Paw.Focus()Txt_UserId.Focus()End IfEnd SubPrivate Sub Bt_cancel_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Bt_cancel.ClickTxt_UserId.Text = ""Txt_Paw.Text = ""Txt_Paw.Focus()Txt_UserId.Focus()End SubEnd ClassImports System.Data.SqlClientPublic Class Frm_yhlbDim conn As New SqlConnection()Dim flag As IntegerDim ds As New DataSetPrivate Sub Form2_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load‘添加数据库中的数据到DGW控件中GroupBox1.Enabled = Falsebaocun.Enabled = Falsequxiao.Enabled = Falseconn.ConnectionString = "server=(local);integrated security=sspi;database=NO.4"conn.Open()Dim st As Stringst = "select * from t1"Dim da As New SqlDataAdapter(st, conn)Dim ds As New DataSetda.Fill(ds)DGW1.ColumnCount = ds.Tables(0).Columns.CountDGW1.RowCount = ds.Tables(0).Rows.Count'DGW1.ColumnCount = 4 '列'DGW1.RowCount = 4 '行For i = 0 To ds.Tables(0).Rows.Count - 1For j = 0 To ds.Tables(0).Columns.Count - 1DGW1.Rows(i).Cells(j).Value = ds.Tables(0).Rows(i).ItemArray(j)Next jFor j = 0 To ds.Tables(0).Columns.Count - 1DGW1.Columns(j).HeaderText = ds.Tables(0).Columns(j).ColumnNameNextNext iEnd SubFunction f_diaoyong(ByVal st As String) As Long'Dim st As String'st = "select * from t1"Dim da As New SqlDataAdapter(st, conn)Dim ds As New DataSetda.Fill(ds)DGW1.ColumnCount = ds.Tables(0).Columns.CountDGW1.RowCount = ds.Tables(0).Rows.Count'DGW1.ColumnCount = 4 '列'DGW1.RowCount = 4 '行For i = 0 To ds.Tables(0).Rows.Count - 1For j = 0 To ds.Tables(0).Columns.Count - 1DGW1.Rows(i).Cells(j).Value = ds.Tables(0).Rows(i).ItemArray(j)Next jFor j = 0 To ds.Tables(0).Columns.Count - 1DGW1.Columns(j).HeaderText = ds.Tables(0).Columns(j).ColumnNameNextNext iEnd FunctionPrivate Sub tianjia_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles tianjia.Clickflag = -1GroupBox1.Enabled = Truebaocun.Enabled = Truequxiao.Enabled = TrueTextBox1.Enabled = TrueTextBox2.Text = ""TextBox1.Text = ""TextBox1.Focus()TextBox3.Text = ""End SubPrivate Sub baocun_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles baocun.ClickIf flag = -1 ThenDim a, b, c As Stringa = Trim(TextBox1.Text)b = Trim(TextBox2.Text)c = Trim(TextBox3.Text)Dim str As StringDim da As New SqlDataAdapter("select * from t1", conn)da.Fill(ds)For i = 0 To ds.Tables(0).Rows.Count - 1str = Trim(ds.Tables(0).Rows(i).ItemArray(0))If Trim(TextBox1.Text) = str ThenMsgBox("对不起，你的ID重复，请重新输入！", MsgBoxStyle.OkOnly, "用户消息提示框")TextBox1.Text = ""TextBox1.Focus()Exit SubEnd IfNextDim stre = "Insert into t1 values('"& Trim(a) & " ',' "& Trim(b) & " ', ' "& Trim(c) & " ' )"Dim com As New SqlCommand(stre, conn)com.ExecuteNonQuery()ElseIf flag = 1 ThenDim name1, mima1, a1 As Stringname1 = TextBox2.Textmima1 = TextBox3.Texta1 = TextBox1.Texta1 = DGW1.SelectedRows(0).Cells(0).ValueDim stre = "update t1 set name= ' " & name1 & " ', psd= ' " & mima1 & " 'where id='" & a1 & " ' "Dim com As New SqlCommand(stre, conn)com.ExecuteNonQuery()End IfTextBox1.Text = ""TextBox1.Focus()TextBox2.Text = ""TextBox3.Text = ""baocun.Enabled = Falsequxiao.Enabled = FalseGroupBox1.Enabled = FalseCall f_diaoyong("select * from t1")End SubPrivate Sub quxiao_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles quxiao.ClickTextBox1.Text = ""TextBox1.Focus()TextBox2.Text = ""TextBox3.Text = ""DGW1.Enabled = Falsebaocun.Enabled = Falsequxiao.Enabled = FalseGroupBox1.Enabled = FalseEnd SubPrivate Sub xiugai_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles xiugai.Clickflag = 1TextBox1.Enabled = Falsebaocun.Enabled = Truequxiao.Enabled = TrueGroupBox1.Enabled = TrueTextBox1.Text = DGW1.SelectedRows(0).Cells(0).ValueTextBox2.Text = DGW1.SelectedRows(0).Cells(1).ValueTextBox3.Text = DGW1.SelectedRows(0).Cells(2).ValueEnd SubPrivate Sub tuichu_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles tuichu.ClickEndEnd SubPrivate Sub shanchu_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles shanchu.ClickDim yh As Stringyh = TextBox1.Textyh = DGW1.SelectedRows(0).Cells(0).ValueDim stre = "delete from t1 where id='" & yh & " '"Dim com As New SqlCommand(stre, conn)com.ExecuteNonQuery()MsgBox("确定删除！", MsgBoxStyle.OkOnly, "提示信息")baocun.Enabled = Truequxiao.Enabled = TrueDGW1.Enabled = FalseCall f_diaoyong("select * from t1")End SubEnd Class。
VB第八章 查看用户信息
任务8.2 查询用户数据
8.2.1 了解DataReader对象
DataReader对象是.NET数据提供程序的核心对象之一，它可以从 数据库中以只读的、向前的方式读取数据，即每次可以从查询结果中 读取一行数据至内存，只能顺序向前读取，不能反复读取数据，也不 能对数据库中的数据进行修改。
DataReader对象采用面向连接的方式读取数据，在读数据时，要 始终和数据库保持连接，不能断开。如果与数据库的连接尚未打开或 连接已关闭，DataReader对象读取数据时将出现异常。
任务8.2 查询用户数据
8.2.2 使用DataReader对象
示G。1设各使 11设”使前在e..例置个t建用置。用，建重创×：按列读立D按完再立新a建 ×创钮的取一t钮次D一获C×aa建控名列个oR控使t个取(nea窗件称信)Wan件用RWDi方dceia体的”息nee的新ant法dcrdda，。时Not对的NeoR将awiarwe读还sm象os对Dma按e应nae应d取可属一对属象te照用用ar以U性般象性后R对程×s程e调值e需，值 ，a象r序×d序用I为要打为 必e前。×n。rf“D如开“ 须对，在所oa在t表 b下与将象b必at窗描t窗Rn中步数其时n须体述eR体Rae列A骤据关，e调中的da中aedm：库的闭将d用ri绘类”绘”n对的个，会C制型用 ，制，l象连数在出o一返户 T一Ts的e接，未异ee个回x的个x(Gt。并关常t)按读密属e按属方t显闭。钮出码性×钮性法示D的信值(×a(值将B各tB数息×u为u为a其t个tR据。t(“t“e关)o列ao。n方顺dn读闭)的e)法控序取控r。名对，件显密件称象，示码， 例M2C2D3452C询然'.l如按s在it用后i在s创调读调cac：字项akR户调项k建 用 取 用g事e事符目ea名用目CD当D件Bd件串中oaaoe为R中前x中mttre中格.导对maa“导aS行编aRRd编式h入象neeA入(写odaa中d写)读wSdd对。mS方代(yee的代iy取s"象rrns法A码t某对对”t码第de，e读，mm一象象，的mi2.调.取使n列列的的D建信D用a用数a用信tRCt立息户Caela据D息ao.o与的.a的dsmSS。t。(emq数Sqa密al)(lQRn)方CC据L码ed方ll语a法对i库id是法ee句e读象n的nr"，tt并名 对取的连名+关执字象一E接字dx闭行r空的行e和空.Dc得G间Fa数u间Ceitt到oe。t据ea，mlSRRmD在dt。ee在aarCaatniobddadbnuteeR对tngnrrnetR((对Ra象e属1)ed)a象方e，a)d性rd按。法定按对统钮创义钮象计的建查的，出 数据有多少列，并遍历所有的列，通过GetName()方法读取每个列的名 字。
VB通过句柄获得进程
msgbox Jubing
End Sub
Private Declare Function CloseHandle Lib "Kernel32.dll " (ByVal Handle As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function EnumProcessModules Lib "psapi.dll " (ByVal hProcess As Long, ByRef lphModule As Long, ByVal cb As Long, ByRef cbNeeded As Long) As Long
Const STANDARD_RIGHTS_REQUIRED = &HF0000
Const SYNCHRONIZE = &H100000
Const SPECIFIC_RIGHTS_ALL = &HFFFF
CБайду номын сангаасnst STANDARD_RIGHTS_ALL = &H1F0000
vb如何让工程的进程名不是文件名
'参数: Handle hSnapshot传入的Snapshot句柄
'参数：LPMODULEENTRY3 lpme 指向一个 MODULEENTRY32结构的指针
'作用: 从Snapshot得到下一个Module记录信息
Private Declare Function Module32Next Lib "kernel32" (ByVal hSnapShot As Long, lppe As MODULEENTRY32) As Long
'关闭句柄
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Type PROCESSENTRY32
dwSize As Long '结构大小
cntUsage As Long '此进程的引用计数
'** ： ByVal lblProcessNumber(Label) -
'**输 出： 无
'**功能描述：建立进程树结构
'**全局变量：
'**调用模块：
'**作 者： Mr.David
'**日 期： 2007-11-27 14:09:37
'**修 改 人：
'**日 期：
'**版 本： V1.0.0
strTreTxt = PEE.szExeFile
Set treNode = treProcess.Nodes.Add(, , strTreKey, strTreTxt) '进程树根是进程名
vb用户登录
Dim sql As String
Dim rs_login As New ADODB.Recordset
Dim conn As New ADODB.Connection
conn.Open "provider=Microsoft.Jet.OLEDB.4.0; data source=" & App.Path & "\database.mdb"
DBconnect.ConnectionString = "dsn=DataAliasName;uid=UserID;pwd=Passwd;"
? 直接连接Access为
Dbconnect.Provider = "Microsoft.jet.OLEDB.4.0" // Access 97为3.51
Unload Me
图书馆理系统.Show
Else
MsgBox "密码不正确,请重输入！", vbOKOnly + vbExclamation, ""
text2.SetFocus
text2.Text = ""
End If
End If
End If
cnt = cnt + 1
conn.ConnectionTimeout = 30
conn.Open
rs.Open "select 用户名,密码 from login where 用户名='" & Trim(Combo1.Text) & "' And 密码='" & Trim(Text1.Text) & "'", conn, adOpenStatic, adLockReadOnly, adCmdText
VB制作系统登录界面,包括用户名,密码和错误校验及效果全代码
VB制作系统登录界面，包括用户名，密码和错误校验及效果全代码第十讲:教你用VB制作系统登录界面，包括用户名，密码和错误校验及效果全代码以下代码均为个人学习心得，经过测试并且无误，可以嵌入大型程序中作为身份认证的功能作用。
其中有一些窗体名和效果代码，不必复制，否则会出现错误，请仔细阅读核心代码理解即可。
红色代码部份为实现用户检测的关键代码，必需要有后台数据库用来存放用户信息，通过 conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\HISDB.mdb"来连接，然后用If rs.EOF = True Then进行判断表中是否存在用户信息即可。
Option ExplicitDim Cnum As IntegerPrivate Sub CmdCancel_Click()'//结束EndEnd SubPrivate Sub CmdLogin_Click()Dim UserName As StringDim PassWord As StringDim conn As New ADODB.ConnectionDim rs As New ADODB.RecordsetDim StrSQL As Stringconn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" &App.Path & "\HISDB.mdb"UserName = Trim(TxtUserName.Text) '//将文本框内的值赋给定义好的全局变量PassWord = Trim(TxtPassword.Text) If UserName = "" Or PassWord = "" ThenMsgBox "对不起，用户或密码不能为空～请重新输入～～", vbCritical, "错误"ElseIf UserName <> Empty And PassWord <> Empty Then '//用户名与密码是否为空Cnum = Cnum + 1StrSQL = "select * from 用户信息表 where 用户名称= '" & UserName & "'and 用户口令 ='" & PassWord & "'"rs.Open StrSQL, conn, adOpenKeyset, adLockPessimistic '//打开记录集If rs.EOF = True ThenMsgBox "对不起，无此用户或者密码不正确～请重新输入～～", vbCritical, "错误"TxtUserName.Text = ""TxtPassword.Text = ""TxtUserName.SetFocusrs.CloseIf Cnum >= 3 ThenMsgBox "对不起，您已经多次失败，无权操作本系统～", vbCritical, "无权限"Unload MeExit SubEnd IfElse '登陆成功,以下为权限验证If rs.Fields("用户权限").Value = "系统管理" Then Frmmdimain.Show Unload MeElseIf rs.Fields("用户权限").Value = "挂号" ThenFrmregistration2.ShowUnload MeElseIf rs.Fields("用户权限").Value = "诊断" Then Frmdiagnose2.Show Unload MeElseIf rs.Fields("用户权限").Value = "收费" Then Frmcharges2.Show Unload MeElseIf rs.Fields("用户权限").Value = "发药" Then Frmmedicine2.Show Unload MeEnd Ifrs.CloseEnd IfEnd IfEnd SubPrivate Sub Form_Load()'//加载主窗时给文本框赋值TxtUserName.Text = "Admin"TxtPassword.Text = "123"Cnum = 0End SubPrivate Sub TmrChangeColor_Timer() '//调用定义好的改变颜色过程, Call changecolor(LblWelcome(0), 0, 1, 2, 3, 4, 5, 6, 7)End SubPrivate Sub TmrMoveText1_Timer() '//移动LblShaSiLblShaSi(0).Move LblShaSi(0).Left + 20 LblShaSi(1).Move LblShaSi(1).Left + 20 End SubPrivate Sub TmrMoveText2_Timer() '//移动LblShaSiIf LblShaSi(0).Left + LblShaSi(0).Width >= Me.Width +LblShaSi(0).WidthThenLblShaSi(0).Move -1500End IfIf LblShaSi(1).Left + LblShaSi(1).Width >= Me.Width +LblShaSi(1).WidthThenLblShaSi(1).Move -1500End IfEnd Sub'//定义一个改变颜色的过程,下面的control就是我们所说的控件 Sub changecolor(LCnt As Control, color1 As Integer, _color2 As Integer, color3 As Integer, _color4 As Integer, color5 As Integer, _color6 As Integer, color7 As Integer, _color8 As Integer)Dim tmep As Integertmep = Val(LCnt.Tag) '//将返回包含于字符串内的数字赋给TEMP Select Case tmepCase color1LCnt.Tag = color2Case color2LCnt.Tag = color3Case color3LCnt.Tag = color4Case color4LCnt.Tag = color5Case color5LCnt.Tag = color6Case color6LCnt.Tag = color7Case color7LCnt.Tag = color8Case color8LCnt.Tag = color1End SelectLCnt.ForeColor = QBColor(LCnt.Tag) '//给控件LCnt中的字体赋予颜色,注意QBColor是将一值'//转换为三色,MSDN详解,我也是在那查的````哈End Sub。
登录的实现并在用户名栏加载登录成功后的用户名(VB详细步骤介绍)
Imports System.Data.SqlClient'打开数据库命名空间Public Class FormLoadDim mx, my As Integer'定义两个变量，用来表示窗体的X轴Y轴位置Dim biaozhi As Boolean'该处的值判定鼠标的按下状态，按下为True，弹起为FalseDim sqlconYidenglu As New SqlConnectionDim sqlconLianjie As New SqlConnectionDim sqlconJiazai As New SqlConnection'定义对应的三个链接Private Sub ContrlBar_MouseDown(ByVal sender As Object, ByVal e AsSystem.Windows.Forms.MouseEventArgs) Handles ContrlBar.MouseDownbiaozhi = True'在此处，定义鼠标按下是的布尔值为真mx = e.Xmy= e.Y '当鼠标刚按下，也是相对每次拖动窗体的第一次，设置了窗体的X轴和Y轴的坐标End SubPrivate Sub ContrlBar_MouseMove(ByVal sender As Object, ByVal e AsSystem.Windows.Forms.MouseEventArgs) Handles ContrlBar.MouseMoveIf biaozhi = True Then'此时，如果鼠标为按下状态Me.Left = Me.Left + (e.X - mx) '窗体的X轴新位置=原来的位置+移动的位置（移动的位置=新的X轴坐标-原来的X轴坐标）Me.Top = Me.Top + (e.Y - my) '窗体的Y轴新位置=原来的位置+移动的位置（移动的位置=新的Y轴坐标-原来的Y轴坐标）End IfEnd SubPrivate Sub ContrlBar_MouseUp(ByVal sender As Object, ByVal e AsSystem.Windows.Forms.MouseEventArgs) Handles ContrlBar.MouseUpbiaozhi = False'定义当鼠标键弹起时的布尔值为假，即没有拖动End Sub'设置一个简单的窗体控制栏Private Sub FormLoad_Shown(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Shown'Labeljishu.Visible = FalseTimer1.Enabled = TrueComboBoxAccountID.Text = ""TextBoxPassword.Clear()Dim sqlcmdYidenglu As New SqlCommandDim mydsYidenglu As New DataSetDim mydaptYidenglu As New SqlDataAdaptersqlconYidenglu.ConnectionString = "user id=sa;password=;initialcatalog=EmployeesInformation;data source=(local)"sqlconYidenglu.Open()mandText = "select * from TABLEyidenglu"'该段代码为获取已经登录成功的用户名，也可以清空登录成功的用户名sqlcmdYidenglu.Connection = sqlconYidenglu '本来是想到达的搜索相似的登录成功的用户名mydaptYidenglu.SelectCommand = sqlcmdYidenglumydaptYidenglu.Fill(mydsYidenglu, "TABLEyidenglu")ComboBoxAccountID.Items.Clear()If mydsYidenglu.Tables("TABLEyidenglu").Rows.Count = 0 ThenComboBoxAccountID.Items.Add("<空>")ElseDim i As IntegerFor i = 0 To mydsYidenglu.Tables("TABLEyidenglu").Rows.Count - 1 '添加列表框的值ComboBoxAccountID.Items.Add(mydsYidenglu.Tables("TABLEyidenglu").Rows(i)(0)) NextComboBoxAccountID.Items.Add("<清空用户名列表>")End IfsqlconYidenglu.Close()End SubPrivate Sub ButtonCancle_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles ButtonCancle.ClickIf MsgBox("-您确定要退出使用本系统？"& vbCrLf & "-欢迎再次使用！", MsgBoxStyle.OkCancel, "退出信息") = MsgBoxResult.Ok ThenEndEnd IfEnd SubPrivate Sub ButtonOK_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles ButtonOK.Click'Dim trycount As Integer'trycount = 3Dim sqlcmdLianjie As New SqlCommandDim mydsLianjie As New DataSetDim mydaptLianjie As New SqlDataAdapterDim sqlcmdJiance As New SqlCommandDim mydsJiance As New DataSetDim mydaptJiance As New SqlDataAdaptersqlconLianjie.ConnectionString = "user id=sa;password=;initialcatalog=EmployeesInformation;data source=(local)"sqlconLianjie.Open()mandText = "select * from TableInformation where AccountID='" &ComboBoxAccountID.Text & "' and Password='" & TextBoxPassword.Text & "'"sqlcmdLianjie.Connection = sqlconLianjiemydaptLianjie.SelectCommand = sqlcmdLianjiemydaptLianjie.Fill(mydsLianjie, "TableInformation")mandText = "select * from TABLEyidenglu where AccountID='" & ComboBoxAccountID.Text & "'"sqlcmdJiance.Connection = sqlconLianjiemydaptJiance.SelectCommand = sqlcmdJiancemydaptJiance.Fill(mydsJiance, "TABLEyidenglu")If ComboBoxAccountID.Text = ""ThenMsgBox("-用户名不能为空"& vbCrLf & "-请您输入正确的用户名！", MsgBoxStyle.OkOnly, "信息")ElseIf TextBoxPassword.Text = ""ThenMsgBox("-密码不能为空" & vbCrLf & "-请您输入正确的密码！", MsgBoxStyle.OkOnly, "信息")ElseIf mydsLianjie.Tables("TableInformation").Rows.Count = 0 Then'trycount = trycount - 1'If trycount = 3 Then' Timer2.Enabled = True' MsgBox("-您的累计错误登录次数达到3次" & vbCrLf & "-系统将自动关闭！", MsgBoxStyle.OkOnly, "信息")'End IfIf MsgBox("-用户名或密码不存在" & vbCrLf & "-请重新输入！", MsgBoxStyle.OkOnly, "错误") = MsgBoxResult.Ok ThenComboBoxAccountID.Text = ""TextBoxPassword.Clear()End If'ElseIf restart = True Then '判断是否为重新登录系统' If MessageBox.Show("请您重新登录！", "登录超时", MessageBoxButtons.OK, MessageBoxIcon.Error) = Windows.Forms.DialogResult.OK Then' End' End IfElseIf mydsJiance.Tables("TABLEyidenglu").Rows.Count = 0 Then'判断防止重复写入相同的用户名If MsgBox("登录成功，欢迎使用！", MsgBoxStyle.OkOnly, "信息") = MsgBoxResult.Ok Then belAccountID.Text = mydsLianjie.Tables("TableInformation").Rows(0)(1) '获取登录帐号的隐藏帐号FMain.ToolStripLabeshenfen.Text =mydsLianjie.Tables("TableInformation").Rows(0)(3)'获取登录帐号对应身份FMain.ToolStripLabelmingzi.Text =mydsLianjie.Tables("TableInformation").Rows(0)(0)'获取登录帐号的隐藏名字Dim sqlcmdXieru As New SqlCommandmandText = "insert into TABLEyidenglu values('" & mydsLianjie.Tables("TableInformation").Rows(0)(1) & "')"sqlcmdXieru.Connection = sqlconLianjiesqlcmdXieru.ExecuteNonQuery() '该情况为满足正确的用户名和密码时，把此时的用户名添加到数据库中。
使用VB获取网上邻居里的计算机名
使用VB获取网上邻居里的计算机名Option ExplicitPrivate Const RESOURCE_CONNECTED As Long = &H1&Private Const RESOURCE_GLOBALNET As Long = &H2&Private Const RESOURCE_REMEMBERED As Long = &H3&Private Const RESOURCEDISPLAYTYPE_DIRECTORY& = &H9Private Const RESOURCEDISPLAYTYPE_DOMAIN& = &H1Private Const RESOURCEDISPLAYTYPE_FILE& = &H4Private Const RESOURCEDISPLAYTYPE_GENERIC& = &H0Private Const RESOURCEDISPLAYTYPE_GROUP& = &H5Private Const RESOURCEDISPLAYTYPE_NETWORK& = &H6Private Const RESOURCEDISPLAYTYPE_ROOT& = &H7Private Const RESOURCEDISPLAYTYPE_SERVER& = &H2Private Const RESOURCEDISPLAYTYPE_SHARE& = &H3Private Const RESOURCEDISPLAYTYPE_SHAREADMIN& = &H8Private Const RESOURCETYPE_ANY As Long = &H0&Private Const RESOURCETYPE_DISK As Long = &H1&Private Const RESOURCETYPE_PRINT As Long = &H2&Private Const RESOURCETYPE_UNKNOWN As Long = &HFFFF&Private Const RESOURCEUSAGE_ALL As Long = &H0&Private Const RESOURCEUSAGE_CONNECTABLE As Long = &H1&Private Const RESOURCEUSAGE_CONTAINER As Long = &H2&Private Const RESOURCEUSAGE_RESERVED As Long = &H80000000Private Const NO_ERROR = 0Private Const ERROR_MORE_DATA = 234 ’L // dderrorPrivate Const RESOURCE_ENUM_ALL As Long = &HFFFFPrivate Type NETRESOURCEdwScope As LongdwType As LongdwDisplayType As LongdwUsage As LongpLocalName As LongpRemoteName As LongpComment As LongpProvider As LongEnd TypePrivate Type NETRESOURCE_REALdwScope As LongdwType As LongdwDisplayType As LongdwUsage As LongsLocalName As StringsRemoteName As StringsComment As StringsProvider As StringEnd TypePrivate Declare Function WNetAddConnection2 Lib "mpr.dll" Alias "WNetAddConnection2A" (lpNetResource AsNETRESOURCE, ByVal lpPassword As String, ByVal lpUserName As String, ByVal dwFlags As Long) As Long Private Declare Function WNetOpenEnum Lib "mpr.dll" Alias "WNetOpenEnumA" (ByVal dwScope As Long, ByVal dwType As Long, ByVal dwUsage As Long, lpNetResource As Any, lphEnum As Long) As LongPrivate Declare Function WNetEnumResource Lib "mpr.dll" Alias "WNetEnumResourceA" (ByVal hEnum As Long, lpcCount As Long, lpBuffer As NETRESOURCE, lpBufferSize As Long) As LongPrivate Declare Function WNetCloseEnum Lib "mpr.dll" (ByVal hEnum As Long) As LongPrivate Declare Function VarPtrAny Lib "vb40032.dll" Alias "VarPtr" (lpObject As Any) As LongPrivate Declare Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" (lpTo As Any, lpFrom As Any, ByVal lLen As Long)Private Declare Sub CopyMemByPtr Lib "kernel32" Alias "RtlMoveMemory" (ByVal lpTo As Long, ByVal lpFrom As Long, ByVal lLen As Long)Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (ByVal lpString1 As String, ByVal lpString2 As Any) As LongPrivate Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As Any) As LongSub main()Const MAX_RESOURCES = 256Const NOT_A_CONTAINER = -1Dim bFirstTime As BooleanDim lReturn As LongDim hEnum As LongDim lCount As LongDim lMin As LongDim lLength As LongDim l As LongDim lBufferSize As LongDim lLastIndex As LongDim uNetApi(0 To MAX_RESOURCES) As NETRESOURCEDim uNet() As NETRESOURCE_REALbFirstTime = TrueDoIf bFirstTime ThenlReturn = WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_ANY, RESOURCEUSAGE_ALL, ByVal 0&, hEnum)bFirstTime = FalseElseIf uNet(lLastIndex).dwUsage And RESOURCEUSAGE_CONTAINER ThenlReturn = WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_ANY, RESOURCEUSAGE_ALL, uNet(lLastIndex), hEnum)ElselReturn = NOT_A_CONTAINERhEnum = 0End IflLastIndex = lLastIndex + 1End IfIf lReturn = NO_ERROR ThenlCount = RESOURCE_ENUM_ALLDolBufferSize = UBound(uNetApi) * Len(uNetApi(0)) / 2lReturn = WNetEnumResource(hEnum, lCount, uNetApi(0), lBufferSize)If lCount > 0 ThenReDim Preserve uNet(0 To lMin + lCount - 1) As NETRESOURCE_REALFor l = 0 To lCount - 1’Each Resource will appear here as uNet(i)uNet(lMin + l).dwScope = uNetApi(l).dwScopeuNet(lMin + l).dwType = uNetApi(l).dwTypeuNet(lMin + l).dwDisplayType = uNetApi(l).dwDisplayTypeuNet(lMin + l).dwUsage = uNetApi(l).dwUsageIf uNetApi(l).pLocalName ThenlLength = lstrlen(uNetApi(l).pLocalName)uNet(lMin + l).sLocalName = Space$(lLength)CopyMem ByVal uNet(lMin + l).sLocalName, ByVal uNetApi(l).pLocalName, lLength End IfIf uNetApi(l).pRemoteName ThenlLength = lstrlen(uNetApi(l).pRemoteName)uNet(lMin + l).sRemoteName = Space$(lLength)CopyMem ByVal uNet(lMin + l).sRemoteName, ByVal uNetApi(l).pRemoteName, lLength End IfIf uNetApi(l).pComment ThenlLength = lstrlen(uNetApi(l).pComment)uNet(lMin + l).sComment = Space$(lLength)CopyMem ByVal uNet(lMin + l).sComment, ByVal uNetApi(l).pComment, lLengthEnd IfIf uNetApi(l).pProvider ThenlLength = lstrlen(uNetApi(l).pProvider)uNet(lMin + l).sProvider = Space$(lLength)CopyMem ByVal uNet(lMin + l).sProvider, ByVal uNetApi(l).pProvider, lLengthEnd IfNext lEnd IflMin = lMin + lCountLoop While lReturn = ERROR_MORE_DATAEnd IfIf hEnum Thenl = WNetCloseEnum(hEnum)End IfLoop While lLastIndex < lMinIf UBound(uNet) > 0 ThenFor l = 0 To UBound(uNet)Select Case uNet(l).dwDisplayTypeCase RESOURCEDISPLAYTYPE_DIRECTORY&Debug.Print "Directory...",Case RESOURCEDISPLAYTYPE_DOMAINDebug.Print "Domain...",Case RESOURCEDISPLAYTYPE_FILEDebug.Print "File...",Case RESOURCEDISPLAYTYPE_GENERICDebug.Print "Generic...",Case RESOURCEDISPLAYTYPE_GROUP Debug.Print "Group...",Case RESOURCEDISPLAYTYPE_NETWORK& Debug.Print "Network...",Case RESOURCEDISPLAYTYPE_ROOT& Debug.Print "Root...",Case RESOURCEDISPLAYTYPE_SERVER Debug.Print "Server...",Case RESOURCEDISPLAYTYPE_SHARE Debug.Print "Share...",Case RESOURCEDISPLAYTYPE_SHAREADMIN& Debug.Print "ShareAdmin...",End SelectDebug.Print uNet(l).sRemoteName, uNet(l).sComment Next lEnd IfEnd Sub。
VB获取本机计算机名、用户名、ip地址的方法代码（含5篇）
VB获取本机计算机名、用户名、ip地址的方法代码（含5篇）第一篇：VB 获取本机计算机名、用户名、ip地址的方法代码VB 获取本机计算机名、用户名、ip地址的方法代码 Private Sub Command1_Click()Dim aa As StringDim strLocalIP As StringDim winIP As Objectaa = aa & “本机电脑名称:” & Environ(“computername”)& vbCrLf aa = aa & “本机用户名称:” & Environ(“username”)& vbCrLfSet winIP = CreateObject(“MSWinsock.Winsock”)strLocalIP = winIP.localipMsgBox aa & “本机IP:” & strLocalIPEnd Sub第二篇：vb 6.0 获取本机公网IP[范文]vb 6.0 获取本机公网IPPrivat e Declare Function InternetOpen Lib “wininet.dll” Alias “InternetOpenA”(_ByVal sAgent As String, ByVal lAccessType As Long, _ByVal sProxyName As String, ByVal sProxyBypass As String, _ByVal lFlags As Long)As LongPrivate Declare Function InternetOpenUrl Lib “wininet.dll” Alias“InternetOpenUrlA”(_ByVal hInternetSession As Long, ByVal sUrl As String, _ByVal sHeaders As String, ByVal lHeadersLength As Long, _ByVal lFlags As Long, ByVal lContext As Long)As Long Private Declare Function InternetReadFile Lib “wininet.dll”(_ByVal hFile As Long, ByVal sBuffer As String, _ByVal lNumBytesT oRead As Long, _lNumberOfBytesRead As Long)As IntegerPrivate Declare Function InternetCloseHandle Lib “wininet.dll”(_ByVal hInet As Long)As IntegerPrivate Const INTERNET_FLAG_NO_CACHE_WRITE = &H4000000 Private Declare Function URLDownloadT oFile Lib “urlmon” Alias“URLDownloadToFileA”(ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long)As LongPublic Function GetIP()As StringDim wburl$, wburl2$, X1, X2, X3, X4On Error GoTo errwburl = GetUrlFile(wburl)If InStr(1, wburl, “无法找到该页”)= 0 ThenX1 = InStr(1, wburl, “[”)X2 = InStr(1, wburl, “]”)X1 = Mid(wburl, X1, X2X3)X3 = Replace(X3, “”, “")X3 = Replace(X3, ” “, ”“)X3 = Replace(X3, vbCrLf, ”“)GetIP = X3Exit FunctionElseGetIP = ”127.0.0.1“End Iferr:GetIP = ”127.0.0.1“End FunctionPrivate Function GetUrlFile(stUrl As String)As StringDim lgInternet As Long, lgSession As LongDim stBuf As String * 1024Dim inRes As IntegerDim lgRet As LongDim stTotal As StringstTotal = vbNullStringlgSession = InternetOpen(”VBTagEdit“, 1, vbNullString, vbNullString, 0)If lgSession ThenlgInternet = InternetOpenUrl(lgSession, stUrl, vbNullString, _0, INTERNET_FLAG_NO_CACHE_WRITE, 0)If lgInternet Then DoinRes = InternetReadFile(lgInternet, stBuf, 1024, lgRet)stTotal = stTotal & Mid$(stBuf, 1, lgRet)Loop While(lgRet <> 0)End IfinRes = InternetCloseHandle(lgInternet)End IfGetUrlFile = stT otalEnd Function使用方法：调用GetIP 返回值即为公网IPPrivate Sub Command1_Click()Dim aa As StringDim strLocalIP As StringDim winIP As Objectaa = aa & ”本机电脑名称:“ & Environ(”computername“)& vbCrLfaa = aa & ”本机用户名称:“ & Environ(”username“)& vbCrLfSet winIP = CreateObject(”MSWinsock.Winsock“)strLocalIP = winIP.localipMsgBox aa & ”本机IP:" & strLocalIPEnd Sub第三篇：PHP 获取客户端真实IP地址多种方法小结PHP 获取客户端真实IP地址多种方法小结经过复杂的判断与算是的获取IP地址函数复制代码代码如下: function getIP(){if(getenv('HTTP_CLIENT_IP')){ $ip = getenv('HTTP_CLIENT_IP');}elseif(getenv('HTTP_X_FORWARDED_FOR')){ $ip = getenv('HTTP_X_FORWARDED_FOR');}elseif(getenv('HTTP_X_FORWARDED')){ $ip = getenv('HTTP_X_FORWARDED');}elseif(getenv('HTTP_FORWARDED_FOR')){ $ip = getenv('HTTP_FORWARDED_FOR');}elseif(getenv('HTTP_FORWARDED')){ $ip = getenv('HTTP_FORWARDED');} else {$ip = $_SERVER['REMOTE_ADDR'];} return $ip;} 最简单获取ip地址代码一句实例复制代码代码如下: $reIP=$_SERVER[“REMOTE_ADDR”];echo $reIP;php获取ip的算法复制代码代码如下: if(getenv('HTTP_CLIENT_IP')){ $onlineip = getenv('HTTP_CLIENT_IP');} elseif(getenv('HTTP_X_FORWARDED_FOR')){ $onlineip = getenv('HTTP_X_FORWARDED_FOR');}elseif(getenv('REMOTE_ADDR')){ $onlineip = getenv('REMOTE_ADDR');} else {$onlineip = $HTTP_SERVER_VARS['REMOTE_ADDR'];}echo $onlineip;可以分出内网与外网站ip地址获取程序复制代码代码如下: function getip_out(){ $ip=false;if(!emp ty($_SERVER[“HTTP_CLIENT_IP”])){ $ip = $_SERVER[“HTTP_CLIENT_IP”];}if(!empty($_SERVER['HTTP_X_FORWARDED_FOR'])){ $ips教程= explode(“, ”, $_SERVER['HTTP_X_FORWARDED_FOR']);if($ip){ array_unshift($i ps, $ip);$ip = FALSE;} for($i = 0;$i < count($ips);$i++){ if(!eregi(“^(10│172.16│192.168).”, $ips[$i])){ $ip = $ips[$i];break;} } }return($ip ? $ip : $_SERVER['REMOTE_ADDR']);}echo getip_out();php获取ip的算法，用了？号表达式来处理复制代码代码如下: $user_IP =($_SERVER[“HTTP_VIA”])? $_SERVER[“HTTP_X_FORWARDED_FOR”] : $_SERVER[“REMOTE_ADDR”];$user_IP =($user_IP)? $user_IP : $_SERVER[“REMOTE_ADDR”];第四篇：用命令行怎样通过IP地址知道对方的计算机名和工作组名局域网中，用命令行怎样通过IP地址知道对方的计算机名和工作组名？方法:nbtstat-A ip Nbtstat命令显示基于 TCP/IP 的 NetBIOS(NetBT)协议统计资料、本地计算机和远程计算机的 NetBIOS 名称表和 NetBIOS 名称缓存。
VB.NET获取计算机系统信息
获取计算机系统信息Visual 拥有许多VB开发者以前只能梦想的新功能和新特色。
比如说，在VB6中只有通过复杂的Win32 API函数调用才能获得的系统信息，到了，就可以以多种方法轻松的获取。
一、Environment类轻松获取系统信息.NET Framework中的System.Environment类提供了丰富而简单的方法取得有关当前环境和平台的系统信息，如计算机名称、系统目录等：获取计算机的 NetBIOS 名称：Environment类的MachineName属性可以轻松获取此本地计算机的 NetBIOS 名称，如：lblMachineName.T ext = "机器名：" & Environment.MachineName获取操作系统标识符和版本号：Environment类的OSVersion可以轻松获取当前操作系统标识符和版本号，如：lblOs.Text = "操作系统：" & Environment.OSVersion.ToString 获取系统目录：Environment类的SystemDirectory属性可以轻松取得系统目录：LblSysDir.Text = "系统目录：" & Environment.SystemDirectory获取系统启动后经过的时间：Environment类的TickCount属性可以轻松获取系统启动后经过的毫秒数，如：LblSysTickCount.Text = "系统已经启动了：" &CStr(Environment.TickCount / 1000) & "秒"获取系统特殊文件夹的路径：使用Environment类的GetFolderPath方法可以轻松获得系统特殊文件夹的路径，如：LblSpecialDir.Text = "我的收藏夹：" & _ mEnvironment.GetFolderPath(Environment.SpecialFolder.Favorit es)获取当前用户名：Environment类的UserName属性可以轻松获取当前用户名，如：LblUser.Text = "用户：" & erName二、SystemInformation类轻松获取系统信息通过SystemInformation类也可以轻松取得如计算机名等操作系统的有关信息：获取系统的启动方式：使用 BootMode 可确定用户如何启动系统。
VB取得拨号网络中的所有连接名下
VB取得拨号网络中的所有连接名下以下在窗口中Private Sub Command3_Click()Unload MeEnd SubPrivate Sub Command1_Click()Dim A$Dim XA$ = "rundll rnaui.dll,RnaDial " & List1.List(List1.ListIndex)On Error GoTo EX = Shell(A$, vbNormalFocus)On Error GoTo 0Unload MeExit SubE:MsgBox "没有找到文件rundll和rnaui.dll", vbExclamation, "网络拨号" End SubPublic Sub Command2_Click()If IsConnected() = True ThenMsgBox "已经连接或正在连接!", , "网络拨号"ElseMsgBox "没有连接上网络!", , "网络拨号"End IfEnd SubPrivate Sub Command4_Click()Shell "C:\WINNT\system32\rasdial.exe " & List1.Text, vbHide End SubPrivate Sub Form_Load()Dim s As Long, l As Long, ln As Long, A$ReDim R(255) As RASENTRYNAME95R(0).dwSize = 264s = 256 * R(0).dwSizel = RasEnumEntries(vbNullString, vbNullString, R (0), s, ln)For l = 0 To ln - 1A$ = StrConv(R(l).szEntryName(), vbUnicode)List1.AddItem Left$(A$, InStr(A$, Chr$(0)) - 1)NextOn Error GoTo EList1.ListIndex = 0Exit SubE:MsgBox "你可能没安装拨号网络！", , "网络拨号" Command1.Enabled = FalseCommand2.Enabled = FalseEnd SubPublic Function IsConnected() As BooleanDim TRasCon(255) As RASCONN95Dim lg As LongDim lpcon As LongDim RetVal As LongDim Tstatus As RASCONNSTATUS95'TRasCon (0).dwSize = 412lg = 256 * TRasCon(0).dwSize 'RetVal = RasEnumConnections(TRasCon (0), lg, lpcon)If RetVal <> 0 ThenMsgBox "ERROR"Exit FunctionEnd If 'Tstatus.dwSize = 160RetVal = RasGetConnectStatus(TRasCon (0).hRasConn, Tstatus)If Tstatus.RasConnState = &H2000 Then IsConnected = TrueElseIsConnected = FalseEnd IfEnd Function。
VB中怎么获取客户机电脑名和IP地址？谢谢!不是.net哦
VB中怎么获取客户机电脑名和IP地址？谢谢!不是.net哦分類:電腦/網絡 >> 程序設計 >> 其他編程語言解析:Private Const NCBASTAT = &H33Private Const NCBNAMSZ = 16Private Const HEAP_ZERO_MEMORY = &H8Private Const HEAP_GENERATE_EXCEPTIONS = &H4 Private Const NCBRESET = &H32Private Type NCBncb_mand As Bytencb_retcode As Bytencb_lsn As Bytencb_num As Bytencb_buffer As Longncb_length As Integerncb_callname As String * NCBNAMSZncb_name As String * NCBNAMSZncb_rto As Bytencb_sto As Bytencb_post As Longncb_lana_num As Bytencb_cmd_cplt As Bytencb_reserve(9) As Byte ' Reserved, must be 0ncb_event As LongEnd TypePrivate Type ADAPTER_STATUSadapter_address(5) As Byterev_major As Bytereserved0 As Byteadapter_type As Byterev_minor As Byteduration As Integerfrmr_recv As Integerfrmr_xmit As Integeriframe_recv_err As Integer xmit_aborts As Integerxmit_success As Longrecv_success As Long iframe_xmit_err As Integer recv_buff_unavail As Integer t1_timeouts As Integerti_timeouts As Integer Reserved1 As Longfree_ncbs As Integermax_cfg_ncbs As Integer max_ncbs As Integerxmit_buf_unavail As Integer max_dgram_size As Integer pending_sess As Integer max_cfg_sess As Integer max_sess As Integermax_sess_pkt_size As Integer name_count As IntegerEnd TypePrivate Type NAME_BUFFER name As String * NCBNAMSZ name_num As Integer name_flags As IntegerEnd TypePrivate Type ASTATadapt As ADAPTER_STATUSNameBuff(30) As NAME_BUFFEREnd TypePrivate Declare Function Netbios Lib "api32.dll" (pncb As NCB) As BytePrivate Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)Private Declare Function GetProcessHeap Lib "kernel32" () As LongPrivate Declare Function HeapAlloc Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, ByVal dwBytes As Long) As LongPrivate Declare Function HeapFree Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, lpMem As Any) As Long Private Function EtherAddress(LanaNumber As Long) As StringDim udtNCB As NCBDim bytResponse As ByteDim udtASTAT As ASTATDim udtT empASTAT As ASTATDim lngASTAT As LongDim strOut As StringDim x As IntegerudtNCB.ncb_mand = NCBRESETbytResponse = Netbios(udtNCB)udtNCB.ncb_mand = NCBASTATudtNCB.ncb_lana_num = LanaNumberudtNCB.ncb_callname = "* "udtNCB.ncb_length = Len(udtASTAT)lngASTAT = HeapAlloc(GetProcessHeap(), HEAP_GENERATE_EXCEPTIONS Or HEAP_ZERO_MEMORY, udtNCB.ncb_length)strOut = ""If lngASTAT ThenudtNCB.ncb_buffer = lngASTATbytResponse = Netbios(udtNCB)CopyMemory udtASTAT, udtNCB.ncb_buffer, Len(udtASTAT) With udtASTAT.adaptFor x = 0 To 5strOut = strOut & "-" & Right$("00" & Hex$(.adapter_address(x)), 2)Next xEnd WithHeapFree GetProcessHeap(), 0, lngASTATEnd IfEtherAddress = strOutEnd FunctionPrivate Sub Command1_Click()Text1.Text = Right$(EtherAddress(0), 17)Text2.Text = Winsock1.LocalIPText3.Text = Winsock1.LocalHostNameEnd SubPrivate Sub Command2_Click()EndEnd Sub。
VB制作系统登录界面,包括用户名,密码和错误校验及效果全代码
VB制作系统登录界面,包括用户名,密码和错误校验及效果全代码VB制作系统登录界面，包括用户名，密码和错误校验及效果全代码第十讲:教你用VB制作系统登录界面，包括用户名，密码和错误校验及效果全代码以下代码均为个人学习心得，经过测试并且无误，可以嵌入大型程序中作为身份认证的功能作用。
其中有一些窗体名和效果代码，不必复制，否则会出现错误，请仔细阅读核心代码理解即可。
红色代码部份为实现用户检测的关键代码，必需要有后台数据库用来存放用户信息，通过conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\HISDB.mdb"来连接，然后用If rs.EOF = True Then进行判断表中是否存在用户信息即可。
Option ExplicitDim Cnum As IntegerPrivate Sub CmdCancel_Click()'//结束EndEnd SubPrivate Sub CmdLogin_Click()Dim UserName As StringDim PassWord As StringDim conn As New ADODB.ConnectionDim rs As New ADODB.RecordsetDim StrSQL As Stringconn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" &App.Path & "\HISDB.mdb"UserName = Trim(TxtUserName.T ext) '//将文本框内的值赋给定义好的全局变量PassWord = Trim(TxtPassword.Text) If UserName = "" Or PassWord = "" ThenMsgBox "对不起，用户或密码不能为空～请重新输入～～", vbCritical, "错误"ElseIf UserName <> Empty And PassWord <> Empty Then '//用户名与密码是否为空Cnum = Cnum + 1StrSQL = "select * from 用户信息表where 用户名称= '" & UserName & "'and 用户口令 ='" & PassWord & "'"rs.Open StrSQL, conn, adOpenKeyset, adLockPessimistic '//打开记录集If rs.EOF = True ThenMsgBox "对不起，无此用户或者密码不正确～请重新输入～～", vbCritical, "错误"TxtUserName.T ext = ""TxtPassword.Text = ""TxtUserName.SetFocusrs.CloseIf Cnum >= 3 ThenMsgBox "对不起，您已经多次失败，无权操作本系统～", vbCritical, "无权限"Unload MeExit SubEnd IfElse '登陆成功,以下为权限验证If rs.Fields("用户权限").Value = "系统管理" Then Frmmdimain.Show Unload MeElseIf rs.Fields("用户权限").Value = "挂号" ThenFrmregistration2.ShowUnload MeElseIf rs.Fields("用户权限").Value = "诊断" Then Frmdiagnose2.Show Unload MeElseIf rs.Fields("用户权限").Value = "收费" Then Frmcharges2.Show Unload MeElseIf rs.Fields("用户权限").Value = "发药" Then Frmmedicine2.Show Unload MeEnd Ifrs.CloseEnd IfEnd IfEnd SubPrivate Sub Form_Load()'//加载主窗时给文本框赋值TxtUserName.T ext = "Admin"TxtPassword.Text = "123"Cnum = 0End SubPrivate Sub TmrChangeColor_Timer() '//调用定义好的改变颜色过程, Call changecolor(LblWelcome(0), 0, 1, 2, 3, 4, 5, 6, 7) End SubPrivate Sub TmrMoveText1_Timer() '//移动LblShaSiLblShaSi(0).Move LblShaSi(0).Left + 20 LblShaSi(1).Move LblShaSi(1).Left + 20 End SubPrivate Sub TmrMoveText2_Timer() '//移动LblShaSiIf LblShaSi(0).Left + LblShaSi(0).Width >= Me.Width +LblShaSi(0).WidthThenLblShaSi(0).Move -1500End IfIf LblShaSi(1).Left + LblShaSi(1).Width >= Me.Width +LblShaSi(1).WidthThenLblShaSi(1).Move -1500End IfEnd Sub'//定义一个改变颜色的过程,下面的control就是我们所说的控件Sub changecolor(LCnt As Control, color1 As Integer, _ color2 As Integer, color3 As Integer, _color4 As Integer, color5 As Integer, _color6 As Integer, color7 As Integer, _color8 As Integer)Dim tmep As Integertmep = Val(LCnt.T ag) '//将返回包含于字符串内的数字赋给TEMP Select Case tmepCase color1LCnt.Tag = color2Case color2LCnt.Tag = color3Case color3LCnt.Tag = color4Case color4LCnt.Tag = color5Case color5LCnt.Tag = color6Case color6LCnt.Tag = color7Case color7LCnt.Tag = color8Case color8LCnt.Tag = color1End SelectLCnt.ForeColor = QBColor(LCnt.Tag) '//给控件LCnt中的字体赋予颜色,注意QBColor是将一值'//转换为三色,MSDN详解,我也是在那查的````哈End Sub。
在VB中通过程序实现向Windows添加用户的方法
Attribute VB_Name = "ModUser"Option Explicit'------------------------------------------' 模块名称：ModUser' 功能说明：windows用户组管理'------------------------------------------Public Const OLAP_Administrators = "OLAP Administrators" 'Olap用户组Public Const UF_OLAP_USER = "UF_OLAP_USER" 'Olap用户名Private Declare Function NetUserGetInfo _Lib "Netapi32" (ByVal servername As String, _ByVal username As String, ByVal Level As Long, _Buffer As Long) As LongPrivate Declare Function NetUserAdd _Lib "Netapi32" (ByVal servername As String, _ByVal Level As Long, Buffer As Any, ParamErr As _Long) As LongDeclare Function NetLocalGroupAddMembers Lib "netapi32.dll" _ (ByVal servername As String, _ByVal GroupName As String, _ByVal Level As Long, _buf As Any, _ByVal totalentries As Long) As LongDeclare Function NetApiBufferFree Lib "netapi32.dll" _(ByVal Buffer As Long) As LongDeclare Function NetUserEnum Lib "netapi32.dll" _(ByVal servername As String, _ByVal Level As Long, _ByVal filter As Long, _bufptr As Any, _ByVal prefmaxlen As Long, _entriesread As Long, _totalentries As Long, _resume_handle As Long) As LongDeclare Function NetLocalGroupEnum Lib "netapi32.dll" _ (ByVal servername As String, _ByVal Level As Long, _bufptr As Any, _ByVal prefmaxlen As Long, _entriesread As Long, _totalentries As Long, _resumehandle As Long) As LongDeclare Function NetUserGetLocalGroups Lib "netapi32.dll" _ (ByVal servername As String, _ByVal username As String, _ByVal Level As Long, _ByVal flag As Long, _bufptr As Any, _ByVal prefmaxlen As Long, _entriesread As Long, _totalentries As Long) As LongDeclare Sub RtlMoveMemory Lib "kernel32.dll" _ (Destination As Any, _Source As Any, _ByVal Length As Long)Declare Function lstrcpy Lib "kernel32.dll" _Alias "lstrcpyW" _(lpszString1 As Any, _lpszString2 As Any) As LongDeclare Function lstrlen Lib "kernel32.dll" _Alias "lstrlenW" _(ByVal lpszString As Long) As LongType USER_INFO_0usri0_name As LongEnd TypeType LOCALGROUP_INFO_0lgrpi0_name As LongEnd TypeType LOCALGROUP_USER_INFO_0lgrui0_name As LongEnd TypeType LOCALGROUP_MEMBERS_INFO_3lgrmi3_domainandname As LongEnd TypePrivate Type UserInfo_1username As StringPassword As StringPasswordAge As LongPrivilege As LongHomeDir As StringComment As StringFlags As LongScriptPath As StringEnd TypePrivate Type lpUserInfo_10username As LongComment As LongUserComment As LongFullname As LongEnd TypePrivate Usr1 As UserInfo_1Private lpUsr10 As lpUserInfo_10Public Const User_Priv_User = &H1Public Const LG_INCLUDE_INDIRECT = &H1Public Const MAX_PREFERRED_LENGTH = -1&Public Const ERROR_MORE_DATA = 234&Public Const NERR_Success = 0'Function PointerToString(lngPointer As Long) As StringDim bytBuffer(255) As Bytelstrcpy bytBuffer(0), ByVal lngPointerPointerToString = Left(bytBuffer, lstrlen(lngPointer))End Function'-----------------------------------------------'功能：向本地组添加用户'参数：servername 服务器名' localGroupName 本地组名' username 用户名'返回：是否成功0-成功'作者：万伟星'日期：2003-06-5'----------------------------------------------Function LocalGroupAddUser(servername As String, LocalGroupName As String, username As String) As LongDim strServerName As StringDim strLocalGroupName As StringDim strUserName As StringDim udtLGMemInfo As LOCALGROUP_MEMBERS_INFO_3Dim lngWin32apiResultCode As LongDim lngBufPtr As LongstrServerName = StrConv(servername, vbUnicode)strLocalGroupName = StrConv(LocalGroupName, vbUnicode)strUserName = usernameudtLGMemInfo.lgrmi3_domainandname = StrPtr(strUserName)lngWin32apiResultCode = _NetLocalGroupAddMembers(strServerName, _strLocalGroupName, _3, _udtLGMemInfo, _1)NetApiBufferFree lngBufPtrLocalGroupAddUser = lngWin32apiResultCodeEnd Function'-----------------------------------------------'功能：向服务器添加用户'参数：servername 服务器名' username 用户名' Password 用户密码' Comment 用户描述' Flags 传入0就可以'返回：是否成功0-成功'作者：万伟星'日期：2003-06-5'----------------------------------------------Function UserAdd(ByVal servername As String, _ ByVal username As String, ByVal Password As _String, ByVal Comment As String, ByVal Flags As _ Long) As Longservername = StrConv(servername, vbUnicode)ername = StrConv(username, vbUnicode)Usr1.Password = StrConv(Password, vbUnicode)Usr1.Privilege = User_Priv_Userment = StrConv(Comment, vbUnicode)Usr1.Flags = FlagsUsr1.HomeDir = "OLAP Administrators"UserAdd = NetUserAdd(servername, 1, Usr1, 0) End Function'-----------------------------------------------'功能：'用户是否存在'参数：servername 服务器名' username 用户名'返回：是否存在'作者：万伟星'日期：2003-06-5'----------------------------------------------Function IsUser(ByVal servername As String, _ ByVal username As String) As BooleanDim Buffer As LongDim rcservername = StrConv(servername, vbUnicode)username = StrConv(username, vbUnicode)rc = NetUserGetInfo(servername, username, 10, _Buffer)If rc = 0 ThenIsUser = TrueElseIsUser = FalseEnd IfNetApiBufferFree BufferEnd Function'-----------------------------------------------'功能：增加Olap用户'参数：无'返回：是否成功'作者：万伟星'日期：2003-06-5'----------------------------------------------Public Function AddOlapUser() As BooleanIf Not IsUserInGroup(UF_OLAP_USER, OLAP_Administrators) ThenIf UserAdd(CurrentMachineName, UF_OLAP_USER, UF_OLAP_USER, "用友U8管理系统——管理驾驶舱用户", 0) <> 0 ThenMsgBox "用户添加失败，请检察是否有同名用户", vbExclamation, "系统错误"Exit FunctionEnd IfIf LocalGroupAddUser(CurrentMachineName, OLAP_Administrators, UF_OLAP_USER) <> 0 The nMsgBox "用户添加到OLAP Administrators组失败，请与系统管理员联系", vbExclamation, "系统错误"Exit FunctionEnd IfEnd IfAddOlapUser = TrueEnd Function'-----------------------------------------------'功能：用户是否在用户组中'参数：username 用户名' GroupName 组名'返回：是否存在'作者：万伟星'日期：2003-06-5'----------------------------------------------Public Function IsUserInGroup(username As String, GroupName As String) As Boolean Dim lngWin32apiResultCode As LongDim strServerName As StringDim strUserName As StringDim lngBufPtr As LongDim lngEntriesRead As LongDim lngTotalEntries As LongDim lngResumeHandle As LongDim udtLGInfo0 As LOCALGROUP_USER_INFO_0Dim lngEntry As LongDim strLocalGroup As StringDim lngListCounter As LongstrServerName = _StrConv("", _vbUnicode)strUserName = _StrConv(username, _vbUnicode)DolngWin32apiResultCode = _NetUserGetLocalGroups(strServerName, _strUserName, _0, _LG_INCLUDE_INDIRECT, _lngBufPtr, _MAX_PREFERRED_LENGTH, _lngEntriesRead, _lngTotalEntries)If (lngWin32apiResultCode = NERR_Success) Or _(lngWin32apiResultCode = ERROR_MORE_DATA) ThenFor lngEntry = 0 To lngEntriesRead - 1RtlMoveMemory udtLGInfo0, _ByVal lngBufPtr + _Len(udtLGInfo0) * _lngEntry, _Len(udtLGInfo0)strLocalGroup = _PointerToString(udtLGInfo0.lgrui0_name)If UCase(GroupName) = UCase(strLocalGroup) Then IsUserInGroup = TrueExit FunctionEnd IfNextEnd IfIf lngBufPtr <> 0 ThenNetApiBufferFree lngBufPtrEnd IfLoop Until lngEntriesRead = lngTotalEntriesIsUserInGroup = FalseEnd Function。
简易VB登陆窗口
说明：把下列内容复制—粘贴到编程窗口后还需添加3个Label（第一个为账号，第二个为密码第三个为输错提示），1个Form2，2个text（第一个为账号、第二个为密码），另还要添加2个按钮。
Private Sub Command1_Click()On Error Resume NextDim a As StringDim b As StringStatic number As Integera = Trim(Text1.Text)b = Trim(Text2.Text)If Text1.Text = "" ThenMsgBox "帐户不能为空,请核对帐户信息！！", vbCritical, "核对帐户信息"ElseIf Text2.Text = "" ThenMsgBox "密码不能为空,请核对密码信息！！", vbCritical, "核对密码信息"ElseIf a <> 账号Or (a = 账号And b <> 密码) Then '请把此句的“账号”改为你想设置的帐号，“密码”改为你想设置的密码！MsgBox "对不起，无此用户或者密码不正确，请重新输入！！", vbCritical, "错误"Text1.Text = ""Text2.Text = ""Text1.SetFocusnumber = number + 1Label3.Caption = "您已经连续输错了" & number & "次（输错3次将被锁定）"’设置账号锁定If number >= 3 ThenCommand1.Enabled = FalseText1.Enabled = FalseText2.Enabled = FalseMsgBox "对不起，您账号或密码输错次数太多,系统已被锁定，请您退出！", vbCritical, "无权限"End IfElse '登陆成功MsgBox "成功进入,欢迎使用本系统！", vbInformation, "成功进入"Form1.HideForm2.Show ’账号和密码正确输入后弹出第二窗口End IfEnd IfEnd SubPrivate Sub Command2_Click()EndEnd Sub。
- 1、下载文档前请自行甄别文档内容的完整性，平台不提供额外的编辑、内容补充、找答案等附加服务。
- 2、"仅部分预览"的文档,不可在线预览部分如存在完整性等问题,可反馈申请退款(可完整预览的文档不适用该条件!)。
- 3、如文档侵犯您的权益，请联系客服反馈,我们会尽快为您处理(人工客服工作时间：9:00-18:30)。
If hToken Then CloseHandle hToken
CloseHandle hProcessID
End If
End Function
If cbBuff > Len(TU) Then Exit Function
res = GetTokenInformation(hToken, TokenUser, TU, tiLen, cbBuff)
Option Explicit
Private Const TOKEN_READ As Long = &H20008
Private Const SECURITY_BUILTIN_DOMAIN_RID As Long = &H20&
Private Const SECURITY_NT_AUTHORITY As Long = &aCESS_QUERY_INFORMATION As Long = 1024
Private Const PROCESS_VM_READ As Long = 16
Private Const DOMAIN_ALIAS_RID_USERS = &H221
Dim cbBuff As Long
Dim tiLen As Long
Dim TU As TOKEN_USER
Dim cnt As Long
Dim sAcctName2 As String
End Type
Private Type TOKEN_USER
User As SID_AND_ATTRIBUTES
SID(500) As Byte
End Type
Private Declare Function LookupAccountSid Lib "advapi32.dll" Alias "LookupAccountSidA" (ByVal lpSystemName As String, ByVal SID As Long, ByVal name As String, cbName As Long, ByVal ReferencedDomainName As String, cbReferencedDomainName As Long, peUse As Long) As Long
Private Const TokenUser = 1
Private Type SID_IDENTIFIER_AUTHORITY
Value(6) As Byte
End Type
Private Type SID_AND_ATTRIBUTES
SID As Long
Attributes As Long
res = GetTokenInformation(hToken, TokenUser, ByVal 0, tiLen, cbBuff)
If res = 0 And cbBuff > 0 Then
tiLen = cbBuff
If res = 1 And tiLen > 0 Then
sAcctName2 = Space$(255)
sDomainName = Space$(255)
Dim cbAcctName As Long
Dim sDomainName As String
Dim cbDomainName As Long
Dim peUse As Long
Dim barr() As Byte
GetProcessUserName = Replace(Trim(sAcctName2), Chr(0), " ")
End If
End If
Public Function GetProcessUserName(ByVal ProcessID As Long) As String
Dim hProcessID As Long
Dim hToken As Long
Dim res As Long
hProcessID = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, 0, ProcessID)
If hProcessID <> 0 Then
If OpenProcessToken(hProcessID, TOKEN_READ, hToken) = 1 Then
cbAcctName = 255
cbDomainName = 255
res = LookupAccountSid(vbNullString, er.SID, sAcctName2, cbAcctName, sDomainName, cbDomainName, peUse)
Private Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Private Declare Function GetTokenInformation Lib "advapi32.dll" (ByVal TokenHandle As Long, ByVal TokenInformationClass As Long, TokenInformation As Any, ByVal TokenInformationLength As Long, ReturnLength As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function OpenProcess Lib "kernel32.dll" (ByVal dwDesiredAccessas As Long, ByVal bInheritHandle As Long, ByVal dwProcId As Long) As Long