'********************************************************************
' KillProcess.bas
'
' Demonstrates how to terminate a running process
'
' Author:   Armando I. Rivera (AIR)
' Date:     2025-03-04
' NOTE:     If you wish to terminate a process running at the system
'           level, you will have to execute this with admin rights.
'
' Compiles with PellesC, MinGW, and MSVC
'********************************************************************

Function main(argc as integer, argv as pchar ptr)

    Dim As String processName

    if ARGC < 2 then print "Usage: ", appexename$, " <Name of process to terminate>": end = 1

    processName = command$(1)
    Dim result = KillProcess(processName) 

End Function

$HEADER
    #include <tlhelp32.h>
$HEADER

Function KillProcess(filename$) As Integer
    Dim As DWORD processPID = 0
    Dim As HANDLE hSnapshot, hProcess
    Dim As PROCESSENTRY32 pe32
    Dim As BOOL found = FALSE
    Dim As Integer result = 0

    ' Take a snapshot of all processes
    hSnapshot = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)
    If hSnapshot = INVALID_HANDLE_VALUE Then
        Print "Failed to create process snapshot. Error: ", GetLastError()
        Return 1
    End If

    ' Set the size of the structure before using it
    pe32.dwSize = sizeof(PROCESSENTRY32)

    ' Get the first process
    If Not Process32First(hSnapshot, &pe32) Then
        Print "Failed to get first process. Error: ", GetLastError()
        CloseHandle(hSnapshot);
        Return 2
    End IF

    ' Find the process
    Do
        If pe32.szExeFile$ = filename$ Then
            processPID = pe32.th32ProcessID
            found = TRUE
            Exit Do
        End IF
    Loop While Process32Next(hSnapshot, &pe32)

    CloseHandle(hSnapshot)

    If Not found Then
        Print filename$," process not found"
        Return 3
    End If

    ' Open the requested process
    hProcess = OpenProcess(PROCESS_TERMINATE, FALSE, processPID)
    If hProcess = NULL Then
        print "Failed to open ", filename$, " process. Error:  ", GetLastError()
        return 4
    End If

    ' Terminate the requested process
    If Not TerminateProcess(hProcess, 0) Then
        print "Failed to terminate ", filename$, " process. Error: ", GetLastError()
        CloseHandle(hProcess)
        Return 5
    End If

    CloseHandle(hProcess)
   
    print filename$," terminated successfully."

    ' Wait a moment to ensure the process is fully terminated
    Sleep(1000)


    Return result
End Function



I needed something like this at work today, and threw this together....

AIR.

Windows Sandbox is useful for testing things in a non-persistent clean Windows environment.

It fires up quickly also, much quicker than an equivalent VM.

Being non-persistent, you can't normally customize it to use Dark Mode because it isn't activated.

That said, you don't need an activated Windows in order to enable dark mode.

I've attached a zip file that will allow you to do this.

Prerequisite:  You'll need to create the C:\sandbox folder, and copy the contents of the zip into it.  The zip contains the configuration file (sandbox.wsb) and a logon script I created (sbox.cmd) that configures things.

You will obviously also need Windows Sandbox installed.  Instructions here: Install Windows Sandbox

See screenshot to see DarkMode on an un-activated Windows Sandbox instance in action.  It's slightly hacky, but it works for me.

AIR.

Took a stab at creating a Snippet Manager in BCX.  This started as an experiment with Windows DarkMode, and runs okay on my Win11Pro 23H2 system.

Note:  This successfully builds using the included _build.cmd file and Pelles.  There's some DarkMode issues when building with MSVC with the ListView.

This is a DarkMode app (see screenshots); I didn't include a way to toggle that because it would require additional conditional code blocks and I'm lazy. 

Modify the section at the top of the cmd file to specify your paths to Pelles and BCX.

This is using the RaEdit C conversion, and Sqlite.

Additional note:  The sqlite3.dll and the snippets.db files MUST be in the same location as the BMagic.exe executable.

Released with an MIT License, do with it as you will....

AIR.

Quote from: MSDN
Control Spy is a tool that helps developers understand common controls: how to apply
styles to them, and how they respond to messages and notifications. Using Control Spy,
you can immediately see how different styles affect the behavior and appearance of
each control, and also how you can change the state of each control by sending
messages.

Stumbled across this while perusing some win32 docs...

Download Link

AIR.

Hi, Kevin.

Would it be possible to add WM_CONTEXTMENU to the "SplitterWndProc" so that it gets passed to the Parent hWnd?

This would be around line 33342 in BC.bas

        FPRINT FP_WRITE, "    if (msg==WM_COMMAND || msg==WM_NOTIFY || msg==WM_HSCROLL || msg==WM_VSCROLL || msg==WM_CTLCOLOREDIT ||"
        FPRINT FP_WRITE, "        msg==WM_CTLCOLORSTATIC || msg==WM_CTLCOLORBTN || msg==WM_CTLCOLORLISTBOX ||msg==WM_CTLCOLORSCROLLBAR ||"
        FPRINT FP_WRITE, "        msg==WM_MEASUREITEM || msg==WM_DRAWITEM)"
        FPRINT FP_WRITE, "    {"
        FPRINT FP_WRITE, "      return SendMessage(GetParent(hwnd), (UINT_PTR)msg, (WPARAM)wParam, (LPARAM)lParam);"
        FPRINT FP_WRITE, "    }"


I'm working with the Splitter object in a project, and it almost drove me crazy as to why I couldn't display a context menu, until I looked at the generated C source.

Sneak peak of what I'm working on is attached. 

AIR.

Years ago, MrB posted several items to the old Yahoo mailing list regarding opening control panel items using BCX.

They basically consisted of items like:

Shell "rundll32.exe shell32.dll,Control_RunDLL appwiz.cpl"

I wondered if there was a way to call "Control_RunDLL" directly from shell32.dll, so here's my approach:

Declare Sub Control_RunDLL lib "shell32.dll" Alias "Control_RunDLL"(hwnd As HWND, hinstance As HINSTANCE, Panel As String, item As Int)

Function WinMain()
    Control_RunDLL(Null, Null, "appwiz.cpl", 0)
    Return 0
End Function


I'm using WinMain so you don't get the momentary console showing, so you'll need to compile this as a GUI app.

Not really useful, was more of a mental exercise on my part...and BCX makes it dead simple.....

AIR.

Since I code in multiple languages on multiple platforms, I've used the massCode snippet manager for a few years now.


One of the downsides is that it doesn't support merging separate snippet db files.  Which can be a problem when working on different systems where the db isn't in a shared, centralized location.

The developer has been asked off and on the last few years about implementing this, but hasn't.

So I took matters into my own hands and created a command-line utility to properly merge databases.

It's on my personal git repository, if anyone is interested, coded in BCX.

Quote from: Here's the blurb from my README:
masscode_merge

Utility to merge massCode snippet databases

massCode, a cross-platform snippet manager, currently doesn't have native support for merging separate snippet databases.

I needed to merge databases from my Mac and PC into a new unified database.

So, masscode_merge was born.

masscode_merge processes both db files, and merges then into a single db file, preserving folder structures, including nested folders, while avoiding duplicates.

It is coded in BCX, which is a Basic to C/C++ transpiler, and uses the Parson json library.

It is currently Windows-only, but Linux and macOS versions are being worked on.

How to use, once compiled

Usage: merge_masscode.exe <file1.db> <file2.db>

AIR.

TIME$ currently only returns 24 hour format for the hour.

Can we add an option to return 12 hour format for the hour?


$typedef struct tm tm

dim as time_t elapse_time
dim strtmp$*256
dim as tm ptr tp


time(&elapse_time)
tp = localtime(&elapse_time)

strftime(strtmp, 256, "%I:%M:%S %p", tp)

print strtmp
pause


AIR.

Quote from: MrBcx on September 10, 2024, 10:00:08 PM

*  BCX 8.1.7 will support all of these loop-local iterator types:
        SINGLE, DOUBLE, FLOAT, INTEGER, INT, LONG, LLONG, LONGLONG, SIZE_T,
        UINT, UINT64, ULONG, ULONGLONG, CHAR, UCHAR, BYTE, UBYTE, SBYTE


For example:  FOR ULONGLONG = 1 to 10

I realize some of those data types are duplicates with only different names but
I try to make things a little easier on users with certain naming preferences.

Will PRINT be extended to support the various *LONG variables at some point as well?

Right now, I have to use printf() with the 'E' sigil in order to print ULONGLONG without a scratch variable...

By way of example:


Function main(argc as int, argv as PCHAR Ptr)

    dim as MEMORYSTATUSEX mem
   
    mem.dwLength = sizeof(mem)
   
    dim as int r = GlobalMemoryStatusEx(&mem)
   
    if iszero(r) then
        print "Failed to get memory status. Code: ", GetLastError()
    end if
   
    with mem
        print "Memory in use:", .dwMemoryLoad, " percent."
        printf(E"Total Memory: %lld\n", .ullTotalPhys)
        printf(E"Free Phyical Memory: %lld\n", .ullAvailPhys)
        printf(E"Total Virtual Memory: %lld\n", .ullTotalVirtual)
        printf(E"Free virtual memory: %lld\n", .ullAvailVirtual)
    end with
    pause
End Function



AIR.

After spending the entire weekend trying to get Microsoft's CNG Encryption working, I decided to go in a different direction.

libsodium to the rescue.  Took about 90 min (in between stuff for work) to get this demo going.

Encrypt.bas

$HEADER
    #include "include\sodium.h"
    #define AES_KEYLEN crypto_aead_chacha20poly1305_KEYBYTES
    #define HMAC_KEYLEN crypto_auth_hmacsha256_KEYBYTES
    #define HMAC_LEN crypto_auth_hmacsha256_BYTES
    #define SALT_SIZE crypto_pwhash_SALTBYTES
    #define NONCE_SIZE crypto_aead_chacha20poly1305_NPUBBYTES
    #define CHUNK_SIZE 4096  // Size of chunks for encryption
$HEADER

$Library "libsodium.lib"

Function main(argc as integer, argv as pchar ptr)
    Dim As String password, filename, output_filename
    Dim As Int result

    ' Prompt User for input/output filenames, and Password
    Input "Enter Input Filename: ", filename
    Input "Enter Output Filename: ", output_filename
    Input "Enter Password to Encrypt: ", password

    ' Encrypt the file, saving to output filename
    result = encrypt(filename, output_filename, password)

    Return result

End Function

Function encrypt(filename as string, output_filename as string, password as string) as int
    Dim As UCHAR aes_key[AES_KEYLEN], hmac_key[HMAC_KEYLEN], salt[SALT_SIZE]
    Dim As UCHAR nonce[NONCE_SIZE], hmac_out[HMAC_LEN], chunk[CHUNK_SIZE]
    Dim As UCHAR encrypted_chunk[CHUNK_SIZE + crypto_aead_chacha20poly1305_ABYTES]
    Dim As ULONGLONG encrypted_chunk_len

    ' // Generate salt for key derivation
    randombytes_buf(salt, sizeof(salt));

    ' // Derive AES and HMAC keys from the password
    if crypto_pwhash(aes_key, sizeof(aes_key), password, len(password), salt, crypto_pwhash_OPSLIMIT_MIN, crypto_pwhash_MEMLIMIT_MIN, crypto_pwhash_ALG_DEFAULT) != 0 Then
        Print "Key derivation failed."
        return 1
    end if
    if crypto_pwhash(hmac_key, sizeof(hmac_key), password, len(password), salt, crypto_pwhash_OPSLIMIT_MIN, crypto_pwhash_MEMLIMIT_MIN, crypto_pwhash_ALG_DEFAULT) != 0 Then
        Print "Key derivation failed."
        return 1
    end if

    ' // Encrypt
    randombytes_buf(nonce, sizeof(nonce));

    ' Open Input and Output files
    Open filename For Binary Input as input_file
    Open output_filename For Binary New as output_file

    ' // Write salt and nonce to the output file
    Put$ output_file, salt, sizeof(salt)
    Put$ output_file, nonce, sizeof(nonce)

    ' // Encrypt data in chunks
    while (1)
        Dim As size_t bytes_read = fread(chunk, 1, sizeof(chunk), input_file);
        if bytes_read = 0 then Exit While

        if crypto_aead_chacha20poly1305_encrypt(encrypted_chunk, &encrypted_chunk_len, chunk, bytes_read, NULL, 0, NULL, nonce, aes_key) != 0 Then
            Close input_file
            Close output_file
            Print  "Encryption failed."
            return 1
        End If

        ' Write the current chuck to output_file
        Put$ output_file, encrypted_chunk, encrypted_chunk_len
    Wend

    ' Cleanup
    Close input_file
    Close output_file

    Print "Data written to file successfully."

    Return 0
End Function


Decrypt.bas

$HEADER
    #include "include\sodium.h"
    #define AES_KEYLEN crypto_aead_chacha20poly1305_KEYBYTES
    #define HMAC_KEYLEN crypto_auth_hmacsha256_KEYBYTES
    #define HMAC_LEN crypto_auth_hmacsha256_BYTES
    #define SALT_SIZE crypto_pwhash_SALTBYTES
    #define NONCE_SIZE crypto_aead_chacha20poly1305_NPUBBYTES
    #define CHUNK_SIZE 4096  // Size of chunks for encryption
$HEADER

$Library "libsodium.lib"

Function main(argc as integer, argv as pchar ptr)
    Dim As String password, filename, output_filename
    Dim As Int result

    ' Prompt User for input/output filenames, and Password
    Input "Enter Input Filename: ", filename
    Input "Enter Output Filename: ", output_filename
    Input "Enter Password to Decrypt: ", password

    ' Decrypt the file, saving to output filename
    result = decrypt(filename, output_filename, password)

    Return result

End Function

Function decrypt(filename as string, output_filename as string, password as string) as int
    Dim As UCHAR aes_key[AES_KEYLEN], hmac_key[HMAC_KEYLEN], salt[SALT_SIZE]
    Dim As UCHAR nonce[NONCE_SIZE], decrypted_chunk[CHUNK_SIZE]
    Dim As UCHAR chunk[CHUNK_SIZE + crypto_aead_chacha20poly1305_ABYTES]
    Dim As ULONGLONG decrypted_chunk_len, chunk_len

    ' Open Input and Output files
    Open filename For Binary Input as input_file
    Open output_filename For Binary New as output_file

    ' Read salt and nonce from the input file
    Get$ input_file, salt, sizeof(salt)
    Get$ input_file, nonce, sizeof(nonce)

    ' Derive AES and HMAC keys from the password
    if crypto_pwhash(aes_key, sizeof(aes_key), password, len(password), salt, crypto_pwhash_OPSLIMIT_MIN, crypto_pwhash_MEMLIMIT_MIN, crypto_pwhash_ALG_DEFAULT) != 0 Then
        Print "Key derivation failed."
        return 1
    end if

    if crypto_pwhash(hmac_key, sizeof(hmac_key), password, len(password), salt, crypto_pwhash_OPSLIMIT_MIN, crypto_pwhash_MEMLIMIT_MIN, crypto_pwhash_ALG_DEFAULT) != 0 Then
        Print "Key derivation failed."
        return 1
    end if   

    ' Decrypt data in chunks
    While True
        chunk_len = fread(chunk, 1, sizeof(chunk), input_file)
        If chunk_len = 0 Then Exit While

        If crypto_aead_chacha20poly1305_decrypt(decrypted_chunk, &decrypted_chunk_len, NULL, chunk, chunk_len, NULL, 0, nonce, aes_key) != 0 Then
            Close input_file
            Close output_file
            Print "Decryption failed."
            return 1;
        End If 

        Put$ output_file, decrypted_chunk, decrypted_chunk_len     
    Wend

    ' Cleanup
    Close input_file
    Close output_file

    Print "Data read from file and decrypted successfully."

    Return 0
End Function

Tested with a 900mb video file.  Compiles with both Pelles and MSVC.

Support files attached below.

AIR.

Had a play with Windows Cryptography over to last 2 days, in an attempt to encrypt/decrypt files.

The code below (which I would like another set of eyes on) appears to successfully encrypt and decrypt both text and pure binary files.

I fed it the 3.2MB War and Peace.txt file from Project Gutenberg;  I also fed it a monster 500MB file without any apparent issue as well as some .exe, .dll and graphics files.

I cobbled this together after using ChatGPT, Microsoft's Cryptography page, and a few other random websites, but I'm not 100% I got it all right.


$HEADER
    #include <wincrypt.h>
$HEADER

Macro BUFFER_SIZE = 4096
Macro AES_KEY_LENGTH = 32
Macro AES_BLOCK_SIZE = 16

Function main(argc as integer, argv as pchar ptr)
    Dim As Byte key[AES_KEY_LENGTH], iv[AES_BLOCK_SIZE]
    Dim As String password = "izrk8TKGI646aFE3AcQWydbwRsLu2xUI"

    memcpy(key, password, len(password))
    ' memset(key, 0x00, sizeof(key))
    memset(iv, 0x00, sizeof(iv))
    encryptFile("ByteReader.jpg", "encrypt.bin", key, iv)
    decryptFile("encrypt.bin","b.jpg", key, iv)

End Function

Sub handleError(message$)
    dim buffer$*BUFFER_SIZE
    FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM OR FORMAT_MESSAGE_IGNORE_INSERTS,Null,GetLastError(),MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT),buffer,BUFFER_SIZE,Null)
    Print message$, " Error Text: ", buffer$
    end = EXIT_FAILURE
End Sub

Sub encryptFile(inputFileName$, outputFileName$, key as Byte Ptr, iv as Byte Ptr)
    Dim As HCRYPTPROV hProv
    Dim As HCRYPTKEY hKey
    Dim As HCRYPTHASH hHash
    Dim As Byte buffer[BUFFER_SIZE]
    Dim As DWORD bytesRead, bytesWritten, bufferSize, dataSize
    Dim As Bool flag = False

    If Not CryptAcquireContext(&hProv, Null, Null, PROV_RSA_AES, CRYPT_VERIFYCONTEXT) Then handleError("CryptAquireContext Failed")
    If Not CryptCreateHash(hProv, CALG_SHA_256, 0, 0, &hHash) Then handleError("CryptCreateHash Failed")
    If Not CryptHashData(hHash, key, AES_KEY_LENGTH, 0) Then handleError("CryptHashData Failed")
    If Not CryptDeriveKey(hProv, CALG_AES_256, hHash, 0, &hKey) Then handleError("CryptDeriveKey Failed")
    if Not CryptSetKeyParam(hKey, KP_IV, iv, 0) Then handleError("CryptSetKeyParam Failed")
 
    dim as HANDLE hInputFile = CreateFile(inputFileName$, GENERIC_READ, 0, Null, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL,Null)
    dim as HANDLE hOutputFile = CreateFile(outputFileName$, GENERIC_WRITE, 0, Null, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, Null)

    If hInputFile = INVALID_HANDLE_VALUE Or hOutputFile = INVALID_HANDLE_VALUE Then handleError("Failed to open file.")

    While ReadFile(hInputFile, buffer, BUFFER_SIZE, &bytesRead, Null) And bytesRead > 0
        bufferSize = bytesRead
        If bytesRead < BUFFER_SIZE Then flag = True
       
        CryptEncrypt(hKey, 0, flag, 0, buffer, &bytesRead, bufferSize)

        if not WriteFile(hOutputFile, buffer, bufferSize, &bytesWritten, Null) Then handleError("WriteFile Failed.")
    Wend

    CryptDestroyKey(hKey)
    CryptDestroyHash(hHash)
    CryptReleaseContext(hProv, 0)
    If hInputFile Then CloseHandle(hInputFile)
    If hOutputFile Then CloseHandle(hOutputFile)

End Sub

Sub decryptFile(inputFileName$, outputFileName$, key as Byte Ptr, iv as Byte Ptr)
     Dim As HCRYPTPROV hProv
    Dim As HCRYPTKEY hKey
    Dim As HCRYPTHASH hHash
    Dim As Byte buffer[BUFFER_SIZE]
    Dim As DWORD bytesRead, bytesWritten, bufferSize, dataSize
    Dim As Bool flag = False

    If Not CryptAcquireContext(&hProv, Null, Null, PROV_RSA_AES, CRYPT_VERIFYCONTEXT) Then handleError("CryptAquireContext Failed")
    If Not CryptCreateHash(hProv, CALG_SHA_256, 0, 0, &hHash) Then handleError("CryptCreateHash Failed")
    If Not CryptHashData(hHash, key, AES_KEY_LENGTH, 0) Then handleError("CryptHashData Failed")
    If Not CryptDeriveKey(hProv, CALG_AES_256, hHash, 0, &hKey) Then handleError("CryptDeriveKey Failed")
    if Not CryptSetKeyParam(hKey, KP_IV, iv, 0) Then handleError("CryptSetKeyParam Failed")
 
    dim as HANDLE hInputFile = CreateFile(inputFileName$, GENERIC_READ, 0, Null, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL,Null)
    dim as HANDLE hOutputFile = CreateFile(outputFileName$, GENERIC_WRITE, 0, Null, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, Null)

    If hInputFile = INVALID_HANDLE_VALUE Or hOutputFile = INVALID_HANDLE_VALUE Then handleError("Failed to open file.")

    While ReadFile(hInputFile, buffer, BUFFER_SIZE, &bytesRead, Null) And bytesRead > 0
        bufferSize = bytesRead
        If bytesRead < BUFFER_SIZE Then flag = True
       
        CryptDecrypt(hKey, 0, flag, 0, buffer, &bufferSize)

        if not WriteFile(hOutputFile, buffer, bufferSize, &bytesWritten, Null) Then handleError("WriteFile Failed.")
    Wend

    CryptDestroyKey(hKey)
    CryptDestroyHash(hHash)
    CryptReleaseContext(hProv, 0)
    If hInputFile Then CloseHandle(hInputFile)
    If hOutputFile Then CloseHandle(hOutputFile)

End Sub



AIR.

Ported BCX AND BED to Windows ARM64.  I was bored so....

Compiled using MSVC ARM, on my M1 Mac Mini running an ARM64 version of Windows 11 Enterprise in a Virtual Machine.  Had to compile Scintilla/Lexilla in ARM64 also.

Don't know if there's much interest at this point, but I've been wanting to try this for a while.  At any rate, both work for when we're ready to make the jump!

Screenshot attached.

AIR.

Stumbled across this site recently via github:  https://it-tools.tech/

Lots of interesting web-based stuff there, from password checkers/generators, various hashing utils, conversion tools, etc...

AIR.

I was working on this last night.  It's not done, but wanted to know if anyone knows a way to have this ignore the "Show Desktop" minimize all apps feature:


GUI "Demo"
$NOWIN

MACRO HKLM = HKEY_LOCAL_MACHINE
MACRO REGKEY = "SOFTWARE\Microsoft\Windows NT\CurrentVersion"

$Library <dnsapi.lib>
$Library <iphlpapi.lib>
$Library <ws2_32.lib>

#include <winsock2.h>
' #include <windows.h>

#include <commctrl.h>
#include <iphlpapi.h>
#include <sysinfoapi.h>
#include <windns.h>

SUB FORMLOAD
    GLOBAL AS CONTROL FORM1, lblComputerName, lblUserName, lblLocalIP, lblMacAddress, lblUpTime, lblOSName, lblOSVersion
    GLOBAL mac_address$, internal_ip$, user_name$, computer_name$, up_time$, external_ip_address$, up_time$, os_name$, os_version$
    GLOBAL buf_size = 2048 AS DWORD
    GLOBAL hThread as HANDLE
   

    ' ? STR$(BCX_ScaleX)
    DIM AS int screenWidth = GetSystemMetrics(SM_CXSCREEN)
    dim as int windowWidth = 400
    dim as int xPos = (screenWidth - windowWidth)/BCX_ScaleX

    FORM1 = BCX_FORM( "Transparent Form",xPos,0,windowWidth,140, WS_POPUP,  WS_EX_LAYERED OR WS_EX_TOOLWINDOW)
    BCX_SET_FORM_COLOR(FORM1,QBCOLOR(0))
    SetLayeredWindowAttributes(FORM1, 0, QBCOLOR(0), LWA_COLORKEY)

    setup()


    ' CENTER FORM1
    SHOW   FORM1
END SUB

BEGIN EVENTS
    SELECT CASE CBMSG
        CASE WM_CTLCOLORSTATIC
            SELECT CASE (HWND) CBLPARAM
                CASE lblUserName, lblComputerName, lblLocalIP, lblMacAddress, lblUpTime, lblOSName, lblOSVersion
                    RETURN BCX_SETCOLOR(QBCOLOR(15), QBCOLOR(0))
            END SELECT
    END SELECT
END EVENTS

SUB setup()
    GetUserName(user_name$, &buf_size)
    ' GetComputerName(computer_name$, &buf_size)
    computer_name$ = ENVIRON$("COMPUTERNAME")
    internal_ip$ = getActiveIP()
    external_ip_address$ = getExternalIP()
    getMacAddress(internal_ip$, mac_address$) 
    up_time$ = getUptime() 
    os_name$ = getOSName()
    os_version$ = getOSVersionNumber()

    lblComputerName = BCX_LABEL(computer_name$, FORM1, 0, 0, 10, 400, 20)
    lblOSName = BCX_LABEL("OSName: " & os_name$, FORM1, 0, 0, 30, 400, 20)
    lblOSVersion = BCX_LABEL("OSVersion: " & os_version$, FORM1, 0, 0, 50, 400, 20)
    lblUpTime = BCX_LABEL("UpTime: " & up_time$, FORM1, 0, 0, 70, 400, 20)
    lblUserName = BCX_LABEL("UserName: " & user_name$, FORM1, 0, 0,90,400,20)
    lblLocalIP = BCX_LABEL("IPAddress: " & internal_ip$, FORM1, 0, 0,110,400,20)
    lblMacAddress = BCX_LABEL("MacAddress: " & mac_address$, FORM1, 0, 0, 130, 400, 20)
   

    BCX_SET_FONT(lblComputerName, "Calibri", 18, FW_BOLD, false, true)
    BCX_SET_FONT(lblUserName, "Calibri", 14, FW_BOLD)
    BCX_SET_FONT(lblLocalIP, "Calibri", 14, FW_BOLD)
    BCX_SET_FONT(lblMacAddress, "Calibri", 14, FW_BOLD)
    BCX_SET_FONT(lblUpTime, "Calibri", 14, FW_BOLD)   
    BCX_SET_FONT(lblOSName, "Calibri", 14, FW_BOLD)
    BCX_SET_FONT(lblOSVersion, "Calibri", 14, FW_BOLD)
    hThread = BCX_THREAD(update)
END SUB

SUB update()
    WHILE TRUE
        DELAY 10 ' wait 10 seconds
        up_time$ = getUptime()
        BCX_SET_TEXT(lblUpTime, "UpTime: " & up_time$)
        ' refresh(FORM1)
        ' InvalidateRect(FORM1, 0, 1)
    WEND
END SUB

SUB getMacAddress(ip$, var$)
    DIM AdapterInfo[32] AS IP_ADAPTER_INFO, dwBufLen AS DWORD, pAdapterInfo AS PIP_ADAPTER_INFO
    DIM szBuffer$

    dwBufLen = SIZEOF(AdapterInfo)

    ' print GetAdaptersInfo(AdapterInfo, &dwBufLen)
    IF GetAdaptersInfo(AdapterInfo, &dwBufLen) != 0 THEN
        PRINT "Error initializing"
        EXIT SUB
    END IF

    pAdapterInfo = AdapterInfo

    WHILE pAdapterInfo

        IF TRIM$(pAdapterInfo->IpAddressList.IpAddress.String) = ip$ THEN
            SPRINT szBuffer$, HEX$(pAdapterInfo->Address[0]), ":", _
            HEX$(pAdapterInfo->Address[1]), ":", _
            HEX$(pAdapterInfo->Address[2]), ":", _
            HEX$(pAdapterInfo->Address[3]), ":", _
            HEX$(pAdapterInfo->Address[4]), ":", _
            HEX$(pAdapterInfo->Address[5])
            SPRINT var$, szBuffer
            EXIT WHILE
        END IF
        pAdapterInfo = pAdapterInfo->Next

    WEND

END SUB

FUNCTION getActiveIP$() AS STRING
    DIM socket_desc AS SOCKET, server AS SOCKADDR_IN, wsaData AS WSADATA
    DIM slen

    slen = SIZEOF(server)

    IF WSAStartup(MAKEWORD(1, 1), &wsaData) <> 0 THEN
        PRINT "WSAStartup failed"
        WSACleanup()
        RETURN ""
    END IF

    socket_desc = socket(AF_INET, SOCK_DGRAM, 0)
    IF socket_desc < 0 THEN
        PRINT "Socket Error"
        WSACleanup()
        FUNCTION = "Socket Error"
    END IF

    server.sin_addr.s_addr = inet_addr("1.0.0.0")
    server.sin_family = AF_INET
    server.sin_port = htons(65530)

    IF connect(socket_desc, (LPSOCKADDR)&server, SIZEOF(server)) < 0 THEN
        PRINT "Connect Error"
        WSACleanup()
        FUNCTION = "Connect Error"
    END IF

    getsockname(socket_desc,  (LPSOCKADDR)&server, &slen)

    WSACleanup()
    FUNCTION = inet_ntoa(server.sin_addr)
END FUNCTION

FUNCTION getUptime$()
    DIM STATIC tmp$
    DIM tc AS DWORD
    DIM days%, hours%, minutes%, seconds%

    tc = GetTickCount64()

    seconds% = IMOD((tc / 1000), 60)
    minutes% = IMOD((tc / 1000 / 60), 60)
    hours% =   IMOD((tc / 1000 / 60 / 60), 24 )
    days% =    IMOD((tc / 1000 / 60 / 60 / 24), 7)

    SPRINT tmp, days%, " Days,", hours%, " Hours,", minutes%, " Min,", seconds%, " Sec"

    FUNCTION = TRIM$(tmp)

END FUNCTION

FUNCTION getExternalIP$() AS STRING
    DIM status AS DNS_STATUS, pDnsRecord AS PDNS_RECORD
    RAW pSrvList AS PIP4_ARRAY
    DIM ipaddr AS IN_ADDR

    pSrvList = (PIP4_ARRAY)LocalAlloc(LPTR, SIZEOF(IP4_ARRAY))

    pSrvList->AddrCount = 1
    pSrvList->AddrArray[0] = inet_addr("208.67.222.222")

    status = DnsQuery("myip.opendns.com", DNS_TYPE_A, DNS_QUERY_BYPASS_CACHE, pSrvList, &pDnsRecord, NULL)

    LocalFree(pSrvList)

    IF status THEN
        PRINT "Failed to query the host record. Error is: ", status
        FUNCTION = "N/A"
    END IF

    ipaddr.S_un.S_addr = (pDnsRecord->Data.A.IpAddress)

    FUNCTION = inet_ntoa(ipaddr)
END FUNCTION

Function getOSName() as string
    dim as string szProductName, szDisplayVersion, szOSName

    szProductName = REGSTRING$(HKLM, REGKEY, "ProductName")
    szDisplayVersion = REGSTRING$(HKLM, REGKEY, "DisplayVersion")

    if val(regstring$(HKLM, REGKEY, "CurrentBuildNumber")) >= 22000 Then
        szProductName = replace$(szProductName, "10","11")
    end if

    sprint szOSName, szProductName,spc$,szDisplayVersion
   
    Return szOSName

End Function

Function getOSVersionNumber() as string
    dim as integer iMajorVersion, iMinorVersion, iInstallDate, iUBR
    dim as string szBuildNumber, szOSBuild

    iMajorVersion = regint(HKLM, REGKEY, "CurrentMajorVersionNumber")
    iMinorVersion = regint(HKLM, REGKEY, "CurrentMinorVersionNumber")
    szBuildNumber = regstring$(HKLM, REGKEY, "CurrentBuildNumber")
    iInstallDate = regint(HKLM, REGKEY, "InstallDate")
    iUBR = regint(HKLM, REGKEY, "UBR")

    sprint szOSBuild, iMajorVersion, ".", str$(iMinorVersion,1), ".",szBuildNumber, ".", str$(iUBR,1)

    return TRIM$(szOSBuild)
End Function



AIR.

Played around with the API for the National Weather Service today (https://www.weather.gov/documentation/services-web-api).

The API responds with JSON data, so I used the Parson json library (with a few fixes so it would compile cleanly with Pelles and MSVC).

Here's the code (see attachment for .bas file and Parson):


#include "parson.c"

type LOCATION
    zipcode as string
    country as string
    city as string
    state as string
    longitude as string
    latitude as string
end type


Function main(argc as integer, argv as pchar ptr)

    dim as LOCATION record
    dim head$

    if argc <> 2 then
        print "Usage: ", AppExeName$, " <US Zip Code>"
        end = 1
    end if
   
    set_location(&record,command$(1))

    sprint head$, "7 Day Forecast for ", record.city,", ",record.state,", ", record.zipcode

    ClearScreen()

    print repeat$(70, "-"),crlf$,cpad$(head$,70), crlf$, repeat$(70, "-")
    get_forecast(get_weather_url(record.latitude, record.longitude))

End Function

function get_text(json_object as JSON_Object Ptr, query as string) as string
    dim res as string

    if json_object_dotget_value(json_object, query) then
        res = json_object_dotget_string(json_object, query)
    end if

    function = res
end function

function load_json(filename as string) as JSON_Object Ptr
    dim as integer fileSize = lof(filename)
    dim as JSON_Value Ptr json
    dim as JSON_Object Ptr root
    dim jFile$*fileSize

    jFile$ = loadfile$(filename)
    json = json_parse_string(jFile)
    root = json_value_get_object(json)
   
    if root then return root
    return null

end function

Sub set_location(byref record as LOCATION, zip as string)
    dim as JSON_Object* root, obj
    dim as JSON_Array* place
    dim url$, path$

    sprint url$,"http://api.zippopotam.us/us/", zip
    sprint path$, tempdir$,"/location.json"


    If Download(url$, path$) Then

        root = load_json(path$)

        place = json_object_get_array(root, "places")
        obj = json_array_get_object (place, 0)

        with record
            .zipcode = get_text(root, "post code")
            .country = get_text(root, "country abbreviation")
            .city = get_text(obj, "place name")
            .state = get_text(obj, "state abbreviation")
            .longitude = get_text(obj, "longitude")
            .latitude = get_text(obj, "latitude")
        end with

        kill path$
    ELSE
        Print "Download Failed"
    End If

End Sub

Function get_weather_url(latitude as string, longitude as string) as string
    dim as JSON_Object* root
    dim url$, path$

    sprint url$,"https://api.weather.gov/points/",latitude,",",longitude
    sprint path$, tempdir$,"/api.json"

    If Download(url$, path$) Then
        root = load_json(path$)
        sprint url$, get_text(root, "properties.forecast")
        kill path$
        return url$
    End IF

    return ""

End Function

Sub get_forecast(url$)
    dim as JSON_Object* root, obj
    dim as JSON_Array* arr
    dim path$

    sprint path$, tempdir$,"/forcast.json"

    If Download(url$, path$) Then
        root = load_json(path$)
        arr = json_object_dotget_array(root, "properties.periods")
        for int i = 0 to json_array_get_count(arr)-1
            obj = json_array_get_object (arr, i)
            if json_object_get_boolean(obj,"isDaytime") then
                print crlf$,"Period: ", tab$,get_text(obj, "name")
                print "Temperature: ", tab$, str$(json_object_get_number(obj, "temperature"),1), get_text(obj, "temperatureUnit")
                print "Forecast: ", tab$, replace$(get_text(obj,"detailedForecast"),".","."+crlf$+space$(15))
                print repeat$(70,"-")
            end if
        next
        kill path$
    End if
End Sub

Sub ClearScreen()
    !printf("\33[1;1H\33[2J\33[3J");
End Sub



The data returned includes daytime and evening forecasts, but I filtered on daytime only in this demo.

AIR.

The CLS() function has one downside of sorts in my opinion.

While it clears the screen, it doesn't seem to clear the scrollback buffer.

So if you scroll up in the terminal window, whatever was there before the call to CLS() is still there.

Sure, we can use SYSTEM("cls") but that is potentially dangerous and isn't really an option.

I tried a bunch of different implementations, from Microsoft themselves to ChatGPT:  NONE cleared the scrollback buffer even though the code comments said that it would.  CONIO's clrscr() also didn't clear the buffer.

I recalled facing a similar issue with MBC (my old BCX port to macOS) which I was able to resolve back then.

With MBC, I resorted to using ANSI escape sequences to achieve clearing both the screen AND the scrollback buffer.

With nothing to lose, I tried it with BCX on a Win11 machine, with both MSVC and Pelles.  It worked!

It's really simple (although you may temporarily lose your vision if you stare at it for to long!), here's the function I used:


Sub ClearScreen()
    !printf("\33[1;1H\33[2J\33[3J");
End Sub


What I DON'T know is if it works on older versions of Windows. I only tested on Win11.

AIR.

In the "Com Programming Adventure" thread, I noted that querying the registry for OS info can return the incorrect OS name.

I threw the following together a little while ago that hopefully addresses that (needed this for work).

Can I ask someone who has Win10 (or anything other than Win11) to test this for me? It works on Win10 Enterprise and Win11 Enterprise at my job.

Thanks!



MACRO HKLM = HKEY_LOCAL_MACHINE
MACRO REGKEY = "SOFTWARE\Microsoft\Windows NT\CurrentVersion"

Function main(argc as integer, argv as pchar ptr)

    Print "OS Name: ", getOSName()
    Print "OS Version:", getOSVersionNumber()

    Pause   

End Function

Function getOSName() as string
    dim as string szProductName, szDisplayVersion, szOSName

    szProductName = REGSTRING$(HKLM, REGKEY, "ProductName")
    szDisplayVersion = REGSTRING$(HKLM, REGKEY, "DisplayVersion")

    if val(regstring$(HKLM, REGKEY, "CurrentBuildNumber")) >= 22000 Then
        szProductName = replace$(szProductName, "10","11")
    end if

    sprint szOSName, szProductName,spc$,szDisplayVersion
   
    Return szOSName

End Function

Function getOSVersionNumber() as string
    dim as integer iMajorVersion, iMinorVersion, iInstallDate, iUBR
    dim as string szBuildNumber, szOSBuild

    iMajorVersion = regint(HKLM, REGKEY, "CurrentMajorVersionNumber")
    iMinorVersion = regint(HKLM, REGKEY, "CurrentMinorVersionNumber")
    szBuildNumber = regstring$(HKLM, REGKEY, "CurrentBuildNumber")
    iInstallDate = regint(HKLM, REGKEY, "InstallDate")
    iUBR = regint(HKLM, REGKEY, "UBR")

    sprint szOSBuild, iMajorVersion, ".", str$(iMinorVersion,1), ".",szBuildNumber, ".", str$(iUBR,1)

    return szOSBuild
End Function


AIR.

Okay, this should be my last foray into using a zip library.

This is using libzip, which is used quite a bit in the wild, it seems.  I compiled the dll from source using VS2022.

https://libzip.org/

I abstracted most of this, to make it simple to use.

ZIP

$include "libzip/libzip.inc"

Function main(argc as integer, argv as pchar ptr)
    dim as zip_t ptr zip
    dim as int err = 0

    if ARGC < 3 then print "Usage: ", appexename$, " <filename.zip> [file(s) to add]": end = 1
   
    zip = open_zip(command$(1), err, ZIP_CREATE | ZIP_TRUNCATE)

    for int i = 2 to ARGC-1
        If GetAttr(command$(i)) = FILE_ATTRIBUTE_DIRECTORY Then
            addFolder(zip, command$(i))
        Else
            addFile(zip, command$(i), command$(i))
        End If
    next

    close_zip(zip)
End Function



UNZIP

$include "libzip/libzip.inc"

Function main(argc as integer, argv as pchar ptr)
    dim as string zip_file, dest_path

    if ARGC < 3 then print "Usage: ", appexename$, " <source.zip> <destination_folder>": end = 1

    zip_file = command$(1)
    dest_path = command$(2)

    unzip(zip_file, dest_path)
End Function


Required support files are in the attached zip file, created and tested with the code above.

AIR.

Looking around for an easy to use library to Zip a file, I came across: https://www.msweet.org/zipc/index.html

Pretty easy to use, I threw this together in about an hour.  My implementation also handles folders and nested folders.

Note that with PellesC, I had to change the C-Standard to C2X from C17 (included a _build.cmd script to handle this) to enable support for the localtime_r() function.

The attached Zip file was created using the code below....


#include "include/zipc.c"

$pragma comment (lib,"zlib.lib")

Function main(argc as integer, argv as pchar ptr)
    Dim As zipc_t*     zc ' ZIP CONTAINER

    If ARGC < 3 Then
        print "Usage: ", appexename$, " <filename.zip> [file(s) to add]"
        End = 1
    End IF

    zc = zipcOpen(command$(1), "w")
    If Not zc Then
        Print "zipOpen(", command$(1), wrap$("w"),") ", strerror(errno)
        End = 1
    End If

    for int i = 2 to ARGC-1
        If GetAttr(command$(i)) = FILE_ATTRIBUTE_DIRECTORY Then
            processFolder(zc, command$(i))
        Else
            zipcCopyFile(zc, command$(i), command$(i), 0, 1)
        End If
    next
    zipcClose(zc)   
End Function

Sub processFolder(zc as zipc_t ptr, foldername as string)
    Dim D$,filepath$

    D$ = FindFirst$(foldername + "\*.*")

    While D$ > ""
        if (D$ = "." or D$ = "..") Then D$ = FindNext$:continue
        sprint filepath$,foldername,"\",D$
        If GetAttr(filepath$) = FILE_ATTRIBUTE_DIRECTORY Then
            processFolder(zc,filepath$)           
        End IF
        zipcCopyFile(zc,filepath$, filepath$, 0, 1)
        D$ = FindNext$
    Wend

End Sub



AIR.

Give it a try and let me know your results....src$ and dest$ need to be full paths, I cheated and just put the zip file in the same directory as the code/exe and created the Macro so I don't have to type out the full paths by hand. 



MACRO DirName$ = replace$(command$(0),appexename$,"")

Dim As Object objShell, objZip
Dim src$, dest$


src$ = DirName$ + "Bcx809.zip"
dest$ = DirName$

set objShell = COM("Shell.Application")

Set objZip = objShell.NameSpace(src$).Items

objShell.NameSpace(dest$).CopyHere objZip, 16

print "DONE."

Set objZip = Nothing
Set objShell = Nothing




AIR.