fb:porticula NoPaste

Info / Hilfe Liste
Übersicht / Liste Neu
Datei hochladen Suche
Quellcode suchen
Dateidownload
Bin2Bas advanced (remake) V2

Uploader:	AndT
Datum/Zeit:	12.07.2007 09:25:55
#define WIN_INCLUDEALL

#include "windows.bi"

function file_openname (Titel as String) as string



    dim ofn as OPENFILENAME

    dim filename as zstring * MAX_PATH+1



    with ofn

        .lStructSize        = sizeof( OPENFILENAME )



        .hInstance          = GetModuleHandle( NULL )

        '.lpstrFilter       = strptr( !"Einfach alles anzeigen MUHAHAHAHAHA\0*.*\0JpgBilder\0*.jpg\0BmpBilder\0*.bmp" )

        .lpstrCustomFilter  = NULL

        .nMaxCustFilter     = 0

        .nFilterIndex       = 1

        .lpstrFile          = @filename

        .nMaxFile           = sizeof( filename )

        .lpstrFileTitle     = NULL

        .nMaxFileTitle      = 0

        .lpstrInitialDir    = NULL

        .lpstrTitle         = @Titel

        .Flags              = OFN_EXPLORER or OFN_FILEMUSTEXIST or OFN_PATHMUSTEXIST

        .nFileOffset        = 0

        .nFileExtension     = 0

        .lpstrDefExt        = NULL

        .lCustData          = 0

        .lpfnHook           = NULL

        .lpTemplateName     = NULL

    end with



    if( GetOpenFileName( @ofn ) = FALSE ) then

        return ""

    else

        return filename

    end if



end function



function file_savename (Titel as String) as string



    dim ofn as OPENFILENAME

    dim filename as zstring * MAX_PATH+1



    with ofn

        .lStructSize        = sizeof( OPENFILENAME )



        .hInstance          = GetModuleHandle( NULL )

        .lpstrFilter        = strptr( !"Freebasic Headerdatei\0*.bi\0" )

        .lpstrCustomFilter  = NULL

        .nMaxCustFilter     = 0

        .nFilterIndex       = 1

        .lpstrFile          = @filename

        .nMaxFile           = sizeof( filename )

        .lpstrFileTitle     = NULL

        .nMaxFileTitle      = 0

        .lpstrInitialDir    = NULL

        .lpstrTitle         = @Titel

        .Flags              = OFN_EXPLORER or OFN_FILEMUSTEXIST or OFN_PATHMUSTEXIST

        .nFileOffset        = 0

        .nFileExtension     = 0

        .lpstrDefExt        = NULL

        .lCustData          = 0

        .lpfnHook           = NULL

        .lpTemplateName     = NULL

    end with



    if( GetSaveFileName( @ofn ) = FALSE ) then

        return ""

    else

        return filename

    end if



end function



sub EinfachesDialog(Ueberschrifft as String,Text as string)



MessageBox( null, Text, Ueberschrifft, MB_ICONINFORMATION  )

end sub



dim as string Eingabe,Ausgabe,Code,TmpEingabe,Arrey,Endung

dim as ubyte ASCCODE

dim as integer Scanner,Checker,filesize,Abort

width 100,80

Eingabe=file_openname ("Eine Datei zum Convertieren nach Freebasic angeben...")

If eingabe=""  then Abort=true :goto ende

Ausgabe=file_savename ("Wohin soll die Datei gespeichert werden?")

If ausgabe=""  then Abort=true :goto ende

Print "Diese Informationen werden nun verarbeitet und in "+Ausgabe+" geschreiben..."

Ausgabe+=".bi"

open Eingabe for binary as #1

Print "Die Bibiolothek befindet sich in:";Ausgabe

open Ausgabe for binary as #2

Print "Analysiere Dateiname..."

Scanner = LEN(Ausgabe)

filesize=LOF(1)

Endung=MID(Eingabe,LEN(Eingabe)-4,4)



DO

    Scanner -=1

    IF MID(Ausgabe,Scanner,1)=CHR(92) THEN exit do

    LOOP

Ausgabe=MID(Ausgabe,Scanner+1,Len(Ausgabe)-Scanner+3)+Endung

   Print "Analysiere Datei..."

   Print "Dateigroesse : ";STR(filesize);" bytes"



   Print #2,"Dim shared as ubyte " + Ausgabe + "(1 to "+STR(filesize)+") = { _"

   Print "Die Codierung erfolgt jetzt..."

   DO

   Locate 15,1:Print STR(CHECKER)+" von "+ STR(filesize)

   FOR Scanner=1 to 20

   get #1,,ASCCODE

   Code="&H"

   IF ASCCODE < 16 THEN Code+="0"

   Code +=HEX(ASCCODE)

   Print #2,Code;

    Checker+=1

    IF EOF(1)=-1 then exit for

    If Checker < Filesize Then Print #2,",";

NEXT

IF EOF(1)=-1 then exit do

Print #2," _"

Code=""

loop

Print #2," }"

ende:

close #1

close #2

IF Abort = true Then EinfachesDialog ("Info","Der Vorgang wurde vom Benutzter abgebrochen") else EinfachesDialog("Info","Das Programm wird jetzt beendet.")