diff options
Diffstat (limited to 'win32/win32.c')
| -rw-r--r-- | win32/win32.c | 837 |
1 files changed, 832 insertions, 5 deletions
diff --git a/win32/win32.c b/win32/win32.c index 9d819b518f..fe38c1e2ae 100644 --- a/win32/win32.c +++ b/win32/win32.c @@ -25,7 +25,14 @@ #include "EXTERN.h" #include "perl.h" + +#define NO_XSLOCKS +#ifdef PERL_OBJECT +extern CPerlObj* pPerl; +#endif #include "XSUB.h" + +#include "Win32iop.h" #include <fcntl.h> #include <sys/stat.h> #ifndef __GNUC__ @@ -53,14 +60,40 @@ int _CRT_glob = 0; #define EXECF_SPAWN 2 #define EXECF_SPAWN_NOWAIT 3 +#if defined(PERL_OBJECT) +#undef win32_perllib_path +#define win32_perllib_path g_win32_perllib_path +#undef do_aspawn +#define do_aspawn g_do_aspawn +#undef do_spawn +#define do_spawn g_do_spawn +#undef do_exec +#define do_exec g_do_exec +#undef opendir +#define opendir g_opendir +#undef readdir +#define readdir g_readdir +#undef telldir +#define telldir g_telldir +#undef seekdir +#define seekdir g_seekdir +#undef rewinddir +#define rewinddir g_rewinddir +#undef closedir +#define closedir g_closedir +#undef getlogin +#define getlogin g_getlogin +#endif + static DWORD os_id(void); static void get_shell(void); static long tokenize(char *str, char **dest, char ***destv); -static int do_spawn2(char *cmd, int exectype); + int do_spawn2(char *cmd, int exectype); static BOOL has_redirection(char *ptr); static long filetime_to_clock(PFILETIME ft); static BOOL filetime_from_time(PFILETIME ft, time_t t); + char * w32_perlshell_tokens = Nullch; char ** w32_perlshell_vec; long w32_perlshell_items = -1; @@ -166,6 +199,7 @@ has_redirection(char *ptr) return FALSE; } +#if !defined(PERL_OBJECT) /* since the current process environment is being updated in util.c * the library functions will get the correct environment */ @@ -200,6 +234,7 @@ my_pclose(PerlIO *fp) { return win32_pclose(fp); } +#endif static DWORD os_id(void) @@ -318,7 +353,7 @@ do_aspawn(void *vreally, void **vmark, void **vsp) argv[index++] = 0; status = win32_spawnvp(flag, - (really ? SvPV(really,na) : argv[0]), + (const char*)(really ? SvPV(really,na) : argv[0]), (const char* const*)argv); if (status < 0 && errno == ENOEXEC) { @@ -331,7 +366,7 @@ do_aspawn(void *vreally, void **vmark, void **vsp) argv[sh_items] = w32_perlshell_vec[sh_items]; status = win32_spawnvp(flag, - (really ? SvPV(really,na) : argv[0]), + (const char*)(really ? SvPV(really,na) : argv[0]), (const char* const*)argv); } @@ -346,7 +381,7 @@ do_aspawn(void *vreally, void **vmark, void **vsp) return (statusvalue = status); } -static int +int do_spawn2(char *cmd, int exectype) { char **a; @@ -756,6 +791,51 @@ win32_stat(const char *path, struct stat *buffer) #ifndef USE_WIN32_RTL_ENV +BOOL GetRegStr(HKEY hkey, const char *lpszValueName, char *lpszDefault, char *lpszData, unsigned long *lpdwDataLen) +{ // Retrieve a REG_SZ or REG_EXPAND_SZ from the registry + HKEY handle; + DWORD type, dwDataLen = *lpdwDataLen; + const char *subkey = "Software\\Perl"; + char szBuffer[MAX_PATH+1]; + long retval; + + retval = RegOpenKeyEx(hkey, subkey, 0, KEY_READ, &handle); + if(retval == ERROR_SUCCESS) + { + retval = RegQueryValueEx(handle, lpszValueName, 0, &type, (LPBYTE)lpszData, &dwDataLen); + RegCloseKey(handle); + if(retval == ERROR_SUCCESS && (type == REG_SZ || type == REG_EXPAND_SZ)) + { + if(type != REG_EXPAND_SZ) + { + *lpdwDataLen = dwDataLen; + return TRUE; + } + strcpy(szBuffer, lpszData); + dwDataLen = ExpandEnvironmentStrings(szBuffer, lpszData, *lpdwDataLen); + if(dwDataLen < *lpdwDataLen) + { + *lpdwDataLen = dwDataLen; + return TRUE; + } + } + } + + strcpy(lpszData, lpszDefault); + return FALSE; +} + +char* GetRegStr(const char *lpszValueName, char *lpszDefault, char *lpszData, unsigned long *lpdwDataLen) +{ + if(!GetRegStr(HKEY_CURRENT_USER, lpszValueName, lpszDefault, lpszData, lpdwDataLen)) + { + GetRegStr(HKEY_LOCAL_MACHINE, lpszValueName, lpszDefault, lpszData, lpdwDataLen); + } + if(*lpszData == '\0') + lpszData = NULL; + return lpszData; +} + DllExport char * win32_getenv(const char *name) { @@ -771,6 +851,12 @@ win32_getenv(const char *name) curlen = needlen; needlen = GetEnvironmentVariable(name,curitem,curlen); } + if(curitem == NULL) + { + unsigned long dwDataLen = curlen; + if(strcmp("PERL5DB", name) == 0) + curitem = GetRegStr(name, "", curitem, &dwDataLen); + } return curitem; } @@ -1209,7 +1295,7 @@ win32_str_os_error(void *sv, DWORD dwErr) sMsg[dwLen]= '\0'; } if (0 == dwLen) { - sMsg = LocalAlloc(0, 64/**sizeof(TCHAR)*/); + sMsg = (char*)LocalAlloc(0, 64/**sizeof(TCHAR)*/); dwLen = sprintf(sMsg, "Unknown error #0x%lX (lookup 0x%lX)", dwErr, GetLastError()); @@ -1967,6 +2053,713 @@ XS(w32_Sleep) XSRETURN_YES; } +#define TMPBUFSZ 1024 +#define MAX_LENGTH 2048 +#define SUCCESSRETURNED(x) (x == ERROR_SUCCESS) +#define REGRETURN(x) XSRETURN_IV(SUCCESSRETURNED(x)) +#define SvHKEY(index) (HKEY)((unsigned long)SvIV(index)) +#define SETIV(index,value) sv_setiv(ST(index), value) +#define SETNV(index,value) sv_setnv(ST(index), value) +#define SETPV(index,string) sv_setpv(ST(index), string) +#define SETPVN(index, buffer, length) sv_setpvn(ST(index), (char*)buffer, length) +#define SETHKEY(index, hkey) SETIV(index,(long)hkey) + +static time_t ft2timet(FILETIME *ft) +{ + SYSTEMTIME st; + struct tm tm; + + FileTimeToSystemTime(ft, &st); + tm.tm_sec = st.wSecond; + tm.tm_min = st.wMinute; + tm.tm_hour = st.wHour; + tm.tm_mday = st.wDay; + tm.tm_mon = st.wMonth - 1; + tm.tm_year = st.wYear - 1900; + tm.tm_wday = st.wDayOfWeek; + tm.tm_yday = -1; + tm.tm_isdst = -1; + return mktime (&tm); +} + +static +XS(w32_RegCloseKey) +{ + dXSARGS; + + if(items != 1) + { + croak("usage: Win32::RegCloseKey($hkey);\n"); + } + + REGRETURN(RegCloseKey(SvHKEY(ST(0)))); +} + +static +XS(w32_RegConnectRegistry) +{ + dXSARGS; + HKEY handle; + + if(items != 3) + { + croak("usage: Win32::RegConnectRegistry($machine, $hkey, $handle);\n"); + } + + if(SUCCESSRETURNED(RegConnectRegistry((char *)SvPV(ST(0), na), SvHKEY(ST(1)), &handle))) + { + SETHKEY(2,handle); + XSRETURN_YES; + } + XSRETURN_NO; +} + +static +XS(w32_RegCreateKey) +{ + dXSARGS; + HKEY handle; + DWORD disposition; + long retval; + + if(items != 3) + { + croak("usage: Win32::RegCreateKey($hkey, $subkey, $handle);\n"); + } + + retval = RegCreateKeyEx(SvHKEY(ST(0)), (char *)SvPV(ST(1), na), 0, NULL, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, + NULL, &handle, &disposition); + + if(SUCCESSRETURNED(retval)) + { + SETHKEY(2,handle); + XSRETURN_YES; + } + XSRETURN_NO; +} + +static +XS(w32_RegCreateKeyEx) +{ + dXSARGS; + + unsigned int length; + long retval; + HKEY hkey, handle; + char *subkey; + char *keyclass; + DWORD options, disposition; + REGSAM sam; + SECURITY_ATTRIBUTES sa, *psa; + + if(items != 9) + { + croak("usage: Win32::RegCreateKeyEx($hkey, $subkey, $reserved, $class, $options, $sam, " + "$security, $handle, $disposition);\n"); + } + + hkey = SvHKEY(ST(0)); + subkey = (char *)SvPV(ST(1), na); + keyclass = (char *)SvPV(ST(3), na); + options = (DWORD) ((unsigned long)SvIV(ST(4))); + sam = (REGSAM) ((unsigned long)SvIV(ST(5))); + psa = (SECURITY_ATTRIBUTES*)SvPV(ST(6), length); + if(length != sizeof(SECURITY_ATTRIBUTES)) + { + psa = &sa; + memset(&sa, 0, sizeof(SECURITY_ATTRIBUTES)); + sa.nLength = sizeof(SECURITY_ATTRIBUTES); + } + + retval = RegCreateKeyEx(hkey, subkey, 0, keyclass, options, sam, + psa, &handle, &disposition); + + if(SUCCESSRETURNED(retval)) + { + if(psa == &sa) + SETPVN(6, &sa, sizeof(sa)); + + SETHKEY(7,handle); + SETIV(8,disposition); + XSRETURN_YES; + } + XSRETURN_NO; +} + +static +XS(w32_RegDeleteKey) +{ + dXSARGS; + + if(items != 2) + { + croak("usage: Win32::RegDeleteKey($hkey, $subkey);\n"); + } + + REGRETURN(RegDeleteKey(SvHKEY(ST(0)), (char *)SvPV(ST(1), na))); +} + +static +XS(w32_RegDeleteValue) +{ + dXSARGS; + + if(items != 2) + { + croak("usage: Win32::RegDeleteValue($hkey, $valname);\n"); + } + + REGRETURN(RegDeleteValue(SvHKEY(ST(0)), (char *)SvPV(ST(1), na))); +} + +static +XS(w32_RegEnumKey) +{ + dXSARGS; + + char keybuffer[TMPBUFSZ]; + + if(items != 3) + { + croak("usage: Win32::RegEnumKey($hkey, $idx, $subkeyname);\n"); + } + + if(SUCCESSRETURNED(RegEnumKey(SvHKEY(ST(0)), SvIV(ST(1)), keybuffer, sizeof(keybuffer)))) + { + SETPV(2, keybuffer); + XSRETURN_YES; + } + XSRETURN_NO; +} + +static +XS(w32_RegEnumKeyEx) +{ + dXSARGS; + int length; + + DWORD keysz, classsz; + char keybuffer[TMPBUFSZ]; + char classbuffer[TMPBUFSZ]; + long retval; + FILETIME filetime; + + if(items != 6) + { + croak("usage: Win32::RegEnumKeyEx($hkey, $idx, $subkeyname, $reserved, $class, $time);\n"); + } + + keysz = sizeof(keybuffer); + classsz = sizeof(classbuffer); + retval = RegEnumKeyEx(SvHKEY(ST(0)), SvIV(ST(1)), keybuffer, &keysz, 0, + classbuffer, &classsz, &filetime); + if(SUCCESSRETURNED(retval)) + { + SETPV(2, keybuffer); + SETPV(4, classbuffer); + SETIV(5, ft2timet(&filetime)); + XSRETURN_YES; + } + XSRETURN_NO; +} + +static +XS(w32_RegEnumValue) +{ + dXSARGS; + HKEY hkey; + DWORD type, namesz, valsz; + long retval; + static HKEY last_hkey; + char myvalbuf[MAX_LENGTH]; + char mynambuf[MAX_LENGTH]; + + if(items != 6) + { + croak("usage: Win32::RegEnumValue($hkey, $i, $name, $reserved, $type, $value);\n"); + } + + hkey = SvHKEY(ST(0)); + + // If this is a new key, find out how big the maximum name and value sizes are and + // allocate space for them. Free any old storage and set the old key value to the + // current key. + + if(hkey != (HKEY)last_hkey) + { + char keyclass[TMPBUFSZ]; + DWORD classsz, subkeys, maxsubkey, maxclass, values, salen, maxnamesz, maxvalsz; + FILETIME ft; + classsz = sizeof(keyclass); + retval = RegQueryInfoKey(hkey, keyclass, &classsz, 0, &subkeys, &maxsubkey, &maxclass, + &values, &maxnamesz, &maxvalsz, &salen, &ft); + + if(!SUCCESSRETURNED(retval)) + { + XSRETURN_NO; + } + memset(myvalbuf, 0, MAX_LENGTH); + memset(mynambuf, 0, MAX_LENGTH); + last_hkey = hkey; + } + + namesz = MAX_LENGTH; + valsz = MAX_LENGTH; + retval = RegEnumValue(hkey, SvIV(ST(1)), mynambuf, &namesz, 0, &type, (LPBYTE) myvalbuf, &valsz); + if(!SUCCESSRETURNED(retval)) + { + XSRETURN_NO; + } + else + { + SETPV(2, mynambuf); + SETIV(4, type); + + // return includes the null terminator so delete it if REG_SZ, REG_MULTI_SZ or REG_EXPAND_SZ + switch(type) + { + case REG_SZ: + case REG_MULTI_SZ: + case REG_EXPAND_SZ: + if(valsz) + --valsz; + case REG_BINARY: + SETPVN(5, myvalbuf, valsz); + break; + + case REG_DWORD_BIG_ENDIAN: + { + BYTE tmp = myvalbuf[0]; + myvalbuf[0] = myvalbuf[3]; + myvalbuf[3] = tmp; + tmp = myvalbuf[1]; + myvalbuf[1] = myvalbuf[2]; + myvalbuf[2] = tmp; + } + case REG_DWORD_LITTLE_ENDIAN: // same as REG_DWORD + SETNV(5, (double)*((DWORD*)myvalbuf)); + break; + + default: + break; + } + + XSRETURN_YES; + } +} + +static +XS(w32_RegFlushKey) +{ + dXSARGS; + + if(items != 1) + { + croak("usage: Win32::RegFlushKey($hkey);\n"); + } + + REGRETURN(RegFlushKey(SvHKEY(ST(0)))); +} + +static +XS(w32_RegGetKeySecurity) +{ + dXSARGS; + SECURITY_DESCRIPTOR sd; + DWORD sdsz; + + if(items != 3) + { + croak("usage: Win32::RegGetKeySecurity($hkey, $security_info, $security_descriptor);\n"); + } + + if(SUCCESSRETURNED(RegGetKeySecurity(SvHKEY(ST(0)), SvIV(ST(1)), &sd, &sdsz))) + { + SETPVN(2, &sd, sdsz); + XSRETURN_YES; + } + XSRETURN_NO; +} + +static +XS(w32_RegLoadKey) +{ + dXSARGS; + + if(items != 3) + { + croak("usage: Win32::RegLoadKey($hkey, $subkey, $filename);\n"); + } + + REGRETURN(RegLoadKey(SvHKEY(ST(0)), (char *)SvPV(ST(1), na), (char *)SvPV(ST(2), na))); +} + +static +XS(w32_RegNotifyChangeKeyValue) +{ + croak("Win32::RegNotifyChangeKeyValue not yet implemented!\n"); +} + +static +XS(w32_RegOpenKey) +{ + dXSARGS; + HKEY handle; + + if(items != 3) + { + croak("usage: Win32::RegOpenKey($hkey, $subkey, $handle);\n"); + } + + if(SUCCESSRETURNED(RegOpenKey(SvHKEY(ST(0)), (char *)SvPV(ST(1), na), &handle))) + { + SETHKEY(2,handle); + XSRETURN_YES; + } + XSRETURN_NO; +} + +static +XS(w32_RegOpenKeyEx) +{ + dXSARGS; + HKEY handle; + + if(items != 5) + { + croak("usage: Win32::RegOpenKeyEx($hkey, $subkey, $reserved, $sam, $handle);\n"); + } + + if(SUCCESSRETURNED(RegOpenKeyEx(SvHKEY(ST(0)), (char *)SvPV(ST(1), na), + 0, (REGSAM) ((unsigned long)SvIV(ST(3))), &handle))) + { + SETHKEY(4,handle); + XSRETURN_YES; + } + XSRETURN_NO; +} + +#pragma optimize("", off) +static +XS(w32_RegQueryInfoKey) +{ + dXSARGS; + int length; + + char keyclass[TMPBUFSZ]; + DWORD subkeys, maxsubkey, maxclass, values, maxvalname, maxvaldata; + DWORD seclen, classsz; + FILETIME ft; + long retval; + + if(items != 10) + { + croak("usage: Win32::RegQueryInfoKey($hkey, $class, $numsubkeys, $maxsubkey," + "$maxclass, $values, $maxvalname, $maxvaldata, $secdesclen," + "$lastwritetime);\n"); + } + + classsz = sizeof(keyclass); + retval = RegQueryInfoKey(SvHKEY(ST(0)), keyclass, &classsz, 0, &subkeys, &maxsubkey, + &maxclass, &values, &maxvalname, &maxvaldata, + &seclen, &ft); + if(SUCCESSRETURNED(retval)) + { + SETPV(1, keyclass); + SETIV(2, subkeys); + SETIV(3, maxsubkey); + SETIV(4, maxclass); + SETIV(5, values); + SETIV(6, maxvalname); + SETIV(7, maxvaldata); + SETIV(8, seclen); + SETIV(9, ft2timet(&ft)); + XSRETURN_YES; + } + XSRETURN_NO; +} +#pragma optimize("", on) + +static +XS(w32_RegQueryValue) +{ + dXSARGS; + + unsigned char databuffer[TMPBUFSZ*2]; + long datasz = sizeof(databuffer); + + if(items != 3) + { + croak("usage: Win32::RegQueryValue($hkey, $valuename, $data);\n"); + } + + if(SUCCESSRETURNED(RegQueryValue(SvHKEY(ST(0)), SvPV(ST(1), na), (char*)databuffer, &datasz))) + { + // return includes the null terminator so delete it + SETPVN(2, databuffer, --datasz); + XSRETURN_YES; + } + XSRETURN_NO; +} + +static +XS(w32_RegQueryValueEx) +{ + dXSARGS; + + unsigned char databuffer[TMPBUFSZ*2]; + DWORD datasz = sizeof(databuffer); + DWORD type; + LONG result; + LPBYTE ptr = databuffer; + + if(items != 5) + { + croak("usage: Win32::RegQueryValueEx($hkey, $valuename, $reserved, $type, $data);\n"); + } + + result = RegQueryValueEx(SvHKEY(ST(0)), SvPV(ST(1), na), 0, &type, ptr, &datasz); + if(result == ERROR_MORE_DATA) + { + New(0, ptr, datasz+1, BYTE); + result = RegQueryValueEx(SvHKEY(ST(0)), SvPV(ST(1), na), 0, &type, ptr, &datasz); + } + if(SUCCESSRETURNED(result)) + { + SETIV(3, type); + + // return includes the null terminator so delete it if REG_SZ, REG_MULTI_SZ or REG_EXPAND_SZ + switch(type) + { + case REG_SZ: + case REG_MULTI_SZ: + case REG_EXPAND_SZ: + --datasz; + case REG_BINARY: + SETPVN(4, ptr, datasz); + break; + + case REG_DWORD_BIG_ENDIAN: + { + BYTE tmp = ptr[0]; + ptr[0] = ptr[3]; + ptr[3] = tmp; + tmp = ptr[1]; + ptr[1] = ptr[2]; + ptr[2] = tmp; + } + case REG_DWORD_LITTLE_ENDIAN: // same as REG_DWORD + SETNV(4, (double)*((DWORD*)ptr)); + break; + + default: + break; + } + + if(ptr != databuffer) + safefree(ptr); + + XSRETURN_YES; + } + if(ptr != databuffer) + safefree(ptr); + + XSRETURN_NO; +} + +static +XS(w32_RegReplaceKey) +{ + dXSARGS; + + if(items != 4) + { + croak("usage: Win32::RegReplaceKey($hkey, $subkey, $newfile, $oldfile);\n"); + } + + REGRETURN(RegReplaceKey(SvHKEY(ST(0)), (char *)SvPV(ST(1), na), (char *)SvPV(ST(2), na), (char *)SvPV(ST(3), na))); +} + +static +XS(w32_RegRestoreKey) +{ + dXSARGS; + + if(items < 2 || items > 3) + { + croak("usage: Win32::RegRestoreKey($hkey, $filename [, $flags]);\n"); + } + + REGRETURN(RegRestoreKey(SvHKEY(ST(0)), (char*)SvPV(ST(1), na), (DWORD)((items == 3) ? SvIV(ST(2)) : 0))); +} + +static +XS(w32_RegSaveKey) +{ + dXSARGS; + + if(items != 2) + { + croak("usage: Win32::RegSaveKey($hkey, $filename);\n"); + } + + REGRETURN(RegSaveKey(SvHKEY(ST(0)), (char *)SvPV(ST(1), na), NULL)); +} + +static +XS(w32_RegSetKeySecurity) +{ + dXSARGS; + + if(items != 3) + { + croak("usage: Win32::RegSetKeySecurity($hkey, $security_info, $security_descriptor);\n"); + } + + REGRETURN(RegSetKeySecurity(SvHKEY(ST(0)), SvIV(ST(1)), (SECURITY_DESCRIPTOR*)SvPV(ST(2), na))); +} + +static +XS(w32_RegSetValue) +{ + dXSARGS; + + unsigned int size; + char *buffer; + + if(items != 4) + { + croak("usage: Win32::RegSetValue($hkey, $subKey, $type, $data);\n"); + } + + DWORD type = SvIV(ST(2)); + if(type != REG_SZ && type != REG_EXPAND_SZ) + { + croak("Win32::RegSetValue: Type was not REG_SZ or REG_EXPAND_SZ, cannot set %s\n", (char *)SvPV(ST(1), na)); + } + + buffer = (char *)SvPV(ST(3), size); + REGRETURN(RegSetValue(SvHKEY(ST(0)), SvPV(ST(1), na), REG_SZ, buffer, size)); +} + +static +XS(w32_RegSetValueEx) +{ + dXSARGS; + + DWORD type; + DWORD val; + unsigned int size; + char *buffer; + + if(items != 5) + { + croak("usage: Win32::RegSetValueEx($hkey, $valname, $reserved, $type, $data);\n"); + } + + type = (DWORD)SvIV(ST(3)); + switch(type) + { + case REG_SZ: + case REG_BINARY: + case REG_MULTI_SZ: + case REG_EXPAND_SZ: + buffer = (char *)SvPV(ST(4), size); + if(type != REG_BINARY) + size++; // include null terminator in size + + REGRETURN(RegSetValueEx(SvHKEY(ST(0)), (char *)SvPV(ST(1), na), 0, type, (PBYTE) buffer, size)); + break; + + case REG_DWORD_BIG_ENDIAN: + case REG_DWORD_LITTLE_ENDIAN: // Same as REG_DWORD + val = (DWORD)SvIV(ST(4)); + REGRETURN(RegSetValueEx(SvHKEY(ST(0)), (char *)SvPV(ST(1), na), 0, type, (PBYTE) &val, sizeof(DWORD))); + break; + + default: + croak("Win32::RegSetValueEx: Type not specified, cannot set %s\n", (char *)SvPV(ST(1), na)); + } +} + +static +XS(w32_RegUnloadKey) +{ + dXSARGS; + + if(items != 2) + { + croak("usage: Win32::RegUnLoadKey($hkey, $subkey);\n"); + } + + REGRETURN(RegUnLoadKey(SvHKEY(ST(0)), (char *)SvPV(ST(1), na))); +} + +static +XS(w32_RegisterServer) +{ + dXSARGS; + BOOL bSuccess = FALSE; + HINSTANCE hInstance; + unsigned int length; + FARPROC sFunc; + + if(items != 1) + { + croak("usage: Win32::RegisterServer($LibraryName)\n"); + } + + hInstance = LoadLibrary((char *)SvPV(ST(0), length)); + if(hInstance != NULL) + { + sFunc = GetProcAddress(hInstance, "DllRegisterServer"); + if(sFunc != NULL) + { + bSuccess = (sFunc() == 0); + } + FreeLibrary(hInstance); + } + + if(bSuccess) + { + XSRETURN_YES; + } + XSRETURN_NO; +} + +static +XS(w32_UnregisterServer) +{ + dXSARGS; + BOOL bSuccess = FALSE; + HINSTANCE hInstance; + unsigned int length; + FARPROC sFunc; + + if(items != 1) + { + croak("usage: Win32::UnregisterServer($LibraryName)\n"); + } + + hInstance = LoadLibrary((char *)SvPV(ST(0), length)); + if(hInstance != NULL) + { + sFunc = GetProcAddress(hInstance, "DllUnregisterServer"); + if(sFunc != NULL) + { + bSuccess = (sFunc() == 0); + } + FreeLibrary(hInstance); + } + + if(bSuccess) + { + XSRETURN_YES; + } + XSRETURN_NO; +} + + void Perl_init_os_extras() { @@ -1991,6 +2784,40 @@ Perl_init_os_extras() newXS("Win32::GetShortPathName", w32_GetShortPathName, file); newXS("Win32::Sleep", w32_Sleep, file); + /* the following extensions are used interally and may be changed at any time */ + /* therefore no documentation is provided */ + newXS("Win32::RegCloseKey", w32_RegCloseKey, file); + newXS("Win32::RegConnectRegistry", w32_RegConnectRegistry, file); + newXS("Win32::RegCreateKey", w32_RegCreateKey, file); + newXS("Win32::RegCreateKeyEx", w32_RegCreateKeyEx, file); + newXS("Win32::RegDeleteKey", w32_RegDeleteKey, file); + newXS("Win32::RegDeleteValue", w32_RegDeleteValue, file); + + newXS("Win32::RegEnumKey", w32_RegEnumKey, file); + newXS("Win32::RegEnumKeyEx", w32_RegEnumKeyEx, file); + newXS("Win32::RegEnumValue", w32_RegEnumValue, file); + + newXS("Win32::RegFlushKey", w32_RegFlushKey, file); + newXS("Win32::RegGetKeySecurity", w32_RegGetKeySecurity, file); + + newXS("Win32::RegLoadKey", w32_RegLoadKey, file); + newXS("Win32::RegOpenKey", w32_RegOpenKey, file); + newXS("Win32::RegOpenKeyEx", w32_RegOpenKeyEx, file); + newXS("Win32::RegQueryInfoKey", w32_RegQueryInfoKey, file); + newXS("Win32::RegQueryValue", w32_RegQueryValue, file); + newXS("Win32::RegQueryValueEx", w32_RegQueryValueEx, file); + + newXS("Win32::RegReplaceKey", w32_RegReplaceKey, file); + newXS("Win32::RegRestoreKey", w32_RegRestoreKey, file); + newXS("Win32::RegSaveKey", w32_RegSaveKey, file); + newXS("Win32::RegSetKeySecurity", w32_RegSetKeySecurity, file); + newXS("Win32::RegSetValue", w32_RegSetValue, file); + newXS("Win32::RegSetValueEx", w32_RegSetValueEx, file); + newXS("Win32::RegUnloadKey", w32_RegUnloadKey, file); + + newXS("Win32::RegisterServer", w32_RegisterServer, file); + newXS("Win32::UnregisterServer", w32_UnregisterServer, file); + /* XXX Bloat Alert! The following Activeware preloads really * ought to be part of Win32::Sys::*, so they're not included * here. |