Option Explicit On
Imports System
Imports System.IO
Imports System.Data
Imports System.Runtime.InteropServices
Imports System.Collections
Imports System.Windows.Forms
Public Class DNFLogin
Dim AppDir As String
Dim QQNumPath As String
Dim Path As String = Application.StartupPath + "\DNF.ini"
Dim QQPath As String = Application.StartupPath + "\QQ号码.txt"
Dim First As Boolean = False
Private Sub Form1_FormClosing(ByVal sender As Object, ByVal e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing
If MsgBox("确认要关闭？", MsgBoxStyle.Question + MsgBoxStyle.OkCancel, "温馨提示") = System.Windows.Forms.DialogResult.Cancel Then
e.Cancel = True
Else
Call UNLoad()
e.Cancel = False
End
End If
End Sub
'下面过程是注册Ctrl+T的组合键为组合键，假如注册成功，则返回true，反之注册失败则返回false，我们可以根据返回的结果判断并提醒用户注册的情况。
Private Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
If Not System.IO.File.Exists(Path) Then
System.IO.File.Create(Path)
File.SetAttributes(Path, FileAttributes.Hidden)
Else
AppDir = GetINI("DNF路径", "游戏路径", "", Path)
AppPath.Text = AppDir
End If
'F3(-配置文件)
'F4(-显示 / 隐藏)
'F5(-运行DNF)
'F6(-登陆DNF)
'F8(-退出)
'F9(-退出DNF)
RegisterHotKey(Handle, 0, MOD_Non, Keys.F8)
RegisterHotKey(Handle, 1, MOD_Non, Keys.F3)
RegisterHotKey(Handle, 2, MOD_Non, Keys.F4)
RegisterHotKey(Handle, 3, MOD_Non, Keys.F5)
RegisterHotKey(Handle, 4, MOD_Non, Keys.F6)
RegisterHotKey(Handle, 5, MOD_Non, Keys.F9)
Dim ID As New ColumnHeader()
ID.Text = " 序号"
ID.Width = 65
ID.TextAlign = HorizontalAlignment.Center
Dim QQNUM As New ColumnHeader()
QQNUM.Width = 93
QQNUM.Text = "QQ号码"
QQNUM.TextAlign = HorizontalAlignment.Center
Dim QQPAW As New ColumnHeader()
QQPAW.Text = "QQ密码"
QQPAW.TextAlign = HorizontalAlignment.Center
QQPAW.Width = 103
NumList.Columns.AddRange(New ColumnHeader() {ID, QQNUM, QQPAW})
End Sub
Private Sub ScanPath_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ScanPath.Click
AppBrows.InitialDirectory = "::{20D04FE0-3AEA-1069-A2D8-08002B30309D}" '我的电脑
AppBrows.Filter = "exe文件 (*.exe)|*.exe|所有文件 (*.*)|*.*"
AppBrows.Title = "选中DNF运行文件"
If AppBrows.
ShowDialog() = DialogResult.OK Then
AppDir = System.IO.Path.GetFullPath(AppBrows.FileName)
AppPath.Text = AppDir
WriteINI("DNF路径", "游戏路径", AppDir, Path)
End If
End Sub
'运行DNF
Private Sub RunDNF()
Dim MyProcesses() As Process = Process.GetProcesses()
Dim IsExist As Boolean = False
Dim Allow As Boolean = False
For i As Integer = 0 To MyProcesses.Length - 1
If "DNFchina" = MyProcesses(i).ProcessName Then
IsExist = True
End If
Next
If IsExist = True Then Allow = True
If Allow = False And AppDir <> "" Then
System.Diagnostics.Process.Start(AppDir)
First = True
IsExist = False
Allow = False
End If
End Sub
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Int32, ByVal lpFileName As String) As Int32
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpString As String, ByVal lpFileName As String) As Int32
Private Declare Function GetPrivateProfileStringW Lib "kernel32" Alias "GetPrivateProfileStringW" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Int32, ByVal lpFileName As String) As Int32
Private Declare Function WritePrivateProfileStringW Lib "kernel32" Alias "WritePrivateProfileStringW" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpString As String, ByVal lpFileName As String) As Int32
'mbcs
Public Shared Function GetINI(ByVal Section As String, ByVal AppName As String, ByVal lpDefault As String, ByVal FileName As String) As String
Dim MyEncoder As System.Text.Encoding = System.Text.Encoding.Default
Dim chars(2048) As Char
Dim strResult As String = New String(chars)
Dim length As Integer = GetPrivateProfileString(Section, AppName, lpDefault, strResult, Len(strResult), FileName)
'编码的转换
Dim rByte() As Byte = System.Text.Encoding.Default.GetBytes(strResult.ToCharArray)
strResult = New String(MyEncoder.GetChars(rByte))
Return Microsoft.VisualBasic.Left(strResult, InStr(strResult, Chr(0)) - 1)
End Function
'写文件
Public Shared Function WriteINI(ByVal Section As String, ByVal AppName As String, ByVal lpDefault As String, ByVal FileName As String) As Long
WriteINI = WritePrivateProfileString(Section, AppName, lpDefault, FileName)
End Function
'unicode
Public Shared Function GetINIW(ByVal Section As String, ByVal AppName As String
, ByVal lpDefault As String, ByVal FileName As String) As String
Dim MyEncoder As System.Text.Encoding = System.Text.Encoding.Default
Dim strResult As String
Dim chars(2048) As Char
strResult = CStr(chars)
GetPrivateProfileStringW(Section, AppName, lpDefault, strResult, Len(strResult), FileName)
Dim rByte() As Byte = System.Text.Encoding.Default.GetBytes(strResult.ToCharArray)
strResult = New String(MyEncoder.GetChars(rByte))
Return Microsoft.VisualBasic.Left(strResult, InStr(strResult, Chr(0)) - 1)
End Function
'写文件
Public Shared Function WriteINIW(ByVal Section As String, ByVal AppName As String, ByVal lpDefault As String, ByVal FileName As String) As Long
WriteINIW = WritePrivateProfileStringW(Section, AppName, lpDefault, FileName)
End Function
Private Sub NotifyApp_DoubleClick(ByVal sender As Object, ByVal e As System.EventArgs) Handles NotifyApp.DoubleClick
Me.ShowInTaskbar = True
Me.Show()
Me.WindowState = FormWindowState.Normal
End Sub
Private Sub Form1_Resize(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Resize
If Me.WindowState = FormWindowState.Minimized Then Me.Hide()
End Sub
Private Sub OpenNum_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles OpenNum.Click
Dim QQNum As String
Dim I As Integer = 0
QQNumBrows.InitialDirectory = System.Environment.GetFolderPath(Environment.SpecialFolder.Deskt
op)
QQNumBrows.Filter = "可执行文件（*.TXT）|"
QQNumBrows.Title = "选中QQ号码列表文件"
If QQNumBrows.ShowDialog() = DialogResult.OK Then
QQNumPath = System.IO.Path.GetFullPath(QQNumBrows.FileName)
NumList.Items.Clear()
End If
If QQNumPath <> "" Then
FileOpen(1, QQNumPath, OpenMode.Input)
Dim MyString(2) As String
Do While Not EOF(1)
QQNum = LineInput(1)
MyString = Split(QQNum, "---", 2)
If MyString(0) <> "" Then
With NumList
.Items.Add(I + 1) '为了从1 开始
.Items(I).SubItems.Add(MyString(0))
.Items(I).SubItems.Add(MyString(MyString.Length - 1))
If I Mod 2 = 0 Then
.Items(I).BackColor = Color.LavenderBlush
End If
End With
I = I + 1
End If
Loop
FileClose(1)
NumList.Items(0).Selected = True
NumList.Items(0).Checked = True
End If
End Sub
Private Sub 显示_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 显示.Click
If Visible Then
Hide()
Else
Show()
End If
End Sub
Private Sub UNLoad()
Call WriteProtectQQ()
NotifyApp.Visible = False
NotifyApp.Dispose()
UnRegisterHotKey(Handle, 0)
UnRegisterHotKey(Handle, 1)
UnRegisterHotKey(Handle, 2)
UnRegisterHotKey(Handle, 3)
UnRegisterHotKey(Handle, 4)
UnRegisterHotKey(Handle, 5)
End
End Sub
Private Sub 退出_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 退出.Click
Call UNLoad()
End
End Sub
Private Sub AppPath_TextChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles AppPath.TextChanged
If InStr(10, AppPath.Text, "", CompareMethod.Text) Then
AppDir = AppPath.Text
WriteINI("DNF路径", "游戏路径", AppDir, Path)
End If
End Sub
Public Const WM_HOTKEY As Integer = &H312
Public Const MOD_ALT As Integer = &H1
Public Const MOD_CONTROL As Integer = &H2
Public Const MOD_SHIFT As Integer = &H4
Public Const MOD_Non As Integer = &H0
Public Const GWL_WNDPROC As Integer = (-4)
Public Declare Auto Function RegisterHotKey Lib "user32.dll" Alias _
"RegisterHotKey" (ByVal hwnd As IntPtr, ByVal id As Integer, ByVal fsModifiers As Integer, ByVal vk As Integer) As Boolean
Public Declare Auto Function UnRegisterHotKey Lib "user32.dll" Alias _
"UnregisterHotKey" (ByVal hwnd As IntPtr, ByVal id As Integer) As Boolean
'下面过程为重载WndProc过程，响应热键并处理热键，这里是用来隐藏和显示程序主界面。
Protected Overrides Sub WndProc(ByRef m As Message)
If m.Msg = WM_HOTKEY Then
Select Case m.WParam
'F3(-配置文件)
'F4(-显示 / 隐藏)
'F5(-运行DNF)
'F6(-登陆DNF)
'F8(-退出)
'F9(-退出DNF)
Case 5 'F9
If MsgBox("确认要关闭？", MsgBoxStyle.Question + MsgBoxStyle.OkCancel, "温馨提示") = System.Windows.Forms.DialogResult.OK Then
Call UNLoad()
End
End If
Case 1 'F3
Config.Show()
Case 2 'F4
If Visible Then
Hide()
Else
Show()
End If
Case 3 'F5
RunDNF()
Case 4 'F6
With NumList
If .Items.Count > 0 Then
Dim item As ListViewItem
Dim Color_Red As Boolean = False
Dim Color_Yellow As Boolean = False
Dim Color_Chartreuse As Boolean = False
Dim C
olors As Boolean = False
For Each item In .SelectedItems
Call Login(.Items(item.Index).SubItems(1).Text, .Items(item.Index).SubItems(2).Text)
.Items(item.Index).Checked = True
.Items(item.Index + 1).Selected = True
If .Items(item.Index + 1).BackColor = Color.Red Then Color_Red = True
Colors = True
If .Items(item.Index + 1).BackColor = Color.Yellow Then Color_Yellow = True : Colors = True
If .Items(item.Index + 1).BackColor = Color.Chartreuse Then Color_Chartreuse = True : Colors = True
.Items(item.Index + 1).BackColor = Color.Cyan
If Colors = False Then '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If item.Index Mod 2 = 0 Then
.Items(item.Index).BackColor = Color.LavenderBlush
Else
.Items(item.Index).BackColor = Color.Whitednfqq会员礼包领取
End If
End If
If Color_Red Then .Items(item.Index + 1).BackColor = Color.Red
If Color_Yellow Then .Items(item.Index + 1).BackColor = Color.Yellow
If Color_Chartreuse Then .Items(item.Index + 1).BackColor = Color.Chartreuse
Next
End If
End With
Case 0 'F8
Dim MyProcesses() As Process = Process.GetProcesses()
For i As Integer = 0 To MyProcesses.Length - 1
If "DNFchina" = MyProcesses(i).ProcessName Then
MyProcesses(i).Kill()
End If
If "QQLogin" = MyProcesses(i).ProcessName Then
MyProcesses(i).Kill()
End If
Next
End Select
End If
MyBase.WndProc(m)
End Sub
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Int32, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByV
al wMsg As Integer, ByVal wParam As Integer, ByVal lParam As String) As Integer
Public Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
Declare Sub Keybd_Event L
发布评论