File "E3.bas"

Path: /E3 - Easy Exe Edit/E3.bas
File size: 16.37 KB
MIME-type:
Charset: 8 bit

#COMPILE EXE
#DIM ALL
#RESOURCE MANIFEST, 1, "XPTheme.xml"
#RESOURCE ICON,     AI, "icon.ico"

'------------------------------------------------------------------------------
'   ** Includes **
'------------------------------------------------------------------------------
#INCLUDE ONCE "WINDOWS.INC"
#INCLUDE ONCE "MYMSGBOX.INC"
'------------------------------------------------------------------------------

'------------------------------------------------------------------------------
'   ** Globals and Constants **
'------------------------------------------------------------------------------
GLOBAL hDlg  AS DWORD
'------------------------------------------------------------------------------
%IDC_LBL_FINDWHAT     = 1001
%IDC_TBX_FINDWHAT     = 1002
%IDC_LBL_REPLACEWITH  = 1003
%IDC_TBX_REPLACEWITH  = 1004
%IDC_CHK_CREATEBKP    = 1005
%IDC_FRAME_ENCODING   = 1006
%IDC_OPT_HEX          = 1007
%IDC_OPT_ASC          = 1008
%IDC_BTN_OK           = 1009
%IDC_LBL_FILE         = 1010
%IDC_BTN_CHOOSEFILE   = 1011
%IDC_LBL_ABOUT        = 1012
'------------------------------------------------------------------------------

'------------------------------------------------------------------------------
'   ** Main Application Entry Point **
'------------------------------------------------------------------------------
FUNCTION PBMAIN()
    ShowMainDlg %HWND_DESKTOP
END FUNCTION
'------------------------------------------------------------------------------

'-----------------------------------------------------------------------------------------------------
FUNCTION Exist(BYVAL fileOrFolder AS STRING) AS LONG
    LOCAL Dummy&
    Dummy& = GETATTR(fileOrFolder)
    FUNCTION = (ERRCLEAR = 0)
END FUNCTION
'-----------------------------------------------------------------------------------------------------

'------------------------------------------------------------------------------
FUNCTION HexVal(t AS STRING) AS STRING
    LOCAL e, r AS STRING
    LOCAL i AS LONG
    e = REMOVE$(t, $SPC)
    FOR i = 1 TO LEN(e)-1 STEP 2
        r += CHR$(VAL("&H0" + MID$(e, i, 2)))
    NEXT
    FUNCTION = r
END FUNCTION
'------------------------------------------------------------------------------

'------------------------------------------------------------------------------
SUB ReplaceOccurence (BYVAL t1 AS STRING, BYVAL occ AS LONG, BYVAL t2 AS STRING, BYREF buff AS STRING)
' Replace occurence #occ of 't1' with 't2' in 'buff'
    IF TALLY(buff, t1) < occ THEN EXIT SUB
    LOCAL i, n AS LONG
    DO WHILE n <> occ
        i = INSTR(i+1, buff, t1)
        INCR n
    LOOP
    buff = LEFT$(buff, i-1) + t2 + MID$(buff, i + LEN(t1))
END SUB
'------------------------------------------------------------------------------

'-----------------------------------------------------------------------------------------------------
FUNCTION GetDroppedFileName(hDrop AS DWORD) AS STRING
  LOCAL fString AS ASCIIZ*%MAX_PATH
  LOCAL cnt AS LONG
  fString=SPACE$(%MAX_PATH)
  cnt = DragQueryFile(hDrop, 0, fString, LEN(fString) - 1)
  FUNCTION = LEFT$(fString, cnt)
END FUNCTION
'-----------------------------------------------------------------------------------------------------

'-----------------------------------------------------------------------------------------------------
MACRO MacroNewFileOpened
    CONTROL SET TEXT  CB.HNDL, %IDC_LBL_FILE, e
    CONTROL ENABLE    CB.HNDL, %IDC_TBX_FINDWHAT
    CONTROL SET TEXT  CB.HNDL, %IDC_TBX_FINDWHAT, ""
    CONTROL ENABLE    CB.HNDL, %IDC_TBX_REPLACEWITH
    CONTROL SET TEXT  CB.HNDL, %IDC_TBX_REPLACEWITH, ""
    CONTROL DISABLE   CB.HNDL, %IDC_BTN_OK
    CONTROL SET FOCUS CB.HNDL, %IDC_TBX_FINDWHAT
END MACRO
'-----------------------------------------------------------------------------------------------------

'-----------------------------------------------------------------------------------------------------
MACRO MacroResetFields
    CONTROL SET TEXT  CB.HNDL, %IDC_TBX_FINDWHAT, ""
    CONTROL SET TEXT  CB.HNDL, %IDC_TBX_REPLACEWITH, ""
    CONTROL DISABLE   CB.HNDL, %IDC_BTN_OK
    CONTROL SET FOCUS CB.HNDL, %IDC_TBX_FINDWHAT
END MACRO
'-----------------------------------------------------------------------------------------------------

'-----------------------------------------------------------------------------------------------------
SUB DecideIfEnableOkBtn
    LOCAL i, r AS LONG
    LOCAL e, t AS STRING
    CONTROL GET TEXT  hDlg, %IDC_TBX_FINDWHAT TO e
    CONTROL GET TEXT  hDlg, %IDC_TBX_REPLACEWITH TO t
    CONTROL GET CHECK hDlg, %IDC_OPT_HEX TO i
    IF LEN(e) = LEN(t) AND LEN(e) <> 0 THEN r = 1
    IF r = 1 AND i = 1 AND LEN(REMOVE$(e, $SPC)) MOD 2 = 1 THEN r = 0
    IF r = 1 THEN CONTROL ENABLE hDlg, %IDC_BTN_OK ELSE CONTROL DISABLE hDlg, %IDC_BTN_OK
END SUB
'-----------------------------------------------------------------------------------------------------

'-----------------------------------------------------------------------------------------------------
SUB SetFilter(BYVAL ID AS LONG, BYVAL filterProc AS DWORD)
    LOCAL wnd AS DWORD
    LOCAL old AS DWORD
    wnd = GetDlgItem(hDlg, ID)
    CONTROL GET USER hDlg, ID, 1 TO old
    IF filterProc = 0 THEN ' Remove subclassing
        IF old <> 0 THEN
            SetWindowLong wnd, %GWL_WNDPROC, old
            CONTROL SET USER hDlg, ID, 1, 0
        END IF
    ELSE                   ' Create subclassing
        IF old = 0 THEN
            old = SetWindowLong(wnd, %GWL_WNDPROC, filterProc)
            CONTROL SET USER hDlg, ID, 1, old
        END IF
    END IF
END SUB
'-----------------------------------------------------------------------------------------------------

'-----------------------------------------------------------------------------------------------------
FUNCTION FilterHexadecimal (BYVAL wnd AS DWORD, BYVAL wMsg AS DWORD, _
              BYVAL wParam AS DWORD, BYVAL lParam AS DWORD) AS LONG
    LOCAL old AS DWORD
    CONTROL GET USER hDlg, GetDlgCtrlId(wnd), 1 TO old
    IF wMsg = %WM_CHAR THEN
        SELECT CASE AS LONG wParam
            CASE ASC("0") TO ASC("9"), ASC("A") TO ASC("F"), ASC("a") TO ASC("f"), 8 : wParam = ASC(UCASE$(CHR$(wParam))) ' 8 = ASC('backspace')
            CASE ELSE : BEEP : EXIT FUNCTION
        END SELECT
    ELSEIF wMsg = %WM_PASTE THEN
        BEEP : EXIT FUNCTION
    END IF
    FUNCTION = CallWindowProc (old, wnd, wMsg, wParam, lParam)
END FUNCTION
'-----------------------------------------------------------------------------------------------------

'-----------------------------------------------------------------------------------------------------
SUB SubFormatHexa (ctl AS LONG)
    LOCAL i, n, p AS LONG
    LOCAL e AS STRING
    CONTROL GET TEXT hDlg, ctl TO e : n = LEN(e)
    IF n = 0 THEN EXIT SUB
    CONTROL SEND hDlg, ctl, %EM_GETSEL, VARPTR(p), VARPTR(i) ' grab carret position, put it in 'p'
    e = REMOVE$(e, $SPC)
    FOR i = 2*(LEN(e)\2) TO 2 STEP -2
        e = LEFT$(e, i) + $SPC + MID$(e, i+1)
    NEXT
    e = RTRIM$(e)
    p = p + LEN(e) - n
    CONTROL SET TEXT hDlg, ctl, e
    CONTROL SEND hDlg, ctl, %EM_SETSEL, p, p ' set updated carret position
END SUB
'-----------------------------------------------------------------------------------------------------

'-----------------------------------------------------------------------------------------------------
FUNCTION BkpFile(file AS STRING) AS STRING
    LOCAL i AS LONG
    i = INSTR(-1, file, ".")
    IF i = 0 THEN ' no extension
        FUNCTION = file + ".e3bkp"
    ELSE
        FUNCTION = LEFT$(file, i-1) + ".e3bkp" + MID$(file, i)
    END IF
END FUNCTION
'-----------------------------------------------------------------------------------------------------

'------------------------------------------------------------------------------
'   ** CallBacks **
'------------------------------------------------------------------------------
CALLBACK FUNCTION ProcMainDlg()
    LOCAL e, t1, t2, filename, filebuff AS STRING
    LOCAL i, bkp, noc AS LONG

    SELECT CASE AS LONG CB.MSG

        CASE %WM_INITDIALOG
            IF COMMAND$ <> "" THEN
                e = TRIM$(COMMAND$, $DQ)
                MacroNewFileOpened
            END IF
            SetFilter %IDC_TBX_FINDWHAT, CODEPTR(FilterHexadecimal)
            SetFilter %IDC_TBX_REPLACEWITH, CODEPTR(FilterHexadecimal)

        CASE %WM_SETCURSOR ' Standard hovering-over-controls message
            IF GetDlgCtrlId(CB.WPARAM) = %IDC_LBL_ABOUT THEN ' Change cursor to link-hand when hovering over link
                SetCursor LoadCursor(%NULL, BYVAL %IDC_HAND)
                SetWindowLong CB.HNDL, %dwl_msgresult, 1
                FUNCTION = 1
            END IF

        CASE %WM_DROPFILES
            e = GetDroppedFileName(CB.WPARAM)
            MacroNewFileOpened

        CASE %WM_COMMAND
            SELECT CASE AS LONG CB.CTL

                CASE %IDC_BTN_CHOOSEFILE
                    IF CB.CTLMSG = %BN_CLICKED OR CB.CTLMSG = 1 THEN
                        DISPLAY OPENFILE CB.HNDL, -100, -100, "Select file", _
                          "", CHR$("All files", 0, "*.*", 0), "", "", %OFN_FILEMUSTEXIST TO e
                        IF e = "" THEN EXIT FUNCTION
                        MacroNewFileOpened
                    END IF

                CASE %IDC_TBX_FINDWHAT, %IDC_TBX_REPLACEWITH
                    IF CB.CTLMSG = %EN_CHANGE THEN
                        CONTROL GET CHECK hDlg, %IDC_OPT_HEX TO i
                        IF i = 1 THEN SubFormatHexa CB.CTL
                        DecideIfEnableOkBtn
                    END IF

                CASE %IDC_OPT_HEX ' Switching to Hexadecimal strings
                    IF CB.CTLMSG = %BN_CLICKED THEN
                        MacroResetFields
                        SetFilter %IDC_TBX_FINDWHAT, CODEPTR(FilterHexadecimal)
                        SetFilter %IDC_TBX_REPLACEWITH, CODEPTR(FilterHexadecimal)
                    END IF

                CASE %IDC_OPT_ASC ' Switching to ASCII strings
                    IF CB.CTLMSG = %BN_CLICKED THEN
                        MacroResetFields
                        SetFilter %IDC_TBX_FINDWHAT, 0
                        SetFilter %IDC_TBX_REPLACEWITH, 0
                    END IF

                CASE %IDC_LBL_ABOUT
                    IF CB.CTLMSG = %STN_CLICKED THEN ShellExecute 0, "open", _
                        "http://mougino.free.fr/freeware/#e3" + $NUL, BYVAL 0, BYVAL 0, %SW_SHOWNORMAL

                CASE %IDC_BTN_OK
                    IF CB.CTLMSG = %BN_CLICKED OR CB.CTLMSG = 1 THEN
                        CONTROL GET TEXT  CB.HNDL, %IDC_LBL_FILE TO filename
                        CONTROL GET CHECK CB.HNDL, %IDC_CHK_CREATEBKP TO bkp ' make a backup ?
                        CONTROL GET TEXT  CB.HNDL, %IDC_TBX_FINDWHAT TO t1
                        CONTROL GET TEXT  CB.HNDL, %IDC_TBX_REPLACEWITH TO t2
                        CONTROL GET CHECK CB.HNDL, %IDC_OPT_HEX TO i
                        IF i = 1 THEN ' Hexadecimal
                            t1 = HexVal(t1)
                            t2 = HexVal(t2)
                        END IF
                        i = FREEFILE ' Get content of file
                        OPEN filename FOR BINARY AS #i
                            GET$ #i, LOF(#i), filebuff
                        CLOSE #i
                        noc = TALLY(filebuff, t1) ' number of occurences
                        IF noc = 0 THEN
                            MyMsgBox CB.HNDL, "String not found in the file!", "[E3] Easy Exe Edit", %MB_ICONERROR
                        ELSE
                            i = MyMsgBox (CB.HNDL, "Found " + TRIM$(noc) + " occurence" + IIF$(noc>1,"s","") _
                              + " of the string in the file. Replace " + IIF$(noc>1,"them","it") + "?" _
                              , "[E3] Easy Exe Edit", IIF(bkp=1,%MB_ICONQUESTION,%MB_ICONWARNING) OR %MB_YESNO)
                            IF i = 1 THEN ' "Yes"
                                IF bkp = 1 THEN ' Backup the file (if not already existing i.e. handle only 1 backup)
                                    IF NOT Exist(BkpFile(filename)) THEN FILECOPY filename, BkpFile(filename)
                                END IF
                                REPLACE t1 WITH t2 IN filebuff
                                KILL filename ' Remove the initial file
                                i = FREEFILE ' Update content of file
                                OPEN filename FOR BINARY AS #i
                                    PUT$ #i, filebuff
                                CLOSE #i
                                MyMsgBox CB.HNDL, "Done!", "[E3] Easy Exe Edit", %MB_ICONINFORMATION
                                MacroResetFields
                            ELSEIF i = 2 AND noc > 1 AND noc < 10 THEN ' "No" and there are 2 or more occurences (limited to 9 occurences max)
                                e = "1;"
                                FOR i = 2 TO noc : e+= TRIM$(i) + ";" : NEXT : e += "None"
                                i = MyMsgBox (CB.HNDL, "Replace what occurence?", "[E3] Easy Exe Edit", %MB_ICONQUESTION, e)
                                IF i >= 1 AND i <= noc THEN
                                    IF bkp = 1 THEN ' Backup the file (if not already existing i.e. handle only 1 backup)
                                        IF NOT Exist(BkpFile(filename)) THEN FILECOPY filename, BkpFile(filename)
                                    END IF
                                    ReplaceOccurence t1, i, t2, filebuff ' Replace occurence #i of 't1' with 't2' in 'filebuff'
                                    KILL filename ' Remove the initial file
                                    i = FREEFILE ' Update content of file
                                    OPEN filename FOR BINARY AS #i
                                        PUT$ #i, filebuff
                                    CLOSE #i
                                    MyMsgBox CB.HNDL, "Done!", "[E3] Easy Exe Edit", %MB_ICONINFORMATION
                                    MacroResetFields
                                END IF
                            END IF
                        END IF
                    END IF

            END SELECT
    END SELECT
END FUNCTION
'------------------------------------------------------------------------------

'------------------------------------------------------------------------------
'   ** Dialogs **
'------------------------------------------------------------------------------
FUNCTION ShowMainDlg(BYVAL hParent AS DWORD) AS LONG
    LOCAL lRslt AS LONG

    DIALOG NEW PIXELS, hParent, "[E3] Easy Exe Edit", , , 319, 103, _
      %DS_MODALFRAME OR %WS_CAPTION OR %WS_POPUP OR %WS_SYSMENU _
      OR %WS_MINIMIZEBOX, %WS_EX_ACCEPTFILES TO hDlg

    CONTROL ADD BUTTON,   hDlg, %IDC_BTN_CHOOSEFILE, "", 8, 6, 24, 16
    CONTROL ADD LABEL,    hDlg, %IDC_LBL_FILE, "<no file open>", 40, 7, 252, 17, %SS_PATHELLIPSIS
    CONTROL SET COLOR     hDlg, %IDC_LBL_FILE, %GRAY, -1
    CONTROL ADD LABEL,    hDlg, %IDC_LBL_ABOUT, "[?]", 300, 3, 18, 17, %SS_NOTIFY
    CONTROL SET COLOR     hDlg, %IDC_LBL_ABOUT, %BLUE, -1
    CONTROL ADD LABEL,    hDlg, %IDC_LBL_FINDWHAT, "Find string :", 8, 30, 67, 16
    CONTROL ADD TEXTBOX,  hDlg, %IDC_TBX_FINDWHAT, "", 75, 29, 157, 18
    CONTROL DISABLE       hDlg, %IDC_TBX_FINDWHAT ' disable by default
    CONTROL ADD LABEL,    hDlg, %IDC_LBL_REPLACEWITH, "Replace with", 8, 54, 67, 17
    CONTROL ADD TEXTBOX,  hDlg, %IDC_TBX_REPLACEWITH, "", 75, 53, 157, 18
    CONTROL DISABLE       hDlg, %IDC_TBX_REPLACEWITH ' disable by default

    CONTROL ADD FRAME,    hDlg, %IDC_FRAME_ENCODING, "Encoding", 243, 28, 68, 68
    CONTROL ADD OPTION,   hDlg, %IDC_OPT_HEX, "Hexa", 251, 50, 52, 16
    CONTROL ADD OPTION,   hDlg, %IDC_OPT_ASC, "Ascii", 251, 71, 52, 16
    CONTROL SET OPTION    hDlg, %IDC_OPT_HEX, %IDC_OPT_HEX, %IDC_OPT_ASC ' hexa by default

    CONTROL ADD CHECKBOX, hDlg, %IDC_CHK_CREATEBKP, "Create a backup", 8, 79, 112, 16
    CONTROL SET CHECK     hDlg, %IDC_CHK_CREATEBKP, 1 ' create backup by default

    CONTROL ADD BUTTON,   hDlg, %IDC_BTN_OK, "Replace", 128, 78, 104, 20
    CONTROL DISABLE       hDlg, %IDC_BTN_OK ' disable by default

    DIALOG SET ICON   hDlg, "AI"
    DIALOG SHOW MODAL hDlg, CALL ProcMainDlg TO lRslt

    FUNCTION = lRslt
END FUNCTION
'------------------------------------------------------------------------------