Archive for category Visual Basic

WolfLAN源码和简单原理介绍

Posted by on 星期一, 28 三月, 2011

>>WolfLAN源码下载<<


  在登录时等待OpenVPN返回“Enter Auth Username”和“Enter Auth Password”,然后将帐号密码送入管道。之后读取管道,根据OpenVPN输出来判断当前状态。


登录代码:


PipeClosed = False
txtLog.Text = Now & vbCrLf
Set OvpnPipe = New ClsPipe
OvpnPipe.ConsoleShell = strAppPath & "openvpn.exe --config " & Chr(34) & strAppPath & "Wolf.ovpn" & Chr(34) '以指定参数在管道中运行OpenVPN
OvpnPipe.Silent = True
OvpnPipe.CreateConsolePipe
tmrLog.Enabled = True
'等待输入用户名并发送用户名===================
Do While InStr(1, txtLog.Text, "Enter Auth Username:") = 0
DoEvents
Loop
lbMsg.ToolTipText = "验证用户名和密码"
OvpnPipe.WriteToPipe txtUserName.Text
'===========================================
'等待输入密码并发送密码======================
Do While InStr(1, txtLog.Text, "Enter Auth Password:") = 0
DoEvents
Loop
OvpnPipe.WriteToPipe txtPassword.Text


状态判断:


If InStr(1, txtLog.Text, "TUN/TAP interface has been stopped") <> 0 Then
ConnectError
lbMsg.Caption = "- 网卡已停止"
Exit Sub
End If
DoEvents
If InStr(1, txtLog.Text, "process exiting") <> 0 Then
ConnectError
lbMsg.Caption = "- 进程终止"
Exit Sub
End If
DoEvents
If InStr(1, txtLog.Text, "Closing TUN/TAP interface") <> 0 Then
ConnectError
lbMsg.Caption = "- 网卡关闭"
Exit Sub
End If
DoEvents
If InStr(1, txtLog.Text, "There are no TAP-Win32 adapters on this system.") <> 0 Then
ConnectError
lbMsg.Caption = "- 未找到Tap网卡"
Exit Sub
End If
DoEvents
If InStr(1, txtLog.Text, "All TAP-Win32 adapters on this system are currently in use.") <> 0 Then
ConnectError
lbMsg.Caption = "- 网卡被占用"
Exit Sub
End If
DoEvents
If (InStr(1, txtLog.Text, "TCP/UDP: Closing socket") <> 0) And (InStr(1, txtLog.Text, "Restart pause, 5 second(s)") <> 0) Then
ConnectError
lbMsg.Caption = "- 错误:Closing socket"
Exit Sub
End If
DoEvents
If InStr(1, txtLog.Text, "Exiting") <> 0 Then
ConnectError
lbMsg.Caption = "- 主动断开"
Exit Sub
End If
DoEvents
If (InStr(1, txtLog.Text, "VERIFY OK") <> 0) And (InStr(1, txtLog.Text, "--dhcp-option") = 0) Then lbMsg.ToolTipText = "建立通道"
If (InStr(1, txtLog.Text, "--dhcp-option") <> 0) And (InStr(1, txtLog.Text, "Initialization Sequence Completed") = 0) Then lbMsg.ToolTipText = "获取IP"
If (InStr(1, txtLog.Text, "Initialization Sequence Completed") <> 0) And (InStr(1, txtLog.Text, "With Errors") = 0) Then
If chkRoute.Value = 1 Then
lbMsg.ToolTipText = "设置借线"
OvpnPipe.Wait (2000)
WaitRun "route", "add 0.0.0.0 mask 0.0.0.0 192.168.27.254"
End If
lbMsg.Caption = "+ 链接成功"
SocketsInitialize
tmrStatus.Enabled = False
cmdLogin.Enabled = True
cmdLogin.Caption = "&D.断开"
PopInfo
Exit Sub
End If
DoEvents
If InStr(1, txtLog.Text, "Initialization Sequence Completed With Errors") <> 0 Then
ConnectError
lbMsg.Caption = "- Errors"
Exit Sub
End If
DoEvents



ros winbox api 应用

Posted by on 星期五, 18 二月, 2011

winbox api VB.net 类库:cls_Mikrotik.vb

代码:

Dim mk = New Mikrotik("192.168.0.1")
Dim strUsername As String, strGrid() As String
If Not mk.Login("admin", "Mikrotik_hhsoft") Then
mk.Close()
Return
End If

mk.Send("/ppp/active/print", True)
For Each row In mk.Read()
If InStr(row, "!done") = 0 Then
strGrid = Split(row, "=")
Console.WriteLine(strGrid(4) & vbTab & vbTab & strGrid(12))
End If
Next

返回的数据包:

!re=.id=*139=name=malidan=service=pppoe=caller-id=00:11:43:57:B9:0F=address=172.16.0.108=uptime=00:22:14=encoding==session-id=2167406760=limit-bytes-in=0=limit-bytes-out=0=radius=true
!re=.id=*13A=name=zhaoliang=service=pppoe=caller-id=00:E0:4D:A5:B2:5E=address=172.16.0.107=uptime=00:13:41=encoding==session-id=2167406761=limit-bytes-in=0=limit-bytes-out=0=radius=true
!done


VB RealOne 皮肤

Posted by on 星期一, 13 九月, 2010

VB仿RealOne Player播放器皮肤 – 单击这里下载

通过ActiveX在Web上启动应用程序

Posted by on 星期一, 19 七月, 2010

  最近在研究一套B/S系统。 系统中需要在Web启动mstsc.exe程序进行远程桌面连接,但如何通过在web上调用来启动这个mstsc.exe呢?

  如果能随随便便的运行一个程序,那么Web将变得毫无安全性可言了。

  思考中突然看到桌面上的迅雷。突然想到可以通过添加url协议来启动程序,比如迅雷:thunder://QUFodHRwOi8vNjEuMTYzLjkyLjE2Nzo4Mi9kb3duL2RpcmVjdHhfOWNfRGVjMDRzZGtfcmVkaXN0LmV4ZVpa,通过这段url就能启动迅雷并将参数传递到迅雷。

  但这个方法有个弊端,就是提前需要在客户端进行url协议注册。这个注册过程要么通过注册表导入实现,要么通过一个安装包实现,这不能达到我的要求。

  这时又看到了PPS,突然想起也许可以用ActiveX来启动程序,于是打开VB进行调试。

  通过ActiveX DLL工程,我已经成功执行了本地的calc.exe计算器这个程序。只是启动前有一个提示安装“Microsoft Visual Studio”组建的提示,这无所谓了。

  B/S开发完了。突然觉得这个ActiveX很危险,我可以用VB写一个下载者,然后挂到Web上,是不是就可以挂马了?

  下面这个链接会启动本地的计算器,有兴趣的可以试一下。IE安全级别高的,会因为无法验证发行者而运行失败。低一点的,会安装成功并运行本地的计算器。至于提示无法验证发行者,可以通过签名解决。

  后期发出详细教程。

http://www.awolf.net/dhtml/Project1.HTM

网众快车自动登录器

Posted by on 星期三, 14 七月, 2010

网众快车自动登录器 – 单击下载

用于网众快车服务端的自动登录。

用VB写的,相关代码:


Private Function EnumWindowsProc(ByVal hwnd As Long, ByVal lParam As Long) As Boolean ‘枚举窗口
On Error Resume Next
Dim sTitle As String
Dim hrect As RECT
sTitle = String(80, 0)
Call GetWindowText(hwnd, sTitle, 80) '获取标题
sTitle = left(sTitle, InStr(sTitle, Chr(0)) - 1)
If Len(sTitle) > 0 And sTitle = "用户登录" Then ’如果标题为“用户登录”,则找到窗口
GetWindowRect hwnd, hrect '获得窗口的位置
coLoginWindow.hwnd = hwnd
coLoginWindow.left = hrect.left
coLoginWindow.top = hrect.top
End If
DoEvents
EnumWindowsProc = True
End Function
Private Function EnumChildWindowsProc(ByVal hwnd As Long, ByVal lParam As Long) As Boolean '枚举子窗口
On Error Resume Next
Dim hrect As RECT
Dim strCaption As String * 255
GetWindowRect hwnd, hrect

If (hrect.left - coLoginWindow.left = 116) And (hrect.top - coLoginWindow.top = 52) Then coUsername.hwnd = hwnd '如果找到指定位置的窗口
If (hrect.left - coLoginWindow.left = 116) And (hrect.top - coLoginWindow.top = 81) Then coPassword.hwnd = hwnd
If (hrect.left - coLoginWindow.left = 104) And (hrect.top - coLoginWindow.top = 177) Then coLogin.hwnd = hwnd

GetWindowText hwnd, strCaption, Len(strCaption)

DoEvents
EnumChildWindowsProc = True

End Function

Public Function GethWnd() As Long '调用枚举窗口和子窗口的过程
EnumWindows AddressOf EnumWindowsProc, 0&
DoEvents
EnumChildWindows coLoginWindow.hwnd, AddressOf EnumChildWindowsProc, 0&
End Function

Public Sub SendText(strUsername As String, strPassword As String) '像窗口发送用户名密码
Dim i As Integer
SendMessage coUsername.hwnd, WM_ACTIVATE, 0&, 0& '激活窗口
SendMessage coUsername.hwnd, WM_LBUTTONDBLCLK, 0&, 0& '双击窗口
SetForegroundWindow coLoginWindow.hwnd '窗口提前

For i = 1 To Len(strUsername) '循环总共 Len(strUsername) 次
Delay 10, True '等10/1000秒
KeyUPDOWN Asc(UCase(Mid(strUsername, i, 1))), coUsername.hwnd '发送按键消息
Next i
KeyUPDOWN vbKeyTab, coLoginWindow.hwnd '按一次TAB键

Delay 100, True
For i = 1 To Len(strPassword)
Delay 10, True
KeyUPDOWN Asc(UCase(Mid(strPassword, i, 1))), coPassword.hwnd
Next i
End Sub
Private Sub KeyUPDOWN(lKey As Long, rhWnd As Long) '发送按键过程
Dim lParam As Long
lParam = makelparam(lKey, False) '生成lparam参数,按下
PostMessage rhWnd, WM_KEYDOWN, lKey, lParam '发送按键消息
DoEvents
lParam = makelparam(lKey, True)'生成lparam参数,弹起
PostMessage rhWnd, WM_KEYUP, lKey, makelparam(lKey, True)
End Sub
Private Function makelparam(ByVal VirtualKey As Long, ByVal flag As Boolean) As Long '生成lparam参数过程
Dim s As String
Dim Firstbyte As String 'lparam参数的24-31位
If flag = False Then 'keydown
Firstbyte = "00"
Else
Firstbyte = "C0" 'keyup
End If
Dim Scancode As Long
'获得虚拟键扫描码
Scancode = MapVirtualKey(VirtualKey, 0)
Dim Secondbyte As String 'lparam参数的16-23位,即虚拟键扫描码
Secondbyte = Right("00" & Hex(Scancode), 2)
s = Firstbyte & Secondbyte & "0001" '0001为lparam参数的0-15位,即发送次数
makelparam = Val("&H" & s)
End Function

Public Sub ClickLogin() '单击“登录”按钮
SendMessage coLogin.hwnd, WM_ACTIVATE, 0&, 0& '激活登录按钮
SetForegroundWindow coLogin.hwnd '按钮提前
PostMessage coLogin.hwnd, WM_LBUTTONDBLCLK, 0, 0 '双击按钮,不知道为什么,用单击不好使-_-||
DoEvents
End Sub

Public Sub Delay(lTimes As Long, Optional bSleep As Boolean) '自定义的延时过程
Dim l As Long
For l = 0 To lTimes
DoEvents
If bSleep = True Then Sleep 1
Next l
End Sub