1
1
#define WIN32_LEAN_AND_MEAN
2
+ #include <wchar.h>
2
3
#include <wctype.h>
3
4
#include <windows.h>
4
5
#include <shlobj.h>
6
+ #include <wchar.h>
5
7
6
8
#define PERL_NO_GET_CONTEXT
7
9
#include "EXTERN.h"
@@ -114,7 +116,7 @@ typedef void (WINAPI *PFNGetNativeSystemInfo)(LPSYSTEM_INFO lpSystemInfo);
114
116
* WORD type has been replaced by unsigned short because
115
117
* WORD is already used by Perl itself.
116
118
*/
117
- struct {
119
+ struct g_osver_t {
118
120
DWORD dwOSVersionInfoSize ;
119
121
DWORD dwMajorVersion ;
120
122
DWORD dwMinorVersion ;
@@ -126,7 +128,7 @@ struct {
126
128
unsigned short wSuiteMask ;
127
129
BYTE wProductType ;
128
130
BYTE wReserved ;
129
- } g_osver = {0 , 0 , 0 , 0 , 0 , "" , 0 , 0 , 0 , 0 , 0 };
131
+ } g_osver = {0 , 0 , 0 , 0 , 0 , "" , 0 , 0 , 0 , 0 , 0 };
130
132
BOOL g_osver_ex = TRUE;
131
133
132
134
#define ONE_K_BUFSIZE 1024
@@ -201,7 +203,7 @@ wstr_to_sv(pTHX_ WCHAR *wstr)
201
203
* characters for the characters not in the ANSI codepage.
202
204
*/
203
205
SV *
204
- get_unicode_env (pTHX_ WCHAR * name )
206
+ get_unicode_env (pTHX_ const WCHAR * name )
205
207
{
206
208
SV * sv = NULL ;
207
209
void * env ;
@@ -377,6 +379,7 @@ get_childenv(void)
377
379
void
378
380
free_childenv (void * d )
379
381
{
382
+ PERL_UNUSED_ARG (d );
380
383
}
381
384
382
385
# define PerlDir_mapA (dir ) (dir)
@@ -388,7 +391,7 @@ XS(w32_ExpandEnvironmentStrings)
388
391
dXSARGS ;
389
392
390
393
if (items != 1 )
391
- croak ("usage: Win32::ExpandEnvironmentStrings($String);\n " );
394
+ croak ("usage: Win32::ExpandEnvironmentStrings($String)" );
392
395
393
396
if (IsWin2000 ()) {
394
397
WCHAR value [31 * 1024 ];
@@ -536,7 +539,7 @@ XS(w32_LookupAccountName)
536
539
537
540
if (items != 5 )
538
541
croak ("usage: Win32::LookupAccountName($system, $account, $domain, "
539
- "$sid, $sidtype);\n " );
542
+ "$sid, $sidtype)" );
540
543
541
544
SIDLen = sizeof (SID );
542
545
DomLen = sizeof (Domain );
@@ -570,7 +573,7 @@ XS(w32_LookupAccountSID)
570
573
BOOL bResult ;
571
574
572
575
if (items != 5 )
573
- croak ("usage: Win32::LookupAccountSID($system, $sid, $account, $domain, $sidtype);\n " );
576
+ croak ("usage: Win32::LookupAccountSID($system, $sid, $account, $domain, $sidtype)" );
574
577
575
578
sid = SvPV_nolen (ST (1 ));
576
579
if (IsValidSid (sid )) {
@@ -601,7 +604,7 @@ XS(w32_InitiateSystemShutdown)
601
604
602
605
if (items != 5 )
603
606
croak ("usage: Win32::InitiateSystemShutdown($machineName, $message, "
604
- "$timeOut, $forceClose, $reboot);\n " );
607
+ "$timeOut, $forceClose, $reboot)" );
605
608
606
609
machineName = SvPV_nolen (ST (0 ));
607
610
@@ -642,7 +645,7 @@ XS(w32_AbortSystemShutdown)
642
645
char * machineName ;
643
646
644
647
if (items != 1 )
645
- croak ("usage: Win32::AbortSystemShutdown($machineName);\n " );
648
+ croak ("usage: Win32::AbortSystemShutdown($machineName)" );
646
649
647
650
machineName = SvPV_nolen (ST (0 ));
648
651
@@ -680,7 +683,7 @@ XS(w32_MsgBox)
680
683
I32 result ;
681
684
682
685
if (items < 1 || items > 3 )
683
- croak ("usage: Win32::MsgBox($message [, $flags [, $title]]);\n " );
686
+ croak ("usage: Win32::MsgBox($message [, $flags [, $title]])" );
684
687
685
688
if (items > 1 )
686
689
flags = (DWORD )SvIV (ST (1 ));
@@ -696,7 +699,7 @@ XS(w32_MsgBox)
696
699
Safefree (title );
697
700
}
698
701
else {
699
- char * title = "Perl" ;
702
+ const char * title = "Perl" ;
700
703
char * msg = SvPV_nolen (ST (0 ));
701
704
if (items > 2 )
702
705
title = SvPV_nolen (ST (2 ));
@@ -787,6 +790,8 @@ XS(w32_UnregisterServer)
787
790
XS (w32_GetArchName )
788
791
{
789
792
dXSARGS ;
793
+ if (items )
794
+ Perl_croak (aTHX_ "usage: Win32::GetArchName()" );
790
795
XSRETURN_PV (getenv ("PROCESSOR_ARCHITECTURE" ));
791
796
}
792
797
@@ -796,6 +801,8 @@ XS(w32_GetChipName)
796
801
SYSTEM_INFO sysinfo ;
797
802
HMODULE module ;
798
803
PFNGetNativeSystemInfo pfnGetNativeSystemInfo ;
804
+ if (items )
805
+ Perl_croak (aTHX_ "usage: Win32::GetChipName()" );
799
806
800
807
Zero (& sysinfo ,1 ,SYSTEM_INFO );
801
808
module = GetModuleHandle ("kernel32.dll" );
@@ -814,8 +821,11 @@ XS(w32_GuidGen)
814
821
dXSARGS ;
815
822
GUID guid ;
816
823
char szGUID [50 ] = {'\0' };
817
- HRESULT hr = CoCreateGuid (& guid );
824
+ HRESULT hr ;
825
+ if (items )
826
+ Perl_croak (aTHX_ "usage: Win32::GuidGen()" );
818
827
828
+ hr = CoCreateGuid (& guid );
819
829
if (SUCCEEDED (hr )) {
820
830
LPOLESTR pStr = NULL ;
821
831
#ifdef __cplusplus
@@ -896,7 +906,7 @@ XS(w32_GetFolderPath)
896
906
SV * sv ;
897
907
HKEY hkey ;
898
908
HKEY root = HKEY_CURRENT_USER ;
899
- WCHAR * name = NULL ;
909
+ const WCHAR * name = NULL ;
900
910
901
911
switch (folder ) {
902
912
case CSIDL_ADMINTOOLS : name = L"Administrative Tools" ; break ;
@@ -997,7 +1007,7 @@ XS(w32_GetFileVersion)
997
1007
char * data ;
998
1008
999
1009
if (items != 1 )
1000
- croak ("usage: Win32::GetFileVersion($filename)\n " );
1010
+ croak ("usage: Win32::GetFileVersion($filename)" );
1001
1011
1002
1012
filename = SvPV_nolen (ST (0 ));
1003
1013
size = GetFileVersionInfoSize (filename , & handle );
@@ -1048,16 +1058,22 @@ XS(w32_SetChildShowWindow)
1048
1058
* inside the thread_intern structure, the MSWin32 implementation
1049
1059
* lives in win32/win32.c in the core Perl distribution.
1050
1060
*/
1051
- dXSARGS ;
1061
+ dSP ;
1062
+ I32 ax = POPMARK ;
1063
+ EXTEND (SP ,1 );
1052
1064
XSRETURN_UNDEF ;
1053
1065
}
1054
1066
#endif
1055
1067
1056
1068
XS (w32_GetCwd )
1057
1069
{
1058
1070
dXSARGS ;
1071
+ char * ptr ;
1072
+ if (items )
1073
+ Perl_croak (aTHX_ "usage: Win32::GetCwd()" );
1074
+
1059
1075
/* Make the host for current directory */
1060
- char * ptr = PerlEnv_get_childdir ();
1076
+ ptr = PerlEnv_get_childdir ();
1061
1077
/*
1062
1078
* If ptr != Nullch
1063
1079
* then it worked, set PV valid,
@@ -1108,6 +1124,8 @@ XS(w32_GetNextAvailDrive)
1108
1124
char ix = 'C' ;
1109
1125
char root [] = "_:\\" ;
1110
1126
1127
+ if (items )
1128
+ Perl_croak (aTHX_ "usage: Win32::GetNextAvailDrive()" );
1111
1129
EXTEND (SP ,1 );
1112
1130
while (ix <= 'Z' ) {
1113
1131
root [0 ] = ix ++ ;
@@ -1122,6 +1140,8 @@ XS(w32_GetNextAvailDrive)
1122
1140
XS (w32_GetLastError )
1123
1141
{
1124
1142
dXSARGS ;
1143
+ if (items )
1144
+ Perl_croak (aTHX_ "usage: Win32::GetLastError()" );
1125
1145
EXTEND (SP ,1 );
1126
1146
XSRETURN_IV (GetLastError ());
1127
1147
}
@@ -1138,6 +1158,8 @@ XS(w32_SetLastError)
1138
1158
XS (w32_LoginName )
1139
1159
{
1140
1160
dXSARGS ;
1161
+ if (items )
1162
+ Perl_croak (aTHX_ "usage: Win32::LoginName()" );
1141
1163
EXTEND (SP ,1 );
1142
1164
if (IsWin2000 ()) {
1143
1165
WCHAR name [128 ];
@@ -1164,6 +1186,8 @@ XS(w32_NodeName)
1164
1186
dXSARGS ;
1165
1187
char name [MAX_COMPUTERNAME_LENGTH + 1 ];
1166
1188
DWORD size = sizeof (name );
1189
+ if (items )
1190
+ Perl_croak (aTHX_ "usage: Win32::NodeName()" );
1167
1191
EXTEND (SP ,1 );
1168
1192
if (GetComputerName (name ,& size )) {
1169
1193
/* size does NOT include NULL :-( */
@@ -1178,9 +1202,11 @@ XS(w32_DomainName)
1178
1202
{
1179
1203
dXSARGS ;
1180
1204
HMODULE module = LoadLibrary ("netapi32.dll" );
1181
- PFNNetApiBufferFree pfnNetApiBufferFree ;
1182
- PFNNetWkstaGetInfo pfnNetWkstaGetInfo ;
1205
+ PFNNetApiBufferFree pfnNetApiBufferFree = NULL ;
1206
+ PFNNetWkstaGetInfo pfnNetWkstaGetInfo = NULL ;
1183
1207
1208
+ if (items )
1209
+ Perl_croak (aTHX_ "usage: Win32::DomainName()" );
1184
1210
if (module ) {
1185
1211
GETPROC (NetApiBufferFree );
1186
1212
GETPROC (NetWkstaGetInfo );
@@ -1242,8 +1268,10 @@ XS(w32_FsType)
1242
1268
dXSARGS ;
1243
1269
char fsname [256 ];
1244
1270
DWORD flags , filecomplen ;
1271
+ if (items )
1272
+ Perl_croak (aTHX_ "usage: Win32::FsType()" );
1245
1273
if (GetVolumeInformation (NULL , NULL , 0 , NULL , & filecomplen ,
1246
- & flags , fsname , sizeof (fsname ))) {
1274
+ & flags , fsname , sizeof (fsname ))) {
1247
1275
if (GIMME_V == G_ARRAY ) {
1248
1276
XPUSHs (sv_2mortal (newSVpvn (fsname ,strlen (fsname ))));
1249
1277
XPUSHs (sv_2mortal (newSViv (flags )));
@@ -1260,6 +1288,8 @@ XS(w32_FsType)
1260
1288
XS (w32_GetOSVersion )
1261
1289
{
1262
1290
dXSARGS ;
1291
+ if (items )
1292
+ Perl_croak (aTHX_ "usage: Win32::GetOSVersion()" );
1263
1293
1264
1294
if (GIMME_V == G_SCALAR ) {
1265
1295
XSRETURN_IV (g_osver .dwPlatformId );
@@ -1282,13 +1312,17 @@ XS(w32_GetOSVersion)
1282
1312
XS (w32_IsWinNT )
1283
1313
{
1284
1314
dXSARGS ;
1315
+ if (items )
1316
+ Perl_croak (aTHX_ "usage: Win32::IsWinNT()" );
1285
1317
EXTEND (SP ,1 );
1286
1318
XSRETURN_IV (IsWinNT ());
1287
1319
}
1288
1320
1289
1321
XS (w32_IsWin95 )
1290
1322
{
1291
1323
dXSARGS ;
1324
+ if (items )
1325
+ Perl_croak (aTHX_ "usage: Win32::IsWin95()" );
1292
1326
EXTEND (SP ,1 );
1293
1327
XSRETURN_IV (IsWin95 ());
1294
1328
}
@@ -1364,6 +1398,8 @@ XS(w32_GetTickCount)
1364
1398
{
1365
1399
dXSARGS ;
1366
1400
DWORD msec = GetTickCount ();
1401
+ if (items )
1402
+ Perl_croak (aTHX_ "usage: Win32::GetTickCount()" );
1367
1403
EXTEND (SP ,1 );
1368
1404
if ((IV )msec > 0 )
1369
1405
XSRETURN_IV (msec );
@@ -1525,7 +1561,7 @@ XS(w32_GetLongPathName)
1525
1561
WCHAR wide_path [MAX_PATH + 1 ];
1526
1562
WCHAR * long_path ;
1527
1563
1528
- if (wcslen (wstr ) < countof (wide_path )) {
1564
+ if (wcslen (wstr ) < ( size_t ) countof (wide_path )) {
1529
1565
wcscpy (wide_path , wstr );
1530
1566
long_path = my_longpathW (wide_path );
1531
1567
if (long_path ) {
@@ -1619,13 +1655,17 @@ XS(w32_OutputDebugString)
1619
1655
XS (w32_GetCurrentProcessId )
1620
1656
{
1621
1657
dXSARGS ;
1658
+ if (items )
1659
+ Perl_croak (aTHX_ "usage: Win32::GetCurrentProcessId()" );
1622
1660
EXTEND (SP ,1 );
1623
1661
XSRETURN_IV (GetCurrentProcessId ());
1624
1662
}
1625
1663
1626
1664
XS (w32_GetCurrentThreadId )
1627
1665
{
1628
1666
dXSARGS ;
1667
+ if (items )
1668
+ Perl_croak (aTHX_ "usage: Win32::GetCurrentThreadId()" );
1629
1669
EXTEND (SP ,1 );
1630
1670
XSRETURN_IV (GetCurrentThreadId ());
1631
1671
}
@@ -1713,27 +1753,35 @@ XS(w32_GetProductInfo)
1713
1753
XS (w32_GetACP )
1714
1754
{
1715
1755
dXSARGS ;
1756
+ if (items )
1757
+ Perl_croak (aTHX_ "usage: Win32::GetACP()" );
1716
1758
EXTEND (SP ,1 );
1717
1759
XSRETURN_IV (GetACP ());
1718
1760
}
1719
1761
1720
1762
XS (w32_GetConsoleCP )
1721
1763
{
1722
1764
dXSARGS ;
1765
+ if (items )
1766
+ Perl_croak (aTHX_ "usage: Win32::GetConsoleCP()" );
1723
1767
EXTEND (SP ,1 );
1724
1768
XSRETURN_IV (GetConsoleCP ());
1725
1769
}
1726
1770
1727
1771
XS (w32_GetConsoleOutputCP )
1728
1772
{
1729
1773
dXSARGS ;
1774
+ if (items )
1775
+ Perl_croak (aTHX_ "usage: Win32::GetConsoleOutputCP()" );
1730
1776
EXTEND (SP ,1 );
1731
1777
XSRETURN_IV (GetConsoleOutputCP ());
1732
1778
}
1733
1779
1734
1780
XS (w32_GetOEMCP )
1735
1781
{
1736
1782
dXSARGS ;
1783
+ if (items )
1784
+ Perl_croak (aTHX_ "usage: Win32::GetOEMCP()" );
1737
1785
EXTEND (SP ,1 );
1738
1786
XSRETURN_IV (GetOEMCP ());
1739
1787
}
@@ -1764,7 +1812,7 @@ PROTOTYPES: DISABLE
1764
1812
1765
1813
BOOT :
1766
1814
{
1767
- char * file = __FILE__ ;
1815
+ const char * file = __FILE__ ;
1768
1816
1769
1817
if (g_osver .dwOSVersionInfoSize == 0 ) {
1770
1818
g_osver .dwOSVersionInfoSize = sizeof (g_osver );
0 commit comments