Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

PB/CC: IsTextUnicode with Microsoft Unicode Layer for Win95/98/ME

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • PB/CC: IsTextUnicode with Microsoft Unicode Layer for Win95/98/ME

    Code:
    $IF 0
    '  FILE: XMLU2A.BAS FOR PB/CC 2.0 & Win 95/98/ME With Microsoft Unicode Layer for Windows support installed
    '  4.10.02  Check if file is Unicode Text and convert to ANSI.
    '  The IsTextUnicode API is not natively supported on Win 95/98/ME so need to use the Microsoft Unicode Layer
    '  for Windows. This layer requires access to "unicows.dll" which is available free from Microsoft at:
    '   [url="http://download.microsoft.com/download/platformsdk/Redist/1.0/W9XMe/EN-US/unicows.exe"]http://download.microsoft.com/download/platformsdk/Redist/1.0/W9XMe/EN-US/unicows.exe[/url] 
    '  NOTES: PB-supplied Win32API files through March 8, 2002 have error in DECLARE of
    '  WideCharToNultiByte; handled here with BYVAL override.
    '  Author:Michael Mattias Racine WI
    '  Placed in the public domain by the author 4/10/02.
    $ENDIF
    
    ' don't allow PB to assign REGISTER variables.
    #REGISTER NONE
    #DEBUG ERROR ON
    $INCLUDE "WIN32API.INC"
    #INCLUDE "ISTEXT.INC"   'includes not provided by PB in Win32API.INC (not used here, but almost were)
    ' TEXT MESSAGES FROM GETLASTERROR
    DECLARE FUNCTION SystemErrorMessageText (BYVAL ECode AS LONG) AS STRING
    FUNCTION SystemErrorMessageText (BYVAL ECode AS LONG) AS STRING
      LOCAL Buffer AS ASCIIZ * 255
      FormatMessage %FORMAT_MESSAGE_FROM_SYSTEM, BYVAL %NULL, ECode, %NULL, buffer, SIZEOF(buffer), BYVAL %NULL
      FUNCTION = FORMAT$(ECode, "(#####) ") & Buffer
    END FUNCTION
    FUNCTION WinMain (BYVAL hCurInstance  AS LONG, _
                      BYVAL hPrevInstance AS LONG, _
                      lpszCmdLine         AS ASCIIZ PTR, _
                      BYVAL nCmdShow      AS LONG) EXPORT AS LONG
    
       DIM ThisFile AS ASCIIZ * 128
       DIM Stat AS LONG
       Stat = GetModuleFileName (hCurInstance, ThisFile, SIZEOF(ThisFile) )
       PRINT "Hello World from Program " & ThisFile
       CALL  ConvertXML
       J$ = WAITKEY$
    
    END FUNCTION
    
    ' DECLARE to use CALL DWORD for IsTextUnicode from Microsoft Unicode Layer For Windows
    DECLARE FUNCTION LayerIsTextUnicode (BYVAL BufferAddr AS DWORD, BYVAL cb AS LONG, lpi AS LONG) AS LONG
    
    FUNCTION ConvertXML () AS LONG
       LOCAL I AS LONG, IH AS LONG, OH AS LONG, fiIn AS STRING,fiOut AS STRING,  UniTest AS LONG
       LOCAL CodePage AS LONG, W2MBFlags AS LONG, szDefaultChar AS ASCIIZ * 2, DefaultUsed AS LONG
       LOCAL Stat AS LONG,E AS LONG
       LOCAL szLibName AS ASCIIZ * %MAX_PATH, szProcName AS ASCIIZ * 48,dwProcAddress AS DWORD, hLib AS LONG
    
       'load the Unicode support
       szLibName = "unicows.dll"
       szProcName = "IsTextUnicode"
       hLib = LoadLibrary (szLibName)
       IF ISTRUE hLib THEN
          DwProcAddress = GetProcAddress(hLib, szProcname)
       ELSE
          PRINT "Could not Load Libary"
          EXIT FUNCTION
       END IF
       IF ISFALSE dwProcAddress THEN
          PRINT "Could not get proc address for " & szProcName & " from Library " & szLibName
          FreeLibrary hLib
          EXIT FUNCTION
       END IF
    
       ' define the input and output files:
       REDIM Fi(1) AS STRING, Fo (1) AS STRING
       fi(0) = "C:\My Documents\Edi\TIE Commerce\result0.xml"
       fo(0) = "C:\My Documents\Edi\TIE Commerce\result0_ansi.xml"
       fi(1) = "C:\My Documents\Edi\TIE Commerce\result1.xml"
       fo(1) = "C:\My Documents\Edi\TIE Commerce\result1_ansi.xml"
       ' set up parameters for IsTextUnicode and WideChartoMultiByte
       Unitest =  %NULL        'all tests used; slower but more reliable
       CodePage = %CP_ACP      'ansi code page
       W2MBFlags = %NULL       'nothing special. Seems to work OK this way
       szdefaultChar = SPACE$(1) ' replacement char for non-mappable Unicode
    
       FOR I = 0 TO 1
           IH = FREEFILE
           OPEN fi(I) FOR BINARY AS IH BASE=0
           GET$ IH, LOF(IH), fiIn
           CLOSE IH
           PRINT "Got file "& fi(I)
           PRINT "size=" & STR$(LEN(fiIn))
           LOCAL StrAddr AS LONG
           StrAddr = STRPTR(fiIn)
           CALL DWORD dwProcAddress USING LayerIsTextUnicode (StrAddr, LEN(fiIn), BYVAL %NULL) TO Stat
           IF ISTRUE Stat THEN
              PRINT "Text **IS** Unicode, converting..."
              fiOut = SPACE$(LEN(FiIn)+ 1)  ' create buffer same size +1, should be safe..
              'override last parameter to correct error in Win32API.INC (unless you like GPFs)
              Stat= WideChartoMultiByte(CodePage, W2MBFlags, BYVAL STRPTR(fiIn), LEN(FiIn), BYVAL STRPTR(fiOut), LEN(fiOut), szDefaultChar, BYVAL VARPTR(DefaultUsed)) '
              IF ISFALSE Stat THEN
                 E = GetLastError
                 PRINT "WideChartoMultibyte ERROR:" & SystemErrorMessageText(E)
              ELSE
                 E= INSTR(FiOut, CHR$(0))         'find the null terminator
                 fiOut = LEFT$(FiOut, E-1)        'collect the valid data
                 PRINT "Converted string is size " & STR$(LEN(FiOut))
              END IF
          ELSE
              PRINT "Input string is not Unicode.. saving 'as is'"
              fiOut = fiIn
          END IF
          OH =FREEFILE
          OPEN fo(I) FOR BINARY AS OH BASE=0
          PUT$ #OH, FiOut
          CLOSE OH
        NEXT I
    
        PRINT "Done Converting..."
        FOR I = 0 TO 1
            PRINT fi(I);"==>";fo(I)
        NEXT
    
        IF ISTRUE hLib THEN
           FreeLibrary hLib
        END IF
    
    END FUNCTION
    
    ' ** END OF FILE **
    ' ***** FILE ISTEXT.INC *****
    Code:
    ' FILE: ISTEXT.INC
    ' MCM 4/10/02
    ' equates not in current (March 8 2002) Win32Api.inc (from winnt.h)
    
    %IS_TEXT_UNICODE_ASCII16               = &h0001
    %IS_TEXT_UNICODE_REVERSE_ASCII16       = &h0010
    
    %IS_TEXT_UNICODE_STATISTICS            = &h0002
    %IS_TEXT_UNICODE_REVERSE_STATISTICS    = &h0020
    
    %IS_TEXT_UNICODE_CONTROLS              = &h0004
    %IS_TEXT_UNICODE_REVERSE_CONTROLS      = &h0040
    
    %IS_TEXT_UNICODE_SIGNATURE             = &h0008
    %IS_TEXT_UNICODE_REVERSE_SIGNATURE     = &h0080
    
    %IS_TEXT_UNICODE_ILLEGAL_CHARS         = &h0100
    %IS_TEXT_UNICODE_ODD_LENGTH            = &h0200
    %IS_TEXT_UNICODE_DBCS_LEADBYTE         = &h0400
    %IS_TEXT_UNICODE_NULL_BYTES            = &h1000
    
    %IS_TEXT_UNICODE_UNICODE_MASK          = &h000F
    %IS_TEXT_UNICODE_REVERSE_MASK          = &h00F0
    %IS_TEXT_UNICODE_NOT_UNICODE_MASK      = &h0F00
    %IS_TEXT_UNICODE_NOT_ASCII_MASK        = &hF000



    ------------------
    Michael Mattias
    Racine WI USA
    [email protected]
    Michael Mattias
    Tal Systems (retired)
    Port Washington WI USA
    [email protected]
    http://www.talsystems.com
Working...
X