Attribute VB_Name = "hlp_GetApiChar"
' Copyright (C) 2004-2006 Jan Vorel
' This program is free software; you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation; either version 2 of the License, or
' (at your option) any later version.

' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY; without even the implied warranty of
' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
' GNU General Public License for more details.

' You should have received a copy of the GNU General Public License
' along with this program; if not, write to the Free Software
' Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA


' This function / declaration can be used without mentioning

'#GetApiChar_FlagA:
' 0 / 1 = GetApiCharA
'     2 = GetApiCharW (using vb unicode)
'     4 = GetApiCharWToA (gets unicode to ansi; not yet implemented)

Option Explicit
Option Base 0

#If GetApiChar_FlagA = 0& Or (GetApiChar_FlagA And &H1&) = &H1& Then
  Private Declare Function lstrcpynA Lib "kernel32" (ByVal lpString1 As String, ByVal lpString2 As Long, ByVal iMaxLength As Long) As Long
  Private Declare Function lstrlenA Lib "kernel32" (ByVal lpString As Long) As Long
  #End If

#If (GetApiChar_FlagA And &H2&) = &H2& Then
  'Private Declare Function lstrcpynW Lib "kernel32" (lpString1 As Any, ByVal lpString2 As Long, ByVal iMaxLength As Long) As Long
  'Private Declare Function lstrlenW Lib "kernel32" (lpString As Long) As Long
  Private Declare Sub RtlMoveMemory Lib "kernel32" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
  #End If

#If GetApiChar_FlagA = 0& Or (GetApiChar_FlagA And &H1&) = &H1& Then
  Public Function GetApiCharA(ByVal ptrChar As Long) As String
    Dim xLong1 As Long
    
    If Not ptrChar = 0& Then
      xLong1 = lstrlenA(ptrChar)
      GetApiCharA = String(xLong1 + 1&, vbNullChar)
      Call lstrcpynA(GetApiCharA, ptrChar, xLong1 + 1&)
      GetApiCharA = Left(GetApiCharA, xLong1)
      End If
    End Function
  #End If

#If (GetApiChar_FlagA And &H2&) = &H2& Then
  Public Function GetApiCharW(ByVal ptrChar As Long) As String
    'Dim xLong1 As Long
    
    'GetApiCharW = GetApiCharWX(ptrChar)
    
    'Stop
    'If Not ptrChar = 0& Then
    '  Stop
    '  xLong1 = lstrlenW(ptrChar)
    '  GetApiCharW = String(xLong1 + 1&, vbNullChar)
    '  Call lstrcpynW(ByVal StrPtr(GetApiCharW), ptrChar, xLong1 + 1&)
    '  GetApiCharW = Left(GetApiCharW, xLong1)
    '  End If
    'End Function
  
  'Public Function GetApiCharWX(ByVal ptrChar As Long) As String
    Dim xIntA1(0) As Integer
    
'    Stop
    'Debug.Print ""
    If Not ptrChar = 0& Then
      Do
        Call RtlMoveMemory(xIntA1(0), ByVal ptrChar, 2&)
        If xIntA1(0) = 0 Then
          Exit Do
          Else
          GetApiCharW = GetApiCharW + ChrW(xIntA1(0))
          'Debug.Print Hex(xIntA1(0)) + " ";
          If ptrChar = &H7FFFFFFF Then
            ptrChar = &H80000001
            ElseIf ptrChar = &H7FFFFFFE Then
            ptrChar = &H80000000
            Else
            ptrChar = ptrChar + 2&
            End If
          End If
        Loop
      End If
    'Debug.Print GetApiCharW + "<"
    'Debug.Print Asc(GetApiCharW + "<")
    End Function
  #End If
