ASCII TO EBCDIC

[karinha]

Buenas foro, és posible hacer esto para FiveWin?

Gracias,

Code: Select all  Expand view

'**************************************
' Name: ASCII_TO_EBCDIC
' Description:Convert ASCII strings into
'     EBCDIC code to upload into an IBM mainfr
'     ame. This code may be used also as a bas
'     ic encrypting method. Both ASCII to EBCD
'     IC and EBCDIC to ASCII are included in t
'     his code.
' By: Aldo Vargas
'
'
' Inputs:None
'
' Returns:None
'
'Assumes:None
'
'Side Effects:None
'This code is copyrighted and has limite
'     d warranties.
'Please see http://www.Planet-Source-Cod
'     e.com/xq/ASP/txtCodeId.5902/lngWId.1/qx/
'     vb/scripts/ShowCode.htm
'for details.
'**************************************



Function ascii_to_ebcdic(ByVal buffer As String) As String

    Dim ascii As Variant
    Dim i As Long, bufferlen As Long

    ascii = Array( _
    &H0, &H1, &H2, &H3, &H37, &H2D, &H2E, &H2F, &H16, &H5, &H25, &HB, &HC, &HD, &HE, &HF, _
    &H10, &H11, &H12, &H13, &H3C, &H3D, &H32, &H26, &H18, &H19, &H3F, &H27, &H1C, &H1D, &H1E, &H1F, _
    &H40, &H4F, &H7F, &H7B, &H5B, &H6C, &H50, &H7D, &H4D, &H5D, &H5C, &H4E, &H6B, &H60, &H4B, &H61, _
    &HF0, &HF1, &HF2, &HF3, &HF4, &HF5, &HF6, &HF7, &HF8, &HF9, &H7A, &H5E, &H4C, &H7E, &H6E, &H6F, _
    &H7C, &HC1, &HC2, &HC3, &HC4, &HC5, &HC6, &HC7, &HC8, &HC9, &HD1, &HD2, &HD3, &HD4, &HD5, &HD6, _
    &HD7, &HD8, &HD9, &HE2, &HE3, &HE4, &HE5, &HE6, &HE7, &HE8, &HE9, &H4A, &HE0, &H5A, &H5F, &H6D, _
    &H79, &H81, &H82, &H83, &H84, &H85, &H86, &H87, &H88, &H89, &H91, &H92, &H93, &H94, &H95, &H96, _
    &H97, &H98, &H99, &HA2, &HA3, &HA4, &HA5, &HA6, &HA7, &HA8, &HA9, &HC0, &H6A, &HD0, &HA1, &H7, _
    &H20, &H21, &H22, &H23, &H24, &H15, &H6, &H17, &H28, &H29, &H2A, &H2B, &H2C, &H9, &HA, &H1B, _
    &H30, &H31, &H1A, &H33, &H34, &H35, &H36, &H8, &H38, &H39, &H3A, &H3B, &H4, &H14, &H3E, &HE1, _
    &H41, &H42, &H43, &H44, &H45, &H46, &H47, &H48, &H49, &H51, &H52, &H53, &H54, &H55, &H56, &H57, _
    &H58, &H59, &H62, &H63, &H64, &H65, &H66, &H67, &H68, &H69, &H70, &H71, &H72, &H73, &H74, &H75, _
    &H76, &H77, &H78, &H80, &H8A, &H8B, &H8C, &H8D, &H8E, &H8F, &H90, &H9A, &H9B, &H9C, &H9D, &H9E, _
    &H9F, &HA0, &HAA, &HAB, &HAC, &HAD, &HAE, &HAF, &HB0, &HB1, &HB2, &HB3, &HB4, &HB5, &HB6, &HB7, _
    &HB8, &HB9, &HBA, &HBB, &HBC, &HBD, &HBE, &HBF, &HCA, &HCB, &HCC, &HCD, &HCE, &HCF, &HDA, &HDB, _
    &HDC, &HDD, &HDE, &HDF, &HEA, &HEB, &HEC, &HED, &HEE, &HEF, &HFA, &HFB, &HFC, &HFD, &HFE, &HFF)
    bufferlen = Len(buffer)


    For i = 1 To bufferlen
        Mid$(buffer, i, 1) = Chr$(ascii(Asc(Mid$(buffer, i, 1))))
    Next

    ascii_to_ebcdic = buffer

End Function

Function ebcdic_to_ascii(ByVal buffer As String) As String

    Dim ebcdic As Variant
    Dim i As Long, bufferlen As Long

    ebcdic = Array( _
    &H0, &H1, &H2, &H3, &H9C, &H9, &H86, &H7F, &H97, &H8D, &H8E, &HB, &HC, &HD, &HE, &HF, _
    &H10, &H11, &H12, &H13, &H9D, &H85, &H8, &H87, &H18, &H19, &H92, &H8F, &H1C, &H1D, &H1E, &H1F, _
    &H80, &H81, &H82, &H83, &H84, &HA, &H17, &H1B, &H88, &H89, &H8A, &H8B, &H8C, &H5, &H6, &H7, _
    &H90, &H91, &H16, &H93, &H94, &H95, &H96, &H4, &H98, &H99, &H9A, &H9B, &H14, &H15, &H9E, &H1A, _
    &H20, &HA0, &HA1, &HA2, &HA3, &HA4, &HA5, &HA6, &HA7, &HA8, &H5B, &H2E, &H3C, &H28, &H2B, &H21, _
    &H26, &HA9, &HAA, &HAB, &HAC, &HAD, &HAE, &HAF, &HB0, &HB1, &H5D, &H24, &H2A, &H29, &H3B, &H5E, _
    &H2D, &H2F, &HB2, &HB3, &HB4, &HB5, &HB6, &HB7, &HB8, &HB9, &H7C, &H2C, &H25, &H5F, &H3E, &H3F, _
    &HBA, &HBB, &HBC, &HBD, &HBE, &HBF, &HC0, &HC1, &HC2, &H60, &H3A, &H23, &H40, &H27, &H3D, &H22, _
    &HC3, &H61, &H62, &H63, &H64, &H65, &H66, &H67, &H68, &H69, &HC4, &HC5, &HC6, &HC7, &HC8, &HC9, _
    &HCA, &H6A, &H6B, &H6C, &H6D, &H6E, &H6F, &H70, &H71, &H72, &HCB, &HCC, &HCD, &HCE, &HCF, &HD0, _
    &HD1, &H7E, &H73, &H74, &H75, &H76, &H77, &H78, &H79, &H7A, &HD2, &HD3, &HD4, &HD5, &HD6, &HD7, _
    &HD8, &HD9, &HDA, &HDB, &HDC, &HDD, &HDE, &HDF, &HE0, &HE1, &HE2, &HE3, &HE4, &HE5, &HE6, &HE7, _
    &H7B, &H41, &H42, &H43, &H44, &H45, &H46, &H47, &H48, &H49, &HE8, &HE9, &HEA, &HEB, &HEC, &HED, _
    &H7D, &H4A, &H4B, &H4C, &H4D, &H4E, &H4F, &H50, &H51, &H52, &HEE, &HEF, &HF0, &HF1, &HF2, &HF3, _
    &H5C, &H9F, &H53, &H54, &H55, &H56, &H57, &H58, &H59, &H5A, &HF4, &HF5, &HF6, &HF7, &HF8, &HF9, _
    &H30, &H31, &H32, &H33, &H34, &H35, &H36, &H37, &H38, &H39, &HFA, &HFB, &HFC, &HFD, &HFE, &HFF)
   
    bufferlen = Len(buffer)


    For i = 1 To bufferlen
        Mid$(buffer, i, 1) = Chr$(ebcdic(Asc(Mid$(buffer, i, 1))))
    Next

    ebcdic_to_ascii = buffer

End Function



[Daniel Garcia-Gil]

Hola

no se si funciona, pero puedes probarlo

Code: Select all  Expand view

function main()
    local a, b
    a = ASCII_to_EBCDIC( "HELLO WORLD" )
    b = EBCDIC_to_ASCII( a )
    ? a, b

return nil


#pragma BEGINDUMP
#include <hbapi.h>

//
//    ASCII to EBCDIC translation table
//
static char ASCII_translate_EBCDIC [ 256 ] =
{
0x00, 0x01, 0x02, 0x03, 0x04, 0x05, 0x06, 0x07, 0x08,
0x09, 0x0A, 0x0B, 0x0C, 0x0D, 0x0E, 0x0F,
0x10, 0x11, 0x12, 0x13, 0x14, 0x15, 0x16, 0x17, 0x18,
0x19, 0x1A, 0x1B, 0x1C, 0x1D, 0x1E, 0x1F,
0x40, 0x5A, 0x7F, 0x7B, 0x5B, 0x6C, 0x50, 0x7D, 0x4D,
0x5D, 0x5C, 0x4E, 0x6B, 0x60, 0x4B, 0x61,
0xF0, 0xF1, 0xF2, 0xF3, 0xF4, 0xF5, 0xF6, 0xF7, 0xF8,
0xF9, 0x7A, 0x5E, 0x4C, 0x7E, 0x6E, 0x6F,
0x7C, 0xC1, 0xC2, 0xC3, 0xC4, 0xC5, 0xC6, 0xC7, 0xC8,
0xC9, 0xD1, 0xD2, 0xD3, 0xD4, 0xD5, 0xD6,
0xD7, 0xD8, 0xD9, 0xE2, 0xE3, 0xE4, 0xE5, 0xE6, 0xE7,
0xE8, 0xE9, 0xAD, 0xE0, 0xBD, 0x5F, 0x6D,
0x7D, 0x81, 0x82, 0x83, 0x84, 0x85, 0x86, 0x87, 0x88,
0x89, 0x91, 0x92, 0x93, 0x94, 0x95, 0x96,
0x97, 0x98, 0x99, 0xA2, 0xA3, 0xA4, 0xA5, 0xA6, 0xA7,
0xA8, 0xA9, 0xC0, 0x6A, 0xD0, 0xA1, 0x4B,
0x4B, 0x4B, 0x4B, 0x4B, 0x4B, 0x4B, 0x4B, 0x4B, 0x4B,
0x4B, 0x4B, 0x4B, 0x4B, 0x4B, 0x4B, 0x4B,
0x4B, 0x4B, 0x4B, 0x4B, 0x4B, 0x4B, 0x4B, 0x4B, 0x4B,
0x4B, 0x4B, 0x4B, 0x4B, 0x4B, 0x4B, 0x4B,
0x4B, 0x4B, 0x4B, 0x4B, 0x4B, 0x4B, 0x4B, 0x4B, 0x4B,
0x4B, 0x4B, 0x4B, 0x4B, 0x4B, 0x4B, 0x4B,
0x4B, 0x4B, 0x4B, 0x4B, 0x4B, 0x4B, 0x4B, 0x4B, 0x4B,
0x4B, 0x4B, 0x4B, 0x4B, 0x4B, 0x4B, 0x4B,
0x4B, 0x4B, 0x4B, 0x4B, 0x4B, 0x4B, 0x4B, 0x4B, 0x4B,
0x4B, 0x4B, 0x4B, 0x4B, 0x4B, 0x4B, 0x4B,
0x4B, 0x4B, 0x4B, 0x4B, 0x4B, 0x4B, 0x4B, 0x4B, 0x4B,
0x4B, 0x4B, 0x4B, 0x4B, 0x4B, 0x4B, 0x4B,
0x4B, 0x4B, 0x4B, 0x4B, 0x4B, 0x4B, 0x4B, 0x4B, 0x4B,
0x4B, 0x4B, 0x4B, 0x4B, 0x4B, 0x4B, 0x4B,
0x4B, 0x4B, 0x4B, 0x4B, 0x4B, 0x4B, 0x4B, 0x4B, 0x4B,
0x4B, 0x4B, 0x4B, 0x4B, 0x4B, 0x4B, 0x4B } ;

//
//    EBCDIC to ASCII translation table
//
static char EBCDIC_translate_ASCII [ 256 ] =
{
0x00, 0x01, 0x02, 0x03, 0x04, 0x05, 0x06, 0x07, 0x08,
0x09, 0x0A, 0x0B, 0x0C, 0x0D, 0x0E, 0x0F,
0x10, 0x11, 0x12, 0x13, 0x14, 0x15, 0x16, 0x17, 0x18,
0x19, 0x1A, 0x1B, 0x1C, 0x1D, 0x1E, 0x1F,
0x20, 0x21, 0x22, 0x23, 0x24, 0x25, 0x26, 0x27, 0x28,
0x29, 0x2A, 0x2B, 0x2C, 0x2D, 0x2E, 0x2F,
0x2E, 0x2E, 0x32, 0x33, 0x34, 0x35, 0x36, 0x37, 0x38,
0x39, 0x3A, 0x3B, 0x3C, 0x3D, 0x2E, 0x3F,
0x20, 0x2E, 0x2E, 0x2E, 0x2E, 0x2E, 0x2E, 0x2E, 0x2E,
0x2E, 0x2E, 0x2E, 0x3C, 0x28, 0x2B, 0x7C,
0x26, 0x2E, 0x2E, 0x2E, 0x2E, 0x2E, 0x2E, 0x2E, 0x2E,
0x2E, 0x21, 0x24, 0x2A, 0x29, 0x3B, 0x5E,
0x2D, 0x2F, 0x2E, 0x2E, 0x2E, 0x2E, 0x2E, 0x2E, 0x2E,
0x2E, 0x7C, 0x2C, 0x25, 0x5F, 0x3E, 0x3F,
0x2E, 0x2E, 0x2E, 0x2E, 0x2E, 0x2E, 0x2E, 0x2E, 0x2E,
0x2E, 0x3A, 0x23, 0x40, 0x27, 0x3D, 0x22,
0x2E, 0x61, 0x62, 0x63, 0x64, 0x65, 0x66, 0x67, 0x68,
0x69, 0x2E, 0x2E, 0x2E, 0x2E, 0x2E, 0x2E,
0x2E, 0x6A, 0x6B, 0x6C, 0x6D, 0x6E, 0x6F, 0x70, 0x71,
0x72, 0x2E, 0x2E, 0x2E, 0x2E, 0x2E, 0x2E,
0x2E, 0x7E, 0x73, 0x74, 0x75, 0x76, 0x77, 0x78, 0x79,
0x7A, 0x2E, 0x2E, 0x2E, 0x5B, 0x2E, 0x2E,
0x2E, 0x2E, 0x2E, 0x2E, 0x2E, 0x2E, 0x2E, 0x2E, 0x2E,
0x2E, 0x2E, 0x2E, 0x2E, 0x5D, 0x2E, 0x2E,
0x7B, 0x41, 0x42, 0x43, 0x44, 0x45, 0x46, 0x47, 0x48,
0x49, 0x2E, 0x2E, 0x2E, 0x2E, 0x2E, 0x2E,
0x7D, 0x4A, 0x4B, 0x4C, 0x4D, 0x4E, 0x4F, 0x50, 0x51,
0x52, 0x2E, 0x2E, 0x2E, 0x2E, 0x2E, 0x2E,
0x5C, 0x2E, 0x53, 0x54, 0x55, 0x56, 0x57, 0x58, 0x59,
0x5A, 0x2E, 0x2E, 0x2E, 0x2E, 0x2E, 0x2E,
0x30, 0x31, 0x32, 0x33, 0x34, 0x35, 0x36, 0x37, 0x38,
0x39, 0x2E, 0x2E, 0x2E, 0x2E, 0x2E, 0x2E } ;

//
//      EBCDIC_to_ASCII (string conversion)
//
void    EBCDIC_to_ASCII ( long buf_length, char *buf_addr1, char *buf_addr2)
{   int i;
    unsigned char temp;
    for (i=0; i < buf_length; i++)
    {
        temp = (unsigned char) buf_addr1[i];
        buf_addr2[i] = EBCDIC_translate_ASCII[temp];
        buf_addr2[i+1] = '\0';              // <nul> terminate
    }
}

//
//      ASCII_to_EBCDIC (string conversion)
//
void    ASCII_to_EBCDIC ( long buf_length, char *buf_addr1, char *buf_addr2)
{   int i;
    unsigned char temp;
    for (i=0; i < buf_length; i++)
    {
        temp = (unsigned char) buf_addr1[i];
        buf_addr2[i] = ASCII_translate_EBCDIC[temp];
        buf_addr2[i+1] = '\0';              // <nul> terminate
    }
}

HB_FUNC( ASCII_TO_EBCDIC ){
    const char * src = hb_parc( 1 );
    int iLenSrc = hb_parclen( 1 );
    char * dest = hb_xgrab( iLenSrc );
    ASCII_to_EBCDIC( iLenSrc, (char*)src,  dest );
    hb_retc( dest );
}


HB_FUNC( EBCDIC_TO_ASCII ){
    const char * src = hb_parc( 1 );
    int iLenSrc = hb_parclen( 1 );
    char * dest = hb_xgrab( iLenSrc );
    EBCDIC_to_ASCII( iLenSrc, (char*)src,  dest );
    hb_retc( dest );
}

#pragma ENDDUMP

 

[karinha]

Gracias Daniel, el que intento hacer, és esto:

http://fivewin.com.br/index.php?/topic/ ... c-do-five/

Salu2.

[El Loco]

Daniel, las dos funciones funcionan perfectamente, a una velocidad alucinante !!!
Convertí un archivo de texto de longitud de registro 460 (3368053760/460 = 7.321.856 registros) a dbf en 00:04:35.
Lo compare con rutinas que utilizaba anteriormente y genera las bases exactamente igual.
Ahora si lo compilo tanto en Harbour como en xHarbour en 32bits compila perfectamente, pero si lo compilo con Harbour 64bits tira estos dos warning:

Code: Select all  Expand view

┌────────────────────────────────────────────────────────────────────────────┐
│ FWH 64 for Harbour 11.03 (MSVC++) Mar. 2011      Harbour development power │▄
│ (c) FiveTech, 1993-2011     for Microsoft Windows 9X/NT/200X/ME/XP/Vista/7 │█
└────────────────────────────────────────────────────────────────────────────┘█
  ▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀
Compiling...
Harbour 3.2.0dev (r1310011443)
Copyright (c) 1999-2013, http://harbour-project.org/
Compiling 'Prueba01.prg' and generating preprocessed output to 'Prueba01.ppo'...
Lines 4339, Functions/Procedures 1
Generating C source output to 'Prueba01.c'... Done.
_______________________________________________________________________________
Compilador de optimización de C/C++ de Microsoft (R) versión 17.00.50727.1 para x64
(C) Microsoft Corporation. Reservados todos los derechos.

Prueba01.c
Prueba01.prg(121) : warning C4244: 'inicializando' : conversión de 'HB_SIZE' a 'int'; posible pérdida de datos
Prueba01.prg(130) : warning C4244: 'inicializando' : conversión de 'HB_SIZE' a 'int'; posible pérdida de datos
_______________________________________________________________________________

     Aplicacion Prueba01 compilada satisfactoriamente  
─────────────────────────────────────────────────────────────
Presione una tecla para continuar . . .

Muchas gracias por este aporte !!!

Un gran abrazo.
Miguel

[Daniel Garcia-Gil]

Hola

prueba cambiar a esta linea

Code: Select all  Expand view

HB_SIZE iLenSrc = hb_parclen( 1 );

[El Loco]

Hola

prueba cambiar a esta linea

Code: Select all  Expand view

HB_SIZE iLenSrc = hb_parclen( 1 );

No, no sigue dando el mismo error.
Abrazo.