Ignore:
Timestamp:
Jun 12, 2007, 7:24:38 PM (17 years ago)
Author:
イグトランス (egtra)
Message:

StringBuilderを追加。String不変へ。共通の文字列操作関数をActiveBasic.Strings内に配置（設計に検討の余地あり）。

File:
1 edited

Legend:

Unmodified
Added
Removed

  • Include/basic/function.sbp

    r269 r272  
    1313
    1414#require <Classes/System/Math.ab>
     15#require <Classes/System/DateTime.ab>
     16#require <Classes/System/Text/StringBuilder.ab>
    1517#require <Classes/ActiveBasic/Math/Math.ab>
     18#require <Classes/ActiveBasic/Strings/Strings.ab>
    1619
    1720
    … …  
    9295End Function
    9396
    94 Const RAND_MAX=&H7FFFFFFF
    95 Dim _System_RndNext=1 As DWord
     97Const RAND_MAX = &H7FFFFFFF
     98Dim _System_RndNext = 1 As DWord
    9699
    97100Function rand() As Long
    98101    _System_RndNext = _System_RndNext * 1103515245 + 12345
    99     rand = _System_RndNext >> 1
     102    rand = (_System_RndNext >> 1) As Long
    100103End Function
    101104
    … …  
    233236
    234237Function Chr$(code As StrChar) As String
    235     Chr$ = ZeroString(1)
    236     Chr$[0] = code
     238    Chr$ = New String(code, 1)
    237239End Function
    238240
    … …  
    252254Function ChrW(c As UCSCHAR) As String
    253255    If c <= &hFFFF Then
    254         ChrW.ReSize(1)
    255         ChrW[0] = c As WCHAR
     256        Return New String(c As StrChar, 1)
    256257    ElseIf c < &h10FFFF Then
    257         ChrW.ReSize(2)
    258         ChrW[0] = &hD800 Or (c >> 10)
    259         ChrW[1] = &hDC00 Or (c And &h3FF)
    260     Else
    261         ' OutOfRangeException
     258        Dim t[1] = [&hD800 Or (c >> 10), &hDC00 Or (c And &h3FF)] As StrChar
     259        Return New String(t, 2)
     260    Else
     261        'ArgumentOutOfRangeException
    262262    End If
    263263End Function
    … …  
    265265
    266266Function Date$() As String
    267     Dim st As SYSTEMTIME
    268     GetLocalTime(st)
     267    Dim date = DateTime.Now
     268    Dim buf = New System.Text.StringBuilder(10)
    269269
    270270    'year
    271     Date$=Str$(st.wYear)
     271    buf.Append(date.Year)
    272272
    273273    'month
    274     If st.wMonth<10 Then
    275         Date$=Date$+"/0"
    276     Else
    277         Date$=Date$+"/"
    278     End If
    279     Date$=Date$+Str$(st.wMonth)
     274    If date.Month < 10 Then
     275        buf.Append("/0")
     276    Else
     277        buf.Append("/")
     278    End If
     279    buf.Append(date.Month)
    280280
    281281    'day
    282     If st.wDay<10 Then
    283         Date$=Date$+"/0"
    284     Else
    285         Date$=Date$+"/"
    286     End If
    287     Date$=Date$+Str$(st.wDay)
     282    If date.Day < 10 Then
     283        buf.Append("/0")
     284    Else
     285        buf.Append("/")
     286    End If
     287    buf.Append(date.Day)
     288
     289    Date$ = buf.ToString
    288290End Function
    289291
    … …  
    358360End Function
    359361
    360 Function Left$(buf As String, length As Long) As String
    361     Left$ = ZeroString(length)
    362     memcpy(StrPtr(Left$), StrPtr(buf), SizeOf (StrChar) * length)
    363 End Function
    364 
    365 Function Mid$(buf As String, StartPos As Long)(ReadLength As Long) As String
    366     Dim length As Long
    367 
    368     StartPos--
    369     If StartPos<0 Then
    370         'error
    371         'Debug
    372         Exit Function
    373     End If
    374 
    375     length=Len(buf)
    376     If length<=StartPos Then Exit Function
    377 
    378     If ReadLength=0 Then
    379         ReadLength=length-StartPos
    380     End If
    381 
    382     If ReadLength>length-StartPos Then
    383         ReadLength=length-StartPos
    384     End If
    385 
    386     Mid$=ZeroString(ReadLength)
    387     memcpy(StrPtr(Mid$), VarPtr(buf.Chars[StartPos]), SizeOf (StrChar) * ReadLength)
    388 End Function
    389 
    390 Function Oct$(num As DWord) As String
    391     Dim i As DWord, i2 As DWord
    392 
    393     For i=10 To 1 Step -1
    394         If (num \ CDWord(8^i)) And &H07 Then
    395             Exit For
    396         End If
    397     Next
    398 
    399     Oct$=ZeroString(i+1)
    400     i2=0
     362Function Left$(s As String, length As Long) As String
     363    Left$ = s.Substring(0, System.Math.Min(s.Length, length))
     364End Function
     365
     366Function Mid$(s As String, startPos As Long) As String
     367    startPos--
     368    Mid$ = s.Substring(startPos)
     369End Function
     370
     371Function Mid$(s As String, startPos As Long, readLength = 0 As Long) As String
     372    startPos--
     373    Dim length = s.Length
     374    Mid$ = s.Substring(System.Math.Min(startPos, length), System.Math.Min(readLength, length - startPos))
     375End Function
     376
     377Const _System_MaxFigure_Oct_QW = 22 As DWord 'QWORD_MAX = &o1,777,777,777,777,777,777,777
     378Function Oct$(n As QWord) As String
     379    Dim s[ELM(_System_MaxFigure_Oct_QW)] As StrChar
     380    Dim i = ELM(_System_MaxFigure_Oct_QW) As Long
    401381    Do
    402         Oct$[i2] = &h30 + ((num \ CDWord(8 ^ i)) And &H07) As StrChar ' &h30 = Asc("0")
    403         If i=0 Then Exit Do
     382        s[i] = ((n And &o7) + &h30) As StrChar '&h30 = Asc("0")
     383        n >>= 3
     384        If n = 0 Then
     385            Return New String(s + i, _System_MaxFigure_Oct_QW - i)
     386        End If
    404387        i--
    405         i2++
    406388    Loop
    407389End Function
    408390
    409 Function Right$(buf As String, length As Long) As String
    410     Dim i As Long
    411 
    412     i=Len(buf)
    413     If i>length Then
    414         Right$=ZeroString(length)
    415         memcpy(StrPtr(Right$), VarPtr(buf.Chars[i-length]), SizeOf (StrChar) * length)
    416     Else
    417         Right$=buf
    418     End If
     391Const _System_MaxFigure_Oct_DW = 11 As DWord 'DWORD_MAX = &o37,777,777,777
     392Function Oct$(n As DWord) As String
     393    Dim s[ELM(_System_MaxFigure_Oct_DW)] As StrChar
     394    Dim i = ELM(_System_MaxFigure_Oct_DW) As Long
     395    Do
     396        s[i] = ((n And &o7) + &h30) As StrChar '&h30 = Asc("0")
     397        n >>= 3
     398        If n = 0 Then
     399            Return New String(s + i, _System_MaxFigure_Oct_DW - i)
     400        End If
     401        i--
     402    Loop
     403End Function
     404
     405Function Right$(s As String, length As Long) As String
     406    Right$ = s.Substring(System.Math.Max(0, s.Length - length), s.Length)
    419407End Function
    420408
    … …  
    447435    '値が0の場合
    448436    If value = 0 Then
    449         _System_FillChar(_System_ecvt_buffer, count As SIZE_T, &H30 As StrChar)
     437        ActiveBasic.Strings.ChrFill(_System_ecvt_buffer, count As SIZE_T, &H30 As StrChar)
    450438        _System_ecvt_buffer[count] = 0
    451439        dec = 0
    … …  
    523511        buffer[i] = Asc(".")
    524512        i++
    525         memcpy(VarPtr(buffer[i]), VarPtr(temp[1]), SizeOf (StrChar) * 14)
     513        ActiveBasic.Strings.ChrCopy(VarPtr(buffer[i]), VarPtr(temp[1]), 14)
    526514        i += 14
    527515        buffer[i] = Asc("e")
    528516        i++
    529         _stprintf(VarPtr(buffer[i]), "+%03d", dec - 1)
     517        _stprintf(VarPtr(buffer[i]), "+%03d", dec - 1) 'ToDo: __STRING_UNICODE_WINDOWS_ANSI状態への対応
    530518
    531519        Return MakeStr(buffer)
    … …  
    538526        buffer[i] = Asc(".")
    539527        i++
    540         memcpy(VarPtr(buffer[i]), VarPtr(temp[1]), SizeOf (StrChar) * 14)
     528        ActiveBasic.Strings.ChrCopy(VarPtr(buffer[i]), VarPtr(temp[1]), 14)
    541529        i+=14
    542530        buffer[i] = Asc("e")
    543531        i++
    544         _stprintf(VarPtr(buffer[i]), "+%03d", dec - 1)
     532        _stprintf(VarPtr(buffer[i]), "+%03d", dec - 1) 'ToDo: __STRING_UNICODE_WINDOWS_ANSI状態への対応
    545533
    546534        Return MakeStr(buffer)
    … …  
    603591
    604592    Dim buf[20] As StrChar
    605     buf[20] = 0
     593    'buf[20] = 0
    606594    Dim i = 19 As Long
    607595    Do
    … …  
    640628    Dim i = 9 As Long
    641629    Do
    642         buf[i] = (x Mod 10 + &h30) As StrChar
     630        buf[i] = (x As Int64 Mod 10 + &h30) As StrChar 'Int64への型変換は#117対策
    643631        x \= 10
    644632        If x = 0 Then
    645             Exit Do
     633            Return New String(VarPtr(buf[i]), 10 - i)
    646634        End If
    647635        i--
    648     Loop
    649     Return New String(VarPtr(buf[i]), 10 - i)
     636    Loop   
    650637#endif
    651638End Function
    … …  
    679666End Function
    680667
    681 Function String$(num As Long, buf As String) As String
    682     Dim dwStrPtr As DWord
    683     Dim length As Long
    684 
    685     length=Len(buf)
    686 
    687     'バッファ領域を確保
    688     String$=ZeroString(length*num)
    689 
    690     '文字列をコピー
     668Function String$(n As Long, s As StrChar) As String
     669    Return New String(s, n)
     670End Function
     671       
     672#ifdef _AB4_COMPATIBILITY_STRING$_
     673Function String$(n As Long, s As String) As String
     674    If n < 0 Then
     675        'Throw ArgumentOutOfRangeException
     676    End If
     677
     678    Dim buf = New System.Text.StringBuilder(s.Length * n)
    691679    Dim i As Long
    692     For i=0 To num-1
    693         memcpy(VarPtr(String$.Chars[i*length]), StrPtr(buf), SizeOf (StrChar) * length)
     680    For i = 0 To n
     681        buf.Append(s)
    694682    Next
    695683End Function
     684#else
     685Function String$(n As Long, s As String) As String
     686    If String.IsNullOrEmpty(s) Then
     687        Return New String(0 As StrChar, n)
     688            Else
     689        Return New String(s[0], n)
     690    End If
     691End Function
     692#endif
    696693
    697694Function Time$() As String
    698     Dim st As SYSTEMTIME
    699 
    700     GetLocalTime(st)
     695    Dim time = DateTime.Now
     696
     697    Dim buf = New System.Text.StringBuilder(8)
    701698
    702699    'hour
    703     If st.wHour<10 Then
    704         Time$="0"
    705     End If
    706     Time$=Time$+Str$(st.wHour)
     700    If time.Hour < 10 Then
     701        buf.Append("0")
     702    End If
     703    buf.Append(time.Hour)
    707704
    708705    'minute
    709     If st.wMinute<10 Then
    710         Time$=Time$+":0"
    711     Else
    712         Time$=Time$+":"
    713     End If
    714     Time$=Time$+Str$(st.wMinute)
     706    If time.Minute < 10 Then
     707        buf.Append(":0")
     708    Else
     709        buf.Append(":")
     710    End If
     711    buf.Append(time.Minute)
    715712
    716713    'second
    717     If st.wSecond<10 Then
    718         Time$=Time$+":0"
    719     Else
    720         Time$=Time$+":"
    721     End If
    722     Time$=Time$+Str$(st.wSecond)
     714    If time.Second < 10 Then
     715        buf.Append(":0")
     716    Else
     717        buf.Append(":")
     718    End If
     719    buf.Append(time.Second)
     720    Time$ = buf.ToString
    723721End Function
    724722
    … …  
    738736    If buf[0]=Asc("&") Then
    739737        temporary = New String( buf )
    740         temporary.ToUpper()
     738        temporary = temporary.ToUpper()
    741739        TempPtr = StrPtr(temporary)
    742740        If TempPtr(1)=Asc("O") Then
    … …  
    816814
    817815Function Loc(FileNum As Long) As Long
    818     Dim NowPos As Long, BeginPos As Long
    819 
    820816    FileNum--
    821817
    822     NowPos=SetFilePointer(_System_hFile(FileNum),0,NULL,FILE_CURRENT)
    823     BeginPos=SetFilePointer(_System_hFile(FileNum),0,NULL,FILE_BEGIN)
    824     SetFilePointer(_System_hFile(FileNum),NowPos-BeginPos,NULL,FILE_BEGIN)
    825 
    826     Loc=NowPos-BeginPos
     818    Dim NowPos = SetFilePointer(_System_hFile(FileNum), 0, 0, FILE_CURRENT)
     819    Dim BeginPos = SetFilePointer(_System_hFile(FileNum), 0, 0, FILE_BEGIN)
     820    SetFilePointer(_System_hFile(FileNum), NowPos - BeginPos, 0, FILE_BEGIN)
     821
     822    Loc = NowPos - BeginPos
    827823End Function
    828824
    … …  
    851847    _System_pGC->__free(lpMem)
    852848End Sub
    853 
    854849
    855850Function _System_malloc(stSize As SIZE_T) As VoidPtr
    … …  
    10441039End Function
    10451040
    1046 Sub _System_FillChar(p As PWSTR, n As SIZE_T, c As WCHAR)
    1047     Dim i As SIZE_T
    1048     For i = 0 To ELM(n)
    1049         p[i] = c
    1050     Next
    1051 End Sub
    1052 
    1053 Sub _System_FillChar(p As PSTR, n As SIZE_T, c As SByte)
    1054     Dim i As SIZE_T
    1055     For i = 0 To ELM(n)
    1056         p[i] = c
    1057     Next
    1058 End Sub
    1059 
    10601041Function _System_ASCII_IsUpper(c As WCHAR) As Boolean
    10611042    Return c As DWord - &h41 < 26 ' &h41 = Asc("A")
    … …  
    10961077Function _System_ASCII_ToUpper(c As SByte) As SByte
    10971078    Return _System_ASCII_ToUpper(c As Byte As WCHAR) As Byte As SByte
    1098 End Function
    1099 
    1100 Function _System_ChrCpy(dst As PCWSTR, src As PCWSTR, size As SIZE_T) As PCWSTR
    1101     memcpy(dst, src, size * SizeOf (WCHAR))
    1102     Return dst
    1103 End Function
    1104 
    1105 Function _System_ChrCpy(dst As PCSTR, src As PCSTR, size As SIZE_T) As PCSTR
    1106     memcpy(dst, src, size)
    1107     Return dst
    1108 End Function
    1109 
    1110 Function _System_StrCmp(s1 As PCSTR, s2 As PCSTR) As Long
    1111     Dim i = 0 As SIZE_T
    1112     While s1[i] = s2[i]
    1113         If s1[i] = 0 Then
    1114             Exit While
    1115         End If
    1116         i++
    1117     Wend
    1118     _System_StrCmp = s1[i] - s2[i]
    1119 End Function
    1120 
    1121 Function _System_StrCmp(s1 As PCWSTR, s2 As PCWSTR) As Long
    1122     Dim i = 0 As SIZE_T
    1123     While s1[i] = s2[i]
    1124         If s1[i] = 0 Then
    1125             Exit While
    1126         End If
    1127         i++
    1128     Wend
    1129     _System_StrCmp = s1[i] - s2[i]
    1130 End Function
    1131 
    1132 Function _System_StrCmpN(s1 As PCSTR, s2 As PCSTR, size As SIZE_T) As Long
    1133     Dim i = 0 As SIZE_T
    1134     For i = 0 To ELM(size)
    1135         _System_StrCmpN = s1[i] - s2[i]
    1136         If _System_StrCmpN <> 0 Then
    1137             Exit Function
    1138         End If
    1139     Next
    1140 End Function
    1141 
    1142 Function _System_StrCmpN(s1 As PCWSTR, s2 As PCWSTR, size As SIZE_T) As Long
    1143     Dim i = 0 As SIZE_T
    1144     For i = 0 To ELM(size)
    1145         _System_StrCmpN = s1[i] - s2[i]
    1146         If _System_StrCmpN <> 0 Then
    1147             Exit Function
    1148         End If
    1149     Next
    1150 End Function
    1151 
    1152 Function _System_MemChr(s As PCSTR, c As CHAR, size As SIZE_T) As PCSTR
    1153     Dim i As SIZE_T
    1154     For i = 0 To ELM(size)
    1155         If s[i] = c Then
    1156             Return VarPtr(s[i])
    1157         End If
    1158     Next
    1159     Return 0
    1160 End Function
    1161 
    1162 Function _System_MemChr(s As PCWSTR, c As WCHAR, size As SIZE_T) As PCWSTR
    1163     Dim i As SIZE_T
    1164     For i = 0 To ELM(size)
    1165         If s[i] = c Then
    1166             Return VarPtr(s[i])
    1167         End If
    1168     Next
    1169     Return 0
    1170 End Function
    1171 
    1172 Function _System_MemPBrk(str As PCSTR, cStr As SIZE_T, Chars As PCSTR, cChars As SIZE_T) As PCSTR
    1173     Dim i As SIZE_T
    1174     For i = 0 To ELM(cStr)
    1175         If _System_MemChr(Chars, str[i], cChars) Then
    1176             Return VarPtr(str[i])
    1177         End If
    1178     Next
    1179     Return 0
    1180 End Function
    1181 
    1182 Function _System_MemPBrk(str As PCWSTR, cStr As SIZE_T, Chars As PCWSTR, cChars As SIZE_T) As PCWSTR
    1183     Dim i As SIZE_T
    1184     For i = 0 To ELM(cStr)
    1185         If _System_MemChr(Chars, str[i], cChars) Then
    1186             Return VarPtr(str[i])
    1187         End If
    1188     Next
    1189     Return 0
    11901079End Function
    11911080
Note: See TracChangeset for help on using the changeset viewer.