XProfan

2010 Author Dieter Zornow
pieces the Codes basieren on the take action from the Include of Thomas Hölzer, Andreas Miethe, Hans-Jürgen Trog
Freeware
DEF MakeWord(2) (%(1) | (%(2)*$100))

Proc picturetype

    parameters file$
    declare mem#
    dim mem#,50
    Set("Filemode", 0)
    blockread(file$,mem#,0,50)
    Set("Filemode", 2)
    var type$ = char$(mem#,0,50)
    dispose mem#

    if Left$(type$,2) = "BM"

        ifnot mid$(type$,3,2) = chr $(142)+chr $(3)

            return ".bmp"

        else

            return ".rle"

        endif

    elseif left$(type$,2) = "II"

        return ".tif"

    endif

    type$= upper$(type$)

    If instr("JFIF",type$)

        return ".jpg"

    elseif instr("PNG",type$)

        return ".png"

    elseif instr("GIF",type$)

        return ".gif"

    elseif instr("EMF",type$)

        return ".emf"

    else

        return ".ico"

    endif

endproc

PROC IconDim

    Parameters file$
    Declare Icons&,size#,return$
    Dim size#,filesize(file$)
    var x% = 0
    Set("Filemode", 0)
    BlockRead(file$,Size#,0,filesize(file$))
    Set("Filemode", 2)
    Icons& = @Word(Size#,4)

    if icons& = 1

        return$ = st$(icons&)+"|"+st$(byte(size#,6))+"|"+st$(byte(size#,7))

    else

        return$ = st$(icons&)+"|"

        WHILENOT x% = Icons&

            return$ = return$+st$(byte(size#,6+(x%*16)))+"|"+st$(byte(size#,6+(x%*16+1)))+"|"
            inc x%

        EndWhile

    endif

    DISPOSE Size#
    case right$(return$,1) = "|":return$ = left$(return$,len(return$)-1)
    return return$

ENDPROC

Proc GifDim

    parameters file$
    declare mem#
    dim mem#,10
    Set("Filemode", 0)
    blockread(file$,mem#,0,10)
    Set("Filemode", 0)
    var b% = word(mem#,6)
    var h% = word(mem#,8)
    dispose mem#
    return st$(b%)+"|"+st$(h%)

endproc

PROC BMPRLEDim

    Parameters file$
    declare size#
    DIM size#,24
    Set("Filemode", 0)
    BlockRead(file$,size#,0,24)
    Set("Filemode", 2)
    var return$ = st$(long(size#,18))+"|"+st$(long(size#,22))
    DISPOSE size#
    return return$ B,H

endproc

PROC PNGDim

    Parameters file$
    declare size#,mem#
    Dim size#,24
    set("Filemode",0)
    BlockRead(file$,size#,0,24)
    set("Filemode",2)
    var return$ = st$(makeword(byte(size#,19),byte(size#,18)))+"|"+st$(makeword(byte(size#,23),byte(size#,22)))
    DISPOSE size#,mem#
    return return$

ENDPROC

PROC JPGDim

    Parameters File$
    declare size#
    Dim size#,filesize(file$)
    Set("Filemode", 0)
    blockread(file$,size#,0,filesize(file$))
    Set("Filemode", 2)
    return GetJPGDIM(size#)

    PROC GetJPGDimension

        Parameters size#,Match%
        var back$ = st$(Makeword(byte(size#,match%+3),byte(size#,match%+2)))  + "|" + st$(Makeword(byte(size#,match%+1),byte(size#,match%)))
        DISPOSE size#
        RETURN back$

    ENDPROC

    PROC GetJPGMatch

        Parameters size#,x%
        Declare fs%,y%,back$
        fs% = sizeof(size#)

        WHILENOT x% = fs%

            IF ((MakeWord(byte(size#,x%+1),byte(size#,x%)) = 65472) | (MakeWord(byte(size#,x%+1),byte(size#,x%)) = 65474))

                y%=x%+5 5 bytes moreover
                back$ = GetJPGDimension(size#,y%)  Groessenangaben reading
                x%=fs%-1

            endif

            inc x%

        EndWhile

        RETURN back$

    ENDPROC

    PROC GetJPGDIM

        parameters size#
        Declare mem#
        dim mem#,65535
        External("Kernel32","RtlMoveMemory",mem#,size#,65535)
        var aaa% = (Makeword(byte(mem#,5),byte(mem#,4))+4)
        DISPOSE mem#
        var back$ = GetJPGMatch(size#,aaa%) position ex Segmentende search
        RETURN back$

    endproc

ENDPROC

PROC TGADim

    Parameters file$
    declare size#,return$
    DIM size#,16
    Set("Filemode", 0)
    BlockRead(file$,size#,0,16)
    Set("Filemode", 2)
    return$ = st$(Word(size#,12))+"|"+st$(Word(size#,14))
    DISPOSE size#
    return return$

ENDPROC

PROC EMFDim

    Parameters file$
    declare size#,return$
    DIM size#,24
    Set("Filemode", 0)
    BlockRead(file$,size#,0,24)
    Set("Filemode", 2)
    return$ = st$(Word(size#,16))+"|"+st$(Word(size#,20))
    DISPOSE size#
    return return$

ENDPROC