Win32OperatingSystem.st
changeset 11253 ea6152cdf700
parent 11247 f4206a7664bb
child 11258 5117e5bd0dc3
equal deleted inserted replaced
11252:a8fd089d1655 11253:ea6152cdf700
    12 "
    12 "
    13 "{ Package: 'stx:libbasic' }"
    13 "{ Package: 'stx:libbasic' }"
    14 
    14 
    15 AbstractOperatingSystem subclass:#Win32OperatingSystem
    15 AbstractOperatingSystem subclass:#Win32OperatingSystem
    16 	instanceVariableNames:''
    16 	instanceVariableNames:''
    17 	classVariableNames:'HostName DomainName CurrentDirectory'
    17 	classVariableNames:'Initialized HostName DomainName CurrentDirectory'
    18 	poolDictionaries:''
    18 	poolDictionaries:''
    19 	category:'OS-Windows'
    19 	category:'OS-Windows'
    20 !
    20 !
    21 
    21 
    22 ByteArray variableByteSubclass:#DevModeStructure
    22 ByteArray variableByteSubclass:#DevModeStructure
   184 # endif
   184 # endif
   185 
   185 
   186 #if WINVER < 0x0400
   186 #if WINVER < 0x0400
   187 # define NO_GETADAPTERSINFO
   187 # define NO_GETADAPTERSINFO
   188 #endif
   188 #endif
   189 
       
   190 
   189 
   191 #define USE_H_ERRNO
   190 #define USE_H_ERRNO
   192 
   191 
   193 # if defined(i386) || defined(__i386__)
   192 # if defined(i386) || defined(__i386__)
   194 #  ifndef _X86_
   193 #  ifndef _X86_
   567 }
   566 }
   568 
   567 
   569 %}
   568 %}
   570 ! !
   569 ! !
   571 
   570 
       
   571 !Win32OperatingSystem primitiveVariables!
       
   572 %{
       
   573 static int coInitialized = 0;
       
   574 %}
       
   575 ! !
       
   576 
   572 !Win32OperatingSystem class methodsFor:'documentation'!
   577 !Win32OperatingSystem class methodsFor:'documentation'!
   573 
   578 
   574 copyright
   579 copyright
   575 "
   580 "
   576  COPYRIGHT (c) 1988 by Claus Gittinger
   581  COPYRIGHT (c) 1988 by Claus Gittinger
   692 "
   697 "
   693 ! !
   698 ! !
   694 
   699 
   695 !Win32OperatingSystem class methodsFor:'initialization'!
   700 !Win32OperatingSystem class methodsFor:'initialization'!
   696 
   701 
       
   702 coInitialize
       
   703 %{
       
   704     HRESULT hres;
       
   705 
       
   706     if( ! coInitialized ) {
       
   707 #ifdef NO_NT4_0_COMPATIBILITY
       
   708 	FARPROC CoInitializeEx_entry = (FARPROC) CoInitializeEx;
       
   709 #else
       
   710 	FARPROC CoInitializeEx_entry = __get_ole32_functionAddress("CoInitializeEx");
       
   711 #endif /* NO_NT4_0_COMPATIBILITY */
       
   712 	hres = (*CoInitializeEx_entry)(NULL, COINIT_MULTITHREADED);
       
   713 	if (! SUCCEEDED(hres)) {
       
   714 	    console_fprintf(stderr, "OperatingSystem [info]: Could not open the COM library hres = %08x\n", hres );
       
   715 	    goto error;
       
   716 	}
       
   717 	coInitialized = 1;
       
   718 #ifdef COM_DEBUG
       
   719 	console_fprintf(stderr, "OperatingSystem [info]: COM initialized\n" );
       
   720 #endif
       
   721     }
       
   722     RETURN (self );
       
   723 
       
   724 error: ;
       
   725 %}.
       
   726     self primitiveFailed
       
   727 !
       
   728 
   697 initOSType
   729 initOSType
   698     "internal - see if running under win-NT/XP/2k
   730     "internal - see if running under win-NT/XP/2k
   699      (as opposed to win-95/98/ME)"
   731      (as opposed to win-95/98/ME)"
   700 
   732 
   701 %{  /* NOCONTEXT */
   733 %{  /* NOCONTEXT */
   714 !
   746 !
   715 
   747 
   716 initialize
   748 initialize
   717     "initialize the class"
   749     "initialize the class"
   718 
   750 
   719     ObjectMemory addDependent:self.
   751     "/ attention: must be ok to be called twice during startup.
   720     HostName := nil.
   752     Initialized == nil ifTrue:[
   721     DomainName := nil.
   753 	Initialized := true.
   722     LastErrorNumber := nil.
   754 	ObjectMemory addDependent:self.
   723     PipeFailed := false.
   755 	HostName := nil.
   724     self initOSType
   756 	DomainName := nil.
       
   757 	LastErrorNumber := nil.
       
   758 	PipeFailed := false.
       
   759 	self initOSType.
       
   760 	self coInitialize.
       
   761     ].
   725 
   762 
   726     "Modified: 13.9.1997 / 10:47:32 / cg"
   763     "Modified: 13.9.1997 / 10:47:32 / cg"
   727 !
   764 !
   728 
   765 
   729 update:something with:aParameter from:changedObject
   766 update:something with:aParameter from:changedObject
   735 	"
   772 	"
   736 	HostName := nil.
   773 	HostName := nil.
   737 	DomainName := nil.
   774 	DomainName := nil.
   738 	LastErrorNumber := nil.
   775 	LastErrorNumber := nil.
   739 	PipeFailed := false.
   776 	PipeFailed := false.
   740 	self initOSType
   777 	self initOSType.
       
   778 	self coInitialize.
   741     ]
   779     ]
   742 
   780 
   743     "Modified: 22.4.1996 / 13:10:43 / cg"
   781     "Modified: 22.4.1996 / 13:10:43 / cg"
   744     "Created: 15.6.1996 / 15:22:37 / cg"
   782     "Created: 15.6.1996 / 15:22:37 / cg"
   745     "Modified: 7.1.1997 / 19:36:11 / stefan"
   783     "Modified: 7.1.1997 / 19:36:11 / stefan"
  3791     "given a filename, which represents a link-file (.lnk),
  3829     "given a filename, which represents a link-file (.lnk),
  3792      return its resolved path, or nil"
  3830      return its resolved path, or nil"
  3793 
  3831 
  3794     |resolvedPath|
  3832     |resolvedPath|
  3795 
  3833 
  3796 %{
  3834 %{  /* STACK:100000 */
  3797     IShellLink *psl;
  3835 
       
  3836     static IShellLink   * ipShellLink   = NULL;
       
  3837     static IPersistFile * ipPersistFile = NULL;
       
  3838 
  3798     HRESULT hres;
  3839     HRESULT hres;
  3799     WIN32_FIND_DATA wfd;
  3840     WIN32_FIND_DATA wfd;
       
  3841     WORD wsz[MAX_PATH];
  3800     char szGotPath[MAX_PATH];
  3842     char szGotPath[MAX_PATH];
  3801     IPersistFile *ppf;
       
  3802     static FARPROC CoInitializeEx_entry = NULL;
       
  3803 
  3843 
  3804     if (! __isString(aPathName)) {
  3844     if (! __isString(aPathName)) {
  3805 #ifdef DEBUG_COM
       
  3806 	console_fprintf(stderr, "OperatingSystem [info]: invalid argument\n");
  3845 	console_fprintf(stderr, "OperatingSystem [info]: invalid argument\n");
  3807 #endif
       
  3808 	goto error;
  3846 	goto error;
  3809     }
  3847     }
  3810 
  3848 
  3811     /*
  3849     if( ! coInitialized ) {
  3812      * Attention: CoInitializeEx is not available on old NT4.0/W95/W98
  3850 	console_fprintf(stderr, "OperatingSystem [info]: com not initialized\n");
  3813      */
       
  3814 #ifdef NO_NT4_0_COMPATIBILITY
       
  3815     CoInitializeEx_entry = (FARPROC) CoInitializeEx;
       
  3816 #else
       
  3817     if (CoInitializeEx_entry == NULL) {
       
  3818 	CoInitializeEx_entry = __get_ole32_functionAddress("CoInitializeEx");
       
  3819     }
       
  3820 #endif /* NO_NT4_0_COMPATIBILITY */
       
  3821 
       
  3822     hres = (*CoInitializeEx_entry)(NULL, COINIT_MULTITHREADED);
       
  3823     if (! SUCCEEDED(hres)) {
       
  3824 #ifdef DEBUG_COM
       
  3825 	console_fprintf(stderr, "OperatingSystem [info]: Could not open the COM library\n");
       
  3826 #endif
       
  3827 	goto error;
  3851 	goto error;
  3828     }
  3852     }
  3829 
  3853 
  3830     hres = CoCreateInstance(&CLSID_ShellLink, NULL, CLSCTX_INPROC_SERVER,
  3854     if ( ipShellLink == NULL ) {
  3831 			    &IID_IShellLink, (LPVOID *)&psl);
  3855 	hres = CoCreateInstance(&CLSID_ShellLink, NULL, CLSCTX_INPROC_SERVER,
       
  3856 				&IID_IShellLink, (LPVOID *)&ipShellLink);
       
  3857 	if (! SUCCEEDED(hres)) {
       
  3858 	    console_fprintf(stderr, "OperatingSystem [info]: CoCreateInstance Error - hres = %08x\n", hres);
       
  3859 	    ipShellLink = NULL;
       
  3860 	    goto error;
       
  3861 	}
       
  3862 
       
  3863 	hres = ipShellLink->lpVtbl->QueryInterface( ipShellLink, &IID_IPersistFile, & ipPersistFile );
       
  3864 	if (! SUCCEEDED(hres)) {
       
  3865 	    console_fprintf(stderr, "OperatingSystem [info]: QueryInterface Error - hres = %08x\n", hres);
       
  3866 	    ipShellLink->lpVtbl->Release(ipShellLink);
       
  3867 	    ipShellLink   = NULL;
       
  3868 	    ipPersistFile = NULL;
       
  3869 	    goto error;
       
  3870 	}
       
  3871     }
       
  3872 
       
  3873     MultiByteToWideChar(CP_ACP, 0, __stringVal(aPathName), -1, wsz, MAX_PATH);
       
  3874 
       
  3875     hres = ipPersistFile->lpVtbl->Load(ipPersistFile, wsz, STGM_READ);
       
  3876 
  3832     if (SUCCEEDED(hres)) {
  3877     if (SUCCEEDED(hres)) {
  3833 	hres = psl->lpVtbl->QueryInterface(psl, &IID_IPersistFile, &ppf);
  3878 	hres = ipShellLink->lpVtbl->GetPath(ipShellLink, szGotPath, MAX_PATH,
  3834 
  3879 		    (WIN32_FIND_DATA *)&wfd, 0 /* SLGP_SHORTPATH */ );
  3835 	if (SUCCEEDED(hres)) {
  3880 	if (SUCCEEDED(hres)) {
  3836 	    WORD wsz[MAX_PATH];
  3881 	    resolvedPath = __MKSTRING(szGotPath);
  3837 
       
  3838 	    MultiByteToWideChar(CP_ACP, 0, __stringVal(aPathName), -1, wsz, MAX_PATH);
       
  3839 
       
  3840 	    hres = ppf->lpVtbl->Load(ppf, wsz, STGM_READ);
       
  3841 	    if (SUCCEEDED(hres)) {
       
  3842 #if 0
       
  3843 		hres = psl->lpVtbl->Resolve(psl, 0, SLR_ANY_MATCH|SLR_NO_UI);
       
  3844 #endif
       
  3845 		if (SUCCEEDED(hres)) {
       
  3846 		    hres = psl->lpVtbl->GetPath(psl, szGotPath, MAX_PATH,
       
  3847 				(WIN32_FIND_DATA *)&wfd, 0 /* SLGP_SHORTPATH */ );
       
  3848 		    if (!SUCCEEDED(hres)) {
       
  3849 #ifdef DEBUG_COM
       
  3850 			console_fprintf(stderr, "OperatingSystem [info]: GetPath failed!\n");
       
  3851 #endif
       
  3852 		    } else {
       
  3853 #if 0
       
  3854 			console_printf("This points to %s\n", wfd.cFileName); console_fflush(stdout);
       
  3855 			console_printf("Path is %s\n", szGotPath); console_fflush(stdout);
       
  3856 			if (wfd.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY) {
       
  3857 			    console_printf("This is a directory\n"); console_fflush(stdout);
       
  3858 			}
       
  3859 #endif
       
  3860 			resolvedPath = __MKSTRING(szGotPath);
       
  3861 #if 0
       
  3862 			hres = psl->lpVtbl->GetWorkingDirectory(psl, szGotPath, MAX_PATH);
       
  3863 			if (!SUCCEEDED(hres)) {
       
  3864 			    console_fprintf(stderr, "GetWorkingDirectory failed!\n");
       
  3865 			} else {
       
  3866 			    console_printf("In Directory %s\n", szGotPath);
       
  3867 			}
       
  3868 #endif
       
  3869 		    }
       
  3870 		}
       
  3871 	    } else {
       
  3872 #ifdef DEBUG_COM
       
  3873 	       console_fprintf(stderr, "OperatingSystem [info]: IPersistFile Load Error\n");
       
  3874 #endif
       
  3875 	    }
       
  3876 	    ppf->lpVtbl->Release(ppf);
       
  3877 	} else {
  3882 	} else {
  3878 #ifdef DEBUG_COM
  3883 #ifdef COM_DEBUG
  3879 	    console_fprintf(stderr, "OperatingSystem [info]: QueryInterface Error\n");
  3884 	    console_fprintf(stderr, "OperatingSystem [info]: GetPath failed - hres = %08x\n", hres );
  3880 #endif
  3885 #endif
  3881 	}
  3886 	}
  3882 	psl->lpVtbl->Release(psl);
       
  3883     } else {
  3887     } else {
  3884 #ifdef DEBUG_COM
  3888 #ifdef COM_DEBUG
  3885 	console_fprintf(stderr, "OperatingSystem [info]: CoCreateInstance Error - hres = %08x\n", hres);
  3889 	console_fprintf(stderr, "OperatingSystem [info]: Load failed - hres = %08x\n", hres );
  3886 #endif
  3890 #endif
  3887     }
  3891     }
       
  3892     /* ipPersistFile->lpVtbl->Release(ipPersistFile);  */
       
  3893 
  3888 error: ;
  3894 error: ;
  3889 %}.
  3895 %}.
  3890     resolvedPath notNil ifTrue:[^ resolvedPath ].
  3896     resolvedPath notNil ifTrue:[^ resolvedPath ].
  3891 
  3897 
  3892     "/ self primitiveFailed.
  3898     "/ self primitiveFailed.
  4668 %{
  4674 %{
  4669     int ret;
  4675     int ret;
  4670 
  4676 
  4671     if (__isString(aPathName)) {
  4677     if (__isString(aPathName)) {
  4672 #ifdef DO_WRAP_CALLS
  4678 #ifdef DO_WRAP_CALLS
  4673         char _aPathName[MAXPATHLEN];
  4679 	char _aPathName[MAXPATHLEN];
  4674 
  4680 
  4675         strncpy(_aPathName, __stringVal(aPathName), MAXPATHLEN-1); _aPathName[MAXPATHLEN-1] = '\0';
  4681 	strncpy(_aPathName, __stringVal(aPathName), MAXPATHLEN-1); _aPathName[MAXPATHLEN-1] = '\0';
  4676         do {
  4682 	do {
  4677             __threadErrno = 0;
  4683 	    __threadErrno = 0;
  4678             ret = STX_API_CALL1( "GetDriveType", GetDriveType, _aPathName);
  4684 	    ret = STX_API_CALL1( "GetDriveType", GetDriveType, _aPathName);
  4679         } while ((ret < 0) && (__threadErrno == EINTR));
  4685 	} while ((ret < 0) && (__threadErrno == EINTR));
  4680 #else
  4686 #else
  4681         ret = GetFileAttributes((char *) __stringVal(aPathName));
  4687 	ret = GetFileAttributes((char *) __stringVal(aPathName));
  4682         if (ret < 0) {
  4688 	if (ret < 0) {
  4683             __threadErrno = __WIN32_ERR(GetLastError());
  4689 	    __threadErrno = __WIN32_ERR(GetLastError());
  4684         }
  4690 	}
  4685 #endif
  4691 #endif
  4686         RETURN (ret);  
  4692 	RETURN (ret);
  4687     }
  4693     }
  4688 %}.
  4694 %}.
  4689     ^ self primitiveFailed
  4695     ^ self primitiveFailed
  4690 !
  4696 !
  4691 
  4697 
  5599      html documents, pdf documents etc."
  5605      html documents, pdf documents etc."
  5600 
  5606 
  5601     |result|
  5607     |result|
  5602 
  5608 
  5603     Error
  5609     Error
  5604         handle:[:ex |
  5610 	handle:[:ex |
  5605             self halt:'shell execution failed'
  5611 	    self halt:'shell execution failed'
  5606         ] do:[
  5612 	] do:[
  5607             |filename|
  5613 	    |filename|
  5608 
  5614 
  5609             filename := aFilenameOrString asFilename.
  5615 	    filename := aFilenameOrString asFilename.
  5610             result := self
  5616 	    result := self
  5611                 shellExecute:nil
  5617 		shellExecute:nil
  5612                 lpOperation:'open'
  5618 		lpOperation:'open'
  5613                 lpFile:filename pathName
  5619 		lpFile:filename pathName
  5614                 lpParameters:nil
  5620 		lpParameters:nil
  5615                 lpDirectory:filename directory pathName
  5621 		lpDirectory:filename directory pathName
  5616                 nShowCmd:#SW_SHOWNORMAL.
  5622 		nShowCmd:#SW_SHOWNORMAL.
  5617             ^ self.
  5623 	    ^ self.
  5618         ]
  5624 	]
  5619 
  5625 
  5620     "
  5626     "
  5621      self openDocumentationFilename: 'C:\WINDOWS\Help\clipbrd.chm' asFilename
  5627      self openDocumentationFilename: 'C:\WINDOWS\Help\clipbrd.chm' asFilename
  5622      self openDocumentationFilename: Filename currentDirectory
  5628      self openDocumentationFilename: Filename currentDirectory
  5623     "
  5629     "
 15653 ! !
 15659 ! !
 15654 
 15660 
 15655 !Win32OperatingSystem class methodsFor:'documentation'!
 15661 !Win32OperatingSystem class methodsFor:'documentation'!
 15656 
 15662 
 15657 version
 15663 version
 15658     ^ '$Header: /cvs/stx/stx/libbasic/Win32OperatingSystem.st,v 1.349 2008-10-21 07:46:52 sr Exp $'
 15664     ^ '$Header: /cvs/stx/stx/libbasic/Win32OperatingSystem.st,v 1.350 2008-10-21 11:47:41 ca Exp $'
 15659 ! !
 15665 ! !
 15660 
 15666 
 15661 Win32OperatingSystem initialize!
 15667 Win32OperatingSystem initialize!
 15662 Win32OperatingSystem::PerformanceData initialize!
 15668 Win32OperatingSystem::PerformanceData initialize!
 15663 Win32OperatingSystem::RegistryEntry initialize!
 15669 Win32OperatingSystem::RegistryEntry initialize!