- Welcome to Interactive PowerBasic Forum.
Your resource for programming with PowerBASIC™
Recent posts
#1
OxygenBasic Examples / Re: Deep Basic
Last post by Zlatko Vid - May 22, 2025, 02:25:58 PMhere is better version i hope 
you may try to compile but i doubt that will work
you may try to compile but i doubt that will work
Code Select
' Basic-like interpreter with fixed-size global arrays, no dynamic Redim
' No dictionaries used; labels stored in parallel arrays
' Constants for maximum sizes
CONST MAX_PROGRAM_LINES = 1000
CONST MAX_FUNCTIONS = 50
CONST MAX_PARAMS = 10
CONST MAX_LABELS = 100
' Data structures
TYPE ProgramLine
label As String * 20
code As String * 80
END TYPE
TYPE UserFunction
name As String * 20
params(0 To MAX_PARAMS - 1) As String * 10
paramCount As Integer
body As String * 80
END TYPE
' Global arrays
DIM program(1 To MAX_PROGRAM_LINES) AS ProgramLine
DIM labels(1 To MAX_LABELS) AS String * 20
DIM labelLines(1 To MAX_LABELS) AS Integer
Dim labelCount As Integer
DIM functions(1 To MAX_FUNCTIONS) AS UserFunction
Dim funcCount As Integer
Dim variables(0 To 25) As Double ' A-Z variables
Dim progCount As Integer
Dim currentLine As Integer
Sub Init()
' Initialize counters
progCount = 0
labelCount = 0
funcCount = 0
' Optional: clear arrays (not strictly necessary)
Dim i As Integer
For i = 1 To MAX_PROGRAM_LINES
program(i).label = ""
program(i).code = ""
Next
For i = 1 To MAX_LABELS
labels(i) = ""
labelLines(i) = 0
Next
For i = 1 To MAX_FUNCTIONS
functions(i).name = ""
functions(i).body = ""
functions(i).paramCount = 0
For j = 0 To MAX_PARAMS - 1
functions(i).params(j) = ""
Next
Next
End Sub
Sub AddLine(label As String, code As String)
If progCount >= MAX_PROGRAM_LINES Then Exit Sub
progCount += 1
program(progCount).label = label
program(progCount).code = code
If label <> "" And labelCount < MAX_LABELS Then
labelCount += 1
labels(labelCount) = UCase(label)
labelLines(labelCount) = progCount
End If
End Sub
Function FindLabel(lbl As String) As Integer
Dim i As Integer
For i = 1 To labelCount
If labels(i) = UCase(lbl) Then
Return labelLines(i)
End If
Next
Return -1
End Function
Function ParseTokens(line As String) As String()
Dim tokens(1 To 100) As String
Dim tokenCount As Integer
tokenCount = 0
Dim p As Integer
p = 1
Dim lenLine As Integer
lenLine = Len(line)
While p <= lenLine
Dim ch As String
ch = Mid(line, p, 1)
If ch = " " Then
p = p + 1
Continue
End If
If ch Like "[0-9.]" Then
Dim startPos As Integer
startPos = p
While p <= lenLine And Mid(line, p, 1) Like "[0-9.]"
p = p + 1
Wend
tokenCount = tokenCount + 1
tokens(tokenCount) = Mid(line, startPos, p - startPos)
ElseIf ch Like "[A-Za-z]" Then
Dim startPos As Integer
startPos = p
While p <= lenLine And Mid(line, p, 1) Like "[A-Za-z0-9]"
p = p + 1
Wend
tokenCount = tokenCount + 1
tokens(tokenCount) = UCase(Mid(line, startPos, p - startPos))
ElseIf ch = "(" Or ch = ")" Or ch = "," Or ch = "=" Or ch = "+" Or ch = "-" Or ch = "*" Or ch = "/" Then
tokenCount = tokenCount + 1
tokens(tokenCount) = ch
p = p + 1
Else
p = p + 1
End If
Wend
ParseTokens = tokens
End Function
Function EvaluateExpression(tokens() As String, ByRef pos As Integer) As Double
Dim val1 As Double = ParseTerm(tokens, pos)
While pos <= UBound(tokens) And (tokens(pos) = "+" Or tokens(pos) = "-")
Dim op As String
op = tokens(pos)
pos = pos + 1
Dim val2 As Double
val2 = ParseTerm(tokens, pos)
If op = "+" Then
val1 = val1 + val2
Else
val1 = val1 - val2
End If
Wend
EvaluateExpression = val1
End Function
Function ParseTerm(tokens() As String, ByRef pos As Integer) As Double
Dim val1 As Double = ParseFactor(tokens, pos)
While pos <= UBound(tokens) And (tokens(pos) = "*" Or tokens(pos) = "/")
Dim op As String
op = tokens(pos)
pos = pos + 1
Dim val2 As Double
val2 = ParseFactor(tokens, pos)
If op = "*" Then
val1 = val1 * val2
ElseIf val2 <> 0 Then
val1 = val1 / val2
End If
Wend
ParseTerm = val1
End Function
Function ParseFactor(tokens() As String, ByRef pos As Integer) As Double
Dim token As String
token = tokens(pos)
Dim result As Double
If IsNumeric(token) Then
result = Val(token)
pos = pos + 1
ElseIf token Like "[A-Z]" Then
' Variable
result = variables(Asc(token) - Asc("A"))
pos = pos + 1
ElseIf token = "(" Then
pos = pos + 1
result = EvaluateExpression(tokens, pos)
If tokens(pos) = ")" Then pos = pos + 1
Else
result = 0
pos = pos + 1
End If
ParseFactor = result
End Function
Function CallFunction(name As String, tokens() As String, ByRef pos As Integer) As Double
Dim args(0 To MAX_PARAMS - 1) As Double
Dim argCount As Integer
argCount = 0
If tokens(pos) = "(" Then
pos = pos + 1
Do While tokens(pos) <> ")" And pos <= UBound(tokens)
args(argCount) = EvaluateExpression(tokens, pos)
argCount = argCount + 1
If tokens(pos) = "," Then pos = pos + 1
Loop
If tokens(pos) = ")" Then pos = pos + 1
CallFunction = CallUserFunction(name, args, argCount)
Else
' no parentheses, no args
CallFunction = CallUserFunction(name, args, 0)
End If
End Function
Function CallUserFunction(name As String, args() As Double, argCount As Integer) As Double
Dim i As Integer
For i = 1 To funcCount
If functions(i).name = name Then
Dim body As String = functions(i).body
Dim p As Integer
p = 1
Dim tempBody As String
tempBody = body
Dim j As Integer
For j = 0 To functions(i).paramCount - 1
Dim paramName As String = functions(i).params(j)
tempBody = Replace(tempBody, paramName, CStr(args(j)))
Next
Dim tokens() As String
tokens = ParseTokens(tempBody)
Return EvaluateExpression(tokens, p)
End If
Next
Return 0
End Function
Sub ExecuteLine(line As String)
Dim tokens() As String
tokens = ParseTokens(line)
If UBound(tokens) < 1 Then Exit Sub
Dim firstToken As String
firstToken = tokens(1)
Select Case firstToken
Case "PRINT"
Dim expr As String
expr = Mid(line, Len("PRINT") + 2)
Dim tokensExpr() As String
tokensExpr = ParseTokens(expr)
Dim pos As Integer
pos = 1
Dim val As Double
val = EvaluateExpression(tokensExpr, pos)
Print val
Case "LET"
' Format: LET A = expression
Dim eqPos As Integer
eqPos = InStr(line, "=")
If eqPos > 0 Then
Dim varPart As String
varPart = Trim(Left(line, eqPos - 1))
Dim varName As String
varName = Trim(Mid(varPart, Len("LET") + 1))
Dim expr As String
expr = Trim(Mid(line, eqPos + 1))
Dim tokensExpr() As String
tokensExpr = ParseTokens(expr)
Dim pos As Integer
pos = 1
Dim val As Double
val = EvaluateExpression(tokensExpr, pos)
If varName Like "[A-Z]" Then
variables(Asc(varName) - Asc("A")) = val
End If
End If
Case "GOTO"
Dim lbl As String
lbl = Trim(Mid(line, Len("GOTO") + 2))
Dim idx As Integer
idx = FindLabel(lbl)
If idx >= 1 Then currentLine = idx - 1
Case "IF"
Dim thenPos As Integer
thenPos = InStr(UCase(line), "THEN")
If thenPos > 0 Then
Dim condPart As String
condPart = Trim(Left(line, thenPos - 1))
Dim lbl As String
lbl = Trim(Mid(line, thenPos + 4))
Dim condExpr As String
condExpr = Trim(Mid(condPart, 3))
Dim tokensCond() As String
tokensCond = ParseTokens(condExpr)
Dim pos As Integer
pos = 1
Dim condVal As Double
condVal = EvaluateExpression(tokensCond, pos)
If condVal <> 0 Then
Dim idx As Integer
idx = FindLabel(lbl)
If idx >= 1 Then currentLine = idx - 1
End If
End If
Case "DEF"
' DEF FN name(params)=expression
Dim defLine As String
defLine = line
Dim eqPos As Integer
eqPos = InStr(defLine, "=")
If eqPos > 0 Then
Dim defPart As String
defPart = Trim(Left(defLine, eqPos - 1))
Dim body As String
body = Trim(Mid(defLine, eqPos + 1))
Dim fnPos As Integer
fnPos = InStr(defPart, "FN")
If fnPos > 0 Then
Dim restStr As String
restStr = Trim(Mid(defPart, fnPos + 2))
Dim openP As Integer
Dim closeP As Integer
openP = InStr(restStr, "(")
closeP = InStr(restStr, ")")
If openP > 0 And closeP > 0 Then
Dim fname As String
fname = Trim(Left(restStr, openP - 1))
Dim paramStr As String
paramStr = Trim(Mid(restStr, openP + 1, closeP - openP - 1))
Dim params() As String
Dim paramCount As Integer
paramCount = 0
If Len(paramStr) > 0 Then
Dim arrParams() As String
arrParams = Split(paramStr, ",")
For j = 0 To UBound(arrParams)
functions(funcCount + 1).params(j) = Trim(arrParams(j))
Next
paramCount = UBound(arrParams) + 1
End If
If funcCount < MAX_FUNCTIONS Then
funcCount = funcCount + 1
functions(funcCount).name = fname
functions(funcCount).body = body
functions(funcCount).paramCount = paramCount
End If
End If
End If
End If
' Add other commands as needed
End Select
End Sub
Sub RunProgram()
currentLine = 1
While currentLine >= 1 And currentLine <= progCount
Dim line As String
line = program(currentLine).code
ExecuteLine(line)
currentLine = currentLine + 1
Wend
Print "Program finished."
End Sub
Sub Main()
Init()
' Example program:
' Define a function: FN Add(a,b) = a + b
AddLine("", "DEF FN Add(a,b)=a+b")
AddLine("", "LET A=10")
AddLine("", "LET B=20")
AddLine("", "PRINT ""Sum=""")
AddLine("", "PRINT FN Add(A,B)")
AddLine("", "IF A<B THEN GOTO Label1")
AddLine("Label1", "PRINT ""A is less than B""")
RunProgram()
End Sub #2
OxygenBasic Examples / Deep Basic
Last post by Zlatko Vid - May 22, 2025, 02:21:52 PMgenerated by Deep AI and me
Code Select
' Basic interpreter with label-based control flow and multi-argument functions
'in Oxygen Basic code by Deep AI & Aurel
' Data structures
Type ProgramLine
label As String
code As String
End Type
Type UserFunction
name As String
params() As String
body As String
End Type
' Globals
Dim program(1 To 500) As ProgramLine
Dim programSize As Integer
Dim labelMap As New Dictionary(Of String, Integer)
Dim variables(0 To 25) As Double ' A-Z
Dim functions() As UserFunction
Dim funcCount As Integer
Dim currentLine As Integer
Dim programRunning As Boolean
' Initialize
Sub InitProgram()
programSize = 0
labelMap.Clear()
ReDim functions(1 To 50)
funcCount = 0
End Sub
Sub AddLine(label As String, code As String)
programSize += 1
program(programSize).label = label
program(programSize).code = code
labelMap.Add(label.ToUpper(), programSize)
End Sub
Function FindLabel(label As String) As Integer
Dim idx As Integer = -1
If labelMap.ContainsKey(label.ToUpper()) Then
idx = labelMap.Item(label.ToUpper())
End If
Return idx
End Function
' Tokenizer
Function Tokenize(expr As String) As String()
Dim tokens() As String
Dim p As Integer = 1
Dim lenExpr As Integer = Len(expr)
Dim tokenCount As Integer = 0
While p <= lenExpr
Dim ch As String = Mid(expr, p, 1)
If ch = " " Then p += 1 : Continue
If ch Like "[0-9.]" Then
Dim startPos As Integer = p
While p <= lenExpr And Mid(expr, p, 1) Like "[0-9.]"
p += 1
Wend
tokenCount += 1 : ReDim Preserve tokens(1 To tokenCount)
tokens(tokenCount) = Mid(expr, startPos, p - startPos)
ElseIf ch Like "[A-Za-z]" Then
Dim startPos As Integer = p
While p <= lenExpr And Mid(expr, p, 1) Like "[A-Za-z0-9]"
p += 1
Wend
tokenCount += 1 : ReDim Preserve tokens(1 To tokenCount)
tokens(tokenCount) = UCase(Mid(expr, startPos, p - startPos))
ElseIf ch = "+" Or ch = "-" Or ch = "*" Or ch = "/" Or ch = "(" Or ch = ")" Or ch = "=" Or ch = "," Then
tokenCount += 1 : ReDim Preserve tokens(1 To tokenCount)
tokens(tokenCount) = ch
p += 1
Else
p += 1
End If
Wend
Return tokens
End Function
' Expression parsing and evaluation (simple recursive descent)
Function ParseExpression(tokens() As String, ByRef pos As Integer) As Double
Dim val1 As Double = ParseTerm(tokens, pos)
While pos <= UBound(tokens) And (tokens(pos) = "+" Or tokens(pos) = "-")
Dim op As String = tokens(pos)
pos += 1
Dim val2 As Double = ParseTerm(tokens, pos)
If op = "+" Then val1 += val2 Else val1 -= val2
Wend
Return val1
End Function
Function ParseTerm(tokens() As String, ByRef pos As Integer) As Double
Dim val1 As Double = ParseFactor(tokens, pos)
While pos <= UBound(tokens) And (tokens(pos) = "*" Or tokens(pos) = "/")
Dim op As String = tokens(pos)
pos += 1
Dim val2 As Double = ParseFactor(tokens, pos)
If op = "*" Then val1 *= val2 Else If val2 <> 0 Then val1 /= val2
Wend
Return val1
End Function
Function ParseFactor(tokens() As String, ByRef pos As Integer) As Double
Dim token As String = tokens(pos)
Dim result As Double
If IsNumeric(token) Then
result = Val(token)
pos += 1
ElseIf token Like "[A-Z]" Then
Dim idx As Integer = Asc(token) - Asc("A")
result = variables(idx)
pos += 1
ElseIf token = "(" Then
pos += 1
result = ParseExpression(tokens, pos)
If tokens(pos) = ")" Then pos += 1
ElseIf tokens(pos) Like "[A-Za-z]" Then
' Function call
result = CallFunction(token, tokens, pos)
Else
result = 0
pos += 1
End If
Return result
End Function
' Call multi-arg function
Function CallFunction(funcName As String, tokens() As String, ByRef pos As Integer) As Double
Dim args() As Double
ReDim args(0 To -1)
If tokens(pos) = "(" Then
pos += 1 ' skip '('
Do While tokens(pos) <> ")" And pos <= UBound(tokens)
Dim argVal As Double = ParseExpression(tokens, pos)
ReDim Preserve args(0 To UBound(args) + 1)
args(UBound(args)) = argVal
If tokens(pos) = "," Then pos += 1
Loop
If tokens(pos) = ")" Then pos += 1
Return CallFunctionByName(funcName, args)
Else
' no parentheses, no args
Return CallFunctionByName(funcName, args)
End If
End Function
Function CallFunctionByName(name As String, args() As Double) As Double
Dim i As Integer
For i = 1 To funcCount
If functions(i).name = name Then
Dim body As String = functions(i).body
Dim params() As String = functions(i).params
Dim pCount As Integer = UBound(params) - LBound(params) + 1
If UBound(args) + 1 <> pCount Then Return 0 ' mismatch
Dim tempBody As String = body
For j As Integer = 0 To pCount - 1
tempBody = Replace(tempBody, params(j), CStr(args(j)))
Next
Return EvaluateExpression(tempBody)
End If
Next
Return 0
End Function
Function EvaluateExpression(expr As String) As Double
Dim tokens() As String = Tokenize(expr)
Dim p As Integer = 1
Return ParseExpression(tokens, p)
End Function
' Execute a line of code
Sub ExecuteLine(line As String)
Dim tokens() As String = Tokenize(line)
If UBound(tokens) < 0 Then Return
Dim cmd As String = tokens(1)
Dim rest As String = Mid(line, Len(cmd) + 2).Trim()
Select Case UCase(cmd)
Case "PRINT"
Print rest
Case "LET"
Dim eqPos As Integer = InStr(rest, "=")
If eqPos > 0 Then
Dim vname As String = Trim(Left(rest, eqPos - 1))
Dim expr As String = Trim(Mid(rest, eqPos + 1))
Dim valRes As Double = EvaluateExpression(expr)
Dim idx As Integer = Asc(UCase(vname)) - Asc("A")
variables(idx) = valRes
End If
Case "GOTO"
Dim lbl As String = rest
Dim idx As Integer = FindLabel(lbl)
If idx >= 1 Then currentLine = idx - 1 ' -1 because main loop increments
Case "IF"
' Format: IF expr THEN label
Dim thenPos As Integer = InStr(UCase(line), "THEN")
If thenPos > 0 Then
Dim condExpr As String = Trim(Mid(line, 4, thenPos - 4))
Dim lbl As String = Trim(Mid(line, thenPos + 4))
Dim condVal As Double = EvaluateExpression(condExpr)
If condVal <> 0 Then
Dim idx As Integer = FindLabel(lbl)
If idx >= 1 Then currentLine = idx - 1
End If
End If
Case "DEF"
' Format: DEF FN name(params) = expression
Dim defLine As String = line
Dim eqPos As Integer = InStr(defLine, "=")
If eqPos > 0 Then
Dim defPart As String = Trim(Left(defLine, eqPos - 1))
Dim body As String = Trim(Mid(defLine, eqPos + 1))
Dim fnPos As Integer = InStr(defPart, "FN")
If fnPos > 0 Then
Dim restStr As String = Trim(Mid(defPart, fnPos + 2))
Dim openP As Integer = InStr(restStr, "(")
Dim closeP As Integer = InStr(restStr, ")")
If openP > 0 And closeP > 0 Then
Dim fname As String = Trim(Left(restStr, openP - 1))
Dim paramStr As String = Trim(Mid(restStr, openP + 1, closeP - openP - 1))
Dim params() As String
If Len(paramStr) > 0 Then
params = Split(paramStr, ",")
For i As Integer = 0 To UBound(params)
params(i) = Trim(params(i))
Next
Else
ReDim params(0 To -1)
End If
If funcCount >= UBound(functions) Then Exit Sub
funcCount += 1
functions(funcCount).name = fname
functions(funcCount).params = params
functions(funcCount).body = body
End If
End If
End If
' Add more commands as needed
End Select
End Sub
Sub RunProgram()
currentLine = 1
programRunning = True
While currentLine >= 1 And currentLine <= programSize
Dim line As String = program(currentLine).code
ExecuteLine(line)
currentLine += 1
Wend
Print "Program finished."
End Sub
Sub Main()
InitProgram()
' Sample program
AddLine("START", "LET A = 5")
AddLine("LOOP", "PRINT ""A=""; A")
AddLine("INCR", "LET A = A + 1")
AddLine("CHECK", "IF A < 10 THEN GOTO LOOP")
AddLine("END", "PRINT ""Done.""")
RunProgram()
End Sub
#3
Windows API Headers / Re: PathYetAnotherMakeUniqueNa...
Last post by José Roca - May 22, 2025, 05:22:01 AMThanks. I have modified it.
#4
Windows API Headers / PathYetAnotherMakeUniqueName a...
Last post by Pierre Bellisle - May 22, 2025, 02:03:18 AMHi José,
in ShlObj.inc a little misspell on the alias "PathYetAnoterMakeUniqueName"
instead of "PathYetAnotherMakeUniqueName"
in ShlObj.inc a little misspell on the alias "PathYetAnoterMakeUniqueName"
instead of "PathYetAnotherMakeUniqueName"
#5
OxygenBasic Examples / Re: get o2 version
Last post by Charles Pegge - May 16, 2025, 12:19:15 AMHi Pierre,
Have you come across Named Shared Memory? This allows different processes to share a block of memory, and treat it like a file. It requires only 2 function calls, and a static variable mapping (bind .. end bind) in o2. In the example below, a 64bit server shares global variables directly with a 32bit client, in the same memory space.
SERVER: (run first, without clicking "ok")
CLIENT:
Remember to "ok" on the SERVER MessageBox to close it when done.
Have you come across Named Shared Memory? This allows different processes to share a block of memory, and treat it like a file. It requires only 2 function calls, and a static variable mapping (bind .. end bind) in o2. In the example below, a 64bit server shares global variables directly with a 32bit client, in the same memory space.
SERVER: (run first, without clicking "ok")
Code Select
'-----------------------------------------
'NAMED SHARED MEMORY
'=========================================
'derived from:
'Creating Named Shared Memory
'http://msdn.microsoft.com/en-us/library/aa366551(VS.85).aspx
'==============
'SERVER PROCESS
'==============
$filename "server4.exe"
uses RTL64
uses CoreWin
' from winbase.h and winnt.h
% PAGE_NOACCESS 0x01
% PAGE_READONLY 0x02
% PAGE_READWRITE 0x04
% PAGE_WRITECOPY 0x08
' Token Specific Access Rights.
% TOKEN_ASSIGN_PRIMARY 0x0001
% TOKEN_DUPLICATE 0x0002
% TOKEN_IMPERSONATE 0x0004
% TOKEN_QUERY 0x0008
% TOKEN_QUERY_SOURCE 0x0010
% TOKEN_ADJUST_PRIVILEGES 0x0020
% TOKEN_ADJUST_GROUPS 0x0040
% TOKEN_ADJUST_DEFAULT 0x0080
% TOKEN_ADJUST_SESSIONID 0x0100
% SECTION_QUERY 0x0001
% SECTION_MAP_WRITE 0x0002
% SECTION_MAP_READ 0x0004
% SECTION_MAP_EXECUTE 0x0008
% SECTION_EXTEND_SIZE 0x0010
% SECTION_ALL_ACCESS 0x001F
% SECTION_MAP_EXECUTE_EXPLICIT 0x0020
% STANDARD_RIGHTS_REQUIRED 0x000F0000L
% FILE_MAP_ALL_ACCESS SECTION_ALL_ACCESS
sys INVALID_HANDLE_VALUE = -1 'as ptr
% TRUE 1
% FALSE 0
string szName="Local\MyFileMappingObject" 'GLOBAL\ NOT SUPPOERTED
string szMsg="This is a Message from the SERVER process."
string cr=chr(13)+chr(10)
% BUF_SIZE 0x1000
======================
sys hMapFile
sys pBuf
hMapFile = CreateFileMapping(
INVALID_HANDLE_VALUE, ' use paging file
NULL, ' default security
PAGE_READWRITE, ' read/write access
0, ' maximum object size (high-order DWORD)
BUF_SIZE, ' maximum object size (low-order DWORD)
szName) ' name of mapping object
if hMapFile == 0
print "Could not create file mapping object" + cr + GetLastError()
jmp fwd done
endif
' 0x7 read/write permission
pBuf = MapViewOfFile( hMapFile, 0x7, 0, 0, BUF_SIZE)
if pBuf == 0
print "Could not map view of file" + cr +
GetLastError()
CloseHandle(hMapFile)
jmp fwd done
endif
'
bind pBuf
sys p
int i1,i2
float f1,f2
char c1[0x100]
end bind
'
i1=123
i2=456
f1=pi()
c1=szMsg
print "SERVER: " cr +
c1 cr +
i1 " / " i2 ", " f1 cr cr +
"Press OK to terminate"
UnmapViewOfFile(pBuf)
CloseHandle(hMapFile)
jmp fwd done
'
'
=====
done:
=====
CLIENT:
Code Select
'-----------------------------------------
'NAMED SHARED MEMORY
'=========================================
'derived from:
'Creating Named Shared Memory
'http://msdn.microsoft.com/en-us/library/aa366551(VS.85).aspx
'==============
'SERVER PROCESS
'==============
$filename "server4.exe"
uses RTL64
uses CoreWin
' from winbase.h and winnt.h
% PAGE_NOACCESS 0x01
% PAGE_READONLY 0x02
% PAGE_READWRITE 0x04
% PAGE_WRITECOPY 0x08
' Token Specific Access Rights.
% TOKEN_ASSIGN_PRIMARY 0x0001
% TOKEN_DUPLICATE 0x0002
% TOKEN_IMPERSONATE 0x0004
% TOKEN_QUERY 0x0008
% TOKEN_QUERY_SOURCE 0x0010
% TOKEN_ADJUST_PRIVILEGES 0x0020
% TOKEN_ADJUST_GROUPS 0x0040
% TOKEN_ADJUST_DEFAULT 0x0080
% TOKEN_ADJUST_SESSIONID 0x0100
% SECTION_QUERY 0x0001
% SECTION_MAP_WRITE 0x0002
% SECTION_MAP_READ 0x0004
% SECTION_MAP_EXECUTE 0x0008
% SECTION_EXTEND_SIZE 0x0010
% SECTION_ALL_ACCESS 0x001F
% SECTION_MAP_EXECUTE_EXPLICIT 0x0020
% STANDARD_RIGHTS_REQUIRED 0x000F0000L
% FILE_MAP_ALL_ACCESS SECTION_ALL_ACCESS
sys INVALID_HANDLE_VALUE = -1 'as ptr
% TRUE 1
% FALSE 0
string szName="Local\MyFileMappingObject" 'GLOBAL\ NOT SUPPOERTED
string szMsg="This is a Message from the SERVER process."
string cr=chr(13)+chr(10)
% BUF_SIZE 0x1000
======================
sys hMapFile
sys pBuf
hMapFile = CreateFileMapping(
INVALID_HANDLE_VALUE, ' use paging file
NULL, ' default security
PAGE_READWRITE, ' read/write access
0, ' maximum object size (high-order DWORD)
BUF_SIZE, ' maximum object size (low-order DWORD)
szName) ' name of mapping object
if hMapFile == 0
print "Could not create file mapping object" + cr + GetLastError()
jmp fwd done
endif
' 0x7 read/write permission
pBuf = MapViewOfFile( hMapFile, 0x7, 0, 0, BUF_SIZE)
if pBuf == 0
print "Could not map view of file" + cr +
GetLastError()
CloseHandle(hMapFile)
jmp fwd done
endif
'
bind pBuf
sys p
int i1,i2
float f1,f2
char c1[0x100]
end bind
'
i1=123
i2=456
f1=pi()
c1=szMsg
print "SERVER: " cr +
c1 cr +
i1 " / " i2 ", " f1 cr cr +
"Press OK to terminate"
UnmapViewOfFile(pBuf)
CloseHandle(hMapFile)
jmp fwd done
'
'
=====
done:
=====
Remember to "ok" on the SERVER MessageBox to close it when done.
#6
OxygenBasic Examples / Re: get o2 version
Last post by Pierre Bellisle - May 14, 2025, 08:36:25 PMHi Charles,
If you see things that could be done in an easier way in o2,
do not hesitate to suggest, the possibilities are vast
and I have the natural tendency to fall back in pb track.
If you see things that could be done in an easier way in o2,
do not hesitate to suggest, the possibilities are vast
and I have the natural tendency to fall back in pb track.
#7
OxygenBasic Examples / Re: get o2 version
Last post by Charles Pegge - May 13, 2025, 12:19:36 PMThanks Pierre.
#8
OxygenBasic / Re: word WordValue at strptr(s...
Last post by Charles Pegge - May 12, 2025, 12:08:46 PMQuotethat "sText = string(CharCount, 0) 'zero to nine "
is the equivalent of "sText = string(CharCount, "0")"
O2 automatically converts string parameters into numbers and numbers into strings to match the function prototype.
This is what happens with string(Charcount,n): In this case n gets converted into a string, as if you had used string(Charcount,str(n) )
O2 performs automatic type conversion for all primitive types in an expression, including integers, floats and strings. It works well in most instances but occasionally produces unintended results!
#9
OxygenBasic Examples / get o2 version
Last post by Pierre Bellisle - May 12, 2025, 09:44:45 AMhere are two exe that get o2 version.
the first one is 32 bit, the second one is 64 bit to get 64 bit dll version.
the interprocess communication is done via the simple WM_SETTEXT.
app is drag and drop aware and command line aware.
the first one is 32 bit, the second one is 64 bit to get 64 bit dll version.
the interprocess communication is done via the simple WM_SETTEXT.
app is drag and drop aware and command line aware.
Code Select
//KickResource "D:\Dev\Oxygen\o2\~code\~~~Resource.res" //kick add a manifest for CommonControl-6
//KickSwitch -32 //compile to 32bit
//KickExeArgument "D:\Dev\Oxygen\o2\oxygen.dll" "D:\Dev\Oxygen\o2\oxygen64.dll" //send this command line to the exe
//KickExeFileName "o2version.exe" // Optional exe/dll FileName
//KickEnd //optional, end of kick instructions
'D:\Dev\Oxygen\o2\demos\Unicode\
'in this 32bit exe you have:
' make use of interprocess WM_SETTEXT to get 64bit exe data
' dynamic api loader
' subclassed edit
' read command line arguments with CommandLineToArgvW
' can receive multi dropped files
' FileExist
' SetWindowPos(HWND_NOTOPMOST)
uses dialogs
$ FileName "o2version.exe"
$ o2version64 = "o2version64.exe" 'other exe that use interprocess WM_SETTEXT for 64 bit dll
% Edit 101
% EditHidden 102
% CheckboxTopMost 201
% Grip 301
% SIZE_MINIMIZED 1
% DEFAULT_GUI_FONT 17
% GCL_HICON -14
% MAXDWORD 0xFFFFFFFF
% WM_NCDESTROY 0x082
% SWP_NOSIZE 1
% HWND_DESKTOP 0
% HWND_NOTOPMOST 0xFFFFFFFE
% SIZE_MAXIMIZED 2
% SBS_SIZEGRIP 0x0010
% SM_CXVSCROLL 2
% SM_CYHSCROLL 3
% SEM_FAILCRITICALERRORS = 0X0001
! SetWindowTheme lib "UxTheme.dll" alias "SetWindowTheme"
(byval hwnd as sys, pszSubAppName as wzstring, pszSubIdList as wzstring) as long
'______________________________________________________________________________
sub TextDel(sys hEdit)
'Erase all, Microsoft recommended way
SendMessage(hEdit, WM_SETTEXT, 0, BYVAL 0)
end sub
'_____________________________________________________________________________
sub TextAdd(sys hEdit, byref string sText)
'Move the caret to the end of text
SendMessage(hEdit, EM_SETSEL, -1, -1)
sText += chr(13) + chr(10) 'Add a CRLF if needed
'Insert the string at caret position
SendMessage(hEdit, EM_REPLACESEL, TRUE, sText)
end sub
'_____________________________________________________________________________
function FileExist(string sFileName) as long
dword Attribute = GetFileAttributes(strptr(sFileName))
if Attribute <> INVALID_HANDLE_VALUE then
if (Attribute AND FILE_ATTRIBUTE_DIRECTORY) = 0 then
function = 1
end if
end if
end function
'_____________________________________________________________________________
sub Dynamic_O2_version(sys hEdit, string sFileName)
if right(lcase(sFileName), 4) = ".dll"
dword ExErrMode = SetErrorMode(SEM_FAILCRITICALERRORS) 'prevent pop-up dialogs if device is not present or loaded
sys hLib = LoadLibrary(sFileName)
SetErrorMode(ExErrMode) 'return to old mode
if hLib then
sys pProc = GetProcAddress(hLib, "o2_version")
if pProc then
char* oTwoVer = call pProc
TextAdd(hEdit, "32-bit " & oTwoVer + " - " + sFileName)
else
TextAdd(hEdit, "no o2_version procedure pointer returned - " + sFileName)
endif
FreeLibrary(hLib)
else
sys hEditHidden = GetDlgItem(GetParent(hEdit), EditHidden)
string sCmdLine = "0x" & hex(hEditHidden, 8) & " " & sFileName
ShellExecute(hwnd_desktop, "", o2version64, sCmdLine, "", 0)
endif
else
TextAdd(hEdit, "not a .dll - " + sFileName)
endif
end sub
'_____________________________________________________________________________
function EditProc(sys hEdit, uint wMsg, sys wParam, sys lParam) as sys callback
static sys pEditProc
long index
select case wMsg
case WM_NULL
if hEdit = 0 and pEditProc = 0 then pEditProc = wParam : return(0)
CASE WM_NCDESTROY
SetWindowLongPtr(hEdit, GWL_WNDPROC, pEditProc) 'Unsubclass edit
CASE WM_DROPFILES
sys hDrop = wParam
long DroppedFileCount = DragQueryFileW(hDrop, 0xFFFFFFFF, byval 0, 0)
zstring zFileName[max_path]
for index = 0 to DroppedFileCount - 1
DragQueryFile(hDrop, index, zFileName, MAX_PATH)
Dynamic_O2_version(hEdit, zFileName)
next
DragFinish(hDrop) 'Releases memory that Windows allocated
end select
function = CallWindowProc(pEditProc, hEdit, wMsg, wParam, lParam)
end function
'_____________________________________________________________________________
function DialogProc(sys hDlg, uint uMsg, sys wParam, lParam) as sys callback
static sys hEdit, hIcon, hFont
static rect ButtonRect
static point GripSize
select case uMsg
case WM_INITDIALOG
ShowWindow(GetDlgItem(hDlg, EditHidden), SW_HIDE)
GripSize.x = GetSystemMetrics(SM_CXVSCROLL) 'Width of grip
GripSize.y = GetSystemMetrics(SM_CYHSCROLL) 'Height of grip
SetWindowTheme(GetDlgItem(hDlg, Grip), " ", " ") 'use old theme grip
hIcon = ExtractIcon(GetModuleHandle(""), "Shell32.dll", 294) 'o
SetClassLongPtr(hDlg, GCL_HICON, hIcon)
hEdit = GetDlgItem(hDlg, Edit)
'subclass listbox with a a one liner and no variables needed...
EditProc(0, WM_NULL, SetWindowLongPtr(hEdit, GWL_WNDPROC, @EditProc), 0)
hFont = CreateFont(14, 0, 'height 14 = 9, 16=12, 15=11, 14=11, width usually 0,
0, 0, 'escapement(angle), orientation
0, 0, 0, 0, 'bold, italic, underline, strikeThru
0, OUT_TT_PRECIS, CLIP_DEFAULT_PRECIS,
DEFAULT_QUALITY, FF_DONTCARE, "Consolas") 'fixed width font ("Segoe UI", 9 Arial Consolas)
SendMessage(hEdit, WM_SETFONT, hFont, 0)
SendMessage(GetDlgItem(hDlg, IDCANCEL), WM_SETFONT, GetStockObject(DEFAULT_GUI_FONT), 0)
SendMessage(GetDlgItem(hDlg, CheckboxTopMost), WM_SETFONT, GetStockObject(DEFAULT_GUI_FONT), 0)
GetWindowRect(GetDlgItem(hDlg, IDCANCEL), ButtonRect) 'keep PushButton size as defined in winmain()
ButtonRect.right = ButtonRect.right - ButtonRect.left : ButtonRect.left = 0
ButtonRect.bottom = ButtonRect.bottom - ButtonRect.top : ButtonRect.top = 0
TextDel(hEdit)
TextAdd(hEdit, "from windows explorer, drag one or more 32 or 64 bit oxygen .dll here")
TextAdd(hEdit, "(or you may add dll filename to this exe command line)")
TextAdd(hEdit, "-----------------------------------")
long ArgumentCount, index
wchar** ppwArgument 'pointer to the first pointer item of an array of wzstring pointers, same as 'wchar ptr ptr ppwArgument'
@@ppwArgument = (sys) CommandLineToArgvW(GetCommandLineW(), @ArgumentCount)
if ArgumentCount > 1
for index = 2 to ArgumentCount
Dynamic_O2_version(hEdit, ppwArgument[index])
next
endif
if GlobalFree(@@ppwArgument) then Beep(5500, 50) 'use GlobalFree() or LocalFree(), if the function succeeds, the return value is NULL
PostMessage(hEdit, EM_SETSEL, -1, 0) 'set caret at the end of text
return true
case WM_COMMAND
select case loword(wParam)
case IDCANCEL
if hiword(wParam) = BN_CLICKED OR hiword(wParam) = 1
EndDialog(hDlg, null)
endif
case EditHidden
if hiword(wParam) = EN_CHANGE
'message was sent by o2version64
word CharCount = SendMessageW(GetDlgItem(hDlg, EditHidden), EM_LINELENGTH, 0, 0)
if CharCount
if CharCount = 1 then CharCount = 2
string sText = string(CharCount, chr(0))
word WordLen at strptr(sText)
WordLen = CharCount
SendDlgItemMessage(hDlg, EditHidden, EM_GETLINE, 0, BYVAL STRPTR(sText))
TextAdd(hEdit, sText)
endif
endif
case CheckboxTopMost
if hiword(wParam) = BN_CLICKED OR hiword(wParam) = 1
if IsDlgButtonChecked(hDlg, CheckboxTopMost) then
SetWindowPos(hDlg, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE | SWP_NOSIZE)
else
SetWindowPos(hDlg, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE | SWP_NOSIZE)
endif
endif
end select
case WM_SIZE 'dialog size have changed
'wParam = Resizing requested: SIZE_MAXHIDE SIZE_MAXIMIZED SIZE_MAXSHOW SIZE_MINIMIZED SIZE_RESTORED
'loword lParam is client area width in pixels
'hiword lParam is client area height in pixels
if wParam <> SIZE_MINIMIZED
long ClientSizeX = loword(lParam)
long ClientSizeY = hiword(lParam)
if wparam = SIZE_MAXIMIZED then
SetWindowPos(GetDlgItem(hDlg, Grip), NULL, 0, 0, 0, 0, SWP_NOZORDER) 'size it to zero by zero
else
SetWindowPos(GetDlgItem(hDlg, Grip), NULL, ClientSizeX - GripSize.x,
ClientSizeY - GripSize.y, GripSize.x, GripSize.y, SWP_NOZORDER)
endif
long posY = ClientSizeY - ButtonRect.bottom - 15
MoveWindow(hEdit, 5, 5, ClientSizeX - 10, posY, TRUE)
MoveWindow(GetDlgItem(hDlg, IDCANCEL), (ClientSizeX - ButtonRect.right) \ 2, posY + 10,
ButtonRect.right, ButtonRect.bottom, TRUE)
MoveWindow(GetDlgItem(hDlg, CheckboxTopMost), 10, posY + 10,
ButtonRect.right, ButtonRect.bottom, TRUE)
endif
case WM_CLOSE
EndDialog(hDlg, null)
case WM_DESTROY
DeleteObject(hFont)
DestroyIcon(hIcon)
end select
return 0
end function
'______________________________________________________________________________
sub winmain()
if sizeof(sys) = 8
mbox "This code must be compiled in 32 bit"
else
if FileExist(o2version64) then
Dialog(0, 0, 280, 100, "oxygenbasic version", WS_OVERLAPPEDWINDOW | DS_CENTER)
MultiLineText("", Edit, 1, 1, 198, 80)
PushButton("&close" , IDCANCEL, 80, 85, 40, 12)
AutoCheckBox("&topmost" , CheckboxTopMost, 5, 85, 40, 12)
SCROLLBAR("", Grip, 270, 90, 10, 10, WS_CHILD | WS_VISIBLE | SBS_SIZEGRIP | SBS_SIZEBOXBOTTOMRIGHTALIGN)
EditText("", EditHidden, "", 0, 0, 100, 20)
CreateModalDialog(null, @DialogProc, 0)
else
mbox o2version64 & " not found !"
endif
endif
end sub
'______________________________________________________________________________
winmain()
'______________________________________________________________________________
'
Code Select
//K ickUseDirectivesFrom "D:\Dev\Oxygen\o2\o2_version3264-01.o2bas"
//KickResource "D:\Dev\Oxygen\o2\~code\~~~Resource.res" //kick add a manifest for CommonControl-6
//KickSwitch -64 //compile to 32bit
//K ickExeArgument "D:\Dev\Oxygen\o2\oxygen.dll" "D:\Dev\Oxygen\o2\oxygen64.dll" //send this command line to the exe
//K ickHelp //show kick help
//KickExeFileName "o2version64.exe" // Optional exe/dll FileName
//KickEnd //optional, end of kick instructions
'in this 64bit exe you have:
' dynamic api loader
' GetCommandLine()
' FileExist
uses corewin
$ FileName "o2version64.exe"
$ o2version = "o2version.exe" 'other exe with dialog for 32 bit dll
% EditHidden 102
% SEM_FAILCRITICALERRORS = 0X0001
macro makdwd(lo, hi)
dword (hi << 16) + lo
end macro
'_____________________________________________________________________________
function FileExist(string sFileName) as long
dword Attribute = GetFileAttributes(strptr(sFileName))
if Attribute <> INVALID_HANDLE_VALUE then
if (Attribute AND FILE_ATTRIBUTE_DIRECTORY) = 0 then
function = 1
end if
end if
end function
'_____________________________________________________________________________
function Dynamic_O2_version(string sFileName) as string
dword ExErrMode = SetErrorMode(SEM_FAILCRITICALERRORS) 'prevent pop-up dialogs if device is not present or loaded
sys hLib = LoadLibrary(sFileName)
SetErrorMode(ExErrMode) 'return to old error mode
if hLib then
sys pProc = GetProcAddress(hLib, "o2_version")
if pProc then
char* oTwoVer = call pProc
function = "64-bit " & oTwoVer + " - " + sFileName
else
function = "no o2_version procedure pointer returned - " + sFileName
endif
FreeLibrary(hLib)
endif
end function
'______________________________________________________________________________
sub winmain()
if sizeof(sys) = 4
mbox "This code must be compiled in 64 bit"
else
if fileExist(o2version) then
zstring ptr pCommandLine = GetCommandLine()
string sCommandLine = pCommandLine
long charPos = instr(2, sCommandLine, chr(34))
if charPos then
sCommandLine = mid(sCommandLine, charPos + 2, len(sCommandLine) - charPos - 1)
if left(sCommandLine, 2) = "0x" then
sys h = val(sCommandLine)
charPos = instr(sCommandLine, chr(32))
sCommandLine = mid(sCommandLine, charPos + 1)
if isWindow(getParent(h)) then
if len(sCommandLine) then
string sResult = Dynamic_O2_version(sCommandLine)
'send text to o2version 32 bit
SendMessage(h, WM_SETTEXT, 0, strptr(sResult))
PostMessage(GetParent(h), WM_COMMAND, MAKDWD(EditHidden, EN_CHANGE), h)
endif
endif
else
mbox "use " & o2version & " !"
endif
endif
else
mbox o2version & " not found !"
endif
endif
end sub
'______________________________________________________________________________
winmain()
'______________________________________________________________________________
'
#10
OxygenBasic / Re: word WordValue at strptr(s...
Last post by Pierre Bellisle - May 12, 2025, 12:19:19 AMHi Charles and Aurel,
I work with both wstring and string.
For this question I wrote a demo that do not use wide character.
I made different variation of "word WordLen at strptr(sText) = CharCount"
Look for "choice" in code
I got a non assigned value in one case, I got a gpf on reassigment try,
and a good result which the normal behavior, now that I'm aware of it.
Thank for the answer.
Note: If you revisit the help file, might be good to say
that "sText = string(CharCount, 0) 'zero to nine "
is the equivalent of "sText = string(CharCount, "0")"
and to obtain a string made of nul like
"sText = nuls(CharCount)" you have to add "chr()" like in
"sText = string(CharCount, chr(0))"
I work with both wstring and string.
For this question I wrote a demo that do not use wide character.
I made different variation of "word WordLen at strptr(sText) = CharCount"
Look for "choice" in code
I got a non assigned value in one case, I got a gpf on reassigment try,
and a good result which the normal behavior, now that I'm aware of it.
Thank for the answer.
Note: If you revisit the help file, might be good to say
that "sText = string(CharCount, 0) 'zero to nine "
is the equivalent of "sText = string(CharCount, "0")"
and to obtain a string made of nul like
"sText = nuls(CharCount)" you have to add "chr()" like in
"sText = string(CharCount, chr(0))"
Code Select
//KickResource "D:\Dev\Oxygen\o2\~code\~~~Resource.res" //kick add a manifest for CommonControl-6
//KickSwitch -32 //compile to 32bit
//KickEnd //optional, end of kick instructions
% Edit01 102
% lText01 201
% CheckboxTopMost 301
% DEFAULT_GUI_FONT 17
% GCL_HICON -14
% SWP_NOSIZE 1
% HWND_NOTOPMOST 0xFFFFFFFE
uses dialogs
'____________________________________________________________________________
function DialogProc(sys hDlg, uint uMsg, sys wParam, lParam) as int callback
select case uMsg
case WM_INITDIALOG
sys hIcon = ExtractIcon(GetModuleHandle(""), "Shell32.dll", 294) 'o
SetClassLongPtr(hDlg, GCL_HICON, hIcon)
sys hEdit = GetDlgItem(hDlg, Edit01)
sys hFont = CreateFont(14, 0, 'Height 14 = 9, 16=12, 15=11, 14=11, Width usually 0,
0, 0, 'Escapement(angle), Orientation
0, 0, 0, 0, 'Bold, Italic, Underline, Strikethru
0, OUT_TT_PRECIS, CLIP_DEFAULT_PRECIS,
DEFAULT_QUALITY, FF_DONTCARE, "Consolas") 'Fixed width font ("Segoe UI", 9 Arial Consolas)
SendMessage(hEdit, WM_SETFONT, hFont, 0)
SendMessage(GetDlgItem(hDlg, IDCANCEL), WM_SETFONT, GetStockObject(DEFAULT_GUI_FONT), 0)
SendMessage(GetDlgItem(hDlg, lText01), WM_SETFONT, GetStockObject(DEFAULT_GUI_FONT), 0)
SendMessage(GetDlgItem(hDlg, CheckboxTopMost), WM_SETFONT, GetStockObject(DEFAULT_GUI_FONT), 0)
PostMessage(hEdit, %EM_SETSEL, -1, 0) 'Set caret at the end of text
return true
case WM_COMMAND
select case loword(wParam)
case IDCANCEL
if hiword(wParam) = BN_CLICKED OR hiword(wParam) = 1
EndDialog(hDlg, null)
end if
case Edit01
if hiword(wParam) = EN_CHANGE 'OR hiword(wParam) = 1
word CharCount = SendMessage(GetDlgItem(hDlg, Edit01), EM_LINELENGTH, 0, 0)
string sText = nuls(CharCount)
if CharCount = 1 then CharCount = 2 'EM_GETLINE need at least 2 to work on a one char string,
'--------------------------------------
long choice = 2 'try 1, 2, or 3
'-
if choice = 1 'bad, value is not assigned to CharCount
word WordLen at strptr(sText) = CharCount
end if
'-
if choice = 2 'ok, value is assigned to CharCount
word WordLen at strptr(sText)
WordLen = CharCount
end if
'-
if choice = 3 'gpf, reassigmnet will gpf
word WordLen at strptr(sText) = CharCount
WordLen = CharCount
end if
'--------------------------------------
long retval = SendDlgItemMessage(hDlg, Edit01, EM_GETLINE, 0, STRPTR(sText))
SetWindowText(GetDlgItem(hDlg, lText01), "[" + sText + "] len " & str(len(sText)) & ", count from em_getline " & str(retval))
end if
case CheckboxTopMost
if hiword(wParam) = BN_CLICKED OR hiword(wParam) = 1
if IsDlgButtonChecked(hDlg, CheckboxTopMost) then
SetWindowPos(hDlg, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE | SWP_NOSIZE)
else
SetWindowPos(hDlg, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE | SWP_NOSIZE)
end if
end if
end select
case WM_CLOSE
EndDialog(hDlg, null)
case WM_DESTROY
DeleteObject(hFont)
DestroyIcon(hIcon)
end select
return 0
end function
'______________________________________________________________________________
sub winmain()
Dialog(0, 0, 155, 30, "edit EM_GETLINE", WS_CAPTION | WS_MINIMIZEBOX | WS_SYSMENU | DS_CENTER, WS_EX_LEFT)
EditText("123456", Edit01, 05, 05, 80, 10)
Ltext("try choice 1, 2, 3 in code", lText01, 5, 18, 100, 10, SS_NOTIFY, ws_ex_staticedge, 0) 'ws_ex_windowedge) 'ws_ex_clientedge) 'ws_ex_staticedge)
PushButton("&close" , IDCANCEL, 110, 5, 40, 10)
AutoCheckBox("topmost" , CheckboxTopMost, 110, 18, 40, 10)
CreateModalDialog(null, @DialogProc, 0)
end sub
'______________________________________________________________________________
winmain()
'______________________________________________________________________________
'