'command.sbp Const _System_Type_SByte = 1 Const _System_Type_Byte = 2 Const _System_Type_Integer = 3 Const _System_Type_Word = 4 Const _System_Type_Long = 5 Const _System_Type_DWord = 6 Const _System_Type_Int64 = 7 Const _System_Type_QWord = 8 Const _System_Type_Single = 9 Const _System_Type_Double = 10 Const _System_Type_Char = 11 Const _System_Type_String = 13 Const _System_Type_VoidPtr = 14 Const _System_MAX_PARMSNUM = 32-1 Dim _System_DummyStr As String Dim _System_DummyStr2 As String Macro BEEP() MessageBeep(MB_OK) End Macro Sub _System_Call_Destructor_of_GlobalObject() 'dummy End Sub Sub _System_End() System.Detail.hasShutdownStarted = True Dim exitCode = System.Environment.ExitCode _System_EndProgram() ExitProcess(exitCode) End Sub Macro END() _System_End() End Macro Macro EXEC(filePath As String)(cmdLine As String) ShellExecute(0, "open", ToTCStr(filePath), ToTCStr(cmdLine), 0, SW_SHOWNORMAL) End Macro Macro INPUT() 'dummy(INPUT_FromFile、INPUT_FromPromptを参照) End Macro Macro PRINT() 'dummy(PRINT_ToFile、PRINT_ToPromptを参照) End Macro Macro RANDOMIZE() srand(GetTickCount()) End Macro Macro WRITE() 'dummy(PRINT_ToFile、PRINT_ToPromptを参照) End Macro '---------------- ' ウィンドウ関連 '---------------- Macro MSGBOX(hwnd As HWND, str As String)(title As String, boxType As DWord, ByRef retAns As DWord) Dim ret = MessageBox(hwnd, ToTCStr(str), ToTCStr(title), boxType) If VarPtr(retAns) Then retAns = ret End If End Macro 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 Macro DELWND(hWnd As HWND) DestroyWindow(hWnd) End Macro 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)) With mii .cbSize = Len(mii) .fMask = MIIM_TYPE If str.Length = 0 Then mii.fType = MFT_SEPARATOR Else .fType = MFT_STRING .fMask = .fMask or MIIM_STATE or MIIM_ID .dwTypeData = ToTCStr(str) .wID = id If hSubMenu Then .fMask = .fMask or MIIM_SUBMENU .hSubMenu = hSubMenu End If .fState = state End If End With InsertMenuItem(hMenu, PosID, flag, mii) End Macro '-------------- ' ファイル関連 '-------------- Dim _System_hFile(255) As HANDLE 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-- Select Case AccessFor Case 0 access = GENERIC_READ or GENERIC_WRITE creationDisposition = OPEN_ALWAYS Case 1 access = GENERIC_READ creationDisposition = OPEN_EXISTING Case 2 access = GENERIC_WRITE creationDisposition = CREATE_ALWAYS Case 3 access = GENERIC_WRITE creationDisposition = OPEN_ALWAYS bAppend = True End Select _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 Macro CLOSE()(FileNumber As Long) FileNumber-- ActiveBasic.Detail.ThrowIfInvaildFileNum(FileNumber) If _System_hFile(FileNumber) Then CloseHandle(_System_hFile(FileNumber)) _System_hFile(FileNumber)=0 End If End Macro 'INPUT Command Data Dim _System_InputDataPtr[_System_MAX_PARMSNUM] As VoidPtr Dim _System_InputDataType[_System_MAX_PARMSNUM] As DWord Sub INPUT_FromFile(FileNumber As Long) FileNumber-- ActiveBasic.Detail.ThrowIfInvaildFileNum(FileNumber) Dim i = 0 As Long Dim buffer = New System.Text.StringBuilder(256) Dim temp[1] As Char Dim dwAccessBytes As DWord Dim IsStr As Long While 1 '次のデータをサーチ Do Dim ret = ReadFile(_System_hFile[FileNumber],temp,SizeOf (Char),VarPtr(dwAccessBytes),ByVal 0) If ret=0 or dwAccessBytes=0 Then 'error Exit Macro End If Loop While temp[0]=32 or temp[0]=9 SetFilePointer(_System_hFile[FileNumber],-1,0,FILE_CURRENT) '読み込み IsStr=0 While 1 Dim ret = ReadFile(_System_hFile[FileNumber],temp,SizeOf (Char),VarPtr(dwAccessBytes),ByVal 0) If ret = 0 or dwAccessBytes = 0 Then 'error Exit Macro End If If temp[0]=34 Then IsStr=IsStr xor 1 buffer.Append(temp[0]) 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,SizeOf (Char),VarPtr(dwAccessBytes),ByVal 0) If Not(dwAccessBytes<>0 And temp[0]=10) Then SetFilePointer(_System_hFile[FileNumber],-1,0,FILE_CURRENT) Continue End If End If If temp[0]=32 or temp[0]=9 Then While 1 ReadFile(_System_hFile[FileNumber],temp,1,VarPtr(dwAccessBytes),ByVal 0) If dwAccessBytes=0 Then Exit While If temp[0]=Asc(",") Then Exit While If Not(temp[0]=32 or temp[0]=9) Then SetFilePointer(_System_hFile[FileNumber],-1,0,FILE_CURRENT) Exit While End If Wend End If buffer.Append(0 As Char) Exit While End If Wend 'データを変数に格納 _System_Input_SetArgument(_System_InputDataPtr[i], _System_InputDataType[i], buffer.ToString) i++ If _System_InputDataPtr[i]=0 Then Exit While Wend End Sub Sub _System_Input_SetArgument(arg As VoidPtr, dataType As DWord, buf As String) Select Case dataType Case _System_Type_Double SetDouble(arg, Val(buf)) Case _System_Type_Single SetSingle(arg, Val(buf)) Case _System_Type_Int64,_System_Type_QWord SetQWord(arg, Val(buf)) Case _System_Type_Long,_System_Type_DWord SetDWord(arg, Val(buf)) Case _System_Type_Integer,_System_Type_Word SetWord(arg, Val(buf)) Case _System_Type_SByte,_System_Type_Byte SetByte(arg, Val(buf)) Case _System_Type_Char SetChar(arg, buf[0]) Case _System_Type_String Dim pTempStr As *String pTempStr = arg As *String pTempStr[0] = buf End Select End Sub Sub PRINT_ToFile(FileNumber As Long, buf As String) Dim dwAccessByte As DWord FileNumber-- ActiveBasic.Detail.ThrowIfInvaildFileNum(FileNumber) WriteFile(_System_hFile(FileNumber), StrPtr(buf), Len(buf), VarPtr(dwAccessByte), ByVal 0) End Sub Dim _System_UsingDblData[_System_MAX_PARMSNUM] As Double Dim _System_UsingStrData[_System_MAX_PARMSNUM] As *Char 'TODO: 暫定対応(動作未確認) Dim _System_UsingDataType[_System_MAX_PARMSNUM] As DWord /* 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 buffer = New System.Text.StringBuilder(1024) ParmNum = 0 i2 = 0 While 1 While 1 If UsingStr[i2]=Asc("#") or UsingStr[i2]=Asc("@") or UsingStr[i2]=Asc("&") Then Exit While buffer[i3]=UsingStr[i2] If UsingStr[i2]=0 Then Exit While i2++ i3++ Wend If UsingStr[i2]=0 Then Exit While If UsingStr[i2]=Asc("#") Then Dim dec As Long, sign As Long Dim temp2 As *Char Dim length_num As Long, length_buf As Long Dim dblRoundOff=0 As Double '---------------------- ' 四捨五入を考慮 '---------------------- i4=i2 While UsingStr[i4]=Asc("#") i4++ Wend If UsingStr[i4]=Asc(".") Then i4++ dblRoundOff=0.5 While UsingStr[i4]=Asc("#") i4++ dblRoundOff /= 10 Wend End If '浮動小数点を文字列に変換 temp2=_ecvt(_System_UsingDblData[ParmNum]+dblRoundOff,15,dec,sign) '整数部 length_num=dec If length_num<=0 Then length_num=1 '符号が有る場合は、一文字分のスペースを考慮する If sign Then length_num++ length_buf=0 Do i2++ length_buf++ Loop While UsingStr[i2]=Asc("#") If length_buf>=length_num Then '通常時 ActiveBasic.Strings.Detail.ChrFill(VarPtr(buffer.Chars[i3]), length_buf - length_num, &h20) 'Asc(" ") i3 += length_buf - length_num If sign Then buffer[i3] = Asc("-") i3++ length_num-- End If If dec > 0 Then memcpy(VarPtr(buffer.Chars[i3]), temp2, SizeOf (Char) * length_num) Else buffer[i3] = &H30 End If i3 += length_num Else '表示桁が足りないとき ActiveBasic.Strings.Detail.ChrFill(VarPtr(buffer.Chars[i3]), length_buf, &h23) 'Asc("#") i3 += length_buf End If If UsingStr[i2] = Asc(".") Then buffer[i3] = UsingStr[i2] i2++ i3++ i4=dec While UsingStr[i2] = Asc("#") If i4<0 Then buffer[i3]=&H30 Else buffer[i3]=temp2[i4] End If i3++ i4++ i2++ Wend End If ElseIf UsingStr[i2]=Asc("@") Then i2++ lstrcat(VarPtr(buffer.Chars[i3]), _System_UsingStrData[ParmNum]) i3 += lstrlen(_System_UsingStrData[ParmNum]) ElseIf UsingStr[i2]=Asc("&") Then i4=0 Do i4++ i2++ Loop While UsingStr[i2]=Asc(" ") If UsingStr[i2]=Asc("&") Then i4++ i2++ i5=lstrlen(_System_UsingStrData[ParmNum]) If i4<=i5 Then i5=i4 Else ActiveBasic.Strings.Detail.ChrFill(VarPtr(buffer.Chars[i3]), i4, &h20) 'Asc(" ") End If memcpy(VarPtr(buffer.Chars[i3]), _System_UsingStrData[ParmNum], SizeOf (Char) * i5) i3 += i4 Else i2 -= i4 buffer[i3] = Asc("&") i2++ i3++ Continue End If End If ParmNum++ Wend _System_GetUsingFormat = buffer.ToString(0, lstrlen(StrBPtr(buffer))) End Function ' TODO: _System_GetUsingFormatを用意して実装する Sub PRINTUSING_ToFile(FileNumber As Long, UsingStr As String) Dim dwAccessByte As DWord Dim buf As String FileNumber-- buf=_System_GetUsingFormat(UsingStr) WriteFile(_System_hFile(FileNumber),buf,Len(buf),VarPtr(dwAccessByte),ByVal NULL) End Sub */ Dim _System_FieldSize(255) As Long Macro FIELD(FileNumber As Long, FieldSize As Long) FileNumber-- ActiveBasic.Detail.ThrowIfInvaildFileNum(FileNumber) _System_FieldSize(FileNumber)=FieldSize End Macro Macro GET(FileNumber As Long, RecodeNumber As Long, ByRef buffer As String) Dim dwAccessByte As DWord FileNumber-- ActiveBasic.Detail.ThrowIfInvaildFileNum(FileNumber) RecodeNumber-- SetFilePointer(_System_hFile(FileNumber), SizeOf (Char) * RecodeNumber * _System_FieldSize(FileNumber), 0, FILE_BEGIN) Dim t = ZeroString(_System_FieldSize(FileNumber)) ReadFile(_System_hFile(FileNumber), StrPtr(t), SizeOf (Char) * _System_FieldSize(FileNumber), VarPtr(dwAccessByte), ByVal 0) If dwAccessByte = _System_FieldSize(FileNumber) Then buffer = t.ToString Else buffer = Left$(t.ToString, dwAccessByte) End If End Macro Macro PUT(FileNumber As Long, RecodeNumber As Long, buffer As String) Dim dwAccessByte As DWord FileNumber-- ActiveBasic.Detail.ThrowIfInvaildFileNum(FileNumber) RecodeNumber-- SetFilePointer(_System_hFile(FileNumber), SizeOf (Char) * RecodeNumber*_System_FieldSize(FileNumber), 0, FILE_BEGIN) WriteFile(_System_hFile(FileNumber), StrPtr(buffer), SizeOf (Char) * _System_FieldSize(FileNumber), VarPtr(dwAccessByte), ByVal 0) End Macro Macro CHDIR(path As String) SetCurrentDirectory(ToTCStr(path)) End Macro Macro MKDIR(path As String) CreateDirectory(ToTCStr(path), 0) End Macro Macro KILL(path As String) DeleteFile(ToTCStr(path)) End Macro