Index: /Include/Classes/System/Drawing/Font.ab =================================================================== --- /Include/Classes/System/Drawing/Font.ab (revision 141) +++ /Include/Classes/System/Drawing/Font.ab (revision 142) @@ -131,7 +131,10 @@ /*IN const*/ ByRef fontCollection As FontCollection) #ifdef __STRING_IS_NOT_UNICODE - Dim name = _System_MultiByteToWideChar(familyName) + Dim oldAlloc = _System_AllocForConvertedString + _System_AllocForConvertedString = AddressOf (_System_malloc) + Dim name = ToWCStr(familyName) Font(name, emSize, style, unit, fontCollection) _System_free(name) + _System_AllocForConvertedString = oldAlloc #else Font(familyName.Chars, emSize, style, unit, fontCollection) @@ -285,5 +288,5 @@ ((lf.fdwUnderline <> FALSE) And FontStyle.Underline)) As FontStyle End Function - + 'Const Function SystemFontName() As String Index: /Include/Classes/System/Environment.ab =================================================================== --- /Include/Classes/System/Environment.ab (revision 142) +++ /Include/Classes/System/Environment.ab (revision 142) @@ -0,0 +1,144 @@ +' System/Environment.ab + +#require + +Class Environment +Public + ' Properties + + Static Function CommandLine() As String + If cmdLine = Nothing Then +#ifdef __STRING_IS_NOT_UNICODE + cmdLine = New String(GetCommandLineA()) +#else + cmdLine = New String(GetCommandLineW()) +#endif + End If + Return cmdLine + End Function + + Static Function CurrentDirectory() As String + Dim size = GetCurrentDirectory(0, 0) + Dim p = _System_malloc(SizeOf (TCHAR) * size) As PCTSTR + GetCurrentDirectory(size, p) + CurrentDirectory = p + _System_free(p) + End Function + + Static Sub CurrentDirectory(cd As String) + SetCurrentDirectory(ToTCStr(cd)) + End Sub + + Static Function ExitCode() As Long + Return exitCode + End Function + + Static Sub ExitCode(code As Long) + exitCode = code + End Sub + + Static Sub HasShutdownStarted() As Boolean + Return False + End Sub + + ' MachineName + + Static Function NewLine() As String + Return Ex"\r\n" + End Function + + Static Function OSVersion() As OperatingSystem + If osVer = Nothing Then + Dim vi As OSVERSIONINFO + GetVersionInfoEx(vi) + osVer = New OperatingSystem(vi) + End If + Return osVer + End Function + + Static Function ProcessorCount() As Long + If processorCount = 0 Then + Dim si As SYSTEM_INFO + GetSystemInfo(si) + processorCount = si.dwNumberOfProcessors + End If + Return processorCount + End Function + + ' StackTrace + + Static Function SystemDirectory() As String + If sysDir = Nothing Then + Dim size = GetSystemDirectory(0, 0) + Dim p = _System_malloc(SizeOf (TCHAR) * size) + GetSystemDirectory(size, p) + sysDir = p + _System_free(p) + End IF + Return sysDir + End Function + + Static Function TickCount() As Long + Return GetTickCount() As Long + End Function + + ' UserDomainName + + ' UserInteractive + + ' UserName + + ' Version + + Static Function WorkingSet() As Int64 + Dim pGetProcessMemoryInfo As *Function(Process As HANDLE, ByRef mc As PPROCESS_MEMORY_COUNTERS, cb As DWord) As BOOL + Dim hmodPSAPI = LoadLibrary("PSAPI.DLL") + If hmodPSAPI = 0 Then Return 0 + pGetProcessMemoryInfo = GetProcAddress(hmodPSAPI, ToMBStr("GetProcessMemoryInfo") + If pGetProcessMemoryInfo <> 0 Then + Dim mc As PPROCESS_MEMORY_COUNTERS + If pGetProcessMemoryInfo(GetCurrentProcess(), mc, Len (mc)) <> FALSE Then + WorkingSet = mc.WorkingSetSize + End If + End If + FreeLibrary(hmodPSAPI) + End Function + + ' Methods + + Static Sub Exit(exitCode As Long) + Environment.exitCode = exitCode + End + End Sub + + Static Function ExpandEnvironmentVariables(s As String) As String + Dim src = ToTCStr(s) + Dim size = ExpandEnvironmentStrings(src, 0, 0) + Dim dst = _System_malloc(SizeOf (TCHAR) * size) + ExpandEnvironmentStrings(src, dst, size) + ExpandEnvironmentVariables = dst + _System_free(dst) + End Function + + Static Sub FailFast(message As String) + OutputDebugString(ToTCStr(message)) + ExitProcess(-1) + End Sub + + ' GetCommandLineArgs + + ' GetEnvironmentVariable + + ' GetEnvironmentVariables + + ' GetLogicalDrives + + ' SetEnvironmentVariable + +Private + Static cmdLine = Nothing As Stirng + Static exitCode = 0 As Long + Static osVer = Nothing As OperatingSystem + Static processorCount = 0 As Long + Static sysDir = Nothing As String +End Class Index: /Include/Classes/System/IO/DirectoryInfo.ab =================================================================== --- /Include/Classes/System/IO/DirectoryInfo.ab (revision 141) +++ /Include/Classes/System/IO/DirectoryInfo.ab (revision 142) @@ -18,5 +18,5 @@ Function Root() As DirectoryInfo - Dim dirInfo as DirectoryInfo(Path.GetPathRoot(FullPath)) + Dim dirInfo As DirectoryInfo(Path.GetPathRoot(FullPath)) Return dirInfo End Function @@ -24,5 +24,5 @@ 'Public Method Sub Create() - CreateDirectory(FullPath, NULL) + CreateDirectory(ToTCStr(FullPath), NULL) End Sub @@ -31,5 +31,5 @@ Override Sub Delete() - RemoveDirectory(FullPath) + RemoveDirectory(ToTCStr(FullPath)) End Sub @@ -54,8 +54,8 @@ /* Function GetFiles() As Array End Function*/ - + /* Function GetFiles(searchPattern As String) As Array End Function*/ - + /* Function GetFiles(searchPattern As String, searchOption As SearchOption) As Array End Function*/ @@ -68,5 +68,5 @@ Sub MoveTo(destDirName As String) - If MoveFile(FullPath, destDirName) = False Then + If MoveFile(ToTCStr(FullPath), ToTCStr(destDirName)) = FALSE Then 'Exception End If Index: /Include/Classes/System/IO/DriveInfo.ab =================================================================== --- /Include/Classes/System/IO/DriveInfo.ab (revision 141) +++ /Include/Classes/System/IO/DriveInfo.ab (revision 142) @@ -35,7 +35,6 @@ Function DriveFormat() As String - Dim systemName As String - systemName.ReSize(15) - If GetVolumeInformation(m_DriveName, NULL, NULL, NULL, NULL, NULL, systemName, 16) Then + Dim systemName[15] As TCHAR + If GetVolumeInformation(m_DriveName, NULL, NULL, NULL, NULL, NULL, systemName, Len (systemName)) Then Return systemName Else @@ -48,9 +47,9 @@ End Function - Function IsReady() As BOOL + Function IsReady() As Boolean If GetVolumeInformation(m_DriveName, NULL, NULL, NULL, NULL, NULL, NULL, NULL) Then - Return _System_TRUE + Return True Else - Return _System_FALSE + Return False End If End Function @@ -82,6 +81,5 @@ Function VolumeLabel() As String - Dim volumeName As String - volumeName.ReSize(63) + Dim volumeName[63] As TCAHR If GetVolumeInformation(m_DriveName, volumeName, 64, NULL, NULL, NULL, NULL, NULL) Then Return volumeName Index: /Include/Classes/System/IO/FileSystemInfo.ab =================================================================== --- /Include/Classes/System/IO/FileSystemInfo.ab (revision 141) +++ /Include/Classes/System/IO/FileSystemInfo.ab (revision 142) @@ -167,6 +167,5 @@ Virtual Sub Refresh() Dim data As WIN32_FIND_DATA - Dim hFind As HANDLE - hFind = FindFirstFile(FullPath, data) + Dim hFind = FindFirstFile(ToTCStr(FullPath), data) FindClose(hFind) @@ -179,6 +178,5 @@ Private Function setFileTime() As Boolean - Dim hFile As HANDLE - hFile = CreateFile(FullPath, GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, 0) + Dim hFile = CreateFile(ToTCStr(FullPath), GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, 0) If hFile = INVALID_HANDLE_VALUE Then setFileTime = False Index: /Include/Classes/System/IO/Path.ab =================================================================== --- /Include/Classes/System/IO/Path.ab (revision 141) +++ /Include/Classes/System/IO/Path.ab (revision 142) @@ -1,2 +1,6 @@ +' System/IO/Path.ab + +#require + Class Path Public @@ -36,5 +40,5 @@ Return path.Remove(0, extPos) End Function - + Static Function ChangeExtension(path As String, extension As String) As String Dim extPos As Long @@ -49,7 +53,7 @@ Static Function HasExtension(ByRef path As String) As Boolean If GetExtension(path) <> "" Then - Return _System_TRUE + Return True Else - Return _System_FALSE + Return False End If End Function @@ -74,16 +78,17 @@ Static Function GetTempPath() As String - GetTempPath.ReSize(__GetTempPath(0, 0) - 1) - __GetTempPath(GetTempPath.Length + 1, GetTempPath) + Dim size = GetTempPath(0, 0 + Dim tempPath = _System_malloc(size)) + __GetTempPath(size, tempPath) + GetTempPath = tempPath + _System_free(tempPath) End Function Static Function GetFullPath(path As String) As String - Dim cd As String - Dim dirSepChar As String(Chr$(DirectorySeparatorChar)) - If IsPathRooted(path) Then Return path - - cd.ReSize = GetCurrentDirectory(0, 0) - 1 - GetCurrentDirectory(cd.Length + 1, cd) - Return cd + dirSepChar + path + If IsPathRooted(path) Then + Return path + Else + Return Environment.CurrentDirectory + Chr$(DirectorySeparatorChar) + path + End If End Function @@ -108,10 +113,10 @@ End Function - Static Function IsPathRooted(path As String) As BOOL + Static Function IsPathRooted(path As String) As Boolean Dim volSepChar As String(Chr$(VolumeSeparatorChar)) If path.IndexOf(volSepChar, 1, 1) = 1 Then - Return _System_TRUE + Return True Else - Return _System_FALSE + Return False End If End Function Index: /Include/Classes/System/OperatingSystem.ab =================================================================== --- /Include/Classes/System/OperatingSystem.ab (revision 142) +++ /Include/Classes/System/OperatingSystem.ab (revision 142) @@ -0,0 +1,80 @@ +' System/OperatingSystem.ab + +#require + +Class OperatingSystem + ' Inherits ICloneable', ISerializable +Public + ' Constractor + Sub OperatingSystem(platform As PlatformID, version As Version) + pf = platform + ver = version + sp = "" + End Sub + + Sub OperatingSystem(vi As OSVERSIONINFOA) As OperatingSystem + pf = vi.dwPlatformId As PlatformID, + ver = New Version(vi.dwMajorVersion, vi.MinorVersion, vi.BuildNumber) + sp = vi.szCSDVersion + End Sub + + Sub OperatingSystem(vi As OSVERSIONINFOW) As OperatingSystem + pf = vi.dwPlatformId As PlatformID, + ver = New Version(vi.dwMajorVersion, vi.MinorVersion, vi.BuildNumber) + sp = vi.szCSDVersion + End Sub + + ' Properties + Const Function Platform() As PlatformID + Return pf + End Function + + Const Function Version() As Version + Return ver + End Function + + Const Function ServicePack() As String + Return sp + End Function + + Const Function VersionString() As String + Select Case pf + Case PlatformID.Win32S + VersionString = "Microsoft Win32S " + Case PlatformID.Win32Windows + VersionString = "Microsoft Windows " + Case PlatformID.Win32NT + VersionString = "Microsoft Windows NT " + Case PlatformID.WinCE + VersionString = "Microsoft Windows CE " + Case PlatformID.Unix + VersionString = " " + End Select + VersionString = VersionString + ver.ToString + If String.IsNullOrEmpty(sp) <> False Then + VersionString = VersionString + " " + sp + End If + End Function + + ' Methods + Override Function ToString() As String + Return VersionString + End Function + + Override Function GetHashCode() As Long + Return pf.GetHashCode Xor ver.GetHashCode Xor sp.GetHashCode + End Function + +Private + pf As PlatformID + ver As Version + sp As String +End Class + +Enum PlatformID + Win32S = VER_PLATFORM_WIN32s '0 + Win32Windows = VER_PLATFORM_WIN32_WINDOWS '1 + Win32NT = VER_PLATFORM_WIN32_NT '2 + WinCE = VER_PLATFORM_WIN32_CE '3 + Unix = 4 +End Enum Index: /Include/Classes/System/String.ab =================================================================== --- /Include/Classes/System/String.ab (revision 141) +++ /Include/Classes/System/String.ab (revision 142) @@ -10,4 +10,7 @@ #else TypeDef StrChar = WCHAR +#ifndef UNICODE +#define __STRING_UNICODE_WINDOWS_ANSI +#endif #endif @@ -494,6 +497,6 @@ Dim i As Long For i = 0 To ELM(.m_Length) - If .Chars[i] = .oldChar Then - .Chars[i] = .newChar + If .Chars[i] = oldChar Then + .Chars[i] = newChar End If Next @@ -558,5 +561,5 @@ Static Function Copy(s As String) As String - Copy.Resize(s.m_Length) + Copy.ReSize(s.m_Length) memcpy(Copy.Chars, This.Chars, SizeOf (StrChar) * m_Length) End Function Index: /Include/Classes/System/Version.ab =================================================================== --- /Include/Classes/System/Version.ab (revision 142) +++ /Include/Classes/System/Version.ab (revision 142) @@ -0,0 +1,144 @@ +' System/Version.ab + +Class Version + ' Inherits ICloneable, IComparable, IComparable, IEquatable +Public + ' Constractor + Sub Version() + major = 0 + minor = 0 + build = -1 + revision = -1 + End Sub + + 'Sub Version(s As String) + 'End Sub + + Sub Version(major As Long, minor As Long) + This.major = major + This.minor = minor + build = -1 + revision = -1 + End Sub + + Sub Version(major As Long, minor As Long, build As Long) + This.major = major + This.minor = minor + This.build = build + revision = -1 + End Sub + + Sub Version(major As Long, minor As Long, revision As Long) + This.major = major + This.minor = minor + This.build = build + This.revision = revision + End Sub + + Const Function Major() As Long + Return major + End Function + + Const Function Minor() As Long + Return minor + End Function + + Const Function Build() As Long + Return build + End Function + + Const Function Revision() As Long + Return revision + End Function + + Const Function MajorRivision As Integer + Return HIWORD(revision) As Integer + End Function + + Const Function MinorRivision As Integer + Return LOWORD(revision) As Integer + End Function + + Const Function CompareTo(v As Version) As Long + CompareTo = major - v.major + If CompareTo <> 0 Then Exit Function + CompareTo = minor - v.minor + If CompareTo <> 0 Then Exit Function + CompareTo = build - v.build + If CompareTo <> 0 Then Exit Function + CompareTo = rivision - v.rivision + End Function + + Const Function Equals(v As Version) As Boolean + Return CompareTo(v) = 0 + End Function + + Override Function GetHashCode() As Long + Return htonl(major) Xor minor Xor build Xor htonl(rivision) + End Function + + Function Operator ==(v As Version) As Boolean + Return CompareTo(v) = 0 + End Function + + Function Operator <>(v As Version) As Boolean + Return CompareTo(v) <> 0 + End Function + + Function Operator <(v As Version) As Boolean + Return CompareTo(v) < 0 + End Function + + Function Operator >(v As Version) As Boolean + Return CompareTo(v) > 0 + End Function + + Function Operator <=(v As Version) As Boolean + Return CompareTo(v) <= 0 + End Function + + Function Operator >=(v As Version) As Boolean + Return CompareTo(v) >= 0 + End Function + + Override Function ToString() As String + ToString = Str$(major) + "." + Str$(minor) + If build >= 0 Then + ToString = ToString + "." + Str$(build) + If rivision >= 0 Then + ToString = ToString + "." + Str$(rivision) + End If + End If + End Function + + Function ToString(fieldCount As Long) As String + If fieldCount < 0 Or fieldCount > 4 Then + ' Throw ArgumentException + Debug + End If + ToString = "" + If fieldCount = 0 Then Exit Function + ToString = Str$(major) + If fieldCount = 1 Then Exit Function + ToString = Str$(minor) + If fieldCount = 2 Then Exit Function + + If build < 0 Then + ' Throw ArgumentException + Debug + End If + ToString = Str$(build) + If fieldCount = 3 Then Exit Function + + If rivision < 0 Then + ' Throw ArgumentException + Debug + End If + ToString = Str$(rivision) + End Function +Private + major As Long + minor As Long + build As Long + rivision As Long +End Class Index: /Include/Classes/System/index.ab =================================================================== --- /Include/Classes/System/index.ab (revision 141) +++ /Include/Classes/System/index.ab (revision 142) @@ -4,2 +4,5 @@ #require "String.ab" #require "TimeSpan.ab" +#require "OperatingSystem.ab" +#require "Version.ab" +#require "Environment.ab" Index: /Include/api_console.sbp =================================================================== --- /Include/api_console.sbp (revision 141) +++ /Include/api_console.sbp (revision 142) @@ -3,4 +3,34 @@ #ifndef _INC_CONSOLE #define _INC_CONSOLE + +#ifdef UNICODE +Const _FuncName_PeekConsoleInput = "PeekConsoleInputW" +Const _FuncName_ReadConsoleInput = "ReadConsoleInputW" +Const _FuncName_WriteConsoleInput = "WriteConsoleInputW" +Const _FuncName_ReadConsoleOutput = "ReadConsoleOutputW" +Const _FuncName_WriteConsoleOutput = "WriteConsoleOutputW" +Const _FuncName_ReadConsoleOutputCharacter = "ReadConsoleOutputCharacterW" +Const _FuncName_WriteConsoleOutputCharacter = "WriteConsoleOutputCharacterW" +Const _FuncName_FillConsoleOutputCharacter = "FillConsoleOutputCharacterW" +Const _FuncName_ScrollConsoleScreenBuffer = "ScrollConsoleScreenBufferW" +Const _FuncName_GetConsoleTitle = "GetConsoleTitleW" +Const _FuncName_SetConsoleTitle = "SetConsoleTitleW" +Const _FuncName_ReadConsole = "ReadConsoleW" +Const _FuncName_WriteConsole = "WriteConsoleW" +#else +Const _FuncName_PeekConsoleInput = "PeekConsoleInputA" +Const _FuncName_ReadConsoleInput = "ReadConsoleInputA" +Const _FuncName_WriteConsoleInput = "WriteConsoleInputA" +Const _FuncName_ReadConsoleOutput = "ReadConsoleOutputA" +Const _FuncName_WriteConsoleOutput = "WriteConsoleOutputA" +Const _FuncName_ReadConsoleOutputCharacter = "ReadConsoleOutputCharacterA" +Const _FuncName_WriteConsoleOutputCharacter = "WriteConsoleOutputCharacterA" +Const _FuncName_FillConsoleOutputCharacter = "FillConsoleOutputCharacterA" +Const _FuncName_ScrollConsoleScreenBuffer = "ScrollConsoleScreenBufferA" +Const _FuncName_GetConsoleTitle = "GetConsoleTitleA" +Const _FuncName_SetConsoleTitle = "SetConsoleTitleA" +Const _FuncName_ReadConsole = "ReadConsoleA" +Const _FuncName_WriteConsole = "WriteConsoleA" +#endif Type COORD @@ -153,14 +183,14 @@ Const ENABLE_WRAP_AT_EOL_OUTPUT = &H0002 -Declare Function PeekConsoleInput Lib "kernel32" Alias "PeekConsoleInputA" (hConsoleInput As HANDLE, ByRef lpBuffer As INPUT_RECORD, nLength As DWord, ByRef lpNumberOfEventsRead As DWord) As BOOL -Declare Function ReadConsoleInput Lib "kernel32" Alias "ReadConsoleInputA" (hConsoleInput As HANDLE, ByRef lpBuffer As INPUT_RECORD, nLength As DWord, ByRef lpNumberOfEventsRead As DWord) As BOOL -Declare Function WriteConsoleInput Lib "kernel32" Alias "WriteConsoleInputA" (hConsoleInput As HANDLE, ByRef lpBuffer As INPUT_RECORD, nLength As DWord, ByRef lpNumberOfEventsWritten As DWord) As BOOL -Declare Function ReadConsoleOutput Lib "kernel32" Alias "ReadConsoleOutputA" (hConsoleOutput As HANDLE, lpBuffer As *CHAR_INFO, ByRef dwBufferSize As COORD, ByRef dwBufferCoord As COORD, ByRef lpReadRegion As SMALL_RECT) As BOOL -Declare Function WriteConsoleOutput Lib "kernel32" Alias "WriteConsoleOutputA" (hConsoleOutput As HANDLE, lpBuffer As *CHAR_INFO, ByRef dwBufferSize As COORD, ByRef dwBufferCoord As COORD, ByRef lpWriteRegion As SMALL_RECT) As BOOL -Declare Function ReadConsoleOutputCharacter Lib "kernel32" Alias "ReadConsoleOutputCharacterA" (hConsoleOutput As HANDLE, lpCharacter As LPSTR, nLength As DWord, ByRef dwReadCoord As COORD, ByRef lpNumberOfCharsRead As DWord) As BOOL +Declare Function PeekConsoleInput Lib "kernel32" Alias _FuncName_PeekConsoleInput (hConsoleInput As HANDLE, ByRef lpBuffer As INPUT_RECORD, nLength As DWord, ByRef lpNumberOfEventsRead As DWord) As BOOL +Declare Function ReadConsoleInput Lib "kernel32" Alias _FuncName_ReadConsoleInput (hConsoleInput As HANDLE, ByRef lpBuffer As INPUT_RECORD, nLength As DWord, ByRef lpNumberOfEventsRead As DWord) As BOOL +Declare Function WriteConsoleInput Lib "kernel32" Alias _FuncName_WriteConsoleInput (hConsoleInput As HANDLE, ByRef lpBuffer As INPUT_RECORD, nLength As DWord, ByRef lpNumberOfEventsWritten As DWord) As BOOL +Declare Function ReadConsoleOutput Lib "kernel32" Alias _FuncName_ReadConsoleOutput (hConsoleOutput As HANDLE, lpBuffer As *CHAR_INFO, ByRef dwBufferSize As COORD, ByRef dwBufferCoord As COORD, ByRef lpReadRegion As SMALL_RECT) As BOOL +Declare Function WriteConsoleOutput Lib "kernel32" Alias _FuncName_WriteConsoleOutput (hConsoleOutput As HANDLE, lpBuffer As *CHAR_INFO, ByRef dwBufferSize As COORD, ByRef dwBufferCoord As COORD, ByRef lpWriteRegion As SMALL_RECT) As BOOL +Declare Function ReadConsoleOutputCharacter Lib "kernel32" Alias _FuncName_ReadConsoleOutputCharacter (hConsoleOutput As HANDLE, lpCharacter As LPSTR, nLength As DWord, ByRef dwReadCoord As COORD, ByRef lpNumberOfCharsRead As DWord) As BOOL Declare Function ReadConsoleOutputAttribute Lib "kernel32" (hConsoleOutput As HANDLE, lpAttribute As *Word, nLength As DWord, ByRef dwReadCoord As COORD, ByRef lpNumberOfAttrsRead As DWord) As BOOL -Declare Function WriteConsoleOutputCharacter Lib "kernel32" Alias "WriteConsoleOutputCharacterA" (hConsoleOutput As HANDLE, lpCharacter As LPSTR, nLength As DWord, ByRef dwWriteCoord As COORD, ByRef lpNumberOfCharsWritten As DWord) As BOOL +Declare Function WriteConsoleOutputCharacter Lib "kernel32" Alias _FuncName_WriteConsoleOutputCharacter (hConsoleOutput As HANDLE, lpCharacter As LPSTR, nLength As DWord, ByRef dwWriteCoord As COORD, ByRef lpNumberOfCharsWritten As DWord) As BOOL Declare Function WriteConsoleOutputAttribute Lib "kernel32" (hConsoleOutput As HANDLE, lpAttribute As *Word, nLength As DWord, ByRef dwWriteCoord As COORD, ByRef lpNumberOfAttrsWritten As DWord) As BOOL -Declare Function FillConsoleOutputCharacter Lib "kernel32" Alias "FillConsoleOutputCharacterA" (hConsoleOutput As HANDLE, cCharacter As Char, nLength As DWord, ByRef dwWriteCoord As COORD, ByRef lpNumberOfCharsWritten As DWord) As BOOL +Declare Function FillConsoleOutputCharacter Lib "kernel32" Alias _FuncName_FillConsoleOutputCharacter (hConsoleOutput As HANDLE, cCharacter As Char, nLength As DWord, ByRef dwWriteCoord As COORD, ByRef lpNumberOfCharsWritten As DWord) As BOOL Declare Function FillConsoleOutputAttribute Lib "kernel32" (hConsoleOutput As HANDLE, wAttribute As Word, nLength As DWord, ByRef dwWriteCoord As COORD, ByRef lpNumberOfAttrsWritten As DWord) As BOOL Declare Function GetConsoleMode Lib "kernel32" (hConsoleHandle As HANDLE, ByRef lpMode As DWord) As BOOL @@ -176,5 +206,5 @@ Declare Function SetConsoleCursorPosition Lib "kernel32" (hConsoleOutput As HANDLE, dwCursorPosition As DWord) As BOOL Declare Function SetConsoleCursorInfo Lib "kernel32" (hConsoleOutput As HANDLE, ByRef lpConsoleCursorInfo As CONSOLE_CURSOR_INFO) As BOOL -Declare Function ScrollConsoleScreenBuffer Lib "kernel32" Alias "ScrollConsoleScreenBufferA" (hConsoleOutput As HANDLE, ByRef lpScrollRectangle As SMALL_RECT, lpClipRectangle As *SMALL_RECT, ByRef dwDestinationOrigin As COORD, lpFill As *CHAR_INFO) As BOOL +Declare Function ScrollConsoleScreenBuffer Lib "kernel32" Alias _FuncName_ScrollConsoleScreenBuffer (hConsoleOutput As HANDLE, ByRef lpScrollRectangle As SMALL_RECT, lpClipRectangle As *SMALL_RECT, ByRef dwDestinationOrigin As COORD, lpFill As *CHAR_INFO) As BOOL Declare Function SetConsoleWindowInfo Lib "kernel32" (hConsoleOutput As HANDLE, bAbsolute As BOOL, ByRef lpConsoleWindow As SMALL_RECT) As BOOL Declare Function SetConsoleTextAttribute Lib "kernel32" (hConsoleOutput As HANDLE, wAttributes As Word) As BOOL @@ -183,8 +213,8 @@ Declare Function AllocConsole Lib "kernel32" () As BOOL Declare Function FreeConsole Lib "kernel32" () As BOOL -Declare Function GetConsoleTitle Lib "kernel32" Alias "GetConsoleTitleA" (lpConsoleTitle As LPSTR, nSize As DWord) As DWord -Declare Function SetConsoleTitle Lib "kernel32" Alias "SetConsoleTitleA" (lpConsoleTitle As LPSTR) As BOOL -Declare Function ReadConsole Lib "kernel32" Alias "ReadConsoleA" (hConsoleInput As HANDLE, lpBuffer As VoidPtr, nNumberOfCharsToRead As DWord, ByRef lpNumberOfCharsRead As DWord, lpReserved As VoidPtr) As BOOL -Declare Function WriteConsole Lib "kernel32" Alias "WriteConsoleA" (hConsoleOutput As HANDLE, lpBuffer As VoidPtr, nNumberOfCharsToWrite As DWord, ByRef lpNumberOfCharsWritten As DWord, lpReserved As VoidPtr) As BOOL +Declare Function GetConsoleTitle Lib "kernel32" Alias _FuncName_GetConsoleTitle (lpConsoleTitle As LPSTR, nSize As DWord) As DWord +Declare Function SetConsoleTitle Lib "kernel32" Alias _FuncName_SetConsoleTitle (lpConsoleTitle As LPSTR) As BOOL +Declare Function ReadConsole Lib "kernel32" Alias _FuncName_ReadConsole (hConsoleInput As HANDLE, lpBuffer As VoidPtr, nNumberOfCharsToRead As DWord, ByRef lpNumberOfCharsRead As DWord, lpReserved As VoidPtr) As BOOL +Declare Function WriteConsole Lib "kernel32" Alias _FuncName_WriteConsole (hConsoleOutput As HANDLE, lpBuffer As VoidPtr, nNumberOfCharsToWrite As DWord, ByRef lpNumberOfCharsWritten As DWord, lpReserved As VoidPtr) As BOOL Const CONSOLE_TEXTMODE_BUFFER = 1 Index: /Include/api_psapi.sbp =================================================================== --- /Include/api_psapi.sbp (revision 141) +++ /Include/api_psapi.sbp (revision 142) @@ -85,5 +85,5 @@ #endif -Declare Function GetProcessMemoryInfo Lib "psapi" (Process As HANDLE, ppsmemCounters As PPROCESS_MEMORY_COUNTERS, cb As DWord) +Declare Function GetProcessMemoryInfo Lib "psapi" (Process As HANDLE, ppsmemCounters As PPROCESS_MEMORY_COUNTERS, cb As DWord) As BOOL Type PERFORMANCE_INFORMATION @@ -107,5 +107,5 @@ TypeDef PPERFORMACE_INFORMATION = *PERFORMANCE_INFORMATION -Declare Function GetPerformanceInfo Lib "psapi" (pPerformanceInformation As PPERFORMACE_INFORMATION, cb As DWord) +Declare Function GetPerformanceInfo Lib "psapi" (pPerformanceInformation As PPERFORMACE_INFORMATION, cb As DWord) As BOOL Type ENUM_PAGE_FILE_INFORMATION Index: /Include/api_system.sbp =================================================================== --- /Include/api_system.sbp (revision 141) +++ /Include/api_system.sbp (revision 142) @@ -875,4 +875,5 @@ Const VER_PLATFORM_WIN32_WINDOWS = 1 Const VER_PLATFORM_WIN32_NT = 2 +Const VER_PLATFORM_WIN32_CE = 3 Type OSVERSIONINFOW dwOSVersionInfoSize As DWord Index: /Include/basic.sbp =================================================================== --- /Include/basic.sbp (revision 141) +++ /Include/basic.sbp (revision 142) @@ -31,4 +31,7 @@ 'Single 'Double + +TypeDef Int16 = Integer +TypeDef Int8 = SByte TypeDef BOOL = Long Index: /Include/basic/command.sbp =================================================================== --- /Include/basic/command.sbp (revision 141) +++ /Include/basic/command.sbp (revision 142) @@ -5,4 +5,6 @@ #define _INC_COMMAND +#require +#require Const _System_Type_SByte = 1 @@ -33,9 +35,9 @@ Macro END() _System_Call_Destructor_of_GlobalObject() - ExitProcess(0) -End Macro - -Macro EXEC(lpFilePath As *Byte)(lpCmdLine As *Byte) - ShellExecute(0,"open",lpFilePath,lpCmdLine,0,SW_SHOWNORMAL) + ExitProcess(Environment.ExitCode) +End Macro + +Macro EXEC(filePath As String)(cmdLine As String) + ShellExecute(0, "open", ToTCStr(filePath), ToTCStr(cmdLine), 0, SW_SHOWNORMAL) End Macro @@ -52,5 +54,4 @@ Macro WRITE() 'dummy（PRINT_ToFile、PRINT_ToPromptを参照） End Macro - '---------------- @@ -58,17 +59,24 @@ '---------------- -Macro MSGBOX(hWnd As HWND, lpStr As String)(lpTitle As String, BoxType As DWord, ByRef retAns As DWord) +Function _System_MessageBox(hw As HWND, s As PCSTR, t As PCSTR, b As DWord) As DWord + Return MessageBoxA(hw, s, t, b) +End Function + +Function _System_MessageBox(hw As HWND, s As PCWSTR, t As PCWSTR, b As DWord) As DWord + Return MessageBoxW(hw, s, t, b) +End Function + +Macro MSGBOX(hwnd As HWND, str As String)(title As String, boxType As DWord, ByRef retAns As DWord) If VarPtr(retAns) Then - retAns=MessageBox(hWnd,lpStr,lpTitle,BoxType) + retAns = _System_MessageBox(hwnd, str, title, boxType) Else - MessageBox(hWnd,lpStr,lpTitle,BoxType) + _System_MessageBox(hwnd, str, title, boxType) End If End Macro -Macro WINDOW(ByRef hWnd As HWND, hOwner As HWND, x As Long, y As Long, nWidth As Long, nHeight As Long, lpTitle As String, dwStyle As DWord)(lpClass As String, id As HMENU, lpFunc As DWord, dwExStyle As DWord) - If VarPtr(hWnd) Then - hWnd=CreateWindowEx(dwExStyle,lpClass,lpTitle,dwStyle,x,y,nWidth,nHeight,hOwner,id,GetModuleHandle(0),NULL) - Else - CreateWindowEx(dwExStyle,lpClass,lpTitle,dwStyle,x,y,nWidth,nHeight,hOwner,id,GetModuleHandle(0),NULL) +Macro WINDOW(ByRef hwndRet As HWND, hOwner As HWND, x As Long, y As Long, width As Long, height As Long, title As String, dwStyle As DWord)(className As String, id As HMENU, lpFunc As DWord, dwExStyle As DWord) + Dim hwnd = CreateWindowEx(dwExStyle, ToTCStr(className), ToTCStr(title), dwStyle, x, y, width, height, hOwner, id, GetModuleHandle(0), 0) + If VarPtr(hwndRet) Then + hwndRet = hwnd End If End Macro @@ -78,5 +86,5 @@ End Macro -Macro INSMENU(hMenu As HMENU, PosID As Long, flag As Long)(lpString As String, id As Long, hSubMenu As HMENU, state As Long) +Macro INSMENU(hMenu As HMENU, PosID As Long, flag As Long)(str As String, id As Long, hSubMenu As HMENU, state As Long) Dim mii As MENUITEMINFO ZeroMemory(VarPtr(mii), Len(mii)) @@ -90,5 +98,5 @@ .fType = MFT_STRING .fMask = .fMask or MIIM_STATE or MIIM_ID - .dwTypeData = StrPtr(lpString) + .dwTypeData = ToTCStr(str) .wID = id If hSubMenu Then @@ -96,5 +104,5 @@ .hSubMenu = hSubMenu End If - .fState=state + .fState = state End If End With @@ -108,8 +116,8 @@ Dim _System_hFile(255) As HANDLE -Macro OPEN(lpFileName As String, AccessFor As Long, FileNumber As Long) - Dim dwAccess As Long - Dim bAppend = 0 As Long - Dim dwCreationDisposition As Long +Macro OPEN(fileName As String, AccessFor As Long, FileNumber As Long) + Dim access As Long + Dim bAppend = False As Boolean + Dim creationDisposition As Long FileNumber-- @@ -117,21 +125,21 @@ Select Case AccessFor Case 0 - dwAccess=GENERIC_READ or GENERIC_WRITE - dwCreationDisposition=OPEN_ALWAYS + access = GENERIC_READ or GENERIC_WRITE + creationDisposition = OPEN_ALWAYS Case 1 - dwAccess=GENERIC_READ - dwCreationDisposition=OPEN_EXISTING + access = GENERIC_READ + creationDisposition = OPEN_EXISTING Case 2 - dwAccess=GENERIC_WRITE - dwCreationDisposition=CREATE_ALWAYS + access = GENERIC_WRITE + creationDisposition = CREATE_ALWAYS Case 3 - dwAccess=GENERIC_WRITE - dwCreationDisposition=OPEN_ALWAYS - bAppend=1 + access = GENERIC_WRITE + creationDisposition = OPEN_ALWAYS + bAppend = True End Select - _System_hFile(FileNumber)=CreateFile(lpFileName,dwAccess,0,ByVal NULL,dwCreationDisposition,FILE_ATTRIBUTE_NORMAL,NULL) - - If bAppend Then SetFilePointer(_System_hFile(FileNumber),0,NULL,FILE_END) + _System_hFile(FileNumber) = CreateFile(ToTCStr(fileName), access, 0, ByVal 0, creationDisposition, FILE_ATTRIBUTE_NORMAL, 0) + + If bAppend Then SetFilePointer(_System_hFile(FileNumber), 0, 0, FILE_END) End Macro @@ -151,5 +159,5 @@ Dim i As Long ,i2 As Long, i3 As Long Dim buffer As String - Dim temp[1] As Char + Dim temp[1] As StrChar Dim dwAccessBytes As DWord Dim IsStr As Long @@ -163,5 +171,5 @@ '次のデータをサーチ Do - i2=ReadFile(_System_hFile[FileNumber],temp,1,VarPtr(dwAccessBytes),ByVal 0) + i2=ReadFile(_System_hFile[FileNumber],temp,SizeOf (StrChar),VarPtr(dwAccessBytes),ByVal 0) If i2=0 or dwAccessBytes=0 Then 'error @@ -177,5 +185,5 @@ i3++ - i2=ReadFile(_System_hFile[FileNumber],temp,1,VarPtr(dwAccessBytes),ByVal 0) + i2=ReadFile(_System_hFile[FileNumber],temp,SizeOf (StrChar),VarPtr(dwAccessBytes),ByVal 0) If i2=0 or (i3=0 and dwAccessBytes=0) Then 'error @@ -187,5 +195,5 @@ If dwAccessBytes=0 or temp[0]=0 or temp[0]=13 or temp[0]=10 or (IsStr=0 and temp[0]=Asc(",")) or (IsStr=0 and (temp[0]=32 or temp[0]=9) and _System_InputDataType[i]<>_System_Type_String) Then If temp[0]=13 Then - ReadFile(_System_hFile[FileNumber],temp,1,VarPtr(dwAccessBytes),ByVal 0) + ReadFile(_System_hFile[FileNumber],temp,SizeOf (StrChar),VarPtr(dwAccessBytes),ByVal 0) If Not(dwAccessBytes<>0 And temp[0]=10) Then SetFilePointer(_System_hFile[FileNumber],-1,0,FILE_CURRENT) @@ -240,5 +248,5 @@ pTempStr = arg As *String pTempStr->ReSize(bufLen) - memcpy(pTempStr->Chars, buf.Chars, SizeOf (Char) * pTempStr->Length) + memcpy(pTempStr->Chars, buf.Chars, SizeOf (StrChar) * pTempStr->Length) pTempStr->Chars[pTempStr->Length] = 0 End Select @@ -249,5 +257,5 @@ FileNumber-- - WriteFile(_System_hFile(FileNumber),buf,Len(buf),VarPtr(dwAccessByte),ByVal NULL) + WriteFile(_System_hFile(FileNumber), buf, Len(buf), VarPtr(dwAccessByte), ByVal 0) End Sub @@ -257,11 +265,11 @@ Function _System_GetUsingFormat(UsingStr As String) As String Dim i2 As Long, i3 As Long, i4 As Long, i5 As Long, ParmNum As Long - Dim temporary[255] As Char + Dim temporary[255] As StrChar Dim buffer As String - buffer=ZeroString(1024) - - ParmNum=0 - i2=0 + buffer = ZeroString(1024) + + ParmNum = 0 + i2 = 0 While 1 While 1 @@ -277,5 +285,5 @@ If UsingStr[i2]=Asc("#") Then Dim dec As Long, sign As Long - Dim temp2 As *Char + Dim temp2 As *StrChar Dim length_num As Long, length_buf As Long @@ -332,5 +340,5 @@ If dec > 0 Then - memcpy(VarPtr(buffer[i3]), temp2, SizeOf (Char) * length_num) + memcpy(VarPtr(buffer[i3]), temp2, SizeOf (StrChar) * length_num) Else buffer[i3] = &H30 @@ -367,5 +375,5 @@ 'lstrcat(StrPtr(buffer)+i3,_System_UsingStrData[ParmNum]) memcpy(VarPtr(buffer[i3 + lstrlen(VarPtr(buffer[i3]))]), _System_UsingStrData[ParmNum], _ - SizeOf (Char) * lstrlen(_System_UsingStrData[ParmNum])) + SizeOf (StrChar) * lstrlen(_System_UsingStrData[ParmNum])) i3 += lstrlen(_System_UsingStrData[ParmNum]) ElseIf UsingStr[i2]=Asc("&") Then @@ -385,5 +393,5 @@ _System_FillChar(VarPtr(buffer[i3]), i4, &h20) 'Asc(" ") End If - memcpy(VarPtr(buffer[i3]), _System_UsingStrData[ParmNum], SizeOf (Char) * i5) + memcpy(VarPtr(buffer[i3]), _System_UsingStrData[ParmNum], SizeOf (StrChar) * i5) i3 += i4 Else @@ -423,9 +431,9 @@ RecodeNumber-- - SetFilePointer(_System_hFile(FileNumber),RecodeNumber*_System_FieldSize(FileNumber),NULL,FILE_BEGIN) - lpBuffer=ZeroString(_System_FieldSize(FileNumber)) - ReadFile(_System_hFile(FileNumber),StrPtr(lpBuffer),_System_FieldSize(FileNumber),VarPtr(dwAccessByte),ByVal NULL) + SetFilePointer(_System_hFile(FileNumber), SizeOf (StrChar) * RecodeNumber * _System_FieldSize(FileNumber), 0, FILE_BEGIN) + lpBuffer = ZeroString(_System_FieldSize(FileNumber)) + ReadFile(_System_hFile(FileNumber), StrPtr(lpBuffer), SizeOf (StrChar) * _System_FieldSize(FileNumber), VarPtr(dwAccessByte),ByVal 0) If Not dwAccessByte=_System_FieldSize(FileNumber) Then - lpBuffer=Left$(lpBuffer,dwAccessByte) + lpBuffer = Left$(lpBuffer, dwAccessByte) End If End Macro @@ -436,16 +444,16 @@ RecodeNumber-- - SetFilePointer(_System_hFile(FileNumber),RecodeNumber*_System_FieldSize(FileNumber),NULL,FILE_BEGIN) - WriteFile(_System_hFile(FileNumber),StrPtr(lpBuffer),_System_FieldSize(FileNumber),VarPtr(dwAccessByte),ByVal NULL) + SetFilePointer(_System_hFile(FileNumber), SizeOf (StrChar) * RecodeNumber*_System_FieldSize(FileNumber), 0, FILE_BEGIN) + WriteFile(_System_hFile(FileNumber), StrPtr(lpBuffer),SizeOf (StrChar) * _System_FieldSize(FileNumber), VarPtr(dwAccessByte), ByVal 0) End Macro Macro CHDIR(path As String) - SetCurrentDirectory(path) + SetCurrentDirectory(ToTCStr(path)) End Macro Macro MKDIR(path As String) - CreateDirectory(path, 0) + CreateDirectory(ToTCStr(path), 0) End Macro Macro KILL(path As String) - DeleteFile(path) + DeleteFile(ToTCStr(path)) End Macro Index: /Include/basic/dos_console.sbp =================================================================== --- /Include/basic/dos_console.sbp (revision 141) +++ /Include/basic/dos_console.sbp (revision 142) @@ -20,5 +20,5 @@ Dim i As Long, i2 As Long, i3 As Long Dim buf As String - Dim InputStr[1023] As Byte + Dim InputBuf[1023] As TCHAR Dim dwAccessBytes As DWord @@ -28,8 +28,9 @@ '入力 - ReadConsole(_System_hConsoleIn, InputStr, Len(InputStr), dwAccessBytes, 0) - If InputStr[dwAccessBytes-2] = &h0d And InputStr[dwAccessBytes-1] = &h0a Then - InputStr[dwAccessBytes-2] = 0 + ReadConsole(_System_hConsoleIn, InputBuf, Len(InputBuf), dwAccessBytes, 0) + If InputBuf[dwAccessBytes-2] = &h0d And InputBuf[dwAccessBytes-1] = &h0a Then + InputBuf[dwAccessBytes-2] = 0 End If + Dim InputStr As String(InputBuf) 'データを変数に格納 @@ -59,9 +60,9 @@ i++ If _System_InputDataPtr[i]=0 And InputStr[i2]=comma Then - PRINT_ToPrompt("入力データの個数が多すぎます"+Chr$(10)) + PRINT_ToPrompt(Ex"入力データの個数が多すぎます\r\n") Goto *InputReStart ElseIf InputStr[i2]=0 Then If _System_InputDataPtr[i]<>0 Then - PRINT_ToPrompt("入力データの個数が足りません"+Chr$(10)) + PRINT_ToPrompt(Ex"入力データの個数が足りません\r\n") Goto *InputReStart Else @@ -80,5 +81,16 @@ Sub PRINT_ToPrompt(buf As String) Dim dwAccessBytes As DWord +#ifdef __STRING_UNICODE_WINDOWS_ANSI +' Debug + Dim oldAlloc = _System_AllocForConvertedString + _System_AllocForConvertedString = AddressOf (_System_malloc) + Dim pszOut As PCSTR + Dim len = GetStr(buf, pszOut) + _System_AllocForConvertedString = oldAlloc + WriteConsole(_System_hConsoleOut, pszOut, len, dwAccessBytes, 0) + _System_free(pszOut) +#else WriteConsole(_System_hConsoleOut, buf.Chars, buf.Length, dwAccessBytes, 0) +#endif End Sub Index: /Include/basic/function.sbp =================================================================== --- /Include/basic/function.sbp (revision 141) +++ /Include/basic/function.sbp (revision 142) @@ -344,14 +344,14 @@ '------------ -Function Asc(buf As *Char) As Char +Function Asc(buf As *StrChar) As StrChar Asc = buf[0] End Function -Function Chr$(code As Char) As String +Function Chr$(code As StrChar) As String Chr$ = ZeroString(1) Chr$[0] = code End Function -#ifdef UNICODE +#ifndef __STRING_IS_NOT_UNICODE Function AscW(s As *WCHAR) As UCSCHAR If s.Length = 0 Then @@ -487,5 +487,5 @@ Mid$=ZeroString(ReadLength) - memcpy(StrPtr(Mid$), VarPtr(buf[StartPos]), SizeOf (Char) * ReadLength) + memcpy(StrPtr(Mid$), VarPtr(buf.Chars[StartPos]), SizeOf (Char) * ReadLength) End Function @@ -515,5 +515,5 @@ If i>length Then Right$=ZeroString(length) - memcpy(StrPtr(Right$), VarPtr(buf[i-length]), SizeOf (Char) * length) + memcpy(StrPtr(Right$), VarPtr(buf.Chars[i-length]), SizeOf (Char) * length) Else Right$=buf @@ -691,11 +691,7 @@ Return MakeStr(buffer) End Function -Function Str$(value As LONG_PTR) As String +Function Str$(value As Int64) As String Dim temp[255] As Char -#ifdef _WIN64 _sntprintf(temp, Len (temp) \ SizeOf (Char), "%I64d", value) -#else - _sntprintf(temp, Len (temp) \ SizeOf (Char), "%d", value) -#endif Str$ = temp End Function @@ -881,5 +877,5 @@ Function Lof(FileNum As Long) As Long - Lof=GetFileSize(_System_hFile(FileNum-1),NULL) + Lof = GetFileSize(_System_hFile(FileNum-1), 0) End Function @@ -1059,4 +1055,7 @@ End Function +'-------- +' 文字列関数その2 +'-------- Function _System_IsSurrogatePair(wcHigh As WCHAR, wcLow As WCHAR) As Boolean If &hD800 <= wcHigh And wcHigh < &hDC00 Then @@ -1068,13 +1067,13 @@ End Function -Function _System_IsDoubleUnitChar(lead As Char, trail As Char) As Boolean -#ifdef UNICODE +Function _System_IsDoubleUnitChar(lead As WCHAR, trail As WCHAR) As Boolean Return _System_IsSurrogatePair(lead, trail) -#else +End Function + +Function _System_IsDoubleUnitChar(lead As SByte, trail As SByte) As Boolean Return IsDBCSLeadByte(lead) <> FALSE -#endif -End Function - -Sub _System_FillChar(p As *Char, n As SIZE_T, c As Char) +End Function + +Sub _System_FillChar(p As PWSTR, n As SIZE_T, c As WCHAR) Dim i As SIZE_T For i = 0 To ELM(n) @@ -1083,13 +1082,28 @@ End Sub -Function _System_ASCII_IsUpper(c As Char) As Boolean +Sub _System_FillChar(p As PSTR, n As SIZE_T, c As SByte) + Dim i As SIZE_T + For i = 0 To ELM(n) + p[i] = c + Next +End Sub + +Function _System_ASCII_IsUpper(c As WCHAR) As Boolean Return c As DWord - &h41 < 26 ' &h41 = Asc("A") End Function +Function _System_ASCII_IsUpper(c As SByte) As Boolean + Return _System_ASCII_IsUpper(c As Byte As WCHAR) +End Function + +Function _System_ASCII_IsLower(c As WCHAR) As Boolean + Return c As DWord - &h61 < 26 ' &h61 = Asc("a") +End Function + Function _System_ASCII_IsLower(c As Char) As Boolean - Return c As DWord - &h61 < 26 ' &h61 = Asc("a") -End Function - -Function _System_ASCII_ToLower(c As Char) As Char + Return _System_ASCII_IsLower(c As Byte As WCHAR) +End Function + +Function _System_ASCII_ToLower(c As WCHAR) As WCHAR If _System_ASCII_IsUpper(c) Then Return c Or &h20 @@ -1097,4 +1111,8 @@ Return c End If +End Function + +Function _System_ASCII_ToLower(c As SByte) As SByte + Return _System_ASCII_ToLower(c As Byte As WCHAR) As Byte As SByte End Function @@ -1107,33 +1125,8 @@ End Function -Function _System_WideCharToMultiByte(s As PCWSTR) As PSTR - Return _System_WideCharToMultiByte(s, lstrlenW(s) + 1, 0) -End Function - -Function _System_WideCharToMultiByte(s As PCWSTR, size As Long) As PSTR - Return _System_WideCharToMultiByte(s, size, 0) -End Function - -Function _System_WideCharToMultiByte(ws As PCWSTR, size As Long, flag As DWord) As PSTR - Dim sizeMBS = WideCharToMultiByte(CP_THREAD_ACP, flag, s, size, 0, 0, 0, 0) - Dim mbs = _System_malloc(sizeMBS) As PSTR - WideCharToMultiByte(CP_THREAD_ACP, flag, s, size, mbs, sizeMBS, 0, 0) - Return mbs -End Function - -Function _System_MultiByteToWideChar(s As PCSTR) As PWSTR - Return _System_MultiByteToWideChar(s, lstrlenA(s) + 1, 0) -End Function - -Function _System_MultiByteToWideChar(s As PCSTR, size As Long) As PWSTR - Return _System_MultiByteToWideChar(s, size, 0) -End Function - -Function _System_MultiByteToWideChar(s As PCSTR, size As Long, flag As DWord) As PWSTR - Dim sizeMBS = MultiByteToWideChar(CP_THREAD_ACP, flag, s, size, 0, 0) - Dim mbs = _System_malloc(SizeOf (WCHAR) * sizeMBS) As PWSTR - MultiByteToWideChar(CP_THREAD_ACP, flag, s, size, mbs, sizeMBS) - Return mbs -End Function +Function _System_ASCII_ToUpper(c As SByte) As SByte + Return _System_ASCII_ToUpper(c As Byte As WCHAR) As Byte As SByte +End Function + Function _System_StrCmp(s1 As PCSTR, s2 As PCSTR) As Long @@ -1158,3 +1151,4 @@ _System_StrCmp = s1[i] - s2[i] End Function + #endif '_INC_FUNCTION Index: /Include/basic/prompt.sbp =================================================================== --- /Include/basic/prompt.sbp (revision 141) +++ /Include/basic/prompt.sbp (revision 142) @@ -8,4 +8,28 @@ #require #require + +Function _PromptSys_GetTextExtentPoint32(hdc As HDC, psz As PCSTR, cb As Long, ByRef Size As SIZE) As Long + _PromptSys_GetTextExtentPoint32 = GetTextExtentPoint32A(hdc, psz, cb, Size) +End Function + +Function _PromptSys_GetTextExtentPoint32(hdc As HDC, psz As PCWSTR, cb As Long, ByRef Size As SIZE) As Long + _PromptSys_GetTextExtentPoint32 = GetTextExtentPoint32W(hdc, psz, cb, Size) +End Function + +Function _PromptSys_TextOut(hdc As HDC, x As Long, y As Long, psz As PCSTR, cb As Long) As Long + _PromptSys_TextOut = TextOutA(hdc, x, y, psz, cb) +End Function + +Function _PromptSys_TextOut(hdc As HDC, x As Long, y As Long, psz As PCWSTR, cb As Long) As Long + _PromptSys_TextOut = TextOutW(hdc, x, y, psz, cb) +End Function + +Function _PromptSys_ImmGetCompositionString(himc As HIMC, index As DWord, pBuf As PSTR, bufLen As DWord) As Long + _PromptSys_ImmGetCompositionString = ImmGetCompositionStringA(himc, index, pBuf, bufLen) +End Function + +Function _PromptSys_ImmGetCompositionString(himc As HIMC, index As DWord, pBuf As PWSTR, bufLen As DWord) As Long + _PromptSys_ImmGetCompositionString = ImmGetCompositionStringW(himc, index, pBuf, bufLen) +End Function Dim _PromptSys_hWnd As HWND @@ -22,5 +46,5 @@ Type _PromptSys_LineInformation Length As Long - Text As *Char + Text As *StrChar CharInfo As *_PromptSys_CharacterInformation End Type @@ -29,5 +53,5 @@ Dim _PromptSys_hFont As HFONT Dim _PromptSys_FontSize As SIZE -Dim _PromptSys_InputStr[255] As Char +Dim _PromptSys_InputStr[255] As StrChar Dim _PromptSys_InputLen As Long Dim _PromptSys_KeyChar As Byte @@ -38,4 +62,5 @@ Dim _PromptSys_SectionOfBufferAccess As CRITICAL_SECTION +Dim _System_OSVersionInfo As OSVERSIONINFO _PromptSys_InputLen = -1 @@ -48,5 +73,10 @@ _PromptSys_hInitFinish = CreateEvent(0, FALSE, FALSE, 0) -CreateThread(0, 0, AddressOf(PromptMain) As LPTHREAD_START_ROUTINE, 0, 0, _PromptSys_dwThreadID) +Dim _PromptSys_hThread As HANDLE +_PromptSys_hThread = CreateThread(0, 0, AddressOf(PromptMain) As LPTHREAD_START_ROUTINE, 0, 0, _PromptSys_dwThreadID) +If _PromptSys_hThread = 0 Then + Debug + ExitProcess(1) +End If WaitForSingleObject(_PromptSys_hInitFinish, INFINITE) @@ -68,5 +98,5 @@ Next _PromptSys_TextLine[100].Length = 0 - _PromptSys_TextLine[100].Text = _System_calloc(SizeOf (Char) * 255) + _PromptSys_TextLine[100].Text = _System_calloc(SizeOf (StrChar) * 255) _PromptSys_TextLine[100].CharInfo = _System_calloc(SizeOf (_PromptSys_CharacterInformation) * 255) _PromptSys_CurPos.y-- @@ -83,5 +113,5 @@ Dim sz As SIZE i3 = _PromptSys_TextLine[i].Length - GetTextExtentPoint32(hDC, _PromptSys_TextLine[i].Text, i3, sz) + _PromptSys_GetTextExtentPoint32(hDC, _PromptSys_TextLine[i].Text, i3, sz) BitBlt(hDC,_ @@ -106,5 +136,5 @@ End If With _PromptSys_FontSize - TextOut(hDC, currentLineCharInfo[i2].StartPos, i * .cy, VarPtr(_PromptSys_TextLine[i].Text[i2]), tempLen) + _PromptSys_TextOut(hDC, currentLineCharInfo[i2].StartPos, i * .cy, VarPtr(_PromptSys_TextLine[i].Text[i2]) As *StrChar, tempLen) End With i2 += tempLen @@ -127,5 +157,5 @@ Dim doubleUnitChar = False As Boolean 'Addition - Dim i2 = 0 As Long, i3 As Long' : Debug + Dim i2 = 0 As Long, i3 As Long For i2 = 0 To ELM(bufLen) If buf[i2] = &h0d Then 'CR \r @@ -158,5 +188,5 @@ charLen = 1 EndIf - GetTextExtentPoint32(hdc, VarPtr(buf.Chars[i2]), charLen, sz) + _PromptSys_GetTextExtentPoint32(hdc, VarPtr(buf.Chars[i2]) As *StrChar, charLen, sz) currentLineCharInfo[.x + 1].StartPos = currentLineCharInfo[.x].StartPos + sz.cx /* @@ -305,4 +335,5 @@ TempStr = Ex"\r\n" ElseIf wParam = &H16 Then +/* 'Paste Command(Use Clippboard) OpenClipboard(hwnd) @@ -324,4 +355,5 @@ GlobalUnlock(hGlobal) CloseClipboard() +*/ Else _PromptSys_InputStr[_PromptSys_InputLen] = wParam As Byte @@ -337,4 +369,24 @@ End If End Sub + +Function _PromptWnd_GetCompositionStringW(himc As HIMC, ByRef rpsz As PWSTR) As Long + Dim size = ImmGetCompositionStringW(himc, GCS_RESULTSTR, 0, 0) 'sizeはバイト単位 + rpsz = _System_malloc(size) As PTSTR + If rpsz = 0 Then + 'Debug + Return 0 + End If + Return ImmGetCompositionStringW(himc, GCS_RESULTSTR, rpsz, size) +End Function + +Function _PromptWnd_GetCompositionStringA(himc As HIMC, ByRef rpsz As PSTR) As Long + Dim size = ImmGetCompositionStringA(himc, GCS_RESULTSTR, 0, 0) 'sizeはバイト単位 + rpsz = _System_malloc(size) As PTSTR + If rpsz = 0 Then + 'Debug + Return 0 + End If + Return ImmGetCompositionStringA(himc, GCS_RESULTSTR, rpsz, size) +End Function Function _PromptWnd_OnImeCompostion(hwnd As HWND, wp As WPARAM, lp As LPARAM) As LRESULT @@ -345,20 +397,29 @@ Return 0 End If - Dim size = ImmGetCompositionString(himc, GCS_RESULTSTR, 0, 0) 'sizeはバイト単位 - Dim str = _System_malloc(size) As PTSTR - If str = 0 Then - 'Debug - Return 0 - End If - ImmGetCompositionString(himc, GCS_RESULTSTR, str, size) + Dim tempStr As String + Dim str As *StrChar +#ifdef __STIRNG_IS_NOT_UNICODE + Dim size = _PromptWnd_GetCompositionStringA(himc, str) + tempStr.Assign(str, size) +#else + With _System_OSVersionInfo + ' GetCompositionStringW is not implimented in Windows 95 + If .dwMajorVersion = 4 And .dwMinorVersion = 0 And .dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then + Dim strA As PCSTR + Dim sizeA = _PromptWnd_GetCompositionStringA(himc, strA) + tempStr.AssignFromMultiByte(strA, sizeA) + Else + Dim size = _PromptWnd_GetCompositionStringW(himc, str) + tempStr.Assign(str, size \ SizeOf (WCHAR)) + End If + End With +#endif ImmReleaseContext(hwnd, himc) - - memcpy(VarPtr(_PromptSys_InputStr[_PromptSys_InputLen]), str, size) - _PromptSys_InputLen += size \ SizeOf (Char) - - Dim tempStr As String(str, size \ SizeOf (Char)) _System_free(str) - SendMessage(hwnd, WM_KILLFOCUS, 0, 0) + memcpy(VarPtr(_PromptSys_InputStr[_PromptSys_InputLen]), tempStr.Chars, SizeOf (StrChar) * tempStr.Length) + _PromptSys_InputLen += tempStr.Length + + SendMessage(hwnd, WM_KILLFOCUS, 0, 0) : Debug PRINT_ToPrompt(tempStr) SendMessage(hwnd, WM_SETFOCUS, 0, 0) @@ -371,11 +432,12 @@ Function PromptMain(dwData As Long) As Long + GetVersionEx(_System_OSVersionInfo) + Dim i As Long - 'Allocate For i = 0 To 100 With _PromptSys_TextLine[i] .Length = 0 - .Text = _System_calloc(SizeOf (Char) * 255) + .Text = _System_calloc(SizeOf (StrChar) * 255) .CharInfo = _System_calloc(SizeOf (_PromptSys_CharacterInformation) * 255) End With @@ -515,5 +577,5 @@ '---------------------------------------------- Sub INPUT_FromPrompt(ShowStr As String) - Dim i As Long ,i2 As Long, i3 As Long + Dim i As Long, i2 As Long, i3 As Long Dim buf As String Index: /Include/com/bstring.ab =================================================================== --- /Include/com/bstring.ab (revision 141) +++ /Include/com/bstring.ab (revision 142) @@ -11,5 +11,5 @@ Sub BString(len As DWord) - bs = SysAllocStringLen(len) + bs = SysAllocStringLen(0, len) End Sub @@ -40,11 +40,31 @@ End Sub + Sub ~BString() + Clear() + End Sub + Sub Operator =(ByRef bstr As BString) - ~BString() + Clear() BString(bstr) End Sub - Sub ~BString() + Sub Operator =(s As LPCOLESTR) Clear() + BString(s) + End Sub + + Sub Assign(ByRef bstr As BString) + Clear() + BString(bstr) + End Sub + + Sub Assign(s As LPCOLESTR) + Clear() + BString(s) + End Sub + + Sub AssignFromBStr(bstr As BSTR) + Clear() + BString(bstr) End Sub @@ -74,5 +94,5 @@ End Function - Const Function Operator [](i As SIZE_T) + Const Function Operator [](i As SIZE_T) As OLECHAR #ifdef _DEBUG If i > Length Then Index: /Include/com/index.ab =================================================================== --- /Include/com/index.ab (revision 142) +++ /Include/com/index.ab (revision 142) @@ -0,0 +1,3 @@ +' com/index.ab + +#require Index: /Include/system/string.sbp =================================================================== --- /Include/system/string.sbp (revision 141) +++ /Include/system/string.sbp (revision 142) @@ -15,8 +15,248 @@ End Function -Function MakeStr(pBuf As *Char) As String +Function MakeStr(pBuf As PSTR) As String Dim temp As String(pBuf) Return temp End Function +Function MakeStr(pBuf As PWSTR) As String + Dim temp As String(pBuf) + Return temp +End Function + +Dim _System_AllocForConvertedString As *Function(size As SIZE_T) As VoidPtr +_System_AllocForConvertedString = AddressOf (GC_malloc_atomic) + +Function GetStr(psz As PSTR, ByRef wcs As PWSTR) As SIZE_T + If psz <> 0 Then + Return GetStr(psz, lstrlenA(psz), wcs) + Else + Return 0 + End If +End Function + +Function GetStr(psz As PSTR, len As SIZE_T, ByRef wcs As PWSTR) As SIZE_T + If psz = 0 Then Return 0 + Dim sizeWCS = MultiByteToWideChar(CP_THREAD_ACP, 0, psz, len, 0, 0) + wcs = _System_AllocForConvertedString(SizeOf (WCHAR) * sizeWCS) As PWSTR + GetWCStr = MultiByteToWideChar(CP_THREAD_ACP, 0, psz, len, wcs, sizeWCS) + wcs[GetWCStr] = 0 +End Function + +Function GetStr(psz As PWSTR, ByRef wcs As PWSTR) As SIZE_T + wcs = psz + If psz <> 0 Then + Return lstrlenW(psz) + Else + Return 0 + End If +End Function + +Function GetStr(psz As PWSTR, len As SIZE_T, ByRef wcs As PWSTR) As SIZE_T + wcs = psz + If psz <> 0 Then + Return lstrlenW(psz) + Else + Return 0 + End If +End Function + +Function GetStr(psz As PWSTR, ByRef mbs As PSTR) As SIZE_T + If psz = 0 Then + Return 0 + Else + Return GetStr(psz, lstrlenW(psz), mbs) + End If +End Function + +Function GetStr(psz As PWSTR, len As SIZE_T, ByRef mbs As PSTR) As SIZE_T + If psz = 0 Then Return 0 + Dim sizeMBS = WideCharToMultiByte(CP_THREAD_ACP, 0, psz, len, 0, 0, 0, 0) + mbs = _System_AllocForConvertedString(SizeOf (SByte) * (sizeMBS + 1)) As PSTR + GetStr = WideCharToMultiByte(CP_THREAD_ACP, 0, psz, len, mbs, sizeMBS, 0, 0) As SIZE_T + mbs[GetStr] = 0 +End Function + +Function GetStr(psz As PSTR, ByRef mbs As PSTR) As SIZE_T + mbs = psz + If psz <> 0 Then + Return lstrlenA(psz) + Else + Return 0 + End If +End Function + +Function GetStr(psz As PSTR, len As SIZE_T, ByRef mbs As PSTR) As SIZE_T + mbs = psz + Return len +End Function + +Function GetStr(ByRef s As String, ByRef mbs As PSTR) As SIZE_T + Return GetStr(s.Chars, s.Length As SIZE_T, mbs) +End Function + +Function GetStr(ByRef s As String, ByRef wcs As PWSTR) As SIZE_T + Return GetStr(s.Chars, s.Length As SIZE_T, wcs) +End Function + +Function GetWCStr(psz As PSTR, ByRef wcs As PWSTR) As SIZE_T + Return GetStr(psz, wcs) +End Function + +Function GetWCStr(psz As PSTR, len As SIZE_T, ByRef wcs As PWSTR) As SIZE_T + Return GetStr(psz, len, wcs) +End Function + +Function GetWCStr(psz As PWSTR, ByRef wcs As PWSTR) As SIZE_T + Return GetStr(psz, wcs) +End Function + +Function GetWCStr(psz As PWSTR, len As SIZE_T, ByRef wcs As PWSTR) As SIZE_T + Return GetStr(psz, len, wcs) +End Function + +Function GetWCStr(ByRef s As String, ByRef wcs As PWSTR) As SIZE_T + Return GetStr(s.Chars, s.Length, wcs) +End Function + +Function GetMBStr(psz As PWSTR, ByRef mbs As PSTR) As SIZE_T + Return GetStr(psz, mbs) +End Function + +Function GetMBStr(psz As PWSTR, len As SIZE_T, ByRef mbs As PSTR) As SIZE_T + Return GetStr(psz, len, mbs) +End Function + +Function GetMBStr(psz As PSTR, ByRef mbs As PSTR) As SIZE_T + Return GetStr(psz, mbs) +End Function + +Function GetMBStr(psz As PSTR, len As SIZE_T, ByRef mbs As PSTR) As SIZE_T + Return GetStr(psz, len, mbs) +End Function + +Function GetMBStr(ByRef s As String, ByRef mbs As PSTR) As SIZE_T + Return GetStr(s.Chars, s.Length, mbs) +End Function + +Function GetTCStr(psz As PSTR, ByRef tcs As PCTSTR) As SIZE_T + Return GetStr(psz, tcs) +End Function + +Function GetTCStr(psz As PSTR, len As SIZE_T, ByRef tcs As PCTSTR) As SIZE_T + Return GetStr(psz, len, tcs) +End Function + +Function GetTCStr(psz As PWSTR, ByRef tcs As PCTSTR) As SIZE_T + Return GetStr(psz, tcs) +End Function + +Function GetTCStr(psz As PWSTR, len As SIZE_T, ByRef tcs As PCTSTR) As SIZE_T + Return GetStr(psz, len, tcs) +End Function + +Function GetTCStr(ByRef s As String, ByRef wcs As PCTSTR) As SIZE_T + Return GetStr(s.Chars, s.Length, tcs) +End Function + +Function GetSCStr(psz As PSTR, ByRef ss As *StrChar) As SIZE_T + Return GetStr(psz, ss) +End Function + +Function GetSCStr(psz As PSTR, len As SIZE_T, ByRef ss As *StrChar) As SIZE_T + Return GetStr(psz, len, ss) +End Function + +Function GetSCStr(psz As PWSTR, ByRef ss As *StrChar) As SIZE_T + Return GetStr(psz, ss) +End Function + +Function GetSCStr(psz As PWSTR, len As SIZE_T, ByRef ss As *StrChar) As SIZE_T + Return GetStr(psz, len, ss) +End Function + +Function GetSCStr(ByRef s As String, ByRef wcs As *StrChar) As SIZE_T + Return GetStr(s.Chars, s.Length, ss) +End Function + +Function ToWCStr(psz As PSTR) As PWSTR + Return GetStr(psz, ToWCStr) +End Function + +Function ToWCStr(psz As PSTR, len As SIZE_T) As PWSTR + Return GetStr(psz, len, ToWCStr) +End Function + +Function ToWCStr(psz As PWSTR) As PWSTR + Return GetStr(psz, ToWCStr) +End Function + +Function ToWCStr(psz As PWSTR, len As SIZE_T) As PWSTR + Return GetStr(psz, len, ToWCStr) +End Function + +Function ToWCStr(ByRef s As String) As PWSTR + Return GetStr(s.Chars, s.Length, ToWCStr) +End Function + +Function ToMBStr(psz As PSTR) As PSTR + Return GetStr(psz, ToMBStr) +End Function + +Function ToMBStr(psz As PSTR, len As SIZE_T) As PSTR + Return GetStr(psz, len, ToMBStr) +End Function + +Function ToMBStr(psz As PWSTR) As PSTR + Return GetStr(psz, ToMBStr) +End Function + +Function ToMBStr(psz As PWSTR, len As SIZE_T) As PSTR + Return GetStr(psz, len, ToMBStr) +End Function + +Function ToMBStr(ByRef s As String) As PSTR + Return GetStr(s.Chars, s.Length, ToMBStr) +End Function + +Function ToTCStr(psz As PSTR) As PCTSTR + Return GetStr(psz, ToTCStr) +End Function + +Function ToTCStr(psz As PSTR, len As SIZE_T) As PCTSTR + Return GetStr(psz, len, ToTCStr) +End Function + +Function ToTCStr(psz As PWSTR) As PCTSTR + Return GetStr(psz, ToTCStr) +End Function + +Function ToTCStr(psz As PWSTR, len As SIZE_T) As PCTSTR + Return GetStr(psz, len, ToTCStr) +End Function + +Function ToTCStr(ByRef s As String) As PCTSTR + Return GetStr(s.Chars, s.Length, ToTCStr) +End Function + +Function ToSCStr(psz As PSTR) As *StrChar + Return GetStr(psz, ToSCStr) +End Function + +Function ToSCStr(psz As PSTR, len As SIZE_T) As *StrChar + Return GetStr(psz, len, ToSCStr) +End Function + +Function ToSCStr(psz As PWSTR) As *StrChar + Return GetStr(psz, ToSCStr) +End Function + +Function ToSCStr(psz As PWSTR, len As SIZE_T) As *StrChar + Return GetStr(psz, len, ToSCStr) +End Function + +Function ToSCStr(ByRef s As String) As *StrChar + Return GetStr(s.Chars, s.Length, ToSCStr) +End Function + #endif '_INC_BASIC_STRING