Changeset 175

Timestamp:

Mar 21, 2007, 7:06:34 PM (18 years ago)

Author:

イグトランス (egtra)

Message:

Variant, VBObjectの追加

Location:

Include

Files:

• Classes/System/OperatingSystem.ab (modified) (2 diffs)
• Classes/System/String.ab (modified) (3 diffs)
• Classes/System/Version.ab (modified) (3 diffs)
• Classes/System/index.ab (modified) (1 diff)
• basic/command.sbp (modified) (1 diff)
• basic/function.sbp (modified) (2 diffs)
• com/bstring.ab (modified) (3 diffs)
• com/variant.ab (added)
• com/vbobject.ab (added)
• objbase.sbp (modified) (13 diffs)
• objidl.sbp (modified) (1 diff)
• system/string.sbp (modified) (5 diffs)

Include/Classes/System/OperatingSystem.ab

@@ -1 +1 @@
 ' System/OperatingSystem.ab
+
+#ifndef _SYSYTEM_OPERATINGSYSTEM_AB_
+#define _SYSYTEM_OPERATINGSYSTEM_AB_
 
 #require <Classes/System/Version.ab>
@@ -79 +82 @@
     Unix = 4
 End Enum
+
+#endif '_SYSYTEM_OPERATINGSYSTEM_AB_

Include/Classes/System/String.ab

@@ -233 +233 @@
     End Sub
 
-    Sub AssignFromStrChar(text As *StrChar, textLength As Long)
-        If text = Chars Then Exit Sub
-        If AllocStringBuffer(textLength) <> 0 Then
-            memcpy(Chars, text, SizeOf (StrChar) * textLength)
-            Chars[m_Length] = 0
-        End If
-    End Sub
-#ifdef __STRCHAR_IS_NOT_UNICODE
-    Sub AssignFromWideChar(text As PCWSTR, textLengthW As Long)
+    Sub Assign(text As PCSTR, textLengthA As Long)
+#ifdef __STRING_IS_NOT_UNICODE
+        AssignFromStrChar(text, textLengthA)
+#else
+        Dim textLengthW = MultiByteToWideChar(CP_THREAD_ACP, 0, text, textLengthA, 0, 0)
+        If AllocStringBuffer(textLengthW) <> 0 Then
+            MultiByteToWideChar(CP_THREAD_ACP, 0, text, textLengthA, Chars, textLengthW)
+        End If
+#endif
+    End Sub
+
+    Sub Assign(text As PCWSTR, textLengthW As Long)
+#ifdef __STRING_IS_NOT_UNICODE
         Dim textLengthA = WideCharToMultiByte(CP_THREAD_ACP, 0, text, textLengthW, 0, 0, 0, 0)
         If AllocStringBuffer(textLengthA) <> 0 Then
             WideCharToMultiByte(CP_THREAD_ACP, 0, text, textLengthW, Chars, textLengthA, 0, 0)
         End If
-    End Sub
 #else
-    Sub AssignFromMultiByte(text As PCSTR, textLengthA As Long)
-        Dim textLengthW = MultiByteToWideChar(CP_THREAD_ACP, 0, text, textLengthA, 0, 0)
-        If AllocStringBuffer(textLengthW) <> 0 Then
-            MultiByteToWideChar(CP_THREAD_ACP, 0, text, textLengthA, Chars, textLengthW)
-        End If
-    End Sub
-#endif
-    Sub Assign(text As PCSTR, textLength As Long)
-#ifdef __STRING_IS_NOT_UNICODE
-        AssignFromStrChar(text, textLength)
-#else
-        AssignFromMultiByte(text, textLength)
-#endif
-    End Sub
-
-    Sub Assign(text As PCWSTR, textLength As Long)
-#ifdef __STRING_IS_NOT_UNICODE
-        AssignFromWideChar(text, textLength)
-#else
-        AssignFromStrChar(text, textLength)
+        AssignFromStrChar(text, textLengthW)
 #endif
     End Sub
@@ -571 +555 @@
         Dim size = m_Length
 #endif
-        Dim hash = 0 As DWord
-        Dim p = Chars As *Word
-        Dim i As Long
-        For i = 0 To ELM(size)
-            hash = ((hash << 16) + p[i]) Mod &h7fffffff
-        Next
-        Return hash As Long
+        Return _System_GetHashFromWordArray(Chars As *Word, size)
     End Function
 Private
@@ -617 +595 @@
     End Function
 
+    Sub AssignFromStrChar(text As *StrChar, textLength As Long)
+        If text = Chars Then Exit Sub
+        If AllocStringBuffer(textLength) <> 0 Then
+            memcpy(Chars, text, SizeOf (StrChar) * textLength)
+            Chars[m_Length] = 0
+        End If
+    End Sub
 End Class

Include/Classes/System/Version.ab

@@ -1 +1 @@
 ' System/Version.ab
+
+#ifndef __SYSTEM_VERSION_AB__
+#define __SYSTEM_VERSION_AB__
+
+#require <api_winsock2.sbp>
 
 Class Version
@@ -75 +80 @@
 
     Override Function GetHashCode() As Long
-        Return htonl(major) Xor minor Xor build Xor htonl(rivision)
+        Return _System_BSwap(major As DWord) Xor minor Xor build Xor _System_BSwap(rivision As DWord)
     End Function
 
@@ -143 +148 @@
     rivision As Long
 End Class
+
+#endif '__SYSTEM_VERSION_AB__

Include/Classes/System/index.ab

@@ -1 @@
-#require "DateTime.ab"
-#require "Math.ab"
-#require "Object.ab"
-#require "String.ab"
-#require "TimeSpan.ab"
-#require "OperatingSystem.ab"
-#require "Version.ab"
-#require "Environment.ab"
+#require <Classes/System/DateTime.ab>
+#require <Classes/System/Math.ab>
+#require <Classes/System/Object.ab>
+#require <Classes/System/String.ab.
+#require <Classes/System/TimeSpan.ab>
+#require <Classes/System/OperatingSystem.ab>
+#require <Classes/System/Version.ab>
+#require <Classes/System/Environment.ab>

Include/basic/command.sbp

@@ -34 +34 @@
 
 Macro END()
+    Dim exitCode = Environment.ExitCode
     _System_EndProgram()
-    ExitProcess(Environment.ExitCode)
+    ExitProcess(exitCode)
 End Macro
 

Include/basic/function.sbp

@@ -1086 +1086 @@
 End Function
 
+Function _System_HashFromPtr(p As VoidPtr) As Long
+#ifdef _WIN64
+    Dim qw = p As QWord
+    Return (HIDWORD(qw) Xor LODWORD(qw)) As Long
+#else
+    Return p As Long
+#endif
+End Function
+
 '--------
 ' 文字列関数その2
@@ -1183 +1192 @@
 End Function
 
+Function _System_GetHashFromWordArray(p As *Word, n As SIZE_T) As Long
+    Dim hash = 0 As DWord
+    Dim i As Long
+    For i = 0 To ELM(n)
+        hash = ((hash << 16) + p[i]) Mod &h7fffffff
+    Next
+    _System_GetHashFromWordArray = hash As Long
+End Function
+
 #endif '_INC_FUNCTION

Include/com/bstring.ab

@@ -66 +66 @@
     Sub AssignFromBStr(bstr As BSTR)
         Clear()
-        BString(bstr)
+        String.Copy(bs, bstr)
     End Sub
+
+    Const Function Copy() As BSTR
+        BString.Copy(Copy, bs)
+    End Function
 
     Sub Clear()
@@ -78 +82 @@
     Sub Attach(bstr As BSTR)
         Clear()
-        bs = bstr
+        BString.Move(bs, bstr)
     End Sub
 
     Function Detach() As BSTR
-        Detach = bs
-        bs = 0
+        BString.Move(Detach, bs)
     End Function
 
@@ -113 +116 @@
 
     Override Function ToString() As String
-        Dim s As String(bs, Length)
+        Dim s As String(bs As PCWSTR, Length As Long)
         Return s
+    End Function
+
+    Override Function GetHashCode() As Long
+        Return _System_GetHashFromWordArray(bs, Length)
     End Function
 
 Private
     bs As BSTR
+
+    Static Sub Copy(ByRef dst As BSTR, ByVal src As BSTR)
+        dst = SysAllocStringLen(src, SysStringLen(src))
+    End Sub
+
+    Static Sub Move(ByRef dst As BSTR, ByRef src As BSTR)
+        dst = src
+        src = 0
+    End Sub
 End Class
 

Include/objbase.sbp

@@ -60 +60 @@
 Const STGM_PRIORITY           = &h00040000
 Const STGM_DELETEONRELEASE    = &h04000000
-'#if (WINVER >= 400)
+'#if (WINVER >= &h400)
 Const STGM_NOSCRATCH          = &h00100000
 '#endif /* WINVER */
@@ -69 +69 @@
 
 Const STGM_NOSNAPSHOT         = &h00200000
-'#if (_WIN32_WINNT >= 0x0500)
+'#if (_WIN32_WINNT >= &h0500)
 Const STGM_DIRECT_SWMR        = &h00400000
 '#endif
@@ -136 +136 @@
     dwAuthnSvc As DWord
     dwAuthzSvc As DWord
-    pwszServerPrincName As PWSTR
+    pwszServerPrincName As LPWSTR
     dwAuthnLevel As DWord
     dwImpersonationLevel As DWord
@@ -144 +144 @@
 Type COSERVERINFO
     dwReserved1 As DWord
-    pwszName As PWSTR
+    pwszName As LPWSTR
     pAuthInfo As *COAUTHINFO
     dwReserved2 As DWord
@@ -157 +157 @@
 
 
-'#if (_WIN32_WINNT >= 0x0400 ) || defined(_WIN32_DCOM)
+'#if (_WIN32_WINNT >= &h0400) Or defined(_WIN32_DCOM)
 #ifdef _WIN32_DCOM
 Const Enum COINIT
-    COINIT_MULTITHREADED     = = &h0
-    COINIT_APARTMENTTHREADED = = &h2
-    COINIT_DISABLE_OLE1DDE   = = &h4
-    COINIT_SPEED_OVER_MEMORY = = &h8
+    COINIT_MULTITHREADED     = &h0
+    COINIT_APARTMENTTHREADED = &h2
+    COINIT_DISABLE_OLE1DDE   = &h4
+    COINIT_SPEED_OVER_MEMORY = &h8
 End Enum
 Declare Function CoInitializeEx Lib "ole32" (pvReserved As VoidPtr, dwCoInit As DWord) As HRESULT
@@ -170 +170 @@
 
 #ifdef __UNDECLARED__
-'#if (_WIN32_WINNT >= 0x0501)
+'#if (_WIN32_WINNT >= &h0501)
 ' 注意：このcokkieは本来ULARGE_INTEGER型
 'Declare Function CoRegisterInitializeSpy Lib "ole32" (pSpy As *IInitializeSpy, ByRef uliCokkie As QWord) As HRESULT
@@ -191 +191 @@
 '#endif
 
-'#if (_WIN32_WINNT >= 0x0500)
+'#if (_WIN32_WINNT >= &h0500)
 
 Type SOleTlsDataPublic
@@ -258 +258 @@
 Declare Sub CoFreeAllLibraries Lib "ole32" ()
 Declare Sub CoFreeUnusedLibraries Lib "ole32" ()
-'#if  (_WIN32_WINNT >= 0x0501)
+'#if  (_WIN32_WINNT >= &h0501)
 Declare Sub CoFreeUnusedLibrariesEx Lib "ole32" (dwUnloadDelay As DWord, dwReserved As DWord)
 '#endif
 
-'#if (_WIN32_WINNT >= 0x0400 ) || defined(_WIN32_DCOM) 'DCOM
+'#if (_WIN32_WINNT >= &h0400) Or defined(_WIN32_DCOM) 'DCOM
 #ifdef _WIN32_DCOM
 
@@ -329 +329 @@
 Declare Function CoCreateInstance Lib "ole32" (ByRef clsid As CLSID, pUnknown As *IUnknown, dwClsContext As DWord, ByRef refiid As IID, ByRef pObj As Any) As HRESULT
 
-'#if (_WIN32_WINNT >= 0x0400 ) || defined(_WIN32_DCOM) 'DCOM
+'#if (_WIN32_WINNT >= &h0400) Or defined(_WIN32_DCOM) 'DCOM
 #ifdef _WIN32_DCOM
-/* objidl.hでのMULTI_QIの宣言が必要。
 Declare Function CoGetInstanceFromFile Lib "ole32" (
     ByVal pServerInfo As *COSERVERINFO,
@@ -356 +355 @@
     ByVal punkOuter As *IUnknown,
     ByVal dwClsCtx As DWord,
-    ByVal pServerInfo As *COSERVERINFO,
+    ByVal pServerInfo As COSERVERINFO,
     ByVal dwCount As DWord,
     ByVal pResults As *MULTI_QI) As HRESULT
-*/
 #endif ' DCOM
 
 /* Call related APIs */
-'#if (_WIN32_WINNT >= 0x0400 ) || defined(_WIN32_DCOM) 'DCOM
+'#if (_WIN32_WINNT >= &h0400) Or defined(_WIN32_DCOM) 'DCOM
 #ifdef _WIN32_DCOM
 
@@ -397 +395 @@
 Declare Function CoRegisterMessageFilter Lib "ole32" (pMessageFilter As *IMessageFilter, ByRef pMessageFilter As *IMessageFilter) As HRESULT
 
-'#if (_WIN32_WINNT >= 0x0400 ) || defined(_WIN32_DCOM) 'DCOM
+'#if (_WIN32_WINNT >= &h0400) Or defined(_WIN32_DCOM) 'DCOM
 #ifdef _WIN32_DCOM
 Declare Function CoRegisterChannelHook Lib "ole32" (ByRef ExtensionUuid As GUID, pChannelHook As *IChannelHook) As HRESULT
 #endif ' DCOM
 
-'#if (_WIN32_WINNT >= 0x0400 ) || defined(_WIN32_DCOM) 'DCOM
+'#if (_WIN32_WINNT >= &h0400) Or defined(_WIN32_DCOM) 'DCOM
 #ifdef _WIN32_DCOM
 
@@ -425 +423 @@
 
 #ifdef __UNDECLARED__
-'#if  (_WIN32_WINNT >= 0x0501)
+'#if  (_WIN32_WINNT >= &h0501)
 Declare Function CoInvalidateRemoteMachineBindings Lib "ole32" (pszMachineName As LPOLESTR) As HRESULT
 #endif
@@ -519 +517 @@
 /*
 // STG initialization options for StgCreateStorageEx and StgOpenStorageEx
-#if _WIN32_WINNT == 0x500
+#if _WIN32_WINNT == &h500
 #define STGOPTIONS_VERSION 1
-#elif _WIN32_WINNT > 0x500
+#elif _WIN32_WINNT > &h500
 #define STGOPTIONS_VERSION 2
 #else

Include/objidl.sbp

@@ -25 +25 @@
 ' IExternalCennection
 
-' IMultiQI
+Type MULTI_QI
+    pIID As * /*Const*/ IID
+    pItf As *IUnknown
+    hr As HRESULT
+End Type
+
+Dim IID_IMultiQI = [&h00000020, &h0000, &h0000, [&hC0, &h00, &h00, &h00, &h00, &h00, &h00, &h46]] As IID
+
+Interface IMultiQI
+    Inherits IUnknown
+
+    Function QueryMultipleInterfaces(
+        /* [in] */ cMQIs As DWord,
+        /* [out][in] */ pMQIs As *MULTI_QI) As HRESULT
+End Interface
 
 ' AsyncIMultiQI

Include/system/string.sbp

@@ -28 +28 @@
 Function GetStr(psz As PSTR, ByRef wcs As PWSTR) As SIZE_T
     If psz <> 0 Then
-        Return GetStr(psz, lstrlenA(psz), wcs)
+        Return GetStr(psz, lstrlenA(psz) As SIZE_T, wcs)
     Else
         Return 0
@@ -45 +45 @@
     wcs = psz
     If psz <> 0 Then
-        Return lstrlenW(psz)
+        Return lstrlenW(psz) As SIZE_T
     Else
         Return 0
@@ -64 +64 @@
         Return 0
     Else
-        Return GetStr(psz, lstrlenW(psz), mbs)
+        Return GetStr(psz, lstrlenW(psz) As SIZE_T, mbs)
     End If
 End Function
@@ -79 +79 @@
     mbs = psz
     If psz <> 0 Then
-        Return lstrlenA(psz)
+        Return lstrlenA(psz) As SIZE_T
     Else
         Return 0
@@ -199 +199 @@
 
 Function ToWCStr(ByRef s As String) As PWSTR
-    GetStr(s.Chars As PWSTR, s.Length As SIZE_T, ToWCStr)
+    GetStr(s.Chars, s.Length As SIZE_T, ToWCStr)
 End Function