fb:porticula NoPaste

Info / Hilfe Liste
Übersicht / Liste Neu
Datei hochladen Suche
Quellcode suchen
Dateidownload
Bin2Bas in Freebasic nachgeschrieben und erheblich verbessert ;-)

Uploader:	AndT
Datum/Zeit:	16.07.2007 09:28:48
#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

dim as integer scan,add

dim as string tmpscan,Eingabe2,Ausgabe2

width 100,80

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

Eingabe2=Eingabe

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

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

Ausgabe2=Ausgabe

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..."

Print Eingabe

Scanner = LEN(Ausgabe)

filesize=LOF(1)

for scan= LEN(Eingabe) to 1 step -1

tmpscan=mid(Eingabe,scan,1)

if tmpscan=chr(92) then exit for



next

Ausgabe=mid(Eingabe,scan+1,Len(Eingabe)-scan)

if LEN(Eingabe)-Scan < 2 Then Ausgabe=HEX(TIMER)

tmpscan=""

Eingabe=""

for scan= 0 to len(Ausgabe)

    tmpscan=mid(Ausgabe,scan,1)



    ' Liste für Zeichen zum ignorieren

    If tmpscan="\" then Add = 0

    If tmpscan="/" then Add = 0

    If tmpscan=">" then Add = 0

    If tmpscan="<" then Add = 0

    If tmpscan="#" then Add = 0

    If tmpscan=":" then Add = 0

    If tmpscan="|" then Add = 0

    If tmpscan="!" then Add = 0

    If tmpscan="""" then Add = 0

    If tmpscan="§" then Add = 0

    If tmpscan="$" then Add = 0

    If tmpscan="%" then Add = 0

    If tmpscan="&" then Add = 0

    If tmpscan="(" then Add = 0

    If tmpscan=")" then Add = 0

    If tmpscan="=" then Add = 0

    If tmpscan="/" then Add = 0

    If tmpscan="*" then Add = 0

    If tmpscan="+" then Add = 0

    If tmpscan="-" then Add = 0

    If tmpscan="." then Add = 0

    If tmpscan="," then Add = 0

    If Add= 1 then Eingabe+=tmpscan

    Add=1

next

Ausgabe=Eingabe

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."+CHR(13)+Eingabe2+" wurde in "+Ausgabe2+" gespeichert."+Chr(13)+"Der Name des Arrey lautet: """+ Ausgabe+""" .")