Encore un programme de dump...

LABEL Quit, Chfich, Dump, Clicbut, GoAds, Imprime, Calcul, Aide
LABEL ChAsc, ChHex, Recher, Recsui, Quitrec, Survh, Mess
DIM f$, sz%, adb%, adf%, a$, ad$, b$, c$, bufh$, ood%, ol%, nla%, noc%, i%, j%, k%
DIM lad%, tyr%, xr%, sq$, buf$, bfr$, ftmp$, h0%
ftmp$ = "C:\TEMP\Fimpr.txt"

h0% = 900: WIDTH 0,630: HEIGHT 0,h0%: BORDER_SMALL 0
FONT_BOLD 0: COLOR 0,190,255,255: CAPTION 0, " - Dump fichier -"
MAIN_MENU 1
SUB_MENU 2: PARENT 2, 1: CAPTION 2, "Fichier"
  SUB_MENU 3: PARENT 3,2: CAPTION 3, "Ouvrir": ON_CLICK 3, Chfich
  SUB_MENU 4: PARENT 4,2: CAPTION 4,"Imprimer la page": ON_CLICK 4,Imprime
  SUB_MENU 5: PARENT 5,2: CAPTION 5, "Quitter": ON_CLICK 5, Quit
SUB_MENU 10: PARENT 10,1: CAPTION 10, "Chercher"
  SUB_MENU 11: PARENT 11,10: CAPTION 11, "Recherche Ascii": ON_CLICK 11,ChAsc
  SUB_MENU 12: PARENT 12,10: CAPTION 12, "Recherche Hexa": ON_CLICK 12,ChHex
SUB_MENU 20: PARENT 20,1: CAPTION 20, "Calculette": ON_CLICK 20, Calcul
SUB_MENU 30: PARENT 30,1: CAPTION 30,"?": ON_CLICK 30, Aide
ol% = 16: ' octets par ligne
LIST 90: TOP 90,24: LEFT 90,0: WIDTH 90,WIDTH(0)-16: HEIGHT 90,h0%-84
FONT_NAME 90,"Lucida Console": FONT_SIZE 90,10: FONT_BOLD_OFF 90
ALPHA 91: TOP 91,3: LEFT 91,5: CAPTION 91,"Adresse:                    H"
EDIT 92: LEFT 92,55: WIDTH 92,80: COLOR 92,255,255,180
BUTTON 93: LEFT 93,150: WIDTH 93,30: HEIGHT 93,22: CAPTION 93,"Go"
ON_CLICK 93, GoAds

BUTTON 94: LEFT 94,260: CAPTION 94,CHR$(235)
BUTTON 95: LEFT 95,LEFT(94)+35: CAPTION 95,CHR$(233)+CHR$(233)
BUTTON 96: LEFT 96,LEFT(95)+35: CAPTION 96,CHR$(233)
BUTTON 97: LEFT 97,LEFT(96)+35: CAPTION 97,CHR$(234)
BUTTON 98: LEFT 98,LEFT(97)+35: CAPTION 98,CHR$(234)+CHR$(234)
BUTTON 99: LEFT 99,LEFT(98)+35: CAPTION 99,CHR$(238)
FOR i% = 94 TO 99
    WIDTH i%,30: HEIGHT i%,22
    FONT_NAME i%,"Wingdings": : FONT_SIZE i%,12: FONT_BOLD_OFF i%
    ON_CLICK i%,Clicbut
NEXT i%

' Recherche
FORM 100: TOP 100,40: LEFT 100,WIDTH(0): HEIGHT 100,150: BORDER_SMALL 100: HIDE 100
COLOR 100,180,255,255: FONT_BOLD 100: CAPTION 100, "RECHERCHE"
ALPHA 101: PARENT 101,100
EDIT 102: PARENT 102,100: TOP 102,20: WIDTH 102,WIDTH(100)-16
CHECK 103: PARENT 103,100: TOP 103,40: LEFT 103,10: WIDTH 103,200
CAPTION 103,"Respecter la casse"
ALPHA 104: PARENT 104,100: TOP 104,60: LEFT 104,25: COLOR 104,255,255,128
BUTTON 105: PARENT 105,100: TOP 105,80: LEFT 105,100: CAPTION 105,"OK"
ON_CLICK 105,Recher
BUTTON 106: PARENT 106,100: TOP 106,TOP(105): LEFT 106,200: CAPTION 106,"Quitter"
ON_CLICK 106, Quitrec

ood% = 199: OPEN_DIALOG ood%

nla% = INT((HEIGHT(90)-2)/13): ' nb de lignes affichables
noc% = nla%*ol%: ' nb d'octets par page

TIMER 200: TIMER_INTERVAL 200,500: ON_TIMER 200,Survh: TIMER_OFF 200
END
' ==============================================================================
Quit:
TERMINATE
' ==============================================================================
Chfich:
a$ = FILE_NAME$(ood%): IF LEN(a$)<4 THEN RETURN
f$ = a$: FILEBIN_OPEN_READ 1,f$: sz% = FILEBIN_SIZE(1): FILEBIN_CLOSE 1
CAPTION 0, f$ + "  "+STR$(sz%)+" octets.  (=h "+HEX$(sz%)+")"
CLEAR 90
IF sz% = 0 THEN ITEM_ADD 90, "Fichier vide !": RETURN
lad% = 3: ' nb de caractères adresse
IF sz% > 4096 THEN lad% = 4
IF sz% > 65535 THEN lad% = 5
IF sz% > 1048575 THEN lad% = 6
IF sz% > 16777215 THEN lad% = 7
IF sz% > 268435455 THEN lad% = 8
adf% = sz%-noc%+ol%
adb% = 0: GOSUB Dump
buf$ = ""
RETURN
' ==============================================================================
Dump:
' dump à partir de adb% (multiple de ol%
IF sz% = 0 THEN RETURN
TIMER_OFF 200
IF adb% < 0 THEN adb% = 0
IF adb% > adf% THEN adb% = adf%
adb% = ol%*INT(adb%/ol%)
j% = noc%: IF (adb%+noc%) > sz% THEN j% = sz%-adb%
FILEBIN_OPEN_READ 1,f$: FILEBIN_POSITION 1,adb%: FILEBIN_HEXA_READ 1,j%,bufh$
FILEBIN_CLOSE 1
CLEAR 90
FOR j% = 1 TO LEN(bufh$) STEP 2*ol%
    ad$ = RIGHT$("000000"+HEX$(adb%+INT(j%/2)),lad%) + ": ": b$ = " "
    FOR i% = j% TO j%+ol%*2-1 step 2
        IF i% > LEN(bufh$)
            ad$ = ad$ + "__ ": b$ = b$ + " ": ' fin de fichier
        ELSE
            a$ = MID$(bufh$,i%, 2): k% = HEX(a$)
            ad$ = ad$ + a$ + " "
            IF k%<32 OR k%=129 OR k%=141 OR k%=143 OR k%=144 OR k%=157 OR k%=160 THEN k%=46
            b$ = b$ + CHR$(k%)
        END_IF
    NEXT i%
    ITEM_ADD 90, ad$ + b$
NEXT j%
TIMER_ON 200
RETURN
' ==============================================================================
ChAsc:
CAPTION 104,"": CAPTION 105,"OK": ON_CLICK 105, Recher
SHOW 100: SHOW 103
tyr% = 0: CAPTION 101,"Rechercher en Ascii:"
RETURN
' ==============================================================================
ChHex:
CAPTION 104,"": CAPTION 105,"OK": ON_CLICK 105, Recher
SHOW 100: HIDE 103
tyr% = 1: CAPTION 101,"Rechercher en Hexa:"
RETURN
' ==============================================================================
Recher:
a$ = TEXT$(102): IF a$ = "" THEN HIDE 100: RETURN
IF buf$ = "" THEN ReadFile(f$): ' fichier entier -> buf$
IF tyr% = 0
    ' recherche Ascii
    sq$ = a$: IF CHECKED(103) = 0 THEN sq$ = UPPER$(sq$)
ELSE
    ' recherche Hexa
    FOR i% = LEN(a$) TO 1 STEP -1: ' suppression des espaces éventuels
        IF MID$(a$, i%, 1) = " " THEN a$=LEFT$(a$,i%-1)+MID$(a$,i%+1,500)
    NEXT i%
    sq$ = ""
    FOR i% = 1 TO LEN(a$) STEP 2
        sq$ = sq$ + CHR$(HEX(MID$(a$, i%, 2)))
    NEXT i%
END_IF
xr% = 1: ' recherche à partir du début
Recsui:
' recherche à partir de xr%
TIMER_OFF 200
IF tyr% = 0 AND CHECKED(103) = 0
    IF xr% > 1
        bfr$ = MID$(buf$, xr%, LEN(buf$))
        k% = INSTR(UPPER$(bfr$), sq$)
    ELSE
        k% = INSTR(UPPER$(buf$), sq$)
    END_IF
ELSE
    IF xr% > 1
        bfr$ = MID$(buf$, xr%, LEN(buf$))
        k% = INSTR(bfr$, sq$)
    ELSE
        k% = INSTR(buf$, sq$)
    END_IF
END_IF
IF k% > 0
    k% = k% -1: ' index par rapport à zéro
    IF xr% > 1 THEN k% = k% + xr%-1
    CAPTION 104," Trouvé en " + HEX$(k%) + " "
    CAPTION 105, "Suivant": ON_CLICK 105,Recsui
    xr% = k%+2: ' pour recherche suivante éventuelle
    adb% = ol%*INT(k%/ol%): GOSUB Dump
ELSE
    CAPTION 104, " Non trouvé ! "
END_IF
TIMER_ON 200
RETURN
' ==============================================================================
Quitrec:
HIDE 100
IF adb% > 0 THEN adb% = 0: GOSUB Dump: ' réaffichage du début
RETURN
' ==============================================================================
Clicbut:
i% = NUMBER_CLICK
SELECT i%
    CASE 94: adb% = 0
    CASE 95: adb% = adb% - noc%
    CASE 96: adb% = adb% - ol%
    CASE 97: adb% = adb% + ol%
    CASE 98: adb% = adb% + noc%
    CASE 99: adb% = adf%
END_SELECT
GOSUB Dump
RETURN
' ==============================================================================
GoAds:
a$ = TEXT$(92): IF a$ = "" THEN RETURN
a$ = UPPER$(a$): k% = 0
FOR i% = LEN(a$) TO 1 STEP -1
    j% = ASC(MID$(a$, i%, 1))
    IF j% = 32
        a$ = LEFT$(a$,j%-1)+MID$(a$,j%+1,LEN(a$): ' élimine les espaces
    ELSE
        IF j%<43 OR j%>70 THEN k% = 1: EXIT_FOR
        IF j%<65 AND j%>57 THEN k% = 1: EXIT_FOR
        IF j%=44 OR j%=46 OR j%=47 THEN k%=1: EXIT_FOR
    END_IF
NEXT i%
IF k% = 1 THEN a$ = "Caractère incorrect !": GOSUB Mess: RETURN
k% = INSTR(a$,"+"): IF k% = 0 THEN k% = INSTR(a$,"-")
IF k% > 0
    j% = HEX(MID$(a$,k%+1,LEN(a$)-k%))
    i% = HEX(LEFT$(a$,k%-1))
    IF INSTR(a$,"+")>0
        adb% = i% + j%
    ELSE
        IF j% > i% THEN a$ = "Valeurs incorrectes !": GOSUB Mess: RETURN
        adb% = i% - j%
    END_IF
ELSE
    adb% = HEX(a$)
END_IF
GOSUB Dump
RETURN
' ==============================================================================
Imprime:
' Impression de la page affichée
IF COUNT(90) = 0 THEN RETURN
FILE_OPEN_WRITE 1, ftmp$
FILE_WRITELN 1, f$
FOR i% = 1 TO COUNT(90)
    FILE_WRITELN 1, ITEM_READ$(90, i%)
NEXT i%
FILE_CLOSE 1
EXECUTE_WAIT "Notepad.exe /P " + ftmp$
FILE_DELETE ftmp$
RETURN
' ==============================================================================
Calcul:
TIMER_OFF 200
Calcul_Hexa(500,100,100, 1)
TIMER_ON 200
RETURN
' ==============================================================================
Survh:
IF HEIGHT(0) = h0% THEN RETURN
h0% = HEIGHT(0)
HEIGHT 90,h0%-84
nla% = INT((HEIGHT(90)-2)/13)
noc% = nla%*ol%
IF f$ <> "" THEN adf% = sz%-noc%+ol%: GOSUB Dump
RETURN
' ==============================================================================
Mess:
TIMER_OFF 200
MESSAGE a$
TIMER_ON 200
RETURN
' ==============================================================================
Aide:
a$ = " - DUMP FICHIER -"+CHR$(10)+CHR$(10)
a$=a$+"Menus :"+CHR$(10)
a$=a$+"- Fichier : choix du fichier à dumper."+CHR$(10)
a$=a$+"  La fonction d'impression est succincte: impression de la page"+CHR$(10)
a$=a$+"  affichée à l'écran."+CHR$(10)
a$=a$+"- Edit : recherche mode Ascii ou hexadécimal. En mode hexadécimal,"+CHR$(10)
a$=a$+"  les octets peuvent être séparés ou non par un espace."+CHR$(10)
a$=a$+"- Calculette: les quatre opérations en mode hexadécimal."+CHR$(10)+CHR$(10)
a$=a$+"Boutons flèches :"+CHR$(10)
a$=a$+" - flèche vers le haut à gauche :"+CHR$(9)+"début de fichier."+CHR$(10)
a$=a$+" - double flèche vers le haut :"+CHR$(9)+"page précédente."+CHR$(10)
a$=a$+" - une flèche vers le haut :"+CHR$(9)+CHR$(9)+"recul d'une ligne."+CHR$(10)
a$=a$+" - une flèche vers le bas :"+CHR$(9)+CHR$(9)+"avance d'une ligne."+CHR$(10)
a$=a$+" - double flèche vers le bas :"+CHR$(9)+"page suivante."+CHR$(10)
a$=a$+" - flèche vers le bas à droite :"+CHR$(9)+"fin de fichier."+CHR$(10)+CHR$(10)
a$=a$+"Accès à une adresse donnée : remplir le champ 'Adresse' en"+CHR$(10)
a$=a$+"hexadécimal, puis bouton 'Go'."+CHR$(10)
a$=a$+"L'adresse peut être donnée sous la forme d'une addition ou d'une"+CHR$(10)
a$=a$+"soustraction, par exemple: 1BF0+7E0"
GOSUB Mess
RETURN
' ==============================================================================
SUB ReadFile(f$)
' Lecture d'un fichier entier dans une chaîne buf$ (appel de KGF.dll)
IF VARIABLE("buf$") = 0 THEN DIM buf$
DIM_LOCAL rs%
IF LABEL("Nor_dll") = 0 THEN LABEL Nor_dll
ON_ERROR_GOTO Nor_dll: ' si pas de dll chargée, dll_off -> erreur
DLL_OFF: ' à tout hasard
Nor_dll:
OFF_ERROR_GOTO
DLL_ON "C:\PANORAMIC\KLAUS\DLLs\KGF.dll"
FILEBIN_OPEN_READ 9, f$: buf$ = STRING$(FILEBIN_SIZE(9)," "): FILEBIN_CLOSE 9
rs% = DLL_CALL2("ReadBinaryFileToString",ADR(f$),ADR(buf$))
END_SUB
' ==============================================================================
SUB Calcul_Hexa(P,x,y,mode)
' calculette hexadécimal ou décimal
' Paramètres: P = 1er de 26 objets consécutifs de P à P+25, x,y = emplacement
' mode = 0 décimal, mode = 1 hexadécimal (permutable en cours d'utilisation)
DIM_LOCAL n, xc, yc, yd, xd, ax$, wa%, lb: lb = 30
IF VARIABLE("Calcul_id")=0
    ' Variables/labels globales: on n'a pas le choix, il faut gérer des événements.
    LABEL Calcul_click, Calcul_val: ' sous-programmes inclus
    DIM Calcul_id: Calcul_id = P
    DIM Calcul_valp, Calcul_ope
    DIM Cal_i%, Cal_hx%, Cal_x, Cal_y, Cal_vl, Cal_vi, Cal_va$, lab$(5,3)
    DATA "Calculatrice_data"
    DATA "D","E","F","hd","A","B","C"," /","7","8","9","x"
    DATA "4","5","6","-","1","2","3","+","C","0",CHR$(7),"="
    ' on pointe sur les bons datas
    RESTORE: READ lab$(0,0)
    WHILE lab$(0,0)<>"Calculatrice_data": READ lab$(0,0): END_WHILE
    FORM P: TOP P,y: LEFT P,x: WIDTH P,160: HEIGHT P,290: BORDER_SMALL P
    COLOR P,255,164,128: ' HIDE P
    n = P + 1
    LIST n: PARENT n,P: TOP n,0: WIDTH n,WIDTH(P)-16: HEIGHT n,25
    COLOR n,200,200,200: FONT_NAME n,"Lucida Console": FONT_SIZE n,14
    n = n + 1: yd = 30: xd = 5
    FOR yc = 0 TO 5
        FOR xc = 0 TO 3
            PICTURE n: PARENT n,P: TOP n,yd+(lb+5)*yc: LEFT n,xd+(lb+5)*xc
            WIDTH n,lb: HEIGHT n,lb
            READ lab$(yc,xc)
            2D_TARGET_IS n: COLOR n,128,128,128: 2D_FILL_COLOR 128,128,128
            2D_PEN_COLOR 164,164,164
            IF xc = 0 AND yc = 5
                COLOR n,164,0,0: 2D_FILL_COLOR 164,0,0: ' touche 'C'
                2D_PEN_COLOR 200,0,0
            ELSE
                IF xc = 3 AND yc = 0
                    COLOR n,0,128,0: 2D_FILL_COLOR 0,128,0: ' touche 'hd'
                    2D_PEN_COLOR 0,164,0
                ELSE
                    IF xc = 3 OR (xc=2 AND yc=5): ' touches opérations
                        COLOR n,80,80,80: 2D_FILL_COLOR 80,80,80
                        2D_PEN_COLOR 120,120,120
                    END_IF
                END_IF
            END_IF
            PRINT_TARGET_IS n
            FONT_COLOR n,255,255,255: FONT_SIZE n,18: FONT_BOLD n
            ax$ = lab$(yc,xc): wa% = TEXT_WIDTH(ax$,n)
            PRINT_LOCATE (lb-wa%)/2,0: PRINT lab$(yc,xc)
            2D_PEN_WIDTH 3: 2D_LINE 1,lb-2,1,1: 2D_POLY_TO lb-2,1
            2D_PEN_COLOR 0,0,0: 2D_LINE lb-2,1,lb-2,lb-2: 2D_POLY_TO 2,lb-2
            ON_CLICK n, Calcul_click
            n = n + 1
        NEXT xc
    NEXT yc
    HEIGHT P,272: CAPTION P, "  -  CALCULETTE  -"
    ITEM_ADD P+1, STRING$(11," ")+"0"
    PRINT_TARGET_IS 0: 2D_TARGET_IS 0
END_IF
Cal_hx% = mode: ' =0 décimal, =1 hexadécimal
IF mode = 0
    HIDE P+2: HIDE P+3: HIDE P+4: HIDE P+6: HIDE P+7: HIDE P+8: ' touches A à F
ELSE
    HIDE Calcul_id+24: ' Touche '.'
END_IF
SHOW Calcul_id: TO_FOREGROUND Calcul_id
EXIT_SUB
Calcul_click:
' Sous-programme événement: appui sur une touche de la calculette
Cal_i% = NUMBER_CLICK-(Calcul_id+2)
Cal_y = INT(Cal_i%/4): Cal_x = Cal_i%-Cal_y*4
Cal_va$ = TRIM$(ITEM_READ$(Calcul_id+1,1))
IF Cal_hx% = 0
    Cal_vi = VAL(Cal_va$)
ELSE
    Cal_vi = HEX(Cal_va$)
END_IF
IF Cal_x < 3
    ' touche valeur numérique 0 à 9 (décimal) ou 0 à F (hexa)
    IF Cal_y < 5 OR Cal_x = 1
        IF Cal_hx% = 0
            Cal_vl = VAL(lab$(Cal_y,Cal_x))
        ELSE
            Cal_vl = HEX(lab$(Cal_y,Cal_x))
        END_IF
        IF Cal_vi = 0
            Cal_va$ = lab$(Cal_y,Cal_x)
        ELSE
            IF Cal_hx% = 0
                Cal_i% = INSTR(Cal_va$,".")
                IF Cal_i% > 0
                    Cal_i% = 1+LEN(Cal_va$)-Cal_i%
                    Cal_x = Cal_vi + Cal_vl/POWER(10,Cal_i%)
                ELSE
                    Cal_x = Cal_vi*10+Cal_vl
                END_IF
            ELSE
                Cal_x = Cal_vi*16+Cal_vl
            END_IF
            IF Cal_x > 2147483647 THEN MESSAGE "Dépassement !": RETURN
            IF Cal_hx% = 0
                Cal_va$ = STR$(Cal_x)
            ELSE
                Cal_va$ = HEX$(Cal_x)
            END_IF
        END_IF
        GOSUB Calcul_val
    ELSE
        IF Cal_x = 0: ' touche 'C' clear
            CLEAR Calcul_id+1
            ITEM_ADD Calcul_id+1, STRING$(11," ")+"0"
        ELSE
            ' touche point décimal (= virgule, calcul décimal)
            Cal_va$ = Cal_va$ + ".": GOSUB Calcul_val
        END_IF
    END_IF
ELSE
    ' Dernière colonne
    ' touche 0: bascule modes hex/dec
    ' touche 1: division 2: multiplication 3: soustraction 4: addition
    ' touche 5: égal, exécuter l'opération
    IF Cal_y = 0: ' Touche 'hd' bascule entre les modes Hexa et Décimal
        IF Cal_hx% = 0
            SHOW Calcul_id+2: SHOW Calcul_id+3: SHOW Calcul_id+4
            SHOW Calcul_id+6: SHOW Calcul_id+7: SHOW Calcul_id+8
            HIDE Calcul_id+24: Cal_hx% = 1
            CLEAR Calcul_id+1: Cal_va$ = HEX$(INT(Cal_vi))
            CAPTION Calcul_id, " MODE HEXADÉCIMAL"
        ELSE
            HIDE Calcul_id+2: HIDE Calcul_id+3: HIDE Calcul_id+4
            HIDE Calcul_id+6: HIDE Calcul_id+7: HIDE Calcul_id+8
            SHOW Calcul_id+24: Cal_hx% = 0: ' mode décimal
            CLEAR Calcul_id+1: Cal_va$ = STR$(Cal_vi)
            CAPTION Calcul_id,"- MODE DÉCIMAL -"
        END_IF
        GOSUB Calcul_val
    ELSE
        IF Cal_y = 5: ' Touche '=': effectuer l'opération demandée
            IF Calcul_ope > 0
                SELECT Calcul_ope
                    CASE 1: Cal_vl = Calcul_valp/Cal_vi
                            IF Cal_hx% = 1 THEN Cal_vl = INT(Cal_vl)
                    CASE 2: Cal_vl = Calcul_valp*Cal_vi
                    CASE 3: Cal_vl = Calcul_valp-Cal_vi
                    CASE 4: Cal_vl = Calcul_valp+Cal_vi
                END_SELECT
                IF Cal_vl > 2147483647 THEN MESSAGE "Dépassement !": RETURN
                IF Cal_hx% = 0
                    Cal_va$ = STR$(Cal_vl)
                ELSE
                    Cal_va$ = HEX$(Cal_vl)
                END_IF
                GOSUB Calcul_val
                Calcul_ope = 0
            END_IF
        ELSE
            Calcul_ope = Cal_y
            Calcul_valp = Cal_vi
            Cal_va$ = "0": GOSUB Calcul_val
        END_IF
    END_IF
END_IF
RETURN
Calcul_val:
CLEAR Calcul_id+1: ' s/p affichage du résultat dans l'écran
ITEM_ADD Calcul_id+1, RIGHT$(STRING$(11," ")+Cal_va$, 12)
RETURN
END_SUB
' ==============================================================================