This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Second patch from:
authorJan Dubois <jand@activestate.com>
Fri, 8 Dec 2006 19:07:06 +0000 (11:07 -0800)
committerRafael Garcia-Suarez <rgarciasuarez@gmail.com>
Mon, 11 Dec 2006 13:22:11 +0000 (13:22 +0000)
Subject: [PATCH] Move Win32::* functions from win32/win32.c to ext/Win32/Win32.xs
Message-ID: <lc9kn2tb0p5sdd4q69rbc7067r4imar59r@4ax.com>

p4raw-id: //depot/perl@29510

ext/Win32/Win32.xs
win32/win32.c

index b92ae65..681a683 100644 (file)
@@ -14,6 +14,22 @@ typedef int (__stdcall *PFNDllUnregisterServer)(void);
 #   define CSIDL_FLAG_CREATE               0x8000
 #endif
 
+static OSVERSIONINFO g_osver = {0, 0, 0, 0, 0, ""};
+
+#define ONE_K_BUFSIZE  1024
+
+int
+IsWin95(void)
+{
+    return (g_osver.dwPlatformId == VER_PLATFORM_WIN32_WINDOWS);
+}
+
+int
+IsWinNT(void)
+{
+    return (g_osver.dwPlatformId == VER_PLATFORM_WIN32_NT);
+}
+
 XS(w32_ExpandEnvironmentStrings)
 {
     dXSARGS;
@@ -524,11 +540,509 @@ XS(w32_GetFileVersion)
     XSRETURN(items);
 }
 
+/*
+ * Extras.
+ */
+
+static
+XS(w32_SetChildShowWindow)
+{
+    dXSARGS;
+    BOOL use_showwindow = w32_use_showwindow;
+    /* use "unsigned short" because Perl has redefined "WORD" */
+    unsigned short showwindow = w32_showwindow;
+
+    if (items > 1)
+       Perl_croak(aTHX_ "usage: Win32::SetChildShowWindow($showwindow)");
+
+    if (items == 0 || !SvOK(ST(0)))
+        w32_use_showwindow = FALSE;
+    else {
+        w32_use_showwindow = TRUE;
+        w32_showwindow = (unsigned short)SvIV(ST(0));
+    }
+
+    EXTEND(SP, 1);
+    if (use_showwindow)
+        ST(0) = sv_2mortal(newSViv(showwindow));
+    else
+        ST(0) = &PL_sv_undef;
+    XSRETURN(1);
+}
+
+static
+XS(w32_GetCwd)
+{
+    dXSARGS;
+    /* Make the host for current directory */
+    char* ptr = PerlEnv_get_childdir();
+    /*
+     * If ptr != Nullch
+     *   then it worked, set PV valid,
+     *   else return 'undef'
+     */
+    if (ptr) {
+       SV *sv = sv_newmortal();
+       sv_setpv(sv, ptr);
+       PerlEnv_free_childdir(ptr);
+
+#ifndef INCOMPLETE_TAINTS
+       SvTAINTED_on(sv);
+#endif
+
+       EXTEND(SP,1);
+       SvPOK_on(sv);
+       ST(0) = sv;
+       XSRETURN(1);
+    }
+    XSRETURN_UNDEF;
+}
+
+static
+XS(w32_SetCwd)
+{
+    dXSARGS;
+    if (items != 1)
+       Perl_croak(aTHX_ "usage: Win32::SetCurrentDirectory($cwd)");
+    if (!PerlDir_chdir(SvPV_nolen(ST(0))))
+       XSRETURN_YES;
+
+    XSRETURN_NO;
+}
+
+static
+XS(w32_GetNextAvailDrive)
+{
+    dXSARGS;
+    char ix = 'C';
+    char root[] = "_:\\";
+
+    EXTEND(SP,1);
+    while (ix <= 'Z') {
+       root[0] = ix++;
+       if (GetDriveType(root) == 1) {
+           root[2] = '\0';
+           XSRETURN_PV(root);
+       }
+    }
+    XSRETURN_UNDEF;
+}
+
+static
+XS(w32_GetLastError)
+{
+    dXSARGS;
+    EXTEND(SP,1);
+    XSRETURN_IV(GetLastError());
+}
+
+static
+XS(w32_SetLastError)
+{
+    dXSARGS;
+    if (items != 1)
+       Perl_croak(aTHX_ "usage: Win32::SetLastError($error)");
+    SetLastError(SvIV(ST(0)));
+    XSRETURN_EMPTY;
+}
+
+static
+XS(w32_LoginName)
+{
+    dXSARGS;
+    char *name = w32_getlogin_buffer;
+    DWORD size = sizeof(w32_getlogin_buffer);
+    EXTEND(SP,1);
+    if (GetUserName(name,&size)) {
+       /* size includes NULL */
+       ST(0) = sv_2mortal(newSVpvn(name,size-1));
+       XSRETURN(1);
+    }
+    XSRETURN_UNDEF;
+}
+
+static
+XS(w32_NodeName)
+{
+    dXSARGS;
+    char name[MAX_COMPUTERNAME_LENGTH+1];
+    DWORD size = sizeof(name);
+    EXTEND(SP,1);
+    if (GetComputerName(name,&size)) {
+       /* size does NOT include NULL :-( */
+       ST(0) = sv_2mortal(newSVpvn(name,size));
+       XSRETURN(1);
+    }
+    XSRETURN_UNDEF;
+}
+
+
+static
+XS(w32_DomainName)
+{
+    dXSARGS;
+    HINSTANCE hNetApi32 = LoadLibrary("netapi32.dll");
+    DWORD (__stdcall *pfnNetApiBufferFree)(LPVOID Buffer);
+    DWORD (__stdcall *pfnNetWkstaGetInfo)(LPWSTR servername, DWORD level,
+                                         void *bufptr);
+
+    if (hNetApi32) {
+       pfnNetApiBufferFree = (DWORD (__stdcall *)(void *))
+           GetProcAddress(hNetApi32, "NetApiBufferFree");
+       pfnNetWkstaGetInfo = (DWORD (__stdcall *)(LPWSTR, DWORD, void *))
+           GetProcAddress(hNetApi32, "NetWkstaGetInfo");
+    }
+    EXTEND(SP,1);
+    if (hNetApi32 && pfnNetWkstaGetInfo && pfnNetApiBufferFree) {
+       /* this way is more reliable, in case user has a local account. */
+       char dname[256];
+       DWORD dnamelen = sizeof(dname);
+       struct {
+           DWORD   wki100_platform_id;
+           LPWSTR  wki100_computername;
+           LPWSTR  wki100_langroup;
+           DWORD   wki100_ver_major;
+           DWORD   wki100_ver_minor;
+       } *pwi;
+       /* NERR_Success *is* 0*/
+       if (0 == pfnNetWkstaGetInfo(NULL, 100, &pwi)) {
+           if (pwi->wki100_langroup && *(pwi->wki100_langroup)) {
+               WideCharToMultiByte(CP_ACP, 0, pwi->wki100_langroup,
+                                   -1, (LPSTR)dname, dnamelen, NULL, NULL);
+           }
+           else {
+               WideCharToMultiByte(CP_ACP, 0, pwi->wki100_computername,
+                                   -1, (LPSTR)dname, dnamelen, NULL, NULL);
+           }
+           pfnNetApiBufferFree(pwi);
+           FreeLibrary(hNetApi32);
+           XSRETURN_PV(dname);
+       }
+       FreeLibrary(hNetApi32);
+    }
+    else {
+       /* Win95 doesn't have NetWksta*(), so do it the old way */
+       char name[256];
+       DWORD size = sizeof(name);
+       if (hNetApi32)
+           FreeLibrary(hNetApi32);
+       if (GetUserName(name,&size)) {
+           char sid[ONE_K_BUFSIZE];
+           DWORD sidlen = sizeof(sid);
+           char dname[256];
+           DWORD dnamelen = sizeof(dname);
+           SID_NAME_USE snu;
+           if (LookupAccountName(NULL, name, (PSID)&sid, &sidlen,
+                                 dname, &dnamelen, &snu)) {
+               XSRETURN_PV(dname);             /* all that for this */
+           }
+       }
+    }
+    XSRETURN_UNDEF;
+}
+
+static
+XS(w32_FsType)
+{
+    dXSARGS;
+    char fsname[256];
+    DWORD flags, filecomplen;
+    if (GetVolumeInformation(NULL, NULL, 0, NULL, &filecomplen,
+                        &flags, fsname, sizeof(fsname))) {
+       if (GIMME_V == G_ARRAY) {
+           XPUSHs(sv_2mortal(newSVpvn(fsname,strlen(fsname))));
+           XPUSHs(sv_2mortal(newSViv(flags)));
+           XPUSHs(sv_2mortal(newSViv(filecomplen)));
+           PUTBACK;
+           return;
+       }
+       EXTEND(SP,1);
+       XSRETURN_PV(fsname);
+    }
+    XSRETURN_EMPTY;
+}
+
+static
+XS(w32_GetOSVersion)
+{
+    dXSARGS;
+    /* Use explicit struct definition because wSuiteMask and
+     * wProductType are not defined in the VC++ 6.0 headers.
+     * WORD type has been replaced by unsigned short because
+     * WORD is already used by Perl itself.
+     */
+    struct {
+        DWORD dwOSVersionInfoSize;
+        DWORD dwMajorVersion;
+        DWORD dwMinorVersion;
+        DWORD dwBuildNumber;
+        DWORD dwPlatformId;
+        CHAR  szCSDVersion[128];
+        unsigned short wServicePackMajor;
+        unsigned short wServicePackMinor;
+        unsigned short wSuiteMask;
+        BYTE  wProductType;
+        BYTE  wReserved;
+    }   osver;
+    BOOL bEx = TRUE;
+
+    osver.dwOSVersionInfoSize = sizeof(osver);
+    if (!GetVersionExA((OSVERSIONINFOA*)&osver)) {
+        bEx = FALSE;
+        osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFOA);
+        if (!GetVersionExA((OSVERSIONINFOA*)&osver)) {
+            XSRETURN_EMPTY;
+        }
+    }
+    if (GIMME_V == G_SCALAR) {
+        XSRETURN_IV(osver.dwPlatformId);
+    }
+    XPUSHs(newSVpvn(osver.szCSDVersion, strlen(osver.szCSDVersion)));
+
+    XPUSHs(newSViv(osver.dwMajorVersion));
+    XPUSHs(newSViv(osver.dwMinorVersion));
+    XPUSHs(newSViv(osver.dwBuildNumber));
+    XPUSHs(newSViv(osver.dwPlatformId));
+    if (bEx) {
+        XPUSHs(newSViv(osver.wServicePackMajor));
+        XPUSHs(newSViv(osver.wServicePackMinor));
+        XPUSHs(newSViv(osver.wSuiteMask));
+        XPUSHs(newSViv(osver.wProductType));
+    }
+    PUTBACK;
+}
+
+static
+XS(w32_IsWinNT)
+{
+    dXSARGS;
+    EXTEND(SP,1);
+    XSRETURN_IV(IsWinNT());
+}
+
+static
+XS(w32_IsWin95)
+{
+    dXSARGS;
+    EXTEND(SP,1);
+    XSRETURN_IV(IsWin95());
+}
+
+static
+XS(w32_FormatMessage)
+{
+    dXSARGS;
+    DWORD source = 0;
+    char msgbuf[ONE_K_BUFSIZE];
+
+    if (items != 1)
+       Perl_croak(aTHX_ "usage: Win32::FormatMessage($errno)");
+
+    if (FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM,
+                       &source, SvIV(ST(0)), 0,
+                       msgbuf, sizeof(msgbuf)-1, NULL))
+    {
+        XSRETURN_PV(msgbuf);
+    }
+
+    XSRETURN_UNDEF;
+}
+
+static
+XS(w32_Spawn)
+{
+    dXSARGS;
+    char *cmd, *args;
+    void *env;
+    char *dir;
+    PROCESS_INFORMATION stProcInfo;
+    STARTUPINFO stStartInfo;
+    BOOL bSuccess = FALSE;
+
+    if (items != 3)
+       Perl_croak(aTHX_ "usage: Win32::Spawn($cmdName, $args, $PID)");
+
+    cmd = SvPV_nolen(ST(0));
+    args = SvPV_nolen(ST(1));
+
+    env = PerlEnv_get_childenv();
+    dir = PerlEnv_get_childdir();
+
+    memset(&stStartInfo, 0, sizeof(stStartInfo));   /* Clear the block */
+    stStartInfo.cb = sizeof(stStartInfo);          /* Set the structure size */
+    stStartInfo.dwFlags = STARTF_USESHOWWINDOW;            /* Enable wShowWindow control */
+    stStartInfo.wShowWindow = SW_SHOWMINNOACTIVE;   /* Start min (normal) */
+
+    if (CreateProcess(
+               cmd,                    /* Image path */
+               args,                   /* Arguments for command line */
+               NULL,                   /* Default process security */
+               NULL,                   /* Default thread security */
+               FALSE,                  /* Must be TRUE to use std handles */
+               NORMAL_PRIORITY_CLASS,  /* No special scheduling */
+               env,                    /* Inherit our environment block */
+               dir,                    /* Inherit our currrent directory */
+               &stStartInfo,           /* -> Startup info */
+               &stProcInfo))           /* <- Process info (if OK) */
+    {
+       int pid = (int)stProcInfo.dwProcessId;
+       if (IsWin95() && pid < 0)
+           pid = -pid;
+       sv_setiv(ST(2), pid);
+       CloseHandle(stProcInfo.hThread);/* library source code does this. */
+       bSuccess = TRUE;
+    }
+    PerlEnv_free_childenv(env);
+    PerlEnv_free_childdir(dir);
+    XSRETURN_IV(bSuccess);
+}
+
+static
+XS(w32_GetTickCount)
+{
+    dXSARGS;
+    DWORD msec = GetTickCount();
+    EXTEND(SP,1);
+    if ((IV)msec > 0)
+       XSRETURN_IV(msec);
+    XSRETURN_NV(msec);
+}
+
+static
+XS(w32_GetShortPathName)
+{
+    dXSARGS;
+    SV *shortpath;
+    DWORD len;
+
+    if (items != 1)
+       Perl_croak(aTHX_ "usage: Win32::GetShortPathName($longPathName)");
+
+    shortpath = sv_mortalcopy(ST(0));
+    SvUPGRADE(shortpath, SVt_PV);
+    if (!SvPVX(shortpath) || !SvLEN(shortpath))
+        XSRETURN_UNDEF;
+
+    /* src == target is allowed */
+    do {
+       len = GetShortPathName(SvPVX(shortpath),
+                              SvPVX(shortpath),
+                              SvLEN(shortpath));
+    } while (len >= SvLEN(shortpath) && sv_grow(shortpath,len+1));
+    if (len) {
+       SvCUR_set(shortpath,len);
+       *SvEND(shortpath) = '\0';
+       ST(0) = shortpath;
+       XSRETURN(1);
+    }
+    XSRETURN_UNDEF;
+}
+
+static
+XS(w32_GetFullPathName)
+{
+    dXSARGS;
+    SV *filename;
+    SV *fullpath;
+    char *filepart;
+    DWORD len;
+    STRLEN filename_len;
+    char *filename_p;
+
+    if (items != 1)
+       Perl_croak(aTHX_ "usage: Win32::GetFullPathName($filename)");
+
+    filename = ST(0);
+    filename_p = SvPV(filename, filename_len);
+    fullpath = sv_2mortal(newSVpvn(filename_p, filename_len));
+    if (!SvPVX(fullpath) || !SvLEN(fullpath))
+        XSRETURN_UNDEF;
+
+    do {
+       len = GetFullPathName(SvPVX(filename),
+                             SvLEN(fullpath),
+                             SvPVX(fullpath),
+                             &filepart);
+    } while (len >= SvLEN(fullpath) && sv_grow(fullpath,len+1));
+    if (len) {
+       if (GIMME_V == G_ARRAY) {
+           EXTEND(SP,1);
+           if (filepart) {
+               XST_mPV(1,filepart);
+               len = filepart - SvPVX(fullpath);
+           }
+           else {
+               XST_mPVN(1,"",0);
+           }
+           items = 2;
+       }
+       SvCUR_set(fullpath,len);
+       *SvEND(fullpath) = '\0';
+       ST(0) = fullpath;
+       XSRETURN(items);
+    }
+    XSRETURN_EMPTY;
+}
+
+static
+XS(w32_GetLongPathName)
+{
+    dXSARGS;
+    SV *path;
+    char tmpbuf[MAX_PATH+1];
+    char *pathstr;
+    STRLEN len;
+
+    if (items != 1)
+       Perl_croak(aTHX_ "usage: Win32::GetLongPathName($pathname)");
+
+    path = ST(0);
+    pathstr = SvPV(path,len);
+    strcpy(tmpbuf, pathstr);
+    pathstr = win32_longpath(tmpbuf);
+    if (pathstr) {
+       ST(0) = sv_2mortal(newSVpvn(pathstr, strlen(pathstr)));
+       XSRETURN(1);
+    }
+    XSRETURN_EMPTY;
+}
+
+static
+XS(w32_Sleep)
+{
+    dXSARGS;
+    if (items != 1)
+       Perl_croak(aTHX_ "usage: Win32::Sleep($milliseconds)");
+    Sleep(SvIV(ST(0)));
+    XSRETURN_YES;
+}
+
+static
+XS(w32_CopyFile)
+{
+    dXSARGS;
+    BOOL bResult;
+    char szSourceFile[MAX_PATH+1];
+
+    if (items != 3)
+       Perl_croak(aTHX_ "usage: Win32::CopyFile($from, $to, $overwrite)");
+    strcpy(szSourceFile, PerlDir_mapA(SvPV_nolen(ST(0))));
+    bResult = CopyFileA(szSourceFile, PerlDir_mapA(SvPV_nolen(ST(1))), !SvTRUE(ST(2)));
+    if (bResult)
+       XSRETURN_YES;
+    XSRETURN_NO;
+}
+
 XS(boot_Win32)
 {
     dXSARGS;
     char *file = __FILE__;
 
+    if (g_osver.dwOSVersionInfoSize == 0) {
+        g_osver.dwOSVersionInfoSize = sizeof(g_osver);
+        GetVersionEx(&g_osver);
+    }
+
     newXS("Win32::LookupAccountName", w32_LookupAccountName, file);
     newXS("Win32::LookupAccountSID", w32_LookupAccountSID, file);
     newXS("Win32::InitiateSystemShutdown", w32_InitiateSystemShutdown, file);
@@ -547,5 +1061,27 @@ XS(boot_Win32)
     newXS("Win32::IsAdminUser", w32_IsAdminUser, file);
     newXS("Win32::GetFileVersion", w32_GetFileVersion, file);
 
+    newXS("Win32::GetCwd", w32_GetCwd, file);
+    newXS("Win32::SetCwd", w32_SetCwd, file);
+    newXS("Win32::GetNextAvailDrive", w32_GetNextAvailDrive, file);
+    newXS("Win32::GetLastError", w32_GetLastError, file);
+    newXS("Win32::SetLastError", w32_SetLastError, file);
+    newXS("Win32::LoginName", w32_LoginName, file);
+    newXS("Win32::NodeName", w32_NodeName, file);
+    newXS("Win32::DomainName", w32_DomainName, file);
+    newXS("Win32::FsType", w32_FsType, file);
+    newXS("Win32::GetOSVersion", w32_GetOSVersion, file);
+    newXS("Win32::IsWinNT", w32_IsWinNT, file);
+    newXS("Win32::IsWin95", w32_IsWin95, file);
+    newXS("Win32::FormatMessage", w32_FormatMessage, file);
+    newXS("Win32::Spawn", w32_Spawn, file);
+    newXS("Win32::GetTickCount", w32_GetTickCount, file);
+    newXS("Win32::GetShortPathName", w32_GetShortPathName, file);
+    newXS("Win32::GetFullPathName", w32_GetFullPathName, file);
+    newXS("Win32::GetLongPathName", w32_GetLongPathName, file);
+    newXS("Win32::CopyFile", w32_CopyFile, file);
+    newXS("Win32::Sleep", w32_Sleep, file);
+    newXS("Win32::SetChildShowWindow", w32_SetChildShowWindow, file);
+
     XSRETURN_YES;
 }
index a7c409f..16bf51e 100644 (file)
@@ -121,8 +121,6 @@ END_EXTERN_C
 
 static OSVERSIONINFO g_osver = {0, 0, 0, 0, 0, ""};
 
-#define ONE_K_BUFSIZE  1024
-
 #ifdef __BORLANDC__
 /* Silence STDERR grumblings from Borland's math library. */
 DllExport int
@@ -4270,498 +4268,38 @@ win32_dynaload(const char* filename)
     return LoadLibraryExA(PerlDir_mapA(filename), NULL, LOAD_WITH_ALTERED_SEARCH_PATH);
 }
 
-/*
- * Extras.
- */
-
-static
-XS(w32_SetChildShowWindow)
-{
-    dXSARGS;
-    BOOL use_showwindow = w32_use_showwindow;
-    /* use "unsigned short" because Perl has redefined "WORD" */
-    unsigned short showwindow = w32_showwindow;
-
-    if (items > 1)
-       Perl_croak(aTHX_ "usage: Win32::SetChildShowWindow($showwindow)");
-
-    if (items == 0 || !SvOK(ST(0)))
-        w32_use_showwindow = FALSE;
-    else {
-        w32_use_showwindow = TRUE;
-        w32_showwindow = (unsigned short)SvIV(ST(0));
-    }
-
-    EXTEND(SP, 1);
-    if (use_showwindow)
-        ST(0) = sv_2mortal(newSViv(showwindow));
-    else
-        ST(0) = &PL_sv_undef;
-    XSRETURN(1);
-}
-
-static
-XS(w32_GetCwd)
-{
-    dXSARGS;
-    /* Make the host for current directory */
-    char* ptr = PerlEnv_get_childdir();
-    /*
-     * If ptr != Nullch
-     *   then it worked, set PV valid,
-     *   else return 'undef'
-     */
-    if (ptr) {
-       SV *sv = sv_newmortal();
-       sv_setpv(sv, ptr);
-       PerlEnv_free_childdir(ptr);
-
-#ifndef INCOMPLETE_TAINTS
-       SvTAINTED_on(sv);
-#endif
-
-       EXTEND(SP,1);
-       SvPOK_on(sv);
-       ST(0) = sv;
-       XSRETURN(1);
-    }
-    XSRETURN_UNDEF;
-}
-
-static
-XS(w32_SetCwd)
-{
-    dXSARGS;
-    if (items != 1)
-       Perl_croak(aTHX_ "usage: Win32::SetCurrentDirectory($cwd)");
-    if (!PerlDir_chdir(SvPV_nolen(ST(0))))
-       XSRETURN_YES;
-
-    XSRETURN_NO;
-}
-
-static
-XS(w32_GetNextAvailDrive)
-{
-    dXSARGS;
-    char ix = 'C';
-    char root[] = "_:\\";
-
-    EXTEND(SP,1);
-    while (ix <= 'Z') {
-       root[0] = ix++;
-       if (GetDriveType(root) == 1) {
-           root[2] = '\0';
-           XSRETURN_PV(root);
-       }
-    }
-    XSRETURN_UNDEF;
-}
-
-static
-XS(w32_GetLastError)
-{
-    dXSARGS;
-    EXTEND(SP,1);
-    XSRETURN_IV(GetLastError());
-}
-
-static
-XS(w32_SetLastError)
-{
-    dXSARGS;
-    if (items != 1)
-       Perl_croak(aTHX_ "usage: Win32::SetLastError($error)");
-    SetLastError(SvIV(ST(0)));
-    XSRETURN_EMPTY;
-}
-
-static
-XS(w32_LoginName)
-{
-    dXSARGS;
-    char *name = w32_getlogin_buffer;
-    DWORD size = sizeof(w32_getlogin_buffer);
-    EXTEND(SP,1);
-    if (GetUserName(name,&size)) {
-       /* size includes NULL */
-       ST(0) = sv_2mortal(newSVpvn(name,size-1));
-       XSRETURN(1);
-    }
-    XSRETURN_UNDEF;
-}
-
-static
-XS(w32_NodeName)
-{
-    dXSARGS;
-    char name[MAX_COMPUTERNAME_LENGTH+1];
-    DWORD size = sizeof(name);
-    EXTEND(SP,1);
-    if (GetComputerName(name,&size)) {
-       /* size does NOT include NULL :-( */
-       ST(0) = sv_2mortal(newSVpvn(name,size));
-       XSRETURN(1);
-    }
-    XSRETURN_UNDEF;
-}
-
-
-static
-XS(w32_DomainName)
-{
-    dXSARGS;
-    HINSTANCE hNetApi32 = LoadLibrary("netapi32.dll");
-    DWORD (__stdcall *pfnNetApiBufferFree)(LPVOID Buffer);
-    DWORD (__stdcall *pfnNetWkstaGetInfo)(LPWSTR servername, DWORD level,
-                                         void *bufptr);
-
-    if (hNetApi32) {
-       pfnNetApiBufferFree = (DWORD (__stdcall *)(void *))
-           GetProcAddress(hNetApi32, "NetApiBufferFree");
-       pfnNetWkstaGetInfo = (DWORD (__stdcall *)(LPWSTR, DWORD, void *))
-           GetProcAddress(hNetApi32, "NetWkstaGetInfo");
-    }
-    EXTEND(SP,1);
-    if (hNetApi32 && pfnNetWkstaGetInfo && pfnNetApiBufferFree) {
-       /* this way is more reliable, in case user has a local account. */
-       char dname[256];
-       DWORD dnamelen = sizeof(dname);
-       struct {
-           DWORD   wki100_platform_id;
-           LPWSTR  wki100_computername;
-           LPWSTR  wki100_langroup;
-           DWORD   wki100_ver_major;
-           DWORD   wki100_ver_minor;
-       } *pwi;
-       /* NERR_Success *is* 0*/
-       if (0 == pfnNetWkstaGetInfo(NULL, 100, &pwi)) {
-           if (pwi->wki100_langroup && *(pwi->wki100_langroup)) {
-               WideCharToMultiByte(CP_ACP, 0, pwi->wki100_langroup,
-                                   -1, (LPSTR)dname, dnamelen, NULL, NULL);
-           }
-           else {
-               WideCharToMultiByte(CP_ACP, 0, pwi->wki100_computername,
-                                   -1, (LPSTR)dname, dnamelen, NULL, NULL);
-           }
-           pfnNetApiBufferFree(pwi);
-           FreeLibrary(hNetApi32);
-           XSRETURN_PV(dname);
-       }
-       FreeLibrary(hNetApi32);
-    }
-    else {
-       /* Win95 doesn't have NetWksta*(), so do it the old way */
-       char name[256];
-       DWORD size = sizeof(name);
-       if (hNetApi32)
-           FreeLibrary(hNetApi32);
-       if (GetUserName(name,&size)) {
-           char sid[ONE_K_BUFSIZE];
-           DWORD sidlen = sizeof(sid);
-           char dname[256];
-           DWORD dnamelen = sizeof(dname);
-           SID_NAME_USE snu;
-           if (LookupAccountName(NULL, name, (PSID)&sid, &sidlen,
-                                 dname, &dnamelen, &snu)) {
-               XSRETURN_PV(dname);             /* all that for this */
-           }
-       }
-    }
-    XSRETURN_UNDEF;
-}
-
-static
-XS(w32_FsType)
-{
-    dXSARGS;
-    char fsname[256];
-    DWORD flags, filecomplen;
-    if (GetVolumeInformation(NULL, NULL, 0, NULL, &filecomplen,
-                        &flags, fsname, sizeof(fsname))) {
-       if (GIMME_V == G_ARRAY) {
-           XPUSHs(sv_2mortal(newSVpvn(fsname,strlen(fsname))));
-           XPUSHs(sv_2mortal(newSViv(flags)));
-           XPUSHs(sv_2mortal(newSViv(filecomplen)));
-           PUTBACK;
-           return;
-       }
-       EXTEND(SP,1);
-       XSRETURN_PV(fsname);
-    }
-    XSRETURN_EMPTY;
-}
-
-static
-XS(w32_GetOSVersion)
-{
-    dXSARGS;
-    /* Use explicit struct definition because wSuiteMask and
-     * wProductType are not defined in the VC++ 6.0 headers.
-     * WORD type has been replaced by unsigned short because
-     * WORD is already used by Perl itself.
-     */
-    struct {
-        DWORD dwOSVersionInfoSize;
-        DWORD dwMajorVersion;
-        DWORD dwMinorVersion;
-        DWORD dwBuildNumber;
-        DWORD dwPlatformId;
-        CHAR  szCSDVersion[128];
-        unsigned short wServicePackMajor;
-        unsigned short wServicePackMinor;
-        unsigned short wSuiteMask;
-        BYTE  wProductType;
-        BYTE  wReserved;
-    }   osver;
-    BOOL bEx = TRUE;
-
-    osver.dwOSVersionInfoSize = sizeof(osver);
-    if (!GetVersionExA((OSVERSIONINFOA*)&osver)) {
-        bEx = FALSE;
-        osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFOA);
-        if (!GetVersionExA((OSVERSIONINFOA*)&osver)) {
-            XSRETURN_EMPTY;
-        }
-    }
-    if (GIMME_V == G_SCALAR) {
-        XSRETURN_IV(osver.dwPlatformId);
-    }
-    XPUSHs(newSVpvn(osver.szCSDVersion, strlen(osver.szCSDVersion)));
-
-    XPUSHs(newSViv(osver.dwMajorVersion));
-    XPUSHs(newSViv(osver.dwMinorVersion));
-    XPUSHs(newSViv(osver.dwBuildNumber));
-    XPUSHs(newSViv(osver.dwPlatformId));
-    if (bEx) {
-        XPUSHs(newSViv(osver.wServicePackMajor));
-        XPUSHs(newSViv(osver.wServicePackMinor));
-        XPUSHs(newSViv(osver.wSuiteMask));
-        XPUSHs(newSViv(osver.wProductType));
-    }
-    PUTBACK;
-}
-
-static
-XS(w32_IsWinNT)
-{
-    dXSARGS;
-    EXTEND(SP,1);
-    XSRETURN_IV(IsWinNT());
-}
-
-static
-XS(w32_IsWin95)
-{
-    dXSARGS;
-    EXTEND(SP,1);
-    XSRETURN_IV(IsWin95());
-}
-
-static
-XS(w32_FormatMessage)
-{
-    dXSARGS;
-    DWORD source = 0;
-    char msgbuf[ONE_K_BUFSIZE];
-
-    if (items != 1)
-       Perl_croak(aTHX_ "usage: Win32::FormatMessage($errno)");
-
-    if (FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM,
-                       &source, SvIV(ST(0)), 0,
-                       msgbuf, sizeof(msgbuf)-1, NULL))
-    {
-        XSRETURN_PV(msgbuf);
-    }
-
-    XSRETURN_UNDEF;
-}
-
-static
-XS(w32_Spawn)
-{
-    dXSARGS;
-    char *cmd, *args;
-    void *env;
-    char *dir;
-    PROCESS_INFORMATION stProcInfo;
-    STARTUPINFO stStartInfo;
-    BOOL bSuccess = FALSE;
-
-    if (items != 3)
-       Perl_croak(aTHX_ "usage: Win32::Spawn($cmdName, $args, $PID)");
-
-    cmd = SvPV_nolen(ST(0));
-    args = SvPV_nolen(ST(1));
-
-    env = PerlEnv_get_childenv();
-    dir = PerlEnv_get_childdir();
-
-    memset(&stStartInfo, 0, sizeof(stStartInfo));   /* Clear the block */
-    stStartInfo.cb = sizeof(stStartInfo);          /* Set the structure size */
-    stStartInfo.dwFlags = STARTF_USESHOWWINDOW;            /* Enable wShowWindow control */
-    stStartInfo.wShowWindow = SW_SHOWMINNOACTIVE;   /* Start min (normal) */
-
-    if (CreateProcess(
-               cmd,                    /* Image path */
-               args,                   /* Arguments for command line */
-               NULL,                   /* Default process security */
-               NULL,                   /* Default thread security */
-               FALSE,                  /* Must be TRUE to use std handles */
-               NORMAL_PRIORITY_CLASS,  /* No special scheduling */
-               env,                    /* Inherit our environment block */
-               dir,                    /* Inherit our currrent directory */
-               &stStartInfo,           /* -> Startup info */
-               &stProcInfo))           /* <- Process info (if OK) */
-    {
-       int pid = (int)stProcInfo.dwProcessId;
-       if (IsWin95() && pid < 0)
-           pid = -pid;
-       sv_setiv(ST(2), pid);
-       CloseHandle(stProcInfo.hThread);/* library source code does this. */
-       bSuccess = TRUE;
-    }
-    PerlEnv_free_childenv(env);
-    PerlEnv_free_childdir(dir);
-    XSRETURN_IV(bSuccess);
-}
-
-static
-XS(w32_GetTickCount)
-{
-    dXSARGS;
-    DWORD msec = GetTickCount();
-    EXTEND(SP,1);
-    if ((IV)msec > 0)
-       XSRETURN_IV(msec);
-    XSRETURN_NV(msec);
-}
-
-static
-XS(w32_GetShortPathName)
-{
-    dXSARGS;
-    SV *shortpath;
-    DWORD len;
-
-    if (items != 1)
-       Perl_croak(aTHX_ "usage: Win32::GetShortPathName($longPathName)");
-
-    shortpath = sv_mortalcopy(ST(0));
-    SvUPGRADE(shortpath, SVt_PV);
-    if (!SvPVX(shortpath) || !SvLEN(shortpath))
-        XSRETURN_UNDEF;
-
-    /* src == target is allowed */
-    do {
-       len = GetShortPathName(SvPVX(shortpath),
-                              SvPVX(shortpath),
-                              SvLEN(shortpath));
-    } while (len >= SvLEN(shortpath) && sv_grow(shortpath,len+1));
-    if (len) {
-       SvCUR_set(shortpath,len);
-       *SvEND(shortpath) = '\0';
-       ST(0) = shortpath;
-       XSRETURN(1);
-    }
-    XSRETURN_UNDEF;
-}
-
-static
-XS(w32_GetFullPathName)
-{
-    dXSARGS;
-    SV *filename;
-    SV *fullpath;
-    char *filepart;
-    DWORD len;
-    STRLEN filename_len;
-    char *filename_p;
-
-    if (items != 1)
-       Perl_croak(aTHX_ "usage: Win32::GetFullPathName($filename)");
-
-    filename = ST(0);
-    filename_p = SvPV(filename, filename_len);
-    fullpath = sv_2mortal(newSVpvn(filename_p, filename_len));
-    if (!SvPVX(fullpath) || !SvLEN(fullpath))
-        XSRETURN_UNDEF;
-
-    do {
-       len = GetFullPathName(SvPVX(filename),
-                             SvLEN(fullpath),
-                             SvPVX(fullpath),
-                             &filepart);
-    } while (len >= SvLEN(fullpath) && sv_grow(fullpath,len+1));
-    if (len) {
-       if (GIMME_V == G_ARRAY) {
-           EXTEND(SP,1);
-           if (filepart) {
-               XST_mPV(1,filepart);
-               len = filepart - SvPVX(fullpath);
-           }
-           else {
-               XST_mPVN(1,"",0);
-           }
-           items = 2;
-       }
-       SvCUR_set(fullpath,len);
-       *SvEND(fullpath) = '\0';
-       ST(0) = fullpath;
-       XSRETURN(items);
-    }
-    XSRETURN_EMPTY;
-}
-
-static
-XS(w32_GetLongPathName)
-{
-    dXSARGS;
-    SV *path;
-    char tmpbuf[MAX_PATH+1];
-    char *pathstr;
-    STRLEN len;
-
-    if (items != 1)
-       Perl_croak(aTHX_ "usage: Win32::GetLongPathName($pathname)");
-
-    path = ST(0);
-    pathstr = SvPV(path,len);
-    strcpy(tmpbuf, pathstr);
-    pathstr = win32_longpath(tmpbuf);
-    if (pathstr) {
-       ST(0) = sv_2mortal(newSVpvn(pathstr, strlen(pathstr)));
-       XSRETURN(1);
-    }
-    XSRETURN_EMPTY;
-}
-
-static
-XS(w32_Sleep)
-{
-    dXSARGS;
-    if (items != 1)
-       Perl_croak(aTHX_ "usage: Win32::Sleep($milliseconds)");
-    Sleep(SvIV(ST(0)));
-    XSRETURN_YES;
-}
-
-static
-XS(w32_CopyFile)
+static void
+forward(pTHX_ const char *function)
 {
     dXSARGS;
-    BOOL bResult;
-    char szSourceFile[MAX_PATH+1];
-
-    if (items != 3)
-       Perl_croak(aTHX_ "usage: Win32::CopyFile($from, $to, $overwrite)");
-    strcpy(szSourceFile, PerlDir_mapA(SvPV_nolen(ST(0))));
-    bResult = CopyFileA(szSourceFile, PerlDir_mapA(SvPV_nolen(ST(1))), !SvTRUE(ST(2)));
-    if (bResult)
-       XSRETURN_YES;
-    XSRETURN_NO;
-}
+    Perl_load_module(aTHX_ PERL_LOADMOD_NOIMPORT, newSVpvn("Win32",5), NULL);
+    PUSHMARK(SP-items);
+    call_pv(function, GIMME_V);
+}
+
+#define FORWARD(function) XS(w32_##function){ forward(aTHX_ "Win32::"#function); }
+FORWARD(GetCwd)
+FORWARD(SetCwd)
+FORWARD(GetNextAvailDrive)
+FORWARD(GetLastError)
+FORWARD(SetLastError)
+FORWARD(LoginName)
+FORWARD(NodeName)
+FORWARD(DomainName)
+FORWARD(FsType)
+FORWARD(GetOSVersion)
+FORWARD(IsWinNT)
+FORWARD(IsWin95)
+FORWARD(FormatMessage)
+FORWARD(Spawn)
+FORWARD(GetTickCount)
+FORWARD(GetShortPathName)
+FORWARD(GetFullPathName)
+FORWARD(GetLongPathName)
+FORWARD(CopyFile)
+FORWARD(Sleep)
+FORWARD(SetChildShowWindow)
+#undef FORWARD
 
 void
 Perl_init_os_extras(void)
@@ -4792,17 +4330,6 @@ Perl_init_os_extras(void)
     newXS("Win32::CopyFile", w32_CopyFile, file);
     newXS("Win32::Sleep", w32_Sleep, file);
     newXS("Win32::SetChildShowWindow", w32_SetChildShowWindow, file);
-
-    /* XXX Bloat Alert! The following Activeware preloads really
-     * ought to be part of Win32::Sys::*, so they're not included
-     * here.
-     */
-    /* LookupAccountName
-     * LookupAccountSID
-     * InitiateSystemShutdown
-     * AbortSystemShutdown
-     * ExpandEnvrironmentStrings
-     */
 }
 
 void *