UnPack ClipArt (MPF)

Дата: 2008

Скачать в ZIP архиве.

/* UnPack ClipArt (MPF) */
'@echo off'
'@cls'
say ''

if ARG() = 0 then Return Usage()

x_range.d_code = xrange( '0'x, '3f'x )
x_range.s_code = xrange( 'A', 'Z' ) || xrange( 'a', 'z' ) || xrange( '0', '9' ) || '+/'

f_data = file_read( strip( ARG(1) ) )
f_data = xml_tag_parser( f_data, 'D:multistatus', 'clipgallery' )
call rxMeter 1, 1, 50, 'Reading  '||ARG(1)

do while length( f_data ) > 0
    temp_f_data = xml_tags_parser( f_data, 'D:response', 'D:propstat', 'D:prop' )
    f_data = xml_dispose_tag( f_data, 'D:response' )
/*    clp.subject = xml_tags_parser( temp_f_data, 'C:subject' )
    clp.xsubject = xml_tags_parser( temp_f_data, 'C:xsubject' )
    clp.collections = xml_tags_parser( temp_f_data, 'C:collections' )
    clp.type = xml_tags_parser( temp_f_data, 'C:type' )
    clp.width = xml_tags_parser( temp_f_data, 'C:width' )
    clp.height = xml_tags_parser( temp_f_data, 'C:height' )*/
    clp.f_name = xml_tags_parser( temp_f_data, 'C:filepath' )
    call rxMeter size.tot - length( f_data ), size.tot, 50, left( 'Total', length( clp.f_name ) + 9 )
    temp_f_data = DeCodeB64( xml_tag_parser( xml_tags_parser( temp_f_data, 'C:resource' ), 'C:contents', 'base64' ) )
    call file_save clp.f_name, temp_f_data
end
call rxMeter 1, 1, 50, 'Done.'
Return 0

rxMeter: procedure
    progress = ARG(3) * ARG(1) % ARG(2)
    progress = ARG(4)||' '||copies( 'Ы', progress )||copies( '°', ARG(3) - progress )||right( 100 * ARG(1) % ARG(2)||'%', 4 )
    progress = left( progress, 80 )
    say progress||copies( d2c(8), 81 )
Return 0
    
file_save: procedure
    if STREAM( ARG(1), 'C', 'QUERY EXIST' ) = '' then
        call charout ARG(1), ARG(2)
    else Return 1
Return 0

file_read: procedure expose size.
    curr_time = TIME( 'R' )
    if STREAM( ARG(1), 'C', 'QUERY EXIST' ) <> '' then
    do
        size.tot = STREAM( ARG(1), 'C', 'QUERY SIZE' )
        call STREAM ARG(1), 'C', 'OPEN READ'
        f_data = linein( ARG(1) )
        do while lines( ARG(1) ) > 0
            if curr_time + 1 < TIME( 'E' ) then
            do
                call rxMeter length( f_data ), size.tot, 50, 'Reading  '||ARG(1)
                curr_time = TIME( 'E' )
            end
            f_data = f_data||strip( strip( linein( ARG(1) ),, d2c(9) ),, '=' )
        end
        call STREAM ARG(1), 'C', 'CLOSE'
    end
    else Return ''
Return f_data
    
xml_dispose_tag: procedure
    retval = ARG(1)
    interpret 'parse value retval with ."<'||ARG(2)||'>".""retval'
Return retval
    
    
xml_tags_parser: procedure
    retval = ARG(1)
    do i = 2 to ARG()
        interpret 'parse value retval with ."<'||ARG(i)||'>"retval"".'
    end
Return retval

xml_tag_parser: procedure
    retval = ARG(1)
    interpret 'parse value retval with ."<'||ARG(2)||'"jmf_1">"retval"".'
    if pos( translate( ARG(3) ), translate( jmf_1 ) ) = 0 & pos( translate( ARG(3) ), translate( jmf_2 ) ) = 0 then
        Return ''
Return retval

DeCodeB64: procedure expose x_range. clp.
    curr_time = TIME( 'R' )
    xml_data = translate( ARG(1), '0000'x, '0d0a'x )
    l64 = length( xml_data )
    if l64 = 0 then
        Return -1 /* Nothing to extract */
    retval = x2b( c2x( translate( xml_data, x_range.d_code, x_range.s_code ) ) )
    t64 = length( retval )
    drop f_data
    f_data = ''
    ChkSum = 0
    do while retval \= ''
        if curr_time + 1 < TIME( 'E' ) then
        do
            call rxMeter length( f_data ), t64, 50, 'Decoding '||clp.f_name
            curr_time = TIME( 'E' )
        end
        parse var retval +2 bin.0 +6 +2 bin.1 +6 +2 bin.2 +6 +2 bin.3 +6 +2 bin.4 +6 +2 bin.5 +6  +2 bin.6 +6 +2 bin.7 +6 +2 bin.8 +6 +2 bin.9 +6 +2 bin.10 +6 +2 bin.11 +6 retval
        f_data = f_data || bin.0 || bin.1 || bin.2 || bin.3 || bin.4 || bin.5 || bin.6 || bin.7 || bin.8 || bin.9 || bin.10 || bin.11
    end
    xml_data = x2c( b2x( left( f_data, length( f_data ) % 8 * 8 ) ) )
Return xml_data
    
Usage: procedure
    say 'Usage: rxClipArt x:\path\to\multipackage\ClipArt.mpf'
Return 0