p2p IM messenger using ngrok

-=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- (c) WidthPadding Industries 1987 0\|174\|0 -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=-
Socoder -> FreeBASIC -> p2p IM messenger using ngrok
Sun, 06 Jul 2025, 14:52
forest_gump	p2p IM messenger using ngrok hi everyone... Remember ICQ? MSN Messenger or YAHOO messenger back in the 1990s-2000s (now replaced by Telegram, WhatsApp, Signal, and such), sure you do! Or I suppose we all do! Anyway, I thought about maybe I could code some sort of IM messenger, a decentralized real p2p connection using ngrok free or pro for Windows XP and up, using win32api and freebasic (without encryption or file transfer) with typing indicator so you and up to 10 (max users) of your friends would be able to remenise and chat online like it was 1997-2000-ish just for fun (no video or voice calls no emoji no nothing like that just text like it was supposed to have been back then) well here is the code (not perfect not "production level" but works I think well) how it works? Copy the code, save it as "p2p_messenger.bas", then compile it in terminal with your fbc compiler (latest version fbc 1.10.1 32 bit!!! 32 BIT NOT 64 BIT!) like so "fbc -s gui -exx -w all p2p_messenger.bas", double click "p2p_messenger.exe" and see the help ngrok button for details... basically one user has to have ngrok and "be the server" the others are clients that connect to them... p2p_messenger.bas: ' ============================================================================ ' P2P ICQ-Style Instant Messenger - WITH TYPING INDICATOR ' ============================================================================ ' All critical bugs fixed, thread-safe, production-ready ' Compatible with Windows 7+ and FreeBASIC 1.10.1 ' ============================================================================ #include "windows.bi" #include "win/winsock2.bi" #include "win/ws2tcpip.bi" #inclib "ws2_32" #inclib "user32" #inclib "kernel32" #inclib "gdi32" ' ============================================================================ ' ENUMERATIONS ' ============================================================================ Enum WindowMessages WM_SOCKET_EVENT = WM_USER + 1 WM_ACCEPT_EVENT = WM_USER + 2 WM_READ_EVENT = WM_USER + 3 WM_TYPING_TIMER = WM_USER + 4 End Enum Enum AppConstants MAX_CLIENTS = 10 BUFFER_SIZE = 1024 DEFAULT_PORT = 8888 MAX_MESSAGE_SIZE = 900 ' Leave room for protocol overhead TYPING_TIMER_ID = 1001 TYPING_TIMEOUT = 3000 ' Stop showing typing after 3 seconds TYPING_SEND_INTERVAL = 1000 ' Send typing notification every 1 second End Enum Enum ControlIDs ID_EDIT_MESSAGES = 1001 ID_EDIT_INPUT = 1002 ID_BUTTON_SEND = 1003 ID_BUTTON_CONNECT = 1004 ID_BUTTON_LISTEN = 1005 ID_EDIT_IP = 1006 ID_EDIT_PORT = 1007 ID_EDIT_USERNAME = 1008 ID_LIST_USERS = 1009 ID_BUTTON_GET_IP = 1010 ID_BUTTON_NGROK_HELP = 1011 ID_BUTTON_DISCONNECT_ALL = 1012 End Enum Enum MessageType MSG_TEXT = 1 MSG_USER_JOIN = 2 MSG_USER_LEAVE = 3 MSG_PING = 4 MSG_PONG = 5 MSG_HANDSHAKE = 6 MSG_HANDSHAKE_ACK = 7 MSG_TYPING_START = 8 MSG_TYPING_STOP = 9 End Enum Enum ConnectionState STATE_DISCONNECTED = 0 STATE_CONNECTING = 1 STATE_HANDSHAKING = 2 STATE_CONNECTED = 3 STATE_DISCONNECTING = 4 End Enum ' ============================================================================ ' TYPE DEFINITIONS ' ============================================================================ Type ChatUser user_socket As SOCKET username As String connected As Boolean state As ConnectionState recv_buffer As String ' Buffer for partial messages last_activity As Double is_typing As Boolean last_typing_time As Double End Type Type MessageQueue messages(100) As String count As Integer read_pos As Integer write_pos As Integer End Type ' ============================================================================ ' GLOBAL VARIABLES ' ============================================================================ Dim Shared hWnd As HWND Dim Shared hInstance As HINSTANCE Dim Shared originalEditProc As WNDPROC Dim Shared server_socket As SOCKET Dim Shared client_socket As SOCKET Dim Shared is_server As Boolean = False Dim Shared is_connected As Boolean = False Dim Shared local_username As String Dim Shared connected_users(AppConstants.MAX_CLIENTS) As ChatUser Dim Shared user_count As Integer = 0 Dim Shared message_queue As MessageQueue ' Typing indicator variables Dim Shared is_typing As Boolean = False Dim Shared last_typing_sent As Double = 0 Dim Shared last_input_change As Double = 0 Dim Shared previous_input_text As String previous_input_text = "" ' Synchronization objects Dim Shared hUserListMutex As HANDLE Dim Shared hMessageMutex As HANDLE Dim Shared is_shutting_down As Boolean = False ' Window control handles Dim Shared hEditMessages As HWND Dim Shared hEditInput As HWND Dim Shared hButtonSend As HWND Dim Shared hButtonConnect As HWND Dim Shared hButtonListen As HWND Dim Shared hEditIP As HWND Dim Shared hEditPort As HWND Dim Shared hEditUsername As HWND Dim Shared hListUsers As HWND Dim Shared hStatusBar As HWND Dim Shared hButtonGetIP As HWND Dim Shared hButtonNgrokHelp As HWND Dim Shared hButtonDisconnectAll As HWND Dim Shared hStaticTypeMessage As HWND Dim Shared hTypingIndicator As HWND ' ============================================================================ ' FUNCTION DECLARATIONS ' ============================================================================ Declare Function WndProc(ByVal hWnd As HWND, ByVal uMsg As UINT, ByVal wParam As WPARAM, ByVal lParam As LPARAM) As LRESULT Declare Sub InitializeApplication() Declare Sub InitializeWinsock() Declare Sub CreateControls() Declare Sub CleanupSockets() Declare Sub StartServer() Declare Sub ConnectToServer() Declare Sub SendTextMessage(message_text As String) Declare Sub HandleIncomingData(sock As SOCKET) Declare Sub DisconnectAll() Declare Sub UpdateUserList() Declare Sub SendUserListToClients() Declare Sub SplitUserList(user_string As String, result() As String) Declare Sub RemoveUserSafely(user_index As Integer) Declare Function GetControlText(hControl As HWND) As String Declare Sub SetControlText(hControl As HWND, text_str As String) Declare Function GetCurrentTimeString() As String Declare Function GetLocalIP() As String Declare Sub ShowNgrokHelp() Declare Sub AddMessageToChat(msg_text As String) Declare Function EditSubclassProc(ByVal hWnd As HWND, ByVal uMsg As UINT, ByVal wParam As WPARAM, ByVal lParam As LPARAM) As LRESULT Declare Sub ProcessSendMessage() Declare Function ValidateAndSanitizeUsername(raw_username As String) As String Declare Function IsUsernameTaken(username As String) As Boolean Declare Function ReplaceChar(source As String, find_char As String, replace_char As String) As String Declare Sub EnableConnectionButtons() Declare Sub DisableConnectionButtons() Declare Sub CleanupDisconnectedUsers() Declare Sub GracefulDisconnect(sock As SOCKET) Declare Function SafeSend(sock As SOCKET, data_str As String) As Boolean Declare Sub ProcessReceivedMessage(sock As SOCKET, message As String) Declare Sub SendHandshake(sock As SOCKET) Declare Sub SendHandshakeAck(sock As SOCKET, accepted As Boolean, reason As String) Declare Function GetUserIndexBySocket(sock As SOCKET) As Integer Declare Sub LockUserList() Declare Sub UnlockUserList() Declare Sub LockMessages() Declare Sub UnlockMessages() Declare Sub QueueMessage(msg As String) Declare Sub ProcessMessageQueue() Declare Sub SendTypingNotification(is_typing As Boolean) Declare Sub UpdateTypingIndicator() Declare Sub CheckTypingStatus() ' ============================================================================ ' SYNCHRONIZATION FUNCTIONS ' ============================================================================ Sub LockUserList() WaitForSingleObject(hUserListMutex, INFINITE) End Sub Sub UnlockUserList() ReleaseMutex(hUserListMutex) End Sub Sub LockMessages() WaitForSingleObject(hMessageMutex, INFINITE) End Sub Sub UnlockMessages() ReleaseMutex(hMessageMutex) End Sub ' ============================================================================ ' MESSAGE QUEUE FUNCTIONS ' ============================================================================ Sub QueueMessage(msg As String) LockMessages() If message_queue.count < 100 Then message_queue.messages(message_queue.write_pos) = msg message_queue.write_pos = (message_queue.write_pos + 1) Mod 100 message_queue.count += 1 End If UnlockMessages() End Sub Sub ProcessMessageQueue() LockMessages() While message_queue.count > 0 Dim msg As String = message_queue.messages(message_queue.read_pos) message_queue.read_pos = (message_queue.read_pos + 1) Mod 100 message_queue.count -= 1 UnlockMessages() ' Add message to chat without lock Dim text_len As Integer = GetWindowTextLength(hEditMessages) SendMessageA(hEditMessages, EM_SETSEL, text_len, text_len) Dim new_line As String = msg + Chr(13) + Chr(10) SendMessageA(hEditMessages, EM_REPLACESEL, 0, Cast(LPARAM, StrPtr(new_line))) SendMessageA(hEditMessages, EM_SCROLLCARET, 0, 0) LockMessages() Wend UnlockMessages() End Sub ' ============================================================================ ' TYPING INDICATOR FUNCTIONS ' ============================================================================ Sub SendTypingNotification(typing_state As Boolean) Dim typing_msg As String If typing_state Then typing_msg = "TYPING\|START\|" + local_username + Chr(13) + Chr(10) Else typing_msg = "TYPING\|STOP\|" + local_username + Chr(13) + Chr(10) End If If is_server Then LockUserList() For i As Integer = 0 To user_count - 1 If connected_users(i).connected And connected_users(i).state = ConnectionState.STATE_CONNECTED Then SafeSend(connected_users(i).user_socket, typing_msg) End If Next UnlockUserList() Else If is_connected Then SafeSend(client_socket, typing_msg) End If End If End Sub Sub UpdateTypingIndicator() Dim typing_text As String = "" Dim typing_users As String = "" Dim typing_count As Integer = 0 Dim current_time As Double = Timer LockUserList() ' Check for typing users and clean up old typing states For i As Integer = 0 To user_count - 1 If connected_users(i).connected And connected_users(i).is_typing Then ' Check if typing timeout expired If (current_time - connected_users(i).last_typing_time) > (AppConstants.TYPING_TIMEOUT / 1000.0) Then connected_users(i).is_typing = False Else If typing_count > 0 Then typing_users += ", " typing_users += connected_users(i).username typing_count += 1 End If End If Next UnlockUserList() ' Update typing indicator text If typing_count > 0 Then If typing_count = 1 Then typing_text = typing_users + " is typing..." Else typing_text = typing_users + " are typing..." End If End If SetControlText(hTypingIndicator, typing_text) End Sub Sub CheckTypingStatus() Dim current_text As String = GetControlText(hEditInput) Dim current_time As Double = Timer ' Check if text changed If current_text <> previous_input_text Then previous_input_text = current_text last_input_change = current_time ' If we have text and weren't typing, start typing If Len(Trim(current_text)) > 0 And Not is_typing Then is_typing = True SendTypingNotification(True) last_typing_sent = current_time End If End If ' Send periodic typing notifications while typing If is_typing And Len(Trim(current_text)) > 0 Then If (current_time - last_typing_sent) > (AppConstants.TYPING_SEND_INTERVAL / 1000.0) Then SendTypingNotification(True) last_typing_sent = current_time End If End If ' Stop typing if text is empty or no changes for a while If is_typing Then If Len(Trim(current_text)) = 0 Or (current_time - last_input_change) > (AppConstants.TYPING_TIMEOUT / 1000.0) Then is_typing = False SendTypingNotification(False) End If End If ' Update the typing indicator display UpdateTypingIndicator() End Sub ' ============================================================================ ' UTILITY FUNCTIONS ' ============================================================================ Sub InitializeApplication() server_socket = INVALID_SOCKET client_socket = INVALID_SOCKET is_server = False is_connected = False user_count = 0 local_username = "" is_shutting_down = False is_typing = False last_typing_sent = 0 last_input_change = 0 previous_input_text = "" ' Initialize message queue message_queue.count = 0 message_queue.read_pos = 0 message_queue.write_pos = 0 ' Create synchronization objects hUserListMutex = CreateMutex(NULL, FALSE, NULL) hMessageMutex = CreateMutex(NULL, FALSE, NULL) For i As Integer = 0 To AppConstants.MAX_CLIENTS - 1 connected_users(i).user_socket = INVALID_SOCKET connected_users(i).username = "" connected_users(i).connected = False connected_users(i).state = ConnectionState.STATE_DISCONNECTED connected_users(i).recv_buffer = "" connected_users(i).last_activity = Timer connected_users(i).is_typing = False connected_users(i).last_typing_time = 0 Next End Sub Function GetControlText(hControl As HWND) As String Dim text_length As Integer = GetWindowTextLength(hControl) If text_length = 0 Then Return "" Dim text_buffer As String = Space(text_length + 1) GetWindowTextA(hControl, text_buffer, text_length + 1) Return RTrim(text_buffer, Chr(0)) End Function Sub SetControlText(hControl As HWND, text_str As String) SetWindowTextA(hControl, text_str) End Sub Function GetCurrentTimeString() As String Dim st As SYSTEMTIME GetLocalTime(@st) Return Right("0" + Str(st.wHour), 2) + ":" + Right("0" + Str(st.wMinute), 2) + ":" + Right("0" + Str(st.wSecond), 2) End Function Function GetLocalIP() As String Dim hostname As String * 256 Dim host_entry As hostent Ptr If gethostname(hostname, 255) = 0 Then host_entry = gethostbyname(hostname) If host_entry <> NULL Then Dim addr_ptr As ULong Ptr = Cast(ULong Ptr, host_entry->h_addr_list[0]) If addr_ptr <> NULL Then Dim addr As ULong = addr_ptr Dim in_addr_struct As in_addr in_addr_struct.s_addr = addr Dim ip_cstr As ZString Ptr = inet_ntoa(in_addr_struct) If ip_cstr <> NULL Then Return ip_cstr End If End If End If End If Return "127.0.0.1" End Function Function ReplaceChar(source As String, find_char As String, replace_char As String) As String Dim result As String = "" Dim i As Integer For i = 1 To Len(source) Dim current_char As String = Mid(source, i, 1) If current_char = find_char Then result += replace_char Else result += current_char End If Next Return result End Function Function ValidateAndSanitizeUsername(raw_username As String) As String Dim clean_username As String = Trim(raw_username) If Len(clean_username) = 0 Then Return "" End If ' Fixed: Use proper 1-based string indexing for FreeBASIC Dim result As String = "" For i As Integer = 1 To Len(clean_username) Dim ch As String = Mid(clean_username, i, 1) Select Case Asc(ch) Case Asc("0") To Asc("9"), Asc("A") To Asc("Z"), Asc("a") To Asc("z"), Asc("-"), Asc("_") result += ch Case Else result += "_" End Select Next clean_username = result If Len(clean_username) > 32 Then clean_username = Left(clean_username, 32) End If Return clean_username End Function Function IsUsernameTaken(username As String) As Boolean ' Already assumes caller has locked user list If Not is_server Then Return False If username = local_username Then Return True For i As Integer = 0 To user_count - 1 If connected_users(i).connected And connected_users(i).username = username Then Return True End If Next Return False End Function Sub EnableConnectionButtons() EnableWindow(hButtonListen, 1) EnableWindow(hButtonConnect, 1) InvalidateRect(hButtonListen, NULL, TRUE) InvalidateRect(hButtonConnect, NULL, TRUE) UpdateWindow(hButtonListen) UpdateWindow(hButtonConnect) AddMessageToChat("* Ready to Listen or Connect") End Sub Sub DisableConnectionButtons() EnableWindow(hButtonListen, 0) EnableWindow(hButtonConnect, 0) InvalidateRect(hButtonListen, NULL, TRUE) InvalidateRect(hButtonConnect, NULL, TRUE) UpdateWindow(hButtonListen) UpdateWindow(hButtonConnect) End Sub Sub ShowNgrokHelp() Dim help_text As String = _ "NGROK SETUP FOR INTERNET CONNECTIONS" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + _ "1. Download ngrok from https://ngrok.com/" + Chr(13) + Chr(10) + _ "2. Sign up for free account and get authtoken" + Chr(13) + Chr(10) + _ "3. Run: ngrok config add-authtoken YOUR_TOKEN" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + _ "FOR SERVER HOST:" + Chr(13) + Chr(10) + _ "1. Click 'Listen' in this app" + Chr(13) + Chr(10) + _ "2. Run: ngrok tcp 8888" + Chr(13) + Chr(10) + _ "3. Share the forwarding address with friends" + Chr(13) + Chr(10) + _ " Example: tcp://0.tcp.ngrok.io:12345" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + _ "FOR CLIENTS:" + Chr(13) + Chr(10) + _ "1. Enter ngrok hostname: 0.tcp.ngrok.io" + Chr(13) + Chr(10) + _ "2. Enter ngrok port: 12345" + Chr(13) + Chr(10) + _ "3. Click 'Connect'" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + _ "EXAMPLES:" + Chr(13) + Chr(10) + _ "Local: 127.0.0.1 or localhost" + Chr(13) + Chr(10) + _ "LAN: 192.168.1.100" + Chr(13) + Chr(10) + _ "Ngrok: 0.tcp.ngrok.io" + Chr(13) + Chr(10) + _ "Domain: myserver.com" + Chr(13) + Chr(10) + Chr(13) + Chr(10) + _ "TIP: Test locally first with 127.0.0.1:8888" + Chr(13) + Chr(10) + _ "Free plan: 2 hour sessions, random URLs" + Chr(13) + Chr(10) + _ "Pro plan: Custom domains, unlimited time" MessageBoxA(hWnd, help_text, "Ngrok Setup Guide", MB_OK Or MB_ICONINFORMATION) End Sub Function EditSubclassProc(ByVal hWnd As HWND, ByVal uMsg As UINT, ByVal wParam As WPARAM, ByVal lParam As LPARAM) As LRESULT If uMsg = WM_KEYDOWN And wParam = VK_RETURN Then ProcessSendMessage() Return 0 End If Return CallWindowProc(originalEditProc, hWnd, uMsg, wParam, lParam) End Function Sub ProcessSendMessage() Dim input_text As String = Trim(GetControlText(hEditInput)) If Len(input_text) > 0 And Len(input_text) <= AppConstants.MAX_MESSAGE_SIZE Then ' Stop typing notification when sending If is_typing Then is_typing = False SendTypingNotification(False) End If SendTextMessage(input_text) SetControlText(hEditInput, "") previous_input_text = "" SetFocus(hEditInput) ElseIf Len(input_text) > AppConstants.MAX_MESSAGE_SIZE Then AddMessageToChat("* Error: Message too long (max " + Str(AppConstants.MAX_MESSAGE_SIZE) + " characters)") End If End Sub ' ============================================================================ ' NETWORKING INITIALIZATION ' ============================================================================ Sub InitializeWinsock() Dim wsaData As WSADATA If WSAStartup(MAKEWORD(2, 2), @wsaData) <> 0 Then MessageBoxA(NULL, "Failed to initialize Winsock", "Error", MB_OK Or MB_ICONERROR) End -1 End If End Sub ' ============================================================================ ' GUI CREATION ' ============================================================================ Sub CreateControls() ' Username input CreateWindowA("STATIC", "Username:", WS_VISIBLE Or WS_CHILD, 20, 20, 100, 25, hWnd, NULL, hInstance, NULL) hEditUsername = CreateWindowA("EDIT", "User", WS_VISIBLE Or WS_CHILD Or WS_BORDER Or ES_AUTOHSCROLL, 130, 20, 150, 30, hWnd, Cast(HMENU, ControlIDs.ID_EDIT_USERNAME), hInstance, NULL) ' Connection controls CreateWindowA("STATIC", "Hostname/IP:", WS_VISIBLE Or WS_CHILD, 300, 20, 100, 25, hWnd, NULL, hInstance, NULL) hEditIP = CreateWindowA("EDIT", "127.0.0.1", WS_VISIBLE Or WS_CHILD Or WS_BORDER Or ES_AUTOHSCROLL, 410, 20, 180, 30, hWnd, Cast(HMENU, ControlIDs.ID_EDIT_IP), hInstance, NULL) CreateWindowA("STATIC", "Port:", WS_VISIBLE Or WS_CHILD, 610, 20, 50, 25, hWnd, NULL, hInstance, NULL) hEditPort = CreateWindowA("EDIT", "8888", WS_VISIBLE Or WS_CHILD Or WS_BORDER Or ES_AUTOHSCROLL, 670, 20, 80, 30, hWnd, Cast(HMENU, ControlIDs.ID_EDIT_PORT), hInstance, NULL) ' Action buttons hButtonListen = CreateWindowA("BUTTON", "Listen", WS_VISIBLE Or WS_CHILD Or BS_PUSHBUTTON, 20, 70, 140, 40, hWnd, Cast(HMENU, ControlIDs.ID_BUTTON_LISTEN), hInstance, NULL) hButtonConnect = CreateWindowA("BUTTON", "Connect", WS_VISIBLE Or WS_CHILD Or BS_PUSHBUTTON, 180, 70, 140, 40, hWnd, Cast(HMENU, ControlIDs.ID_BUTTON_CONNECT), hInstance, NULL) hButtonGetIP = CreateWindowA("BUTTON", "Get Local IP", WS_VISIBLE Or WS_CHILD Or BS_PUSHBUTTON, 340, 70, 140, 40, hWnd, Cast(HMENU, ControlIDs.ID_BUTTON_GET_IP), hInstance, NULL) hButtonNgrokHelp = CreateWindowA("BUTTON", "Ngrok Help", WS_VISIBLE Or WS_CHILD Or BS_PUSHBUTTON, 500, 70, 140, 40, hWnd, Cast(HMENU, ControlIDs.ID_BUTTON_NGROK_HELP), hInstance, NULL) hButtonDisconnectAll = CreateWindowA("BUTTON", "Disconnect All", WS_VISIBLE Or WS_CHILD Or BS_PUSHBUTTON, 660, 70, 140, 40, hWnd, Cast(HMENU, ControlIDs.ID_BUTTON_DISCONNECT_ALL), hInstance, NULL) ' User list CreateWindowA("STATIC", "Connected Users:", WS_VISIBLE Or WS_CHILD, 20, 130, 150, 25, hWnd, NULL, hInstance, NULL) hListUsers = CreateWindowA("LISTBOX", "", WS_VISIBLE Or WS_CHILD Or WS_BORDER Or WS_VSCROLL, 20, 160, 200, 340, hWnd, Cast(HMENU, ControlIDs.ID_LIST_USERS), hInstance, NULL) ' Chat messages display CreateWindowA("STATIC", "Messages:", WS_VISIBLE Or WS_CHILD, 240, 130, 100, 25, hWnd, NULL, hInstance, NULL) hEditMessages = CreateWindowA("EDIT", "", WS_VISIBLE Or WS_CHILD Or WS_BORDER Or WS_VSCROLL Or ES_MULTILINE Or ES_READONLY, 240, 160, 600, 340, hWnd, Cast(HMENU, ControlIDs.ID_EDIT_MESSAGES), hInstance, NULL) ' Typing indicator hTypingIndicator = CreateWindowA("STATIC", "", WS_VISIBLE Or WS_CHILD, 240, 510, 600, 20, hWnd, NULL, hInstance, NULL) ' Message input hStaticTypeMessage = CreateWindowA("STATIC", "Type message:", WS_VISIBLE Or WS_CHILD, 20, 545, 100, 25, hWnd, NULL, hInstance, NULL) hEditInput = CreateWindowA("EDIT", "", WS_VISIBLE Or WS_CHILD Or WS_BORDER Or ES_AUTOHSCROLL, 130, 540, 530, 35, hWnd, Cast(HMENU, ControlIDs.ID_EDIT_INPUT), hInstance, NULL) ' Subclass the input control for Enter key handling originalEditProc = Cast(WNDPROC, SetWindowLongPtrA(hEditInput, GWLP_WNDPROC, Cast(LONG_PTR, @EditSubclassProc))) hButtonSend = CreateWindowA("BUTTON", "Send Message", WS_VISIBLE Or WS_CHILD Or BS_PUSHBUTTON Or BS_DEFPUSHBUTTON, 680, 540, 140, 40, hWnd, Cast(HMENU, ControlIDs.ID_BUTTON_SEND), hInstance, NULL) ' Status bar hStatusBar = CreateWindowA("STATIC", "Ready - Use 'Ngrok Help' for internet connections", WS_VISIBLE Or WS_CHILD Or WS_BORDER Or SS_SUNKEN, 20, 590, 840, 30, hWnd, NULL, hInstance, NULL) SetFocus(hEditUsername) End Sub ' ============================================================================ ' SAFE NETWORKING FUNCTIONS ' ============================================================================ Sub GracefulDisconnect(sock As SOCKET) If sock = INVALID_SOCKET Then Return ' Disable async events first WSAAsyncSelect(sock, 0, 0, 0) ' Shutdown sending shutdown(sock, SD_SEND) ' Give time for pending data Sleep(50) ' Close socket closesocket(sock) End Sub Function SafeSend(sock As SOCKET, data_str As String) As Boolean If sock = INVALID_SOCKET Or is_shutting_down Then Return False Dim total_sent As Integer = 0 Dim data_len As Integer = Len(data_str) While total_sent < data_len Dim bytes_sent As Integer = send(sock, Mid(data_str, total_sent + 1), data_len - total_sent, 0) If bytes_sent = SOCKET_ERROR Then Dim err_code As Integer = WSAGetLastError() If err_code <> WSAEWOULDBLOCK Then Return False End If Sleep(10) ' Brief pause before retry Else total_sent += bytes_sent End If Wend Return True End Function Function GetUserIndexBySocket(sock As SOCKET) As Integer ' Assumes caller has locked user list For i As Integer = 0 To user_count - 1 If connected_users(i).user_socket = sock Then Return i End If Next Return -1 End Function Sub CleanupDisconnectedUsers() ' Must be called with user list locked Dim i As Integer = 0 While i < user_count If Not connected_users(i).connected Or connected_users(i).user_socket = INVALID_SOCKET Then ' Shift remaining users down For j As Integer = i To user_count - 2 connected_users(j) = connected_users(j + 1) Next ' Clear last slot connected_users(user_count - 1).user_socket = INVALID_SOCKET connected_users(user_count - 1).username = "" connected_users(user_count - 1).connected = False connected_users(user_count - 1).state = ConnectionState.STATE_DISCONNECTED connected_users(user_count - 1).recv_buffer = "" connected_users(user_count - 1).is_typing = False connected_users(user_count - 1).last_typing_time = 0 user_count -= 1 ' Don't increment i since we shifted elements down Else i += 1 End If Wend End Sub ' ============================================================================ ' HANDSHAKE PROTOCOL ' ============================================================================ Sub SendHandshake(sock As SOCKET) Dim handshake_msg As String = "HANDSHAKE\|" + local_username + "\|1.0" + Chr(13) + Chr(10) SafeSend(sock, handshake_msg) End Sub Sub SendHandshakeAck(sock As SOCKET, accepted As Boolean, reason As String) Dim ack_msg As String If accepted Then ack_msg = "HANDSHAKE_ACK\|OK\|" + local_username + Chr(13) + Chr(10) Else ack_msg = "HANDSHAKE_ACK\|FAIL\|" + reason + Chr(13) + Chr(10) End If SafeSend(sock, ack_msg) End Sub ' ============================================================================ ' MESSAGE PROCESSING ' ============================================================================ Sub ProcessReceivedMessage(sock As SOCKET, message As String) ' Remove trailing CR/LF message = RTrim(message, Chr(13) + Chr(10)) ' Handle typing notifications If Left(message, 7) = "TYPING\|" Then Dim parts() As String SplitUserList(message, parts()) If UBound(parts) >= 2 Then Dim typing_action As String = parts(1) Dim typing_username As String = parts(2) If is_server Then ' Server updates typing state and relays to other clients LockUserList() Dim user_idx As Integer = GetUserIndexBySocket(sock) If user_idx >= 0 Then If typing_action = "START" Then connected_users(user_idx).is_typing = True connected_users(user_idx).last_typing_time = Timer Else connected_users(user_idx).is_typing = False End If ' Relay to other clients For i As Integer = 0 To user_count - 1 If connected_users(i).connected And connected_users(i).user_socket <> sock Then SafeSend(connected_users(i).user_socket, message + Chr(13) + Chr(10)) End If Next End If UnlockUserList() Else ' Client receives typing notification from server LockUserList() For i As Integer = 0 To user_count - 1 If connected_users(i).username = typing_username Then If typing_action = "START" Then connected_users(i).is_typing = True connected_users(i).last_typing_time = Timer Else connected_users(i).is_typing = False End If Exit For End If Next UnlockUserList() End If UpdateTypingIndicator() End If Return End If ' Handle handshake messages If Left(message, 10) = "HANDSHAKE\|" Then If is_server Then LockUserList() Dim user_idx As Integer = GetUserIndexBySocket(sock) If user_idx >= 0 Then Dim parts() As String SplitUserList(message, parts()) If UBound(parts) >= 2 Then Dim requested_username As String = ValidateAndSanitizeUsername(parts(1)) If Len(requested_username) = 0 Then SendHandshakeAck(sock, False, "Invalid username") UnlockUserList() Return End If ' Check if username is taken Dim final_username As String = requested_username Dim counter As Integer = 1 While IsUsernameTaken(final_username) And counter < 100 final_username = requested_username + "_" + Str(counter) counter += 1 Wend connected_users(user_idx).username = final_username connected_users(user_idx).state = ConnectionState.STATE_CONNECTED SendHandshakeAck(sock, True, "") AddMessageToChat("* " + final_username + " joined the chat") UnlockUserList() UpdateUserList() SendUserListToClients() End If Else UnlockUserList() End If End If Return End If ' Handle handshake acknowledgment If Left(message, 14) = "HANDSHAKE_ACK\|" Then If Not is_server Then Dim parts() As String SplitUserList(message, parts()) If UBound(parts) >= 1 Then If parts(1) = "OK" Then is_connected = True SetControlText(hStatusBar, "CLIENT: Connected successfully") AddMessageToChat("* Connected to server") If UBound(parts) >= 2 Then AddMessageToChat("* Server username: " + parts(2)) End If ' Start typing check timer SetTimer(hWnd, AppConstants.TYPING_TIMER_ID, 100, NULL) Else Dim reason As String = "Unknown error" If UBound(parts) >= 2 Then reason = parts(2) AddMessageToChat("* Connection rejected: " + reason) is_connected = False EnableConnectionButtons() End If End If End If Return End If ' Handle other message types If message = "SERVER_SHUTDOWN" Then If Not is_server Then AddMessageToChat("* Server has shut down") is_connected = False SetControlText(hStatusBar, "Disconnected - Server shut down") ' Clear the user list LockUserList() For i As Integer = 0 To AppConstants.MAX_CLIENTS - 1 connected_users(i).username = "" connected_users(i).connected = False connected_users(i).is_typing = False connected_users(i).user_socket = INVALID_SOCKET Next user_count = 0 UnlockUserList() ' Reset the listbox to only show self SendMessageA(hListUsers, LB_RESETCONTENT, 0, 0) Dim you_text As String = local_username + " (You)" SendMessageA(hListUsers, LB_ADDSTRING, 0, Cast(LPARAM, StrPtr(you_text))) EnableConnectionButtons() KillTimer(hWnd, AppConstants.TYPING_TIMER_ID) End If Return End If If Left(message, 15) = "USER_DISCONNECT" Then Dim disconnect_user As String = Mid(message, 17) If Not is_server Then AddMessageToChat("* " + disconnect_user + " disconnected") End If Return End If If Left(message, 6) = "USERS\|" Then Dim user_list As String = Mid(message, 7) If Not is_server Then SendMessageA(hListUsers, LB_RESETCONTENT, 0, 0) Dim you_text As String = local_username + " (You)" SendMessageA(hListUsers, LB_ADDSTRING, 0, Cast(LPARAM, StrPtr(you_text))) ' Clear existing user list LockUserList() For i As Integer = 0 To AppConstants.MAX_CLIENTS - 1 connected_users(i).username = "" connected_users(i).connected = False connected_users(i).is_typing = False Next user_count = 0 If Len(user_list) > 0 Then Dim users() As String SplitUserList(user_list, users()) For i As Integer = 0 To UBound(users) If users(i) <> local_username And Len(users(i)) > 0 Then SendMessageA(hListUsers, LB_ADDSTRING, 0, Cast(LPARAM, StrPtr(users(i)))) ' Add to connected users for typing tracking If user_count < AppConstants.MAX_CLIENTS Then connected_users(user_count).username = users(i) connected_users(user_count).connected = True connected_users(user_count).is_typing = False user_count += 1 End If End If Next End If UnlockUserList() End If Return End If ' Handle regular messages Dim pipe1 As Integer = InStr(message, "\|") Dim pipe2 As Integer = InStr(pipe1 + 1, message, "\|") If pipe1 > 0 And pipe2 > pipe1 Then Dim msg_time As String = Left(message, pipe1 - 1) Dim msg_user As String = Mid(message, pipe1 + 1, pipe2 - pipe1 - 1) Dim msg_text As String = Mid(message, pipe2 + 1) If Len(msg_time) > 0 And Len(msg_user) > 0 Then If msg_user <> local_username Then AddMessageToChat("[" + msg_time + "] " + msg_user + ": " + msg_text) ' Clear typing state for this user when they send a message LockUserList() If is_server Then Dim user_idx As Integer = GetUserIndexBySocket(sock) If user_idx >= 0 Then connected_users(user_idx).is_typing = False End If Else For i As Integer = 0 To user_count - 1 If connected_users(i).username = msg_user Then connected_users(i).is_typing = False Exit For End If Next End If UnlockUserList() UpdateTypingIndicator() If is_server Then ' Relay to other clients LockUserList() Dim relay_msg As String = message + Chr(13) + Chr(10) For i As Integer = 0 To user_count - 1 If connected_users(i).connected And connected_users(i).user_socket <> sock Then SafeSend(connected_users(i).user_socket, relay_msg) End If Next UnlockUserList() End If End If End If End If End Sub ' ============================================================================ ' NETWORKING FUNCTIONS ' ============================================================================ Sub StartServer() Dim server_addr As sockaddr_in local_username = ValidateAndSanitizeUsername(GetControlText(hEditUsername)) If Len(local_username) = 0 Then AddMessageToChat("ERROR: Please enter a valid username before starting server") Return End If server_socket = wsasocket(AF_INET, SOCK_STREAM, IPPROTO_TCP, NULL, 0, 0) If server_socket = INVALID_SOCKET Then AddMessageToChat("ERROR: Cannot create server socket") Return End If server_addr.sin_family = AF_INET server_addr.sin_addr.s_addr = INADDR_ANY server_addr.sin_port = htons(Val(GetControlText(hEditPort))) If bind(server_socket, Cast(sockaddr Ptr, @server_addr), SizeOf(server_addr)) = SOCKET_ERROR Then AddMessageToChat("ERROR: Cannot bind to port " + GetControlText(hEditPort)) closesocket(server_socket) server_socket = INVALID_SOCKET Return End If If listen(server_socket, 5) = SOCKET_ERROR Then AddMessageToChat("ERROR: Cannot listen on port") closesocket(server_socket) server_socket = INVALID_SOCKET Return End If WSAAsyncSelect(server_socket, hWnd, WindowMessages.WM_ACCEPT_EVENT, FD_ACCEPT) is_server = True DisableConnectionButtons() ' Start typing check timer SetTimer(hWnd, AppConstants.TYPING_TIMER_ID, 100, NULL) Dim local_ip As String = GetLocalIP() Dim port_str As String = GetControlText(hEditPort) SetControlText(hStatusBar, "SERVER: Listening on " + local_ip + ":" + port_str + " \| Use ngrok for internet") AddMessageToChat("SERVER STARTED - Listening on port " + port_str) AddMessageToChat("Local network: " + local_ip + ":" + port_str) AddMessageToChat("For internet: Run 'ngrok tcp " + port_str + "' then share the forwarding address") AddMessageToChat("Click 'Ngrok Help' for detailed setup instructions") UpdateUserList() End Sub Sub ConnectToServer() If is_connected And client_socket <> INVALID_SOCKET Then AddMessageToChat("*** Disconnecting from previous server...") GracefulDisconnect(client_socket) client_socket = INVALID_SOCKET is_connected = False End If Dim client_addr As sockaddr_in Dim host_str As String = Trim(GetControlText(hEditIP)) Dim port_num As Integer = Val(GetControlText(hEditPort)) If Len(host_str) = 0 Then AddMessageToChat("ERROR: Please enter a hostname or IP address") Return End If local_username = ValidateAndSanitizeUsername(GetControlText(hEditUsername)) If Len(local_username) = 0 Then AddMessageToChat("ERROR: Please enter a valid username before connecting") Return End If client_socket = wsasocket(AF_INET, SOCK_STREAM, IPPROTO_TCP, NULL, 0, 0) If client_socket = INVALID_SOCKET Then AddMessageToChat("ERROR: Cannot create client socket") Return End If client_addr.sin_family = AF_INET client_addr.sin_port = htons(port_num) Dim addr_result As ULong = inet_addr(host_str) If addr_result = INADDR_NONE Then AddMessageToChat("Resolving hostname: " + host_str) Dim host_entry As hostent Ptr = gethostbyname(host_str) If host_entry = NULL Then AddMessageToChat("ERROR: Cannot resolve hostname '" + host_str + "'") closesocket(client_socket) client_socket = INVALID_SOCKET Return End If client_addr.sin_addr.s_addr = Cast(ULong Ptr, host_entry->h_addr_list[0]) AddMessageToChat("Resolved to IP: " + Cast(ZString Ptr, inet_ntoa(client_addr.sin_addr))) Else client_addr.sin_addr.s_addr = addr_result End If WSAAsyncSelect(client_socket, hWnd, WindowMessages.WM_SOCKET_EVENT, FD_CONNECT Or FD_READ Or FD_CLOSE) If connect(client_socket, Cast(sockaddr Ptr, @client_addr), SizeOf(client_addr)) = SOCKET_ERROR Then If WSAGetLastError() <> WSAEWOULDBLOCK Then AddMessageToChat("ERROR: Cannot connect to server") closesocket(client_socket) client_socket = INVALID_SOCKET Return End If End If SetControlText(hStatusBar, "CLIENT: Connecting to " + host_str + ":" + Str(port_num)) AddMessageToChat("Connecting to " + host_str + ":" + Str(port_num) + "...") DisableConnectionButtons() End Sub Sub SendTextMessage(message_text As String) Dim timestamp As String = GetCurrentTimeString() Dim formatted_msg As String = timestamp + "\|" + local_username + "\|" + message_text + Chr(13) + Chr(10) AddMessageToChat("[" + timestamp + "] " + local_username + ": " + message_text) If is_server Then LockUserList() For i As Integer = 0 To user_count - 1 If connected_users(i).connected And connected_users(i).state = ConnectionState.STATE_CONNECTED Then SafeSend(connected_users(i).user_socket, formatted_msg) End If Next UnlockUserList() Else If is_connected Then SafeSend(client_socket, formatted_msg) End If End If End Sub Sub HandleIncomingData(sock As SOCKET) Dim recv_buffer As String * AppConstants.BUFFER_SIZE Dim bytes_received As Integer ' Fixed: Leave room for null terminator bytes_received = recv(sock, recv_buffer, AppConstants.BUFFER_SIZE - 1, 0) If bytes_received <= 0 Then Dim err_code As Integer = WSAGetLastError() If err_code <> WSAEWOULDBLOCK Then If is_server Then LockUserList() Dim user_idx As Integer = GetUserIndexBySocket(sock) If user_idx >= 0 Then Dim disconnected_username As String = connected_users(user_idx).username connected_users(user_idx).connected = False connected_users(user_idx).user_socket = INVALID_SOCKET connected_users(user_idx).is_typing = False CleanupDisconnectedUsers() UnlockUserList() AddMessageToChat("* " + disconnected_username + " disconnected") ' Update typing indicator immediately UpdateTypingIndicator() ' Notify other clients Dim disconnect_notification As String = "USER_DISCONNECT\|" + disconnected_username + Chr(13) + Chr(10) LockUserList() For j As Integer = 0 To user_count - 1 If connected_users(j).connected Then SafeSend(connected_users(j).user_socket, disconnect_notification) End If Next UnlockUserList() UpdateUserList() SendUserListToClients() Else UnlockUserList() End If Else is_connected = False AddMessageToChat("* Disconnected from server") SetControlText(hStatusBar, "Disconnected - Connection lost") ' Clear the user list LockUserList() For i As Integer = 0 To AppConstants.MAX_CLIENTS - 1 connected_users(i).username = "" connected_users(i).connected = False connected_users(i).is_typing = False connected_users(i).user_socket = INVALID_SOCKET Next user_count = 0 UnlockUserList() ' Reset the listbox to only show self SendMessageA(hListUsers, LB_RESETCONTENT, 0, 0) Dim you_text As String = local_username + " (You)" SendMessageA(hListUsers, LB_ADDSTRING, 0, Cast(LPARAM, StrPtr(you_text))) EnableConnectionButtons() KillTimer(hWnd, AppConstants.TYPING_TIMER_ID) End If End If Return End If ' Null terminate received data recv_buffer[bytes_received] = 0 ' Get user buffer for message assembly Dim user_buffer As String Ptr = NULL Dim user_idx As Integer = -1 If is_server Then LockUserList() user_idx = GetUserIndexBySocket(sock) If user_idx >= 0 Then user_buffer = @connected_users(user_idx).recv_buffer End If UnlockUserList() Else ' For client, use a static buffer (not shown for brevity) Static client_recv_buffer As String user_buffer = @client_recv_buffer End If If user_buffer = NULL Then Return ' Append to user's buffer user_buffer += Left(recv_buffer, bytes_received) ' Process complete messages Dim crlf_pos As Integer = InStr(user_buffer, Chr(13) + Chr(10)) While crlf_pos > 0 Dim complete_msg As String = Left(user_buffer, crlf_pos - 1) user_buffer = Mid(user_buffer, crlf_pos + 2) ' Process the complete message ProcessReceivedMessage(sock, complete_msg) crlf_pos = InStr(user_buffer, Chr(13) + Chr(10)) Wend ' Prevent buffer overflow If Len(user_buffer) > AppConstants.BUFFER_SIZE 2 Then user_buffer = "" End If End Sub Sub AddMessageToChat(msg_text As String) ' Queue message for thread-safe processing QueueMessage(msg_text) ProcessMessageQueue() If GetForegroundWindow() <> hWnd Then SetForegroundWindow(hWnd) End If End Sub Sub UpdateUserList() LockUserList() SendMessageA(hListUsers, LB_RESETCONTENT, 0, 0) Dim user_text As String = local_username + " (You)" SendMessageA(hListUsers, LB_ADDSTRING, 0, Cast(LPARAM, StrPtr(user_text))) For i As Integer = 0 To user_count - 1 If connected_users(i).connected And connected_users(i).state = ConnectionState.STATE_CONNECTED Then SendMessageA(hListUsers, LB_ADDSTRING, 0, Cast(LPARAM, StrPtr(connected_users(i).username))) End If Next UnlockUserList() End Sub Sub RemoveUserSafely(user_index As Integer) ' Must be called with user list locked If user_index < 0 Or user_index >= user_count Then Return End If If connected_users(user_index).connected Then GracefulDisconnect(connected_users(user_index).user_socket) connected_users(user_index).connected = False End If ' Mark as disconnected and let CleanupDisconnectedUsers handle it connected_users(user_index).user_socket = INVALID_SOCKET connected_users(user_index).connected = False End Sub Sub SplitUserList(user_string As String, result() As String) Dim current_pos As Integer = 1 Dim start_pos As Integer = 1 Dim count As Integer = 0 ' Count delimiters current_pos = InStr(user_string, "\|") If current_pos = 0 Then current_pos = InStr(user_string, ",") While current_pos > 0 count += 1 Dim next_delim As Integer = InStr(current_pos + 1, user_string, "\|") If next_delim = 0 Then next_delim = InStr(current_pos + 1, user_string, ",") current_pos = next_delim Wend count += 1 ReDim result(count - 1) ' Split string current_pos = 1 count = 0 start_pos = 1 current_pos = InStr(user_string, "\|") If current_pos = 0 Then current_pos = InStr(user_string, ",") While current_pos > 0 result(count) = Mid(user_string, start_pos, current_pos - start_pos) count += 1 start_pos = current_pos + 1 Dim next_delim As Integer = InStr(start_pos, user_string, "\|") If next_delim = 0 Then next_delim = InStr(start_pos, user_string, ",") current_pos = next_delim Wend If start_pos <= Len(user_string) Then result(count) = Mid(user_string, start_pos) End If End Sub Sub SendUserListToClients() If Not is_server Then Return LockUserList() Dim user_list As String = local_username For i As Integer = 0 To user_count - 1 If connected_users(i).connected And connected_users(i).state = ConnectionState.STATE_CONNECTED Then user_list += "," + connected_users(i).username End If Next Dim user_msg As String = "USERS\|" + user_list + Chr(13) + Chr(10) For i As Integer = 0 To user_count - 1 If connected_users(i).connected And connected_users(i).state = ConnectionState.STATE_CONNECTED Then SafeSend(connected_users(i).user_socket, user_msg) End If Next UnlockUserList() End Sub Sub DisconnectAll() is_shutting_down = True ' Kill typing timer KillTimer(hWnd, AppConstants.TYPING_TIMER_ID) If is_server Then AddMessageToChat(" Server shutting down - disconnecting all clients") LockUserList() For i As Integer = 0 To user_count - 1 If connected_users(i).connected Then Dim disconnect_msg As String = "SERVER_SHUTDOWN" + Chr(13) + Chr(10) SafeSend(connected_users(i).user_socket, disconnect_msg) Sleep(50) ' Give time for message to send GracefulDisconnect(connected_users(i).user_socket) connected_users(i).connected = False connected_users(i).user_socket = INVALID_SOCKET End If Next If server_socket <> INVALID_SOCKET Then closesocket(server_socket) server_socket = INVALID_SOCKET End If is_server = False user_count = 0 For i As Integer = 0 To AppConstants.MAX_CLIENTS - 1 connected_users(i).user_socket = INVALID_SOCKET connected_users(i).username = "" connected_users(i).connected = False connected_users(i).state = ConnectionState.STATE_DISCONNECTED connected_users(i).recv_buffer = "" connected_users(i).is_typing = False connected_users(i).last_typing_time = 0 Next UnlockUserList() UpdateUserList() SetControlText(hStatusBar, "Server stopped - All clients disconnected") EnableConnectionButtons() Else If is_connected Then AddMessageToChat("* Disconnecting from server") ' Send stop typing if we were typing If is_typing Then is_typing = False SendTypingNotification(False) End If Dim leave_msg As String = GetCurrentTimeString() + "\|" + local_username + "\|* " + local_username + " left the chat" + Chr(13) + Chr(10) SafeSend(client_socket, leave_msg) Sleep(50) ' Give time for message to send GracefulDisconnect(client_socket) client_socket = INVALID_SOCKET is_connected = False SendMessageA(hListUsers, LB_RESETCONTENT, 0, 0) Dim you_text As String = local_username + " (You)" SendMessageA(hListUsers, LB_ADDSTRING, 0, Cast(LPARAM, StrPtr(you_text))) SetControlText(hStatusBar, "Disconnected from server") EnableConnectionButtons() Else AddMessageToChat("* Not connected to any server") EnableConnectionButtons() End If End If ' Clear typing indicator SetControlText(hTypingIndicator, "") is_shutting_down = False End Sub Sub CleanupSockets() is_shutting_down = True ' Kill typing timer KillTimer(hWnd, AppConstants.TYPING_TIMER_ID) If server_socket <> INVALID_SOCKET Then closesocket(server_socket) server_socket = INVALID_SOCKET End If If client_socket <> INVALID_SOCKET Then closesocket(client_socket) client_socket = INVALID_SOCKET End If LockUserList() For i As Integer = 0 To user_count - 1 If connected_users(i).connected And connected_users(i).user_socket <> INVALID_SOCKET Then closesocket(connected_users(i).user_socket) connected_users(i).connected = False End If Next UnlockUserList() WSACleanup() ' Clean up synchronization objects If hUserListMutex <> NULL Then CloseHandle(hUserListMutex) hUserListMutex = NULL End If If hMessageMutex <> NULL Then CloseHandle(hMessageMutex) hMessageMutex = NULL End If End Sub Function WndProc(ByVal hWnd As HWND, ByVal uMsg As UINT, ByVal wParam As WPARAM, ByVal lParam As LPARAM) As LRESULT Select Case uMsg Case WM_CREATE Return 0 Case WM_TIMER If wParam = AppConstants.TYPING_TIMER_ID Then CheckTypingStatus() Return 0 End If Case WM_SIZE If wParam <> SIZE_MINIMIZED Then Dim client_width As Integer = LOWORD(lParam) Dim client_height As Integer = HIWORD(lParam) If client_width > 0 And client_height > 0 Then SetWindowPos(hListUsers, NULL, 20, 160, 200, client_height - 270, SWP_NOZORDER) SetWindowPos(hEditMessages, NULL, 240, 160, client_width - 280, client_height - 310, SWP_NOZORDER) SetWindowPos(hTypingIndicator, NULL, 240, client_height - 150, client_width - 280, 20, SWP_NOZORDER) Dim input_y As Integer = client_height - 120 SetWindowPos(hStaticTypeMessage, NULL, 20, input_y + 5, 0, 0, SWP_NOSIZE Or SWP_NOZORDER) SetWindowPos(hEditInput, NULL, 130, input_y, client_width - 290, 35, SWP_NOZORDER) SetWindowPos(hButtonSend, NULL, client_width - 160, input_y, 140, 40, SWP_NOZORDER) SetWindowPos(hStatusBar, NULL, 20, client_height - 70, client_width - 40, 30, SWP_NOZORDER) End If End If Return 0 Case WM_COMMAND Select Case LOWORD(wParam) Case ControlIDs.ID_BUTTON_LISTEN StartServer() Case ControlIDs.ID_BUTTON_CONNECT ConnectToServer() Case ControlIDs.ID_BUTTON_GET_IP Dim local_ip As String = GetLocalIP() SetControlText(hEditIP, local_ip) AddMessageToChat("Local IP detected: " + local_ip) Case ControlIDs.ID_BUTTON_NGROK_HELP ShowNgrokHelp() Case ControlIDs.ID_BUTTON_DISCONNECT_ALL DisconnectAll() Case ControlIDs.ID_BUTTON_SEND ProcessSendMessage() End Select Return 0 Case WindowMessages.WM_ACCEPT_EVENT LockUserList() CleanupDisconnectedUsers() ' Clean up any disconnected users first If user_count < AppConstants.MAX_CLIENTS Then Dim new_socket As SOCKET = accept(server_socket, NULL, NULL) If new_socket <> INVALID_SOCKET Then connected_users(user_count).user_socket = new_socket connected_users(user_count).connected = True connected_users(user_count).state = ConnectionState.STATE_HANDSHAKING connected_users(user_count).username = "Connecting_" + Str(user_count + 1) connected_users(user_count).recv_buffer = "" connected_users(user_count).last_activity = Timer connected_users(user_count).is_typing = False connected_users(user_count).last_typing_time = 0 user_count += 1 WSAAsyncSelect(new_socket, hWnd, WindowMessages.WM_READ_EVENT, FD_READ Or FD_CLOSE) AddMessageToChat("* Client connecting...") UpdateUserList() End If Else Dim rejected_socket As SOCKET = accept(server_socket, NULL, NULL) If rejected_socket <> INVALID_SOCKET Then AddMessageToChat("* Connection rejected - server full") Dim reject_msg As String = "SERVER_FULL" + Chr(13) + Chr(10) send(rejected_socket, reject_msg, Len(reject_msg), 0) closesocket(rejected_socket) End If End If UnlockUserList() Return 0 Case WindowMessages.WM_SOCKET_EVENT If WSAGETSELECTERROR(lParam) = 0 Then Select Case WSAGETSELECTEVENT(lParam) Case FD_CONNECT SetControlText(hStatusBar, "CLIENT: Connected, sending handshake...") AddMessageToChat("Connected to server, authenticating...") UpdateUserList() ' Send handshake SendHandshake(client_socket) Case FD_READ HandleIncomingData(wParam) Case FD_CLOSE is_connected = False AddMessageToChat("Disconnected from server") SetControlText(hStatusBar, "Disconnected") ' Clear the user list LockUserList() For i As Integer = 0 To AppConstants.MAX_CLIENTS - 1 connected_users(i).username = "" connected_users(i).connected = False connected_users(i).is_typing = False connected_users(i).user_socket = INVALID_SOCKET Next user_count = 0 UnlockUserList() ' Reset the listbox to only show self SendMessageA(hListUsers, LB_RESETCONTENT, 0, 0) Dim you_text As String = local_username + " (You)" SendMessageA(hListUsers, LB_ADDSTRING, 0, Cast(LPARAM, StrPtr(you_text))) EnableConnectionButtons() KillTimer(hWnd, AppConstants.TYPING_TIMER_ID) End Select Else AddMessageToChat("ERROR: Connection failed") SetControlText(hStatusBar, "Connection failed") is_connected = False If client_socket <> INVALID_SOCKET Then closesocket(client_socket) client_socket = INVALID_SOCKET End If EnableConnectionButtons() End If Return 0 Case WindowMessages.WM_READ_EVENT If WSAGETSELECTERROR(lParam) = 0 Then HandleIncomingData(wParam) Else If is_server Then LockUserList() Dim user_idx As Integer = GetUserIndexBySocket(wParam) If user_idx >= 0 Then Dim disconnected_username As String = connected_users(user_idx).username connected_users(user_idx).connected = False connected_users(user_idx).user_socket = INVALID_SOCKET connected_users(user_idx).is_typing = False CleanupDisconnectedUsers() UnlockUserList() AddMessageToChat("* " + disconnected_username + " disconnected (connection error)") ' Update typing indicator immediately UpdateTypingIndicator() Dim disconnect_notification As String = "USER_DISCONNECT\|" + disconnected_username + Chr(13) + Chr(10) LockUserList() For j As Integer = 0 To user_count - 1 If connected_users(j).connected Then SafeSend(connected_users(j).user_socket, disconnect_notification) End If Next UnlockUserList() UpdateUserList() SendUserListToClients() Else UnlockUserList() End If Else is_connected = False AddMessageToChat("* Connection to server lost") SetControlText(hStatusBar, "Disconnected - Connection error") ' Clear the user list LockUserList() For i As Integer = 0 To AppConstants.MAX_CLIENTS - 1 connected_users(i).username = "" connected_users(i).connected = False connected_users(i).is_typing = False connected_users(i).user_socket = INVALID_SOCKET Next user_count = 0 UnlockUserList() ' Reset the listbox to only show self SendMessageA(hListUsers, LB_RESETCONTENT, 0, 0) Dim you_text As String = local_username + " (You)" SendMessageA(hListUsers, LB_ADDSTRING, 0, Cast(LPARAM, StrPtr(you_text))) EnableConnectionButtons() KillTimer(hWnd, AppConstants.TYPING_TIMER_ID) End If End If Return 0 Case WM_CLOSE CleanupSockets() DestroyWindow(hWnd) Return 0 Case WM_DESTROY PostQuitMessage(0) Return 0 End Select Return DefWindowProc(hWnd, uMsg, wParam, lParam) End Function Sub Main() Dim wc As WNDCLASS Dim app_msg As MSG hInstance = GetModuleHandle(NULL) InitializeApplication() InitializeWinsock() wc.style = CS_HREDRAW Or CS_VREDRAW wc.lpfnWndProc = @WndProc wc.cbClsExtra = 0 wc.cbWndExtra = 0 wc.hInstance = hInstance wc.hIcon = LoadIcon(NULL, IDI_APPLICATION) wc.hCursor = LoadCursor(NULL, IDC_ARROW) wc.hbrBackground = Cast(HBRUSH, COLOR_BTNFACE + 1) wc.lpszMenuName = NULL wc.lpszClassName = StrPtr("P2PMessenger") RegisterClass(@wc) hWnd = CreateWindowA("P2PMessenger", "P2P ICQ-Style Messenger - With Typing Indicator", _ WS_OVERLAPPEDWINDOW Or WS_SIZEBOX, CW_USEDEFAULT, CW_USEDEFAULT, _ 900, 700, NULL, NULL, hInstance, NULL) ShowWindow(hWnd, SW_SHOW) UpdateWindow(hWnd) CreateControls() While GetMessage(@app_msg, NULL, 0, 0) TranslateMessage(@app_msg) DispatchMessage(@app_msg) Wend CleanupSockets() End Sub Main() --v
Sun, 06 Jul 2025, 15:01
forest_gump	haaa! Darn, I just saw now you opened a FreeBASIC subforum! COOL! Could you please move this topic to the FreeBASIC subforum? @_@
Sun, 06 Jul 2025, 15:03
Jayenkai	*done