-
VisualFreeBasic控件_YFbunGroup 按钮组 可以添加一系列按钮 使用方法 拖控件到窗口后，在设计属性中，添加按钮 双击控件，产生事件，将会有自动产生Select Function Form1_YFbunGroup1_Command(hWndForm As hWnd, hWndControl As hWnd, nID As Long ) As Long Select Case nID Case Form1_YFbunGroup1_Button_1 ' Case Form1_YFbunGroup1_Button_2 ' Case Form1_YFbunGroup1_Button_3 ' Case Form1_YFbunGroup1_Button_4 ' End Select Function = TRUE ' 如果你处理了事件，就返回 Return TRUE ,控件就不进行默认处理了。 End Function 设置图标 本控件使用字体图标或图标文件，设计模式添加按钮时，可以选择相关图标 运行后才有效果。 图标制作 使用 VisualFreeBasic 自带的 【矢量图标编辑器】 编辑一个，里面自带了很多图标，可以复制过来即可，在 VFB里的 工具菜单里，就可以找到这个软件。 -
VisualFreeBasic控件_YFproTab 加强版标签 标签，多标签控件，如同浏览器上的标签一样。可以拖动交换位置。 有多种样式，样式也可以设置，具体效果，可以自己选择了看。 主要事件 使用方法 先给每个页面添加一个 子窗口的窗口 Dim 页面窗口 As hWnd =Form2.Show(hWndForm) YFproTab1.AddTab(页面窗口,"标签文字1","提示文字1",矢量图标字符串) 页面窗口 =Form3.Show(hWndForm) YFproTab1.AddTab(页面窗口,"标签文字2","提示文字2",矢量图标字符串) 图标制作 使用 VisualFreeBasic 自带的 【矢量图标编辑器】 编辑一个，里面自带了很多图标，可以复制过来即可，在 VFB里的 工具菜单里，就可以找到这个软件。 -
VisualFreeBasic控件_HotKey 热键 热键、快捷键，2种功能 热键使用方法 先向系统注册，要是系统中其它软件已经注册过相同的，那么会被我们抢注，假如我们注册后，其它软件再注册相同的，那么就被其它软件抢注。我们软件就失效。 HotKey1.AddHotKey(虚拟键码,组合键 ) 虚拟键码: https://docs.microsoft.com/en-us/windows/win32/inputdev/virtual-key-codes 组合键： MOD_ALT(ALT键) MOD_CONTROL(CTRL键) MOD_SHIFT(SHIFT键) MOD_WIN(WINDOWS键) 按下热键，触发事件 Sub Form1_HotKey1_KeyboardState(hWndForm As hWnd, vKey As Long ,fsModifiers As Long) If (fsModifiers And MOD_ALT)=MOD_ALT Then Print "有ALT键按下" If (fsModifiers And 16) = 16 Then Print "键被按下" Else Print "键被放开" Select Case vKey Case VK_LBUTTON ,VK_RBUTTON '鼠标 Case &H30 To &H39 '0 -- 9 Case &H41 To &H5A 'A -- Z Case &H60 To &H69 '数字键盘 0 -- 9 Case VK_F1 To VK_F24 'F1 -- F24 键 End Select End Sub 快捷键使用方法 不需要注册，不需要代码，就选中事件即可，就会有按钮事件，假如其它软件也使用相同的，大家都会被触发。 这个事件，只要键盘的任意键被按下，都触发本事件，然后自己判断按下了什么键。 Sub Form1_HotKey1_KeyboardState(hWndForm As hWnd, vKey As Long ,fsModifiers As Long) If (fsModifiers And MOD_ALT)=MOD_ALT Then Print "有ALT键按下" If (fsModifiers And 16) = 16 Then Print "键被按下" Else Print "键被放开" Select Case vKey Case VK_LBUTTON ,VK_RBUTTON '鼠标 Case &H30 To &H39 '0 -- 9 Case &H41 To &H5A 'A -- Z Case &H60 To &H69 '数字键盘 0 -- 9 Case VK_F1 To VK_F24 'F1 -- F24 键 End Select End Sub -
VisualFreeBasic控件_VEH 崩溃处理 当软件发生崩溃后，就会触发本控件事件。 本控件功能只有一个，就是监控自己运行的软件，当软件发生崩溃的时候，系统会触发本控件事件，来执行事件，执行事件中，软件不会消失，继续运行，当执行事件里代码再发生崩溃，那么软件就真要崩溃了。 Function Form1_VEH1_VectExcepHandler(ByRef excp As EXCEPTION_POINTERS)As Integer 保存软件崩溃日志(App.Path & "bug" & NowString(1) & ".txt" ,excp) '返回日志内容 End Function excp 变量中，包含各自汇编级别的信息，下面代码提供保存的汇编内容 Function 保存软件崩溃日志(文件名 As String, excp As EXCEPTION_POINTERS) As String '返回日志内容 Dim vi As OSVERSIONINFO vi.dwOsVersionInfoSize = SizeOf(OSVERSIONINFO) GetVersionEx @vi Dim bug As String = " OS 版本: " & vi.dwMajorVersion & "." & vi.dwMinorVersion & "." & vi.dwBuildNumber & vbCrLf bug &= "区域设置 ID: " & GetUserDefaultLangID & vbCrLf bug &= "应用程序名: " & App.EXEName & vbCrLf bug &= "应用程序版本: " & App.ProductMajor & "." & App.ProductMinor & "." & App.ProductRevision & "." & App.ProductBuild & vbCrLf Dim gzmk As String, AllMode As String, pianyi As UInteger, gzmkbb As String Dim ExceptionAddress As UInteger = Cast(UInteger, excp.ExceptionRecord->ExceptionAddress) Dim I As UInteger Dim bI As Long, mSnapshot As HANDLE Dim Mode As MODULEENTRY32 Dim gMode() As MODULEENTRY32 '----------------查找进程的执行程序的路径----------------------- '通过模块快照，获得进程的模块快照句柄 mSnapshot = CreateToolhelp32Snapshot(&H8, GetCurrentProcessId()) 'Const TH32CS_SNAPmodule = &H8 If mSnapshot > 0 Then Mode.dwSize = SizeOf(Mode) '初始化结构mo的大小 '用该进程第1个模块的szExePath字段，作为进程的程序路径 If Module32First(mSnapshot, @Mode) Then Do ReDim Preserve gMode(bi) gMode(bi) = Mode bi = bi + 1 AllMode &= Hex(Mode.modBaseAddr, Len(UInteger) * 2) & " " & CWSTRtoString(Mode.szExePath) & " [" & GetVersionInfo(Mode.szExePath) & "][" & GetFileLength(Mode.szExePath) & "]" & vbCrLf If ExceptionAddress > Cast(UInteger, Mode.modBaseAddr) And ExceptionAddress < Cast(UInteger, Mode.modBaseAddr) + Cast(UInteger, Mode.modBaseSize) Then gzmk = CWSTRtoString(Mode.szModule) gzmkbb = GetVersionInfo(Mode.szExePath) pianyi = ExceptionAddress - Cast(UInteger, Mode.modBaseAddr) End if Loop Until Module32Next(mSnapshot, @Mode) = 0 End If CloseHandle(mSnapshot) '关闭模块快照句柄 End If '32位 寄存器 excp.ContextRecord->Eax Ebx Ecx Edx Ebp Esi Edi Eip '62位 寄存器 excp.ContextRecord->Rax Rbx Rcx Rdx Rbp Rsi Rdi Rip Rsp R8 R9 R10 R11 R12 R13 R14 R15 bug &= "故障模块名称: " & gzmk & vbCrLf bug &= "故障模块版本: " & gzmkbb & vbCrLf Dim ErrStr As String Select Case excp.ExceptionRecord->ExceptionCode '发生异常的原因。这是由硬件异常生成的代码，或在RaiseException函数中为软件生成的异常指定的代码 。 Case EXCEPTION_ACCESS_VIOLATION ErrStr = "线程试图读取或写入对其没有适当访问权限的虚拟地址。" Case EXCEPTION_ARRAY_BOUNDS_EXCEEDED ErrStr = "线程尝试访问超出范围的数组元素，并且基础硬件支持范围检查。" Case EXCEPTION_BREAKPOINT ErrStr = "遇到断点。" Case EXCEPTION_DATATYPE_MISALIGNMENT ErrStr = "线程试图读取或写入在不提供对齐方式的硬件上未对齐的数据。例如，必须在2字节边界上对齐16位值；4字节边界上的32位值，依此类推。" Case EXCEPTION_FLT_DENORMAL_OPERAND ErrStr = "浮点运算中的操作数之一是非正规的。非标准值是一个太小而无法表示为标准浮点值的值。" Case EXCEPTION_FLT_DIVIDE_BY_ZERO ErrStr = "线程试图将浮点值除以零的浮点除数。" Case EXCEPTION_FLT_INEXACT_RESULT ErrStr = "浮点运算的结果不能完全表示为小数。" Case EXCEPTION_FLT_INVALID_OPERATION ErrStr = "此异常表示此列表中未包含的任何浮点异常。" Case EXCEPTION_FLT_OVERFLOW ErrStr = "浮点运算的指数大于相应类型所允许的大小。" Case EXCEPTION_FLT_STACK_CHECK ErrStr = "由于浮点运算，堆栈上溢或下溢。" Case EXCEPTION_FLT_UNDERFLOW ErrStr = "浮点运算的指数小于相应类型所允许的大小。" Case EXCEPTION_ILLEGAL_INSTRUCTION ErrStr = "线程试图执行无效指令。" Case EXCEPTION_IN_PAGE_ERROR ErrStr = "该线程试图访问一个不存在的页面，系统无法加载该页面。例如，如果通过网络运行程序时网络连接丢失，可能会发生此异常。" Case EXCEPTION_INT_DIVIDE_BY_ZERO ErrStr = "线程尝试将整数值除以零的整数除数。" Case EXCEPTION_INT_OVERFLOW ErrStr = "整数运算的结果导致对结果的最高有效位进行进位。" Case EXCEPTION_INVALID_DISPOSITION ErrStr = "异常处理程序将无效处置返回给异常调度程序。使用诸如C之类的高级语言的程序员应该永远不会遇到此异常。" Case EXCEPTION_NONCONTINUABLE_EXCEPTION ErrStr = "发生不可连续的异常后，线程尝试继续执行。" Case EXCEPTION_PRIV_INSTRUCTION ErrStr = "线程试图执行一条指令，该指令在当前机器模式下是不允许的。" Case EXCEPTION_SINGLE_STEP ErrStr = "跟踪陷阱或其他单指令机制表明已执行了一条指令。" Case EXCEPTION_STACK_OVERFLOW ErrStr = "线程耗尽了其堆栈。" Case Else ErrStr = "未知" End Select bug &= "异常代码: " & Hex(excp.ExceptionRecord->ExceptionCode) & " " & ErrStr & vbCrLf bug &= "异常偏移: " & Hex(pianyi, 8) & vbCrLf #IfDef __FB_64BIT__ bug &= "寄存器值: Rax=" & Hex(excp.ContextRecord->Rax) If excp.ContextRecord->Rax > &H10000 Then bug &= " [Rax]=" & Hex(MEM_Read_ULongInt(GetCurrentProcessId, excp.ContextRecord->Rax)) bug &= " Rbx=" & Hex(excp.ContextRecord->Rbx) If excp.ContextRecord->Rbx > &H10000 Then bug &= " [Rbx]=" & Hex(MEM_Read_ULongInt(GetCurrentProcessId, excp.ContextRecord->Rbx)) bug &= " Rcx=" & Hex(excp.ContextRecord->Rcx) If excp.ContextRecord->Rcx > &H10000 Then bug &= " [Rcx]=" & Hex(MEM_Read_ULongInt(GetCurrentProcessId, excp.ContextRecord->Rcx)) bug &= " Rdx=" & Hex(excp.ContextRecord->Rdx) If excp.ContextRecord->Rdx > &H10000 Then bug &= " [Rdx]=" & Hex(MEM_Read_ULongInt(GetCurrentProcessId, excp.ContextRecord->Rdx)) bug &= " Rbp=" & Hex(excp.ContextRecord->Rbp) If excp.ContextRecord->Rbp > &H10000 Then bug &= " [Rbp]=" & Hex(MEM_Read_ULongInt(GetCurrentProcessId, excp.ContextRecord->Rbp)) bug &= " Rsp=" & Hex(excp.ContextRecord->Rsp) If excp.ContextRecord->Rsp > &H10000 Then bug &= " [Rsp]=" & Hex(MEM_Read_ULongInt(GetCurrentProcessId, excp.ContextRecord->Rsp)) bug &= " Rsi=" & Hex(excp.ContextRecord->Rsi) If excp.ContextRecord->Rsi > &H10000 Then bug &= " [Rsi]=" & Hex(MEM_Read_ULongInt(GetCurrentProcessId, excp.ContextRecord->Rsi)) bug &= " Rdi=" & Hex(excp.ContextRecord->Rdi) If excp.ContextRecord->Rdi > &H10000 Then bug &= " [Rdi]=" & Hex(MEM_Read_ULongInt(GetCurrentProcessId, excp.ContextRecord->Rdi)) bug &= " Rip=" & Hex(excp.ContextRecord->Rip) & vbCrLf #else bug &= "寄存器值: Eax=" & Hex(excp.ContextRecord->Eax) If excp.ContextRecord->Eax > &H10000 Then bug &= " [Eax]=" & Hex(MEM_Read_ULong(GetCurrentProcessId, excp.ContextRecord->Eax)) bug &= " Ebx=" & Hex(excp.ContextRecord->Ebx) If excp.ContextRecord->Ebx > &H10000 Then bug &= " [Ebx]=" & Hex(MEM_Read_ULong(GetCurrentProcessId, excp.ContextRecord->Ebx)) bug &= " Ecx=" & Hex(excp.ContextRecord->Ecx) If excp.ContextRecord->Ecx > &H10000 Then bug &= " [Ecx]=" & Hex(MEM_Read_ULong(GetCurrentProcessId, excp.ContextRecord->Ecx)) bug &= " Edx=" & Hex(excp.ContextRecord->Edx) If excp.ContextRecord->Edx > &H10000 Then bug &= " [Edx]=" & Hex(MEM_Read_ULong(GetCurrentProcessId, excp.ContextRecord->Edx)) bug &= " Ebp=" & Hex(excp.ContextRecord->Ebp) If excp.ContextRecord->Ebp > &H10000 Then bug &= " [Ebp]=" & Hex(MEM_Read_ULong(GetCurrentProcessId, excp.ContextRecord->Ebp)) bug &= " Esp=" & Hex(excp.ContextRecord->Esp) If excp.ContextRecord->Esp > &H10000 Then bug &= " [Esp]=" & Hex(MEM_Read_ULong(GetCurrentProcessId, excp.ContextRecord->Esp)) bug &= " Esi=" & Hex(excp.ContextRecord->Esi) If excp.ContextRecord->Esi > &H10000 Then bug &= " [Esi]=" & Hex(MEM_Read_ULong(GetCurrentProcessId, excp.ContextRecord->Esi)) bug &= " Edi=" & Hex(excp.ContextRecord->Edi) If excp.ContextRecord->Edi > &H10000 Then bug &= " [Edi]=" & Hex(MEM_Read_ULong(GetCurrentProcessId, excp.ContextRecord->Edi)) bug &= " Eip=" & Hex(excp.ContextRecord->Eip) & vbCrLf #endif Dim 堆栈列表 As String, zdcc As UInteger, zdi As Long, sjStr As String, sjc As Long, zpi As Long, zk As Long = Len(UInteger) * 2, jcm As String Dim sp As UInteger #IfDef __FB_64BIT__ jcm = "[Rsp" I = excp.ContextRecord->Rsp sp = i While zdi < 30 And zpi < 100 zdcc = MEM_Read_ULongInt(GetCurrentProcessId, I) i += 8 #Else jcm = "[Esp" I = excp.ContextRecord->Esp sp = i While zdi < 30 And zpi < 100 zdcc = MEM_Read_ULong(GetCurrentProcessId, I) i += 4 #endif sjc = 0 '是不是查到模块 zpi += 1 if zdcc Then if zdcc > &H400000 Then For bI = 0 To UBound(gMode) if zdcc > Cast(UInteger, gMode(bI).modBaseAddr) And zdcc < Cast(UInteger, gMode(bI).modBaseAddr) + Cast(UInteger, gMode(bI).modBaseSize) Then if Len(sjStr) Then '纯数据 堆栈列表 &= sjStr & vbCrLf sjStr = "" End if 堆栈列表 &= jcm & "+" & Hex(i - sp, 4) & "]=" & Hex(zdcc, zk) & " " & CWSTRtoString(gMode(bI).szModule) & "+" & Hex(zdcc - Cast(UInteger, gMode(bI).modBaseAddr)) & vbCrLf sjc = 1 zdi += 1 Exit For End if Next End if End if if sjc = 0 Then If Len(sjStr) Then sjStr &= "," & Hex(zdcc, zk) Else sjStr = jcm & "+" & Hex(i - sp, 4) & "]=" & Hex(zdcc, zk) End if End if Wend if Len(sjStr) Then 堆栈列表 &= sjStr & vbCrLf Dim 局部列表 As String zdi = 9 #IfDef __FB_64BIT__ jcm = "[Rbp" I = excp.ContextRecord->Rbp + 72 While zdi > -121 zdcc = MEM_Read_ULongInt(GetCurrentProcessId, i) i -= 8 #Else jcm = "[Ebp" I = excp.ContextRecord->Ebp + 36 While zdi > -121 zdcc = MEM_Read_ULong(GetCurrentProcessId, i) i -= 4 #endif if zdi >= 0 then 局部列表 &= jcm & "+" & Hex(zdi *Len(UInteger), 4) & "]=" & Hex(zdcc, zk) & " " ElseIf zdi < 0 Then 局部列表 &= jcm & "-" & Hex(abs(zdi) *Len(UInteger), 4) & "]=" & Hex(zdcc, zk) & " " End if if (zdi Mod 10) = 0 Then 局部列表 &= vbCrLf zdi -= 1 Wend bug &= "堆栈列表(栈顶): Esp/Rsp ------------------------------" & vbCrLf & 堆栈列表 bug &= "局部列表(栈底): Ebp/Rbp ------------------------------------" & vbCrLf & 局部列表 bug &= "模块列表: ------------------------------------------" & vbCrLf & AllMode If Len(文件名) Then SaveFileStr 文件名, bug Function = bug End Function -
VisualFreeBasic控件_WinHook 系统钩子 系统钩子（System Hooks）在编程中，特别是在Windows操作系统环境下，是一种强大的机制，允许应用程序拦截、监视或修改系统级事件。这些事件可以包括键盘和鼠标输入、消息传递、窗口创建和销毁等。通过使用钩子，开发者可以创建出功能强大的应用程序，如键盘记录器、屏幕捕获工具、游戏作弊软件等，但同时也需要谨慎使用，以避免侵犯用户隐私或违反软件许可协议。 钩子类型 Windows提供了多种类型的钩子，根据你想要拦截的事件类型来选择： WH_CALLWNDPROC 和 WH_CALLWNDPROCRET：这些钩子允许你监视发送到窗口过程的消息。前者在消息被处理前调用，后者在消息被处理后调用。 WH_CBT：CBT（Callback to Task Window）钩子允许你监视Windows的各种系统级操作，如窗口的创建和销毁。 WH_DEBUG：调试钩子，主要用于调试目的，允许你监视和记录系统级事件。 WH_FOREGROUNDIDLE：当系统前台线程处于空闲状态时，此钩子被调用。它允许应用程序执行后台任务而不影响用户界面的响应性。 WH_GETMESSAGE 和 WH_JOURNALRECORD：这两个钩子与消息队列有关。WH_GETMESSAGE在消息从消息队列中检索之前被调用，而WH_JOURNALRECORD用于记录输入事件（如键盘和鼠标事件）到日志文件中。 WH_KEYBOARD 和 WH_KEYBOARD_LL：键盘钩子，用于监视键盘输入。WH_KEYBOARD是低级钩子，它在系统级别拦截键盘事件，而WH_KEYBOARD_LL是更底层的钩子，它在Windows的底层键盘驱动程序中拦截事件。 WH_MOUSE 和 WH_MOUSE_LL：鼠标钩子，与键盘钩子类似，但用于监视鼠标输入。 WH_MSGFILTER 和 WH_SYSMSGFILTER：这两个钩子允许应用程序在消息到达窗口过程之前过滤掉某些消息。WH_MSGFILTER仅适用于与钩子安装线程相关联的窗口，而WH_SYSMSGFILTER则适用于系统中的所有线程。 WH_SHELL：外壳钩子，用于监视与外壳相关的通知，如窗口的激活和最小化。 使用钩子的注意事项 性能影响：安装钩子可能会对系统性能产生负面影响，尤其是全局钩子（如WH_KEYBOARD_LL和WH_MOUSE_LL），因为它们会影响整个系统的输入事件。 权限要求：某些类型的钩子需要管理员权限才能安装。 安全性和隐私：由于钩子可以监视和修改用户的输入，因此它们可能被用于恶意目的。确保你的应用程序尊重用户的隐私和安全。 兼容性：随着Windows版本的更新，钩子的行为可能会发生变化。确保你的应用程序与目标操作系统版本兼容。 卸载钩子：在应用程序退出或不再需要钩子时，应确保卸载钩子以避免资源泄漏或意外行为。 钩子控件的使用方法 使用方法非常简单，无需你写任何代码，只要选择相关事件即可。没选择的事件并不会去钩操作系统里的东西，也不影响系统速度。钩子会影响操作系统性能。只要你创建了事件，那么就创建了钩子。没创建就没钩子。 为了不影响系统性能，你需要在事件中执行代码尽量简单。 -
-
VisualFreeBasic控件_Network 网络通信 实现 UDP 和 TCP 通信，用于写服务器和客户端，广域网和局域网通信。 本控件已经封装复杂的通信操作，让我们能简单的方便的使用通信。而且都提供了源码，可以打开控件工程查看那些复杂的封装代码。 本控件没有显示内容，只有事件和属性。 为了能顺利使用本控件，建议先恶补“ UDP和TCP”“广域网和局域网”的相关知识体系，本文档不再阐述这些基础知识。 获取本机IP 通信的首要条件，IP地址，这里的IP地址是局域网的IP print Network1.LocalIP 获取广域网IP 我们自己电脑是无法获知自己电脑广域网IP地址的，需要访问外网，外网反馈给我们IP地址才可以得知。此IP地址是由宽带服务商提供，而且是动态的，一天可能变好几次。已经有一些服务器提供这样的功能，只要访问它的域名，就返回我们的IP地址。 print Http_Get("http://ip.3322.net/") UDP通信 启动UDP接收 首先，必须开启接收，就是让软件监听UDP Network1.UdpPort =999 '每台电脑有很多UDP通信，用此端口号区分，如同电话的分机号 If Network1.UdpOpen() = 0 Then Print "开启失败，请注意防火墙提示时，需要允许。或者端口号被占用" Else Print "开启成功" End If 收到数据事件 当其它电脑发来数据，就会触发事件 Sub Form1_Network1_UdpNewData(hWndForm As hWnd, nn As Network_Data) Print "接收数据，内容：" , nn.Dat '非文本数据不要打印 End Sub 发送数据到目标IP（IP就是上面获取的IP地址，局域网IP和广域网IP都可以） 其它电脑把数据发送到接收方 Network1.UdpPostData(IP地址,端口号,"要发送的数据") 端口号就是开启接收时，设置的号码。 广域网互相通信（服务器电脑和家庭电脑通信） 两台电脑都启动UDP接收，那么就可以实现相互通信了 局域网时，双方都知道对方的IP和端口，互相发数据即可，要是广域网，2台电脑都有独立外网IP地址，也没问题，和局域网一样操作。 要是2台电脑，全部是家庭电脑，就无法实现广域网通信。当1台电脑有独立IP（比方服务器），1台家庭电脑，先由家庭电脑发UDP数据给服务器电脑，服务器电脑收到后，可以直接返回数据发送给家庭电脑 Sub Form1_Network1_UdpNewData(hWndForm As hWnd, nn As Network_Data) Print "接收数据，内容：" , nn.Dat '非文本数据不要打印 Network1.UdpPostData(nn.ip,nn.Port,"数据") '发给家庭电脑数据 End Sub 此时的 nn.ip,nn.Port IP 和端口，端口是一个伪端口，和真实的家庭电脑中的端口会不同（具体原理我们不需要懂，好奇的可以网上搜索原理）。有网上教程说此为：打洞 广域网互相通信（家庭电脑和家庭电脑通信） 家庭电脑和家庭电脑通信，是无法直接广域通信的，因此我们必须有一个服务器电脑，实现中转 上面服务器电脑收到 家庭电脑的 “IP和端口”伪数据，A家庭电脑和B家庭电脑，都发送数据到服务器电脑，然后由服务器电脑，把 AB家庭电脑“IP和伪端口”返回。那么A家知道B家，B家知道A家，AB两家就可以脱离服务，自己互相发数据了。但是家庭电脑随时可能会发生IP地址和端口改变，为了保持长久连接，就需要每隔一定时间，和服务器通信来更新AB家庭电脑“IP和伪端口” TCP通信（获取网页代码） 网站都是使用TCP通信，要是获取网页代码，其实不需要本控件，直接一个函数搞定 print Http_Get("http://ip.3322.net/") 还有一个函数：Http_Post 可以向服务发送大量数据，比方上传文件等等。 其实这个一个基于 HTTP协议的 TCP 通信，HTTP协议已经被自动处理，而后面要说的，都是原始通信数据，包括HTTP协议部分。 TCP通信（服务端） TCP需区分服务端和客户端，服务端，一般都用在服务器电脑上，就是有独立外网IP的电脑，假如是家用电脑，需要路由器设置端口转发，而且IP随时会变，需要路由器设置DDNS（花生壳之类的服务，以前有免费免流量，现在到处是收费限制流量） 只是在局域网中使用，使用局域网IP，那么直接上，没任何限制。 开启服务端 Network1.TcpServerPort =999 '每台电脑有很多TCP通信，用此端口号区分，如同电话的分机号 If Network1.TcpServerOpen() = 0 Then Print "开启失败，请注意防火墙提示时，需要允许。或者端口号被占用" Else Print "开启成功" End If 当客户端发送数据过来，触发事件 Sub Form1_Network1_TcpServerNewData(hWndForm As hWnd, nn As Network_Data) Print "服务端收到数据：" ,Len(nn.Dat) '这里开始才正式处理数据--- 'Network1.TcpServerSend(nn.SOCKET,"返回给客户端数据，可以是任意数据，不单单是文本") 'Network1.TcpServerCloseClient nn.SOCKET '主动断开客户端连接，并非立即断开，控件会自动等返回给客户端数据发送完成后才会断开。 End Sub 还有 “客户端连接请求” 和 “客户端断开连接” 事件 基本流程是，客户端请求连接-->连接成功-->互相发数据（只要不断开，双方可以一直连接，可以互相发数据，也可以不发）-->断开连接（客户端主动断开和服务端主动断开） TCP通信（客户端） 客户端，不管是家庭电脑，服务器电脑，都可以用。 一次性连接 就是连接服务端，发送数据，服务端返回数据，就断开连接，一次完成。 返回数据 = Network1.TcpClientSendGet( IP , 端口 , "发送数据" ) 网站一般都是如此，比方要获取网页代码，下面例题就是获取网页代码的 Dim 域名 As String= "www.baidu.com" Dim 路径 As String = "index.html" Dim http请求 As String '构造HTTP协议 http请求 = "GET /" + 路径 + !" HTTP/1.1\r\n" + "Host: " + 域名 + !" \r\n" + _ "Pragma: no-cache" + !"\r\n" + _ "User-Agent: Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/96.0.4664.55 Safari/537.36 Edg/96.0.1054.34" + !"\r\n" + _ "Referer: https://www.baidu.com/" + !"\r\n" + _ "Connection: close" + !"\r\n" + _ "Accept-Language: zh-CN,zh;q=0.9,en;q=0.8,en-GB;q=0.7,en-US;q=0.6" + !"\r\n\r\n" Dim 网页 As String = Network1.TcpClientSendGet( 域名 , 80 , http请求 ) '网站端口是 80 长时间连接通信 服务端和客户端一直连接着，随时随地互相发数据（注意：服务端连接数量有限制，超过限制，新连接就无法连接了，具体多少请网上搜索） 先启动客户端 Dim 域名 As String = "88.88.88.88" '可以是域名，可以是IP地址，要是域名，控件会自动转换成IP的。 Dim 端口 As Long = 999 '服务端开发的端口 If Network1.TcpClientOpen(域名, 端口) =0 Then Print "TCP连接到服务失败，请检查！！" End If 连接成功，向服务端发数据 Network1.TcpClientSend(“发数据”) 客户端收到服务端发来的数据，触发事件 Sub Form1_Network1_TcpClientNewData(hWndForm As hWnd, nn As Network_Data) Print "客户端收到数据：" ,nn.Dat '假如是文本，非文本不要打印 End Sub 通信协议 网络通信中，一台电脑到另一台电脑经过很多设备，存在很多不确定因素。 在UDP和TCP通信中，双方只是发送数据，系统则是以数据包的形式传送到其它电脑。但是会存在各种问题。 UDP 通信问题，只管发数据包，不管对方是否接收到，因此存在丢包问题，无法保障数据完整性，一般解决方法，制造一个协议，校对数据CRC值，不正确可以通知对方重新发送。 TCP 通信问题，虽然是安全通信，不会丢包，但存在粘包和拆包问题。 拆包：发送数据大，系统会拆分成 N个小包，接收方，收到的是一个一个小包 粘包：发送数据小，系统会把小的合成一个合适的包发送。接收方收到的可能是多个数据。 你永远无法知道是接收到的数据，是拆包还是粘包？还无法确定数据是否全部接收，等了好久，也不知道对方网卡了还是太忙来不及发送。 因此，大家都各自创造了各自的协议来处理这些问题，比方网络游戏，各自保密还加密，网页则使用HTTP协议，可以网上搜索到，可以搜索HTTP协议，可以参考这些成熟的协议，来解决自己的问题。 协议，只存在你写的服务端和客户端软件中，没有固定方法。 我的做法是：发数据时，添加一个头标记，表示开始，然后头标记后面是长度 '发送方 ----------------- Dim 数据 As String = "要发送的内容" Dim 长度 As Long = Len(数据) + 4 + 4 数据 = "<yf>" & MKL(长度) & 数据 '接收方 ---------------- Sub Form1_Network1_TcpServerNewData(hWndForm As hWnd ,nn As Network_Data) 'TCP服务器接收到新数据 If Left(nn.dat ,4) <> "<yf>" Then Network1.TcpServerCloseClient nn.SOCKET Return '自己创建协议头，不对就不处理。 End If Dim 总长度 As Long = CVL(Mid(nn.Dat,5,4)) If Len(nn.dat) < 总长度 Then '总长度=头部+数据 nn.nLen = 总长度 '（根据自己搞的协议获取总长度赋值，然后 nn.Dat 就累积收到的数据） Return End If Dim bb As String =mid(nn.dat,9,总长度-8) bb 就是完整的数据 End Sub 以上简单的协议，仅供参考 -
VisualFreeBasic控件_WinInet 互联网访问 这是WIn操作系统提供的网页访问功能，由VFB封装成控件使用。 这是一个功能性控件，无界面。 使用方法 使用方法很简单，就是访问一个网页，返回网页代码 Dim bb As String = WinInet1.HttpGet("http://www.yfvb.com") Dim bb As String = WinInet1.HttpPost("http://www.yfvb.com") WinInet1.HttpGetThread("http://www.yfvb.com") WinInet1.HttpPostThread("http://www.yfvb.com") 前一个是直接获取，后一个是多线程方式，当网络有卡顿，或者是下载文件时，需要比较长的时间，直接获取会发生软件假死，无反应。需要用多线程处理。 不管是多线程还是直接，接收文件时，都会产生事件 标头数据、下载开始、下载完成、文件下载中 等事件 利用事件，可以在下载文件时，提示文件进度等人性化操作 关于GET和POST 在HTTP（Hypertext Transfer Protocol，超文本传输协议）网页访问中，GET和POST是两种最常用的HTTP方法（也称为请求方法或动作），用于向服务器发送请求以获取或提交数据。尽管它们都能达到与服务器交换数据的目的，但它们在使用场景、安全性、数据传输量等方面存在差异。 GET 方法 用途：主要用于请求访问已经被URI（统一资源标识符）识别的资源，即发送一个请求来取得服务器上的某一资源。这里的资源可以是网页、图片、文档等。 特点： 数据在URL中：GET请求的数据会附加在URL之后（通过?分隔URL和传输数据，参数之间以&相连），发送的信息对所有人都是可见的（包括服务器日志、浏览器历史记录等），因此隐私性较差，且不适合用于传输敏感信息。 缓存：GET请求是可以被缓存的，而POST请求则不会。 长度限制：由于URL长度的限制，GET请求传输的数据量有限制。 无副作用：GET请求通常不会对服务器上的数据产生影响（即不会改变数据状态），仅仅是获取数据。 POST 方法 用途：主要用于向服务器提交数据，如提交表单或上传文件。POST请求的数据包含在请求体中，而不是附加在URL之后。 特点： 数据在请求体中：POST请求的数据不会附加在URL之后，而是放在HTTP请求的消息体中，对用户来说是不可见的，因此适合用于传输敏感信息。 无缓存：POST请求不会被缓存。 无长度限制：理论上POST请求的数据量没有限制，但实际应用中会受到服务器和客户端的限制。 有副作用：POST请求通常会导致服务器上的数据发生改变（例如，提交表单后数据被保存到数据库中）。 使用场景 GET：通常用于请求服务器发送资源，如请求网页、图片等，或者搜索查询等不需要修改服务器数据的场景。 POST：通常用于提交数据到服务器，如用户注册、提交表单、文件上传等需要修改服务器数据的场景。 安全性 由于GET请求的数据是明文显示在URL中的，所以不适合传输敏感信息（如密码）。而POST请求的数据在请求体中，对用户来说是不可见的，相对更安全。然而，无论是GET还是POST，都应当使用HTTPS来确保数据传输的安全性，因为HTTP本身并不加密数据。 -
VisualFreeBasic控件_MyDrawWin 窗口外框 这个是改变窗口外框的控件，放上控件后，运行才效 运行后的效果 可以在窗口属性中增加阴影，效果更好（注意：是主窗口的设计属性，不是控件的） 运行效果 可以修改窗口外壳颜色已经高度 还增加2个常用的窗口按钮，已经可以设置更多小按钮 注意： 按钮ID 设置大点，不然可能被其它控件占用，发生重叠错误 MyDrawWin1.nButID(0 到 9 共10个) = 10001 MyDrawWin1.nButTxt(0 到 9 共10个) = "按钮文字" 按钮点击事件，在主窗口的事件中 Sub Form1_WM_Command(hWndForm As hWnd, hWndControl As hWnd, wNotifyCode As Long, wID As Long) Select Case wID '命令ID，设计菜单和工具栏的设置的值。 Case 10001 ‘和 MyDrawWin1.nButID 设置的相同 Case 10002 End Select End Sub 假如你窗口上设置了窗口菜单，运行后，菜单也会在窗口外框上面 -
VisualFreeBasic控件_mCtrlTreeList 目录树列表 一个目录树和列表组合控件，如同：TreeView和ListView 这两个控件合并在一起的效果。 使用方法 也是TreeView和ListView控件的组合方式 添加“列” mCtrlTreeList1.AddColumn("列0", 100) mCtrlTreeList1.AddColumn("列1", 100) mCtrlTreeList1.AddColumn("列2", 100) 添加“行”数据 Dim aa As MC_HTREELISTITEM = mCtrlTreeList1.AddItem(MC_TLI_ROOT, "列0数据") mCtrlTreeList1.SetItemText(aa, 1, "列1数据") mCtrlTreeList1.SetItemText(aa, 2, "列2数据") 假如添加子项目 Dim bb As MC_HTREELISTITEM = mCtrlTreeList1.AddItem(aa, "列0数据") 其它功能 功能同 TreeView和ListView 一样类似，可以参考它们，这里不再相信阐述。 图标显示 没一个行头都可以显示一个图标，使用方法和TreeView一样。 先添加一个图像列表控件，然后选择绑定。添加图像 在添加行数据时，设置图像索引 mCtrlTreeList1.AddItem(MC_TLI_ROOT, "列0数据",用户自定义数据,图像索引)