Leisureeen

导航

HotspotXY

‎January ‎15, ‎2019那天晚上我写完一个VB应用程序,功能是可以让电脑放热点出去。

 

ini配置文件(HotspotXY.ini):

1 Leisureeen
2 12345678
3 0

 

主窗体文件(main.frm):

VERSION 5.00
Begin VB.Form main 
   BackColor       =   &H00FFBBFF&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "HotspotXY"
   ClientHeight    =   2385
   ClientLeft      =   45
   ClientTop       =   375
   ClientWidth     =   4545
   MaxButton       =   0   'False
   ScaleHeight     =   2385
   ScaleWidth      =   4545
   StartUpPosition =   2  '屏幕中心
   Begin VB.CheckBox opn 
      BackColor       =   &H00FFBBFF&
      Caption         =   "open"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   2520
      TabIndex        =   6
      Top             =   1080
      Width           =   1215
   End
   Begin VB.CheckBox allow 
      BackColor       =   &H00FFBBFF&
      Caption         =   "allow"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   960
      TabIndex        =   5
      Top             =   1080
      Width           =   1215
   End
   Begin VB.TextBox key 
      BackColor       =   &H00FFBBFF&
      BorderStyle     =   0  'None
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   1800
      MaxLength       =   30
      TabIndex        =   4
      Text            =   "12345678"
      Top             =   600
      Width           =   1815
   End
   Begin VB.TextBox ssid 
      BackColor       =   &H00FFBBFF&
      BorderStyle     =   0  'None
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   1800
      MaxLength       =   30
      TabIndex        =   1
      Text            =   "Leisureeen"
      Top             =   240
      Width           =   1815
   End
   Begin VB.CommandButton r 
      Caption         =   "Exit"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   11.25
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   1440
      TabIndex        =   0
      Top             =   1680
      Width           =   1695
   End
   Begin VB.Label Label2 
      BackStyle       =   0  'Transparent
      Caption         =   "KEY"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   960
      TabIndex        =   3
      Top             =   600
      Width           =   495
   End
   Begin VB.Label Label1 
      BackStyle       =   0  'Transparent
      Caption         =   "SSID"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   960
      TabIndex        =   2
      Top             =   240
      Width           =   615
   End
End
Attribute VB_Name = "main"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private iniDir As String

Private Sub allow_Click()
    ssid.Enabled = allow.Value - 1
    key.Enabled = ssid.Enabled
    If allow.Value = 0 Then opn.Value = 0
    If Len(Me.Caption) > 24 Then
        If allow.Value = 1 Then
            Shell "netsh wlan set hostednetwork mode=allow ssid=" & ssid.Text & " key=" & key.Text
        Else
            Shell "netsh wlan set hostednetwork mode=disallow"
        End If
    End If
End Sub

Private Sub Form_Load()
    Dim strTmp As String
    On Error Resume Next
    iniDir = App.Path & "\HotspotXY.ini"
    If Dir(iniDir) <> "" Then
        Open iniDir For Input As #1
            Line Input #1, strTmp
            ssid.Text = strTmp
            Line Input #1, strTmp
            key.Text = strTmp
            Line Input #1, strTmp
            allow.Value = Sgn(Val(strTmp))
            opn.Value = Val(strTmp) Mod 2
        Close #1
    End If
    allow_Click
    Me.Caption = VBA.Left(Me.Caption, 9) & "  Designer:Leisureeen"
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    r_Click
End Sub

Private Sub opn_Click()
    If opn.Value = 1 Then allow.Value = 1
    If Len(Me.Caption) > 24 Then
        Shell "netsh wlan st" & IIf(opn.Value = 1, "art", "op") & " hostednetwork"
    End If
End Sub

Private Sub r_Click()
    On Error Resume Next
    Open iniDir For Output As #1
        Print #1, ssid.Text
        Print #1, key.Text
        Print #1, Trim(Val(allow.Value) * 2 - Val(opn.Value))
    Close
    End
End Sub

 

posted on 2020-04-11 16:42  Leisureeen  阅读(223)  评论(0编辑  收藏  举报

JS