From Raku/Perl6, how to read this registry key? - winapi

Windows
With Raku/Perl6, how do I use NativeCall to read the value of
[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\System\ "EnableLUA"]
with RegQueryValueExW?
https://learn.microsoft.com/en-us/windows/win32/api/winreg/nf-winreg-regqueryvalueexw
Many thanks,
-T
edit 12-27-2019 #1: removing bad code and inserting new code
This is how far I have gotten.
Test run string:
K:\Windows\NtUtil>perl6 -I. -e "use WinMount :GetLUA; say GetLUA();"
RegOpenKeyExW
RegOpenKeyExW RtnCode 0
RegQueryValueExW
1
2
RegQueryValueExW RtnCode 87 (87 = ERROR_INVALID_PARAMETER)
lpData pointer 0
lpcbData data length 0
RegCloseKey
RegCloseKey RtnCode 0
True
WinMount.pm6
# unit module WinMount;
# WinMount.pm6#`{
Utilities to mount and dismound drive partitions
Note: LUA must be unset (0x00000000) for mount to function prpoperly
raku -I. -c WinMount.pm6
}
use NativeCall;
use WinPopUps :WinMsg;
# Reference to types and values: http://dsource.org/projects/tango/ticket/820
constant BYTE := uint8;
constant WCHAR := uint16;
constant DWORD := int32;
constant REGSAM := int32;
constant WCHARS := CArray[WCHAR];
constant BYTES := CArray[BYTE];
constant HKEY_CURRENT_USER = 0x80000001;
constant HKEY_LOCAL_MACHINE = 0x80000002;
constant KEY_QUERY_VALUE = 1;
constant ERROR_SUCCESS = 0; # Yeah, I know. The Win-Api uses 0 for success and other values to indicate errors
constant REG_SZ = 1;
constant KEY_READ = 0x20019;
constant KEY_SET_VALUE = 0x0002;
constant REG_DWORD = 0x00000004;
sub to-c-str( Str $str ) returns CArray[WCHAR] is export( :to-c-str ) {
my #str := CArray[WCHAR].new;
for ( $str.comb ).kv -> $i, $char { #str[$i] = $char.ord; }
#str[ $str.chars ] = 0;
#str;
}
sub wstr( Str $str ) returns WCHARS is export( :wstr ) {
CArray[WCHAR].new( $str.comb.map: *.ord )
}
sub GetLUA() is export( :GetLUA ) {
#`{
Returns the LUA value in the registry to True (0x00000001) or False (0x00000000)
[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\System]
"EnableLUA"=dword:00000000
https://docs.perl6.org/language/nativecall
Win32 return codes:
https://learn.microsoft.com/en-us/windows/win32/debug/system-error-codes--0-499-
}
my Str $SubName = &?ROUTINE.name;
my Str $OS = $*KERNEL.name;
if not $OS eq "win32" { say "Sorry, $SubName only work in Windows."; exit; }
my Bool $LUA = True;
my $RtnCode;
my Str $SubKey = Q[SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\System\];
my Str $Key = Q[EnableLUA];
my $lpSubKey = wstr( $SubKey );
my $lpValueName = wstr( $Key );
# my $lpSubKey = CArray[uint8].new($Key.encode.list);
# my $lpValueName = CArray[uint8].new($SubKey.encode.list);
my int32 $Handle;
my int32 $ulOptions = 0;
my int32 $lpData;
my int32 $lpcbData;
my int32 $lpReserved = 1;
#`{
Open the key:
https://learn.microsoft.com/en-us/windows/win32/api/winreg/nf-winreg-regopenkeyexw
https://learn.microsoft.com/en-us/windows/win32/sysinfo/registry-key-security-and-access-rights
C++
LSTATUS RegOpenKeyExW(
HKEY hKey, # Hive name (HKEY_LOCAL_MACHINE)
LPCWSTR lpSubKey, # path to the key(/SOFTWARE/Microsoft/Windows/CurrentVersion/Policies/System/EnableLUA)
DWORD ulOptions, # 0
REGSAM samDesired, # KEY_READ (0x20019), KEY_SET_VALUE (0x0002)
PHKEY phkResult # A pointer to a variable that receives a handle to the opened key
);
}
say "RegOpenKeyExW";
sub RegOpenKeyExW( DWORD, WCHARS, DWORD, DWORD, DWORD is rw) is native("Kernel32.dll") returns DWORD { * };
$RtnCode = RegOpenKeyExW( HKEY_LOCAL_MACHINE, $lpSubKey, $ulOptions, KEY_READ, $Handle );
say "RegOpenKeyExW RtnCode $RtnCode\n";
#`{
Read the key:
use RegQueryValueExW if you know key and value name
https://learn.microsoft.com/en-us/windows/win32/api/winreg/nf-winreg-regqueryvalueexw
C++
LSTATUS RegQueryValueExW(
HKEY hKey, # Hive name (HKEY_LOCAL_MACHINE)
LPCWSTR lpValueName, # path to the key(\SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\System\EnableLUA)
LPDWORD lpReserved, # give it "int32" without the quotes to give it a NULL
LPDWORD lpType, # Registry Value Type (REG_DWORD which is 32 bit)
LPBYTE lpData, # Pointer to the return value
LPDWORD lpcbData # number of bytes in the return value
);
}
say "RegQueryValueExW";
sub RegQueryValueExW( DWORD, WCHARS, DWORD, DWORD, DWORD is rw, DWORD is rw ) is native("Kernel32.dll") returns DWORD { * };
say "1";
$RtnCode = RegQueryValueExW( $Handle, $lpValueName, $lpReserved, REG_DWORD, $lpData, $lpcbData );
say "2";
say "RegQueryValueExW RtnCode $RtnCode (87 = ERROR_INVALID_PARAMETER)\nlpData pointer $lpData\nlpcbData data length $lpcbData\n";
#`{
Close the key
https://learn.microsoft.com/en-us/windows/win32/api/winreg/nf-winreg-regclosekey
C++
LSTATUS RegCloseKey(
HKEY hKey # handle to the open key to be closed. See RegOpenKeyExW phkResult
);
}
say "RegCloseKey";
sub RegCloseKey( DWORD ) is native("Kernel32.dll") returns DWORD { * };
$RtnCode = RegCloseKey( $Handle );
say "RegCloseKey RtnCode $RtnCode\n";
return $LUA;
}

Here's what I have so far. I am able to successfully retrieve the handle for the registry key, but when I try to read the key it throws "Native call expected argument that references a native integer, but got P6int". And I don't know why yet. But I figured I post this already, maybe someone else can shed some light.
use NativeCall;
constant BYTE := uint8;
constant WCHAR := uint16;
constant DWORD := int32;
constant REGSAM := int32;
constant WCHARS := CArray[WCHAR];
constant BYTES := CArray[BYTE];
constant HKEY_CURRENT_USER = 0x80000001;
constant HKEY_LOCAL_MACHINE = 0x80000002;
constant KEY_QUERY_VALUE = 1;
constant ERROR_SUCCESS = 0; # Yeah, I know. The Win-Api uses 0 for success and other values to indicate errors
constant REG_SZ = 1;
sub RegOpenKeyExW( DWORD, WCHARS, DWORD, REGSAM, DWORD is rw) is native("Kernel32.dll") returns DWORD { * };
#DWORD RegOpenKeyExW(
# HKEY hKey,
# LPCWSTR lpSubKey,
# DWORD ulOptions,
# REGSAM samDesired,
# PHKEY phkResult
#);
sub RegQueryValueExW( DWORD, WCHARS, DWORD is rw, DWORD is rw, BYTE is rw, DWORD is rw) is native("Kernel32.dll") returns DWORD { * };
#DWORD RegQueryValueExW(
# HKEY hKey,
# LPCWSTR lpValueName,
# LPDWORD lpReserved,
# LPDWORD lpType,
# LPBYTE lpData,
# LPDWORD lpcbData
#);
my $key = 'SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\System';
my DWORD $hkey;
my $length = 1024;
if RegOpenKeyExW(HKEY_LOCAL_MACHINE, wstr($key), 0, KEY_QUERY_VALUE, $hkey) == ERROR_SUCCESS
{
say "Got handle: $hkey";
my BYTES $buffer = CArray[BYTE].new( 0 xx 1024 );
# throws "Native call expected argument that references a native integer, but got P6int"
if RegQueryValueExW( $hkey, WCHARS, DWORD, REG_SZ, $buffer, $length ) == ERROR_SUCCESS
{
say "Got data of length $length";
say gather for 0 .. $length { take $buffer[$_] };
}
}
sub wstr( Str $str ) returns WCHARS {
CArray[WCHAR].new( $str.comb.map: *.ord )
}

Related

NativeCall to Windows API function RegEnumKeyExW resulting in inconsistent and incomplete output

I have some Raku code using the NativeCall module to make calls to the Windows API:
#! /usr/bin/env raku
use v6;
use NativeCall;
constant BYTE = uint8;
constant WCHAR = uint16;
constant DWORD = int32;
constant REGSAM = int32;
constant WCHARS = CArray[WCHAR];
constant BYTES = CArray[BYTE];
constant HKEY_LOCAL_MACHINE = 0x80000002;
constant KEY_QUERY_VALUE = 0x1 +| 0x0008;
constant ERROR_SUCCESS = 0; # Yeah, I know. The Win-Api uses 0 for success and other values to indicate errors
sub RegOpenKeyExW( DWORD, WCHARS, DWORD, REGSAM, DWORD is rw) is native("Kernel32.dll") returns DWORD { * };
sub RegQueryValueExW( DWORD, WCHARS, DWORD is rw, DWORD is rw, BYTE is rw, DWORD is rw) is native("Kernel32.dll") returns DWORD { * };
my $key = 'SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths';
my DWORD $hkey;
my $length = 1024;
sub wstr( Str $str ) returns WCHARS {
my $return = CArray[WCHAR].new( $str.encode.list );
$return[$return.elems] = 0;
return $return;
}
my $h-key = RegOpenKeyExW(HKEY_LOCAL_MACHINE, wstr($key), 0, KEY_QUERY_VALUE, $hkey);
say "hkey: $hkey";
sub RegQueryInfoKeyW( int32, int32, int32, int32, int32 is rw, int32 is rw, int32, int32, int32, int32, int32, int32 ) returns int32 is native('kernel32') { * };
my $blah = RegQueryInfoKeyW( $hkey, 0, 0, 0, my int32 $num-subkeys, my int32 $max-sk-len, 0, 0, 0, 0, 0, 0);
say 'max subkey length: ' ~ $max-sk-len;
#arg name
#1 hkey: handle to an open reg. key
#2 dwIndex: the index of the subkey to retrieve
#3 lpName: pointer to a buffer
#4 lpccName: pointer to a variable that specifies the size of the buffer specified by lpName param
#5 lpReserved: unused
#6 lpClass: pointer to a buffer, can be null
#7 lpcchClass: pointer to a variable, can be null
#8 lpftLastWriteTime: pointer to a file structure, can be null
sub RegEnumKeyExW(
int32, # 1
int32, # 2
CArray[uint16], # 3
int32 is rw, # 4
int32, # 5
CArray[int16], # 6
int32, # 7
int32 # 8
) returns int32 is native('kernel32') { * };
my $count;
for 0..$num-subkeys - 1 {
my $subkeyname = CArray[uint16].new;
$subkeyname[$_] = 0 for 0..$max-sk-len;
say 'bing';
my $result = RegEnumKeyExW($hkey, $_, $subkeyname, $max-sk-len + 1, 0, CArray[int16], 0, 0);
say 'bang';
my $name = '';
for 0..$max-sk-len - 1 {
$name ~= chr($subkeyname[$_]);
}
say $name;
say '';
$count++;
}
say $count;
Weirdly, the code only partially works. The last for loop in the code, which repeatedly calls RegEnumKeyExW does not iterate over the entire number of subkeys and crashes, resulting in output that looks like this:
PS Z:\devel> raku RegOpenKeyExW.raku
hkey: 588
max subkey length: 26
bing
bang
cmmgr32.exe
bing
bang
dfshim.dll
bing
bang
fsquirt.exe
<snip>
bing
bang
wab.exe
bing
bang
wabmig.exe
bing
bang
wmplayer.exe
bing
The call to RegEnumKeyExW just suddenly craps out with no warning. Sometimes the call makes it through 10 iterations, sometimes fewer and sometimes less, but it never makes it through the whole loop.
Anyone have any ideas what the problem might be?
UPDATE: Very weirdly, if I tighten up the last loop and remove all extraneous print statements and the inner loop that builds the $subkyename, all the subkeys are iterated over successfully (the looping finishes).
If I modify the last loop to include an inner loop to print characters to the screen, the number of iterations that succeed is dependent upon the number of characters printed as set by the $printx variable. So with a large number of characters printed, say 1000, the loop only completes once before failing. If I print out a only 5 characters, the loop will make it through about 15 iterations. If I remove the inner loop that prints characters, the loop finishes every time. See:
my $count;
my $printx = 5; # changing this value higher or lower will change how many iterations complete before an iteration fails.
for 0..$num-subkeys - 1 {
my $subkeyname = CArray[uint16].new;
$subkeyname[$_] = 0 for 0..$max-sk-len;
say 'bing';
my $result = RegEnumKeyExW($hkey, $_, $subkeyname, $max-sk-len + 1, 0, CArray[int16], 0, 0);
for 0..$printx {
print 'x';
}
$count++;
}
say $count;
UPDATE #2: If I get rid of the loop and replace it with 19 (the number of subkeys) manually typed out calls to RegEnumKeyExW, everything works perfectly.
A knowledgeable person on raku-irc had me set MVM_SPESH_DISABLE=1 in the powershell environment. Once set, the problem was resolved. So there is some kind of bug with the Moar VM.
I found a workaround, which is to move the RegEnumKeyExW function into the loop:
for 0..$num-subkeys - 1 {
#arg name
#1 hkey: handle to an open reg. key
#2 dwIndex: the index of the subkey to retrieve
#3 lpName: pointer to a buffer
#4 lpccName: pointer to a variable that specifies the size of the buffer specified by lpName param
#5 lpReserved: unused
#6 lpClass: pointer to a buffer, can be null
#7 lpcchClass: pointer to a variable, can be null
#8 lpftLastWriteTime: pointer to a file structure, can be null
sub RegEnumKeyExW(
int32, # 1
int32, # 2
CArray[uint16], # 3
int32 is rw, # 4
int32, # 5
CArray[int16], # 6
int32, # 7
int32 # 8
) returns int32 is native('kernel32') { * };
my $subkeyname = CArray[uint16].new;
$subkeyname[$_] = 0 for 0..$max-sk-len;
my $result = RegEnumKeyExW($hkey, $_, $subkeyname, $max-sk-len + 1, 0, CArray[int16], 0, 0);
for 1..200 {
print 'x';
}
my $name = '';
for 0..$max-sk-len - 1 {
$name ~= chr($subkeyname[$_]);
}
say $name;
}

NtReadFile not properly reading the file

I am attempting to read ntdl.dll from disk using the NtReadFile native call. A handle has already been acquired through the NtCreateFile native call. However, when I attempt to read it using NtReadFIle, it neither fails nor succeeds. I try to print out the NtStatus, but there's nothing, as it looks like the call never actually completes. It does seem to work with the ReadFile Win API call, so not quite sure why the native call isn't working.
In the debugger, it seems like an unhandled exception is raised when transitioning back to userland after making the syscall, so not sure what is going on. Below is a snippet of the code.
#define OBJ_CASE_INSENSITIVE 0x00000040
#define FILE_OPEN 0x00000001
#define FILE_DIRECTORY_FILE 0x00000001
#define FILE_NON_DIRECTORY_FILE 0x00000040
#define FILE_RANDOM_ACCESS 0x00000800
#define FILE_OPEN_BY_FILE_ID 0x00002000
#define FILE_SYNCHRONOUS_IO_NONALERT 0x00000020
SIZE_T bytesWritten = 0;
DWORD oldProtection = 0;
//HANDLE file = NULL;
HANDLE file = NULL;
ULONG fileSize = NULL;
LPDWORD bytesRead = NULL;
PVOID fileData = NULL;
OBJECT_ATTRIBUTES oa;
UNICODE_STRING f;
IO_STATUS_BLOCK IoStatusBlock;
WCHAR ntdl[100] = L"\\?\\c:\\windows\\system32\\ntdll.dll";
WCHAR filepath[100] = L"\\??\\c:\\windows\\system32";
RtlInitUnicodeString(&f, ntdl);
InitializeObjectAttributes(&oa, &f, OBJ_CASE_INSENSITIVE, NULL, NULL);
NTSTATUS stat = NtCreateFile(&file, FILE_GENERIC_READ, &oa, &IoStatusBlock, 0, FILE_ATTRIBUTE_NORMAL, FILE_SHARE_READ, FILE_OPEN, FILE_SYNCHRONOUS_IO_NONALERT | FILE_NON_DIRECTORY_FILE, 0, 0);
fileSize = GetFileSize(file, NULL);
fileData = HeapAlloc(GetProcessHeap(), 0, fileSize);
NTSTATUS stat1 = NtReadFile(file, NULL, NULL, NULL, &IoStatusBlock, fileData, sizeof(fileData), 0, NULL);
if (stat1 != 0)
{
printf("failed: %X\n", stat1);
}
Instead of sizeof(fileData) pass the fileSize and initialize + pass the ByteOffset value of 0.
LARGE_INTEGER liBytes = { 0 };
status = SysNtReadFile(file, NULL, NULL, NULL, &statusBlock, fileData, fileSize, &liBytes, NULL);
And, In code line
fileData = HeapAlloc(GetProcessHeap(), 0, fileSize);
the third parameter should be set HEAP_ZERO_MEMORY, not 0. See nf-heapapi-heapalloc

RegOpenKeyEx() fails with HKEY_LOCAL_MACHIENE when trying to get the "Path" variable

I am trying to get the "Path" variable in my MFC application.
Please find the code.
HKEY hKey;
char data[256] = "";
unsigned long length = 255;
LPCTSTR keyPath = TEXT("System\\CurrentControlSet\\Control\\Session Manager\\Environment");
if (RegOpenKeyEx(HKEY_LOCAL_MACHINE, keyPath, 0, KEY_ALL_ACCESS, &hKey) == ERROR_SUCCESS) {
length = 255;
RegQueryValueEx(hKey, "Path", 0, NULL, (unsigned char *)data, &length);
RegCloseKey(hKey);
}
But the RegOpenKeyEx function fails. Thanks in advance.

mfc acombo box add string

HKEY hKey = 0;
DWORD dwType = REG_SZ;
TCHAR buf[255] = {0};
DWORD dwBufSize = sizeof(buf);
DWORD ret;
CComboBox m_portCombo;
if( RegOpenKeyEx( HKEY_LOCAL_MACHINE, TEXT("HARDWARE\\DEVICEMAP\\SERIALCOMM"), 0, KEY_QUERY_VALUE, &hKey ) == ERROR_SUCCESS )
{
if( RegQueryValueEx( hKey, TEXT("\\Device\\Serial0"), 0, &dwType, (LPBYTE)buf, &dwBufSize ) == ERROR_SUCCESS )
{
CString str = buf;
m_portCombo.AddString(str);
}
if( RegQueryValueEx( hKey, TEXT("\\Device\\Serial1"), 0, &dwType, (LPBYTE)buf, &dwBufSize ) == ERROR_SUCCESS )
{
CString str = buf;
}
if( RegQueryValueEx( hKey, TEXT("\\Device\\Serial2"), 0, &dwType, (LPBYTE)buf, &dwBufSize ) == ERROR_SUCCESS )
{
CString str = buf;
}
if( RegQueryValueEx( hKey, TEXT("\\Device\\Serial3"), 0, &dwType, (LPBYTE)buf, &dwBufSize ) == ERROR_SUCCESS )
{
CString str = buf;
}
}
First problem: i want to change the TEXT("\\Device\\Serial3") with something like TEXT("\\Device\\Serial",%i), so i can resume all that lines of code to a for loop.Is tehre a way to accomplish this?
Second problem: if i use the m_portCombo.AddString(str); i get an Debug Assertion Failed! error, and, of course, the combobox is not populated with that registry value. Why could that happen?
First Problem: Use the CString Format() function using %d for integer.
for (int i =0 ; i<10; i++)
{
CString szPath;
szPath.Format(TEXT("\\Device\\Serial%d"),i);
// ...
}
Second Problem:
There could be many reasons this would fail. Most likely of which would be having not created the combo box yet.(It needs a window handle before it can add strings) To figure out the cause of the debug assertion, click the "retry" button on the Debug Assertion Failed window and it should jump to the code which caused the assertion. For example it might be something like:
ASSERT(GetSafeHwnd()!=NULL);
Your combo box class won't be 'subclassed' until after the first DoDataExchange is called (and any attempt to use it before that happens will ASSERT). Either wait until the base class has run OnInitDialog or do something like this:
CComboBox * pcombo = static_cast<CComboBox*>(GetDlgItem( IDC_MYCOMBO ));
pcombo->AddString( szPath );
See #TheSteve's answer for string problem.

VBA socket connection in Office 2010

Short Question
Is there a library that is supposed to replace mswinsoc.osx used to create and maintain socket connections within VBA applications?
Background
I am trying to create socket connection(s) within a Visio 2010 Professional document. I have found a way to register mswinsoc.osx on Windows 7 here, but this seems very strange that Microsoft would get rid of a library to make socket connections without having something (better) to replace it. To add to my concern, there are little to no examples using the Winsoc library for Office 2010. I am not supporting old documents, so Winsoc is not a requirement; it's just the closet thing I know will work.
Additional Thoughts
I have found some very useful VBA stuff for Visio here that lead me to believe that there should be a new solution.
Any examples of socket connections for Office 2010 or insight to what happened to mswinsoc.osx would be of great help.
I made vba login client (ws2_32.dll) example
It may works fine (I tested.)
Tested Screen Image Here
ServerMain.c
#undef UNICODE
#define WIN32_LEAN_AND_MEAN
#include <windows.h>
#include <winsock2.h>
#include <ws2tcpip.h>
#include <stdlib.h>
#include <stdio.h>
// Need to link with Ws2_32.lib
#pragma comment (lib, "Ws2_32.lib")
#define DEFAULT_BUFLEN 512
#define DEFAULT_PORT "16001"
static char LoginCheck(char * recvbuf);
int main(void)
{
WSADATA wsaData;
int iResult;
SOCKET ListenSocket = INVALID_SOCKET;
SOCKET ClientSocket = INVALID_SOCKET;
struct addrinfo *result = NULL;
struct addrinfo hints;
int iSendResult;
char recvbuf[DEFAULT_BUFLEN];
int recvbuflen = DEFAULT_BUFLEN;
char sendbuf[DEFAULT_BUFLEN];
int sendbuflen = DEFAULT_BUFLEN;
printf("Excel Login Server Start..\n");
// Initialize Winsock
iResult = WSAStartup(MAKEWORD(2, 2), &wsaData);
if (iResult != 0) {
printf("WSAStartup failed with error: %d\n", iResult);
return 1;
}
ZeroMemory(&hints, sizeof(hints));
hints.ai_family = AF_INET;
hints.ai_socktype = SOCK_STREAM;
hints.ai_protocol = IPPROTO_TCP;
hints.ai_flags = AI_PASSIVE;
// Resolve the server address and port
iResult = getaddrinfo(NULL, DEFAULT_PORT, &hints, &result);
if (iResult != 0) {
printf("getaddrinfo failed with error: %d\n", iResult);
WSACleanup();
return 1;
}
// Create a SOCKET for connecting to server
ListenSocket = socket(result->ai_family, result->ai_socktype, result->ai_protocol);
if (ListenSocket == INVALID_SOCKET) {
printf("socket failed with error: %ld\n", WSAGetLastError());
freeaddrinfo(result);
WSACleanup();
return 1;
}
// Setup the TCP listening socket
iResult = bind(ListenSocket, result->ai_addr, (int)result->ai_addrlen);
if (iResult == SOCKET_ERROR) {
printf("bind failed with error: %d\n", WSAGetLastError());
freeaddrinfo(result);
closesocket(ListenSocket);
WSACleanup();
return 1;
}
freeaddrinfo(result);
iResult = listen(ListenSocket, SOMAXCONN);
if (iResult == SOCKET_ERROR) {
printf("listen failed with error: %d\n", WSAGetLastError());
closesocket(ListenSocket);
WSACleanup();
return 1;
}
printf("Server Is running at port %s\n", DEFAULT_PORT);
while(1) {
// Accept a client socket
ClientSocket = accept(ListenSocket, NULL, NULL);
if (ClientSocket == INVALID_SOCKET) {
printf("accept failed with error: %d\n", WSAGetLastError());
//closesocket(ListenSocket);
//WSACleanup();
//return 1;
}
// recieve data from client
iResult = recv(ClientSocket, recvbuf, recvbuflen, 0);
if (iResult > 0) {
printf("Bytes received: %d\n", iResult);
recvbuf[iResult] = '\0';
printf("Recieved string : %s\n", recvbuf);
// id, pw check
sendbuf[0] = LoginCheck(recvbuf); //success code
sendbuf[1] = '\0';
// Echo the buffer back to the sender
iSendResult = send(ClientSocket, sendbuf, 1, 0);
if (iSendResult == SOCKET_ERROR) {
printf("send failed with error: %d\n", WSAGetLastError());
//closesocket(ClientSocket);
//WSACleanup();
//return 1;
}
printf("Bytes sent: %d\n", iSendResult);
}
else if (iResult == 0)
printf("Connection closing...\n");
else {
printf("recv failed with error: %d\n", WSAGetLastError());
//closesocket(ClientSocket);
//WSACleanup();
//return 1;
}
Sleep(10);
}
// No longer need server socket
closesocket(ListenSocket);
// shutdown the connection since we're done
iResult = shutdown(ClientSocket, SD_SEND);
if (iResult == SOCKET_ERROR) {
printf("shutdown failed with error: %d\n", WSAGetLastError());
closesocket(ClientSocket);
WSACleanup();
return 1;
}
// cleanup
closesocket(ClientSocket);
WSACleanup();
return 0;
}
// check if login info correct (input : "id"|"pw")
static char LoginCheck(char * recvbuf)
{
char *id, *pw;
if (!recvbuf | !recvbuf[0])
return 0;
// temp id, pw info (later, may use db info)
id = strtok(recvbuf, "|");
if (!id)
return 0;
if (strcmp(id, "testid"))
return 0;
pw = strtok(NULL, "|");
if (!pw)
return 0;
if (strcmp(pw, "testpw"))
return 0;
return 's'; //success
}
Server.vb
'
' reference site https://stackoverflow.com/questions/49028281/vba-with-winsock2-send-sends-wrong-data
' edited by robotmanya (2018.10.28) (https://blog.naver.com/monkey5255/221386590654)
' Constants ----------------------------------------------------------
Const ip = "127.0.0.1"
Const port = "16001"
Const INVALID_SOCKET = -1
Const WSADESCRIPTION_LEN = 256
Const SOCKET_ERROR = -1
Const SD_SEND = 1
' Typ definitions ----------------------------------------------------
Private Type WSADATA
wVersion As Integer
wHighVersion As Integer
szDescription(0 To WSADESCRIPTION_LEN) As Byte
szSystemStatus(0 To WSADESCRIPTION_LEN) As Byte
iMaxSockets As Integer
iMaxUdpDg As Integer
lpVendorInfo As Long
End Type
Private Type ADDRINFO
ai_flags As Long
ai_family As Long
ai_socktype As Long
ai_protocol As Long
ai_addrlen As Long
ai_canonName As LongPtr 'strptr
ai_addr As LongPtr 'p sockaddr
ai_next As LongPtr 'p addrinfo
End Type
' Enums ---------------------------------------------------------------
Enum AF
AF_UNSPEC = 0
AF_INET = 2
AF_IPX = 6
AF_APPLETALK = 16
AF_NETBIOS = 17
AF_INET6 = 23
AF_IRDA = 26
AF_BTH = 32
End Enum
Enum sock_type
SOCK_STREAM = 1
SOCK_DGRAM = 2
SOCK_RAW = 3
SOCK_RDM = 4
SOCK_SEQPACKET = 5
End Enum
' External functions --------------------------------------------------
Public Declare Function WSAStartup Lib "ws2_32.dll" (ByVal wVersionRequested As Integer, ByRef data As WSADATA) As Long
Public Declare Function connect Lib "ws2_32.dll" (ByVal socket As Long, ByVal SOCKADDR As Long, ByVal namelen As Long) As Long
Public Declare Sub WSACleanup Lib "ws2_32.dll" ()
Private Declare PtrSafe Function GetAddrInfo Lib "ws2_32.dll" Alias "getaddrinfo" (ByVal NodeName As String, ByVal ServName As String, ByVal lpHints As LongPtr, lpResult As LongPtr) As Long
Public Declare Function ws_socket Lib "ws2_32.dll" Alias "socket" (ByVal AF As Long, ByVal stype As Long, ByVal Protocol As Long) As Long
Public Declare Function closesocket Lib "ws2_32.dll" (ByVal socket As Long) As Long
Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal length As Long)
Public Declare Function Send Lib "ws2_32.dll" Alias "send" (ByVal s As Long, ByVal buf As String, ByVal buflen As Long, ByVal flags As Long) As Long
Public Declare Function Recv Lib "ws2_32.dll" Alias "recv" (ByVal s As Long, ByRef buf As Byte, ByVal buflen As Long, ByVal flags As Long) As Long
Public Declare Function SendWithPtr Lib "ws2_32.dll" Alias "send" (ByVal s As Long, ByVal bufPtr As Long, ByVal buflen As Long, ByVal flags As Long) As Long
Public Declare Function shutdown Lib "ws2_32.dll" (ByVal s As Long, ByVal how As Long) As Long
Private Declare PtrSafe Function WSAGetLastError Lib "ws2_32.dll" () As Long
Private Declare Function VarPtrArray Lib "VBE7" Alias "VarPtr" (var() As Any) As Long
'Login Button Click Event
Function Login(ID As String, pw As String)
Dim m_wsaData As WSADATA
Dim m_RetVal As Integer
Dim m_Hints As ADDRINFO
Dim m_ConnSocket As Long: m_ConnSocket = INVALID_SOCKET
Dim pAddrInfo As LongPtr
Dim RetVal As Long
Dim lastError As Long
Dim iRC As Long
Dim MAX_BUF_SIZE As Integer: MAX_BUF_SIZE = 512
Login = 0
'Socket Settings
RetVal = WSAStartup(MAKEWORD(2, 2), m_wsaData)
If (RetVal <> 0) Then
LogError "WSAStartup failed with error " & RetVal, WSAGetLastError()
Call WSACleanup
Exit Function
End If
m_Hints.ai_family = AF.AF_UNSPEC
m_Hints.ai_socktype = sock_type.SOCK_STREAM
RetVal = GetAddrInfo(ip, port, VarPtr(m_Hints), pAddrInfo)
If (RetVal <> 0) Then
LogError "Cannot resolve address " & ip & " and port " & port & ", error " & RetVal, WSAGetLastError()
Call WSACleanup
Exit Function
End If
m_Hints.ai_next = pAddrInfo
Dim connected As Boolean: connected = False
Do While m_Hints.ai_next > 0
CopyMemory m_Hints, ByVal m_Hints.ai_next, LenB(m_Hints)
m_ConnSocket = ws_socket(m_Hints.ai_family, m_Hints.ai_socktype, m_Hints.ai_protocol)
If (m_ConnSocket = INVALID_SOCKET) Then
LogError "Error opening socket, error " & RetVal
Else
Dim connectionResult As Long
connectionResult = connect(m_ConnSocket, m_Hints.ai_addr, m_Hints.ai_addrlen)
If connectionResult <> SOCKET_ERROR Then
connected = True
Exit Do
End If
LogError "connect() to socket failed"
closesocket (m_ConnSocket)
End If
Loop
If Not connected Then
LogError "Fatal error: unable to connect to the server", WSAGetLastError()
RetVal = closesocket(m_ConnSocket)
Call WSACleanup
Exit Function
End If
'After Socket Connected
Dim SendBuf As String
SendBuf = ID + "|" + pw
'Send Login Data
RetVal = Send(m_ConnSocket, SendBuf, Len(SendBuf), 0)
If RetVal = SOCKET_ERROR Then
LogError "send() failed", WSAGetLastError()
RetVal = closesocket(m_ConnSocket)
Call WSACleanup
Exit Function
Else
Debug.Print "sent " & RetVal & " bytes"
End If
' shutdown the connection since no more data will be sent
RetVal = shutdown(m_ConnSocket, SD_SEND)
If RetVal <> 0 Then
LogError "send socket close failed", WSAGetLastError()
RetVal = closesocket(m_ConnSocket)
Call WSACleanup
Else
Debug.Print "send socket closed"
End If
'Recieve From Server (Login Success : 1, Fail : 0)
Dim RecvBuf As Byte
RetVal = Recv(m_ConnSocket, RecvBuf, MAX_BUF_SIZE, 0)
If RetVal = SOCKET_ERROR Then
LogError "recv() failed", WSAGetLastError()
RetVal = closesocket(m_ConnSocket)
Call WSACleanup
Exit Function
Else
Debug.Print "recieved " & RetVal & " bytes"
End If
'Login Check (s : success(id,pw correspond, f : fail)
If Left(Chr(RecvBuf), 1) = "s" Then
Login = 1
Else
Login = 0
End If
RetVal = closesocket(m_ConnSocket)
If RetVal <> 0 Then
LogError "closesocket() failed", WSAGetLastError()
Call WSACleanup
Else
Debug.Print "closed socket"
End If
End Function
Public Function MAKEWORD(Lo As Byte, Hi As Byte) As Integer
MAKEWORD = Lo + Hi * 256& Or 32768 * (Hi > 127)
End Function
Private Sub LogError(msg As String, Optional ErrorCode As Long = -1)
If ErrorCode > -1 Then
msg = msg & " (error code " & ErrorCode & ")"
End If
Debug.Print msg
End Sub
I think this code explained all you need.
but if you know more detailed process,
I also posted this to my blog
https://blog.naver.com/monkey5255/221386590654
Short Answer
wsock32.dll
Additional Information
I have found a few detailed examples in C and VB using this DLL.
Examples in C
Examples in VB
Thus far I have not had a chance to run any examples within VBA due to a shift in my projects scope. I am instead using Python to control Visio via a COM connection with great success.
You might want to take a look at Webxcel https://github.com/michaelneu/webxcel, a full REST-Backend written in Excel-Macros.

Resources