XProfan

2010 Autor Dieter Zornow
Teile des Codes basieren auf dem Verfahren aus der Include von 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 typ$ = char$(mem#,0,50)
    dispose mem#

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

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

            return ".bmp"

        else

            return ".rle"

        endif

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

        return ".tif"

    endif

    typ$= upper$(typ$)

    If instr("JFIF",typ$)

        return ".jpg"

    elseif instr("PNG",typ$)

        return ".png"

    elseif instr("GIF",typ$)

        return ".gif"

    elseif instr("EMF",typ$)

        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$ = str$(icons&)+"|"+str$(Byte(size#,6))+"|"+str$(Byte(size#,7))

    else

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

        WHILENOT x% = Icons&

            return$ = return$+str$(Byte(size#,6+(x%*16)))+"|"+str$(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 str$(b%)+"|"+str$(h%)

endproc

PROC BMPRLEDim

    Parameters file$
    declare size#
    DIM size#,24
    Set("Filemode", 0)
    BlockRead(file$,size#,0,24)
    Set("Filemode", 2)
    var return$ = str$(long(size#,18))+"|"+str$(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$ = str$(makeword(byte(size#,19),byte(size#,18)))+"|"+str$(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$ = str$(Makeword(byte(size#,match%+3),byte(size#,match%+2)))  + "|" + str$(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 dazu
                back$ = GetJPGDimension(size#,y%)  Groessenangaben lesen
                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 ab Segmentende suchen
        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$ = str$(Word(size#,12))+"|"+str$(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$ = str$(Word(size#,16))+"|"+str$(Word(size#,20))
    DISPOSE size#
    return return$

EndProc