' o2cmpl.bas

  'FOR COMPILING WITH FREEBASIC

    '
    #define here .byte &he8,0,0,0,0,&h58,&hc3
    '
    #macro adrf(afun)
      call afun
      call addrunfun
    #endmacro
    '
    #define freebasic 'compiling with FreeBasic / therwise Oxygen self compiling (in progress)
    #define OS_MS
    #define global dim shared
    #define sys long
    #define hexci(v) hex(cast(integer,v))
    '
    #define DLL_PROCESS_ATTACH   1
    #define DLL_THREAD_ATTACH    2
    #define DLL_THREAD_DETACH    3
    #define DLL_PROCESS_DETACH   0
    #define DLL_PROCESS_VERIFIER 4
    '
    Type HWND As sys
    Type HMODULE As sys
    Type HINSTANCE As sys
    Type BOOL As sys
    Type UINT As sys
    Type DWORD As sys
    Type BSTR As Any Ptr
    Type FARPROC As Any Ptr
    Type PVOID As Any Ptr
    Type PCVOID As Any Ptr
    Type PLONG As Long Ptr
    Type PDWORD As dword Ptr
    Type LPCSTR As Zstring Ptr
    Type LPSECURITY_ATTRIBUTES As Any Ptr
    Type LPOVERLAPPED As Any Ptr
    Type HANDLE As sys
    #define iostring bstr
    '
  Extern "windows" lib "kernel32"
    'Declare Function  Alias "" (Byval a as long) as long
    Declare Function GetCommandLine Alias "GetCommandLineA" ( ) as ubyte ptr
    Declare Function GetModuleFileName Alias "GetModuleFileNameA" (ByVal As DWORD, Byval As Zstring Ptr, ByVal As DWORD) as DWORD
    'Declare Function GetCurrentDirectoryA( Byval As Uinteger, Byval As Zstring Ptr) As Integer
    'Declare Function GetFullPathNameA(Byval As Zstring Ptr, Byval As Uinteger, Byval As Zstring Ptr, Byval As Zstring Ptr) As Integer
    Declare Function ReadFile ( _
      Byval As HANDLE, _
      Byval As PVOID,  _
      Byval As DWORD,  _
      Byval As PDWORD,  _
      Byval As LPOVERLAPPED) As BOOL
    Declare Function WriteFile ( _
      Byval Byval As HANDLE, _
      Byval As PCVOID,  _
      Byval As DWORD,  _
      Byval As PDWORD, _
      Byval As LPOVERLAPPED) As BOOL
    Declare Function LoadLibrary Alias "LoadLibraryA" ( _
      Byval As LPCSTR) As HINSTANCE
    Declare Function CreateFile Alias "CreateFileA" ( _
      Byval As LPCSTR, _
      Byval As DWORD, _
      Byval As DWORD, _
      Byval As LPSECURITY_ATTRIBUTES, _
      Byval As DWORD, _
      Byval As DWORD, _
      Byval As HANDLE) As HANDLE
    Declare Function FreeLibrary(Byval As HMODULE) As BOOL
    Declare Function GetProcAddress( _
      Byval As HINSTANCE, _
      Byval As LPCSTR) As FARPROC
    Declare Function GetFileSize ( _
      Byval As HANDLE, _
      Byval As PDWORD) As DWORD
    Declare Function SetFilePointer( _
      Byval As HANDLE, _
      Byval As Long, _
      Byval As PLONG, _
      Byval As DWORD) As DWORD
    Declare Function CloseHandle( _
      Byval As HANDLE) As BOOL
  End Extern

  Extern "windows" lib "oleaut32"
    Declare Function SysAllocStringByteLen ( _
      Byval As Zstring Ptr, _
      Byval As Uinteger) As BSTR
    Declare Sub SysFreeString (Byval As BSTR)
  End Extern

  Extern "windows" lib "user32"
    Declare Function MessageBox Alias "MessageBoxA" ( _
      Byval As HWND, _
      Byval As LPCSTR, _
      Byval As LPCSTR, _
      Byval As UINT) As Integer
    Declare Function MessageBoxW Alias "MessageBoxW" ( _
      Byval As HWND, _
      Byval As LPCSTR, _
      Byval As LPCSTR, _
      Byval As UINT) As Integer
  End Extern

  #define AllocString(p,le) SysAllocStringByteLen(p,le)
  #define FreeString(p) SysFreeString(p)
  #define Library(s) LoadLibrary(s)
  #define FreeLibr(a) FreeLibrary(a)
  #define ProcAddr(a,b) GetProcAddress(a,b)





  '==================
  'STRING CONVERSIONS
  '==================


    global as sys omo

    '-----------------------------------------------------------------
    function ps_to_str(byval ps as any ptr, byval le as sys) as string
    '=================================================================
    dim as string src
    dim as any ptr pd
    src=space(le)
    pd=strptr(src)
    asm
      mov esi,[ps]
      mov edi,[pd]
      mov ecx,[le] 'length of data
      nexch:
        mov al,[esi] ' src
        mov [edi],al ' dest
        inc esi
        inc edi
        dec ecx
      jnz nexch
    end asm
    function=src
    end function


    '-----------------------------------------
    function lenzs(byval ps as any ptr) as sys
    '=========================================
      asm
      mov edx,[ps]
      mov ecx,0
      cmp edx,0
      jz xlenzs
      rlenzs:
        cmp byte ptr [edx],0
        jz xlenzs
        inc ecx
        inc edx
      jmp rlenzs
      xlenzs:
      mov [function],ecx
      end asm 
    end function


    '-----------------------------------------
    function lenws(byval ps as any ptr) as sys
    '=========================================
      asm
      mov edx,[ps]
      mov ecx,0
      cmp edx,0
      jz xlenws
      rlenws:
        cmp word ptr [edx],0
        jz xlenws
        inc ecx
        inc edx
        inc ecx
        inc edx
      jmp rlenws
      xlenws:
      mov [function],ecx
      end asm 
    end function


    '-------------------------------------------------------------
    function acode(byval ps as any ptr, byval le as sys) as string
    '=============================================================
      dim as any ptr p
      le*=.5
      function=string(le,chr(0))
      asm
        mov esi,[ps]
        mov edi,[function]
        mov ecx,[le]
        racode:
          dec ecx
          jl xacode
          mov al,[esi]
          mov [edi],al
          inc esi
          inc esi
          inc edi
          jmp racode
        xacode:
      end asm      
    end function



    '-------------------------------------------------------------
    function ucode(byval ps as any ptr, byval le as sys) as string
    '=============================================================
      le*=2
      function=string(le+2,chr(0))
      asm
        mov esi,[ps]
        mov edi,[function]
        mov ecx,[le]
        rucode:
          dec ecx
          jl xucode
          mov al,[esi]
          mov [edi],al
          inc esi
          inc edi
          inc edi
          jmp rucode
        xucode:
      end asm      
    end function


    '---------------------------------------------------------------------------------
    sub bstr_to_fstr alias "bstr_to_fstr" ( byval srcBSTR as BSTR, byref src as string)
    '==================================================================================
    dim as sys i
    dim as any ptr j
    src=""
    if srcBSTR=0 then exit sub
    '
    'GET LENGTH
    '
    asm
      mov eax,[srcBSTR]
      mov ecx,[eax-4]
      mov [i],ecx
    end asm
    '
    if i<=0 then exit sub
    '
    'COPY DATA
    '
    src=ps_to_str(cast(any ptr,srcBSTR),i)
    '
    end sub



    '-----------------------------------------------------------------
    function fstr_to_ostr(byval ps as any ptr, byval le as sys) as sys
    '=================================================================
    dim as sys a=omo and 7
    static as string uc
    if a=2 then uc=ucode(ps,le)
    if (omo and 8) then
      if a<=1 then
        function=cast(long,AllocString(ps,le))
      elseif a=2 then
        function=cast(long,AllocString(strptr(uc),le*2))
      end if
    else
      if a<=1 then
        function=cast(long,ps)
      elseif a=2 then
        function=cast(long,strptr(uc))
      end if
    end if
    end function


    '---------------------------------------------------
    function istr_to_fstr(byval ps as any ptr) as string
    '===================================================
    if ps=0 then exit function
    dim as sys a=omo and 7
    if a=2 then function=acode(ps,lenws(ps)) else function=ps_to_str(ps,lenzs(ps))
    end function


  global as sys pVarCall,pPathCall 'pointers

  function GetvarPtr(byval VarName as string) as sys
  '=================================================
    dim as any ptr p=strptr(VarName)+1
    if pvarcall then
      asm
      push [p]
      call [pvarcall]
      mov [function],eax
      end asm
    end if
  end function
  '
  function InclPath(byval VarName as string) as zstring ptr
  '========================================================
    'function=0 'host variable not available
    dim as any ptr p=strptr(VarName)
    if pPathCall then
      asm
      push [p]
      call [pPathCall]
      mov [function],eax
      end asm
    end if
  end function
  '


