File "Translater.bas"

Path: /Translater/Translater.bas
File size: 22.95 KB
MIME-type:
Charset: utf-8


'-------------------------------------------------------------------------------------------------
#COMPILE EXE "Translater.exe"
$VER = "0.1"
'-------------------------------------------------------------------------------------------------
#INCLUDE ONCE "Win32Api.inc"
#INCLUDE ONCE "inc\SendInput.inc"
#INCLUDE ONCE "inc\Toast.inc"
'-------------------------------------------------------------------------------------------------
#RESOURCE "Translater.pbr"
'-------------------------------------------------------------------------------------------------

'-------------------------------------------------------------------------------------------------
$HotKey = "Ctrl-Alt-t"
$WHITESPACE = $NUL+$CR+$LF+$SPC+$TAB+":*"
%MOD_CONTROL  = 1
%MOD_ALT      = 2
%WM_TRAYICON  = %WM_USER + 501
%IDM_Settings = %WM_USER + 502
%IDM_Startup  = %WM_USER + 503
%IDM_Exit     = %WM_USER + 504
%IDM_Toast    = %WM_USER + 505
%IDM_Paste    = %WM_USER + 506
%IDM_Popup    = %WM_USER + 507
%IDC_LABEL1   = 1001
%IDC_LABEL2   = 1002
%IDC_LABEL3   = 1003
%IDC_CHECKBOX = 1004
%IDC_IMAGE    = 1005
'-------------------------------------------------------------------------------------------------
GLOBAL hMenu, hOut AS DWORD
GLOBAL trs_lang AS STRING
GLOBAL trs_mode AS LONG
GLOBAL trs_timo AS LONG
'-------------------------------------------------------------------------------------------------
MACRO INIFILE = EXE.PATH$ + EXE.NAME$ + ".ini"
'-------------------------------------------------------------------------------------------------

'-------------------------------------------------------------------------------------------------
FUNCTION PBMAIN

    ' Allow only one instance
    LOCAL smutex AS STRING
    LOCAL x AS LONG
    smutex = EXE.NAME$                                      ' Mutex string
    x = CreateMutex(BYVAL %NULL, 0, BYVAL STRPTR(smutex))   ' check if running
    IF x <> %NULL THEN                                      ' Program probably already running ?
        IF GetLastError = %ERROR_ALREADY_EXISTS THEN        ' yes
            CloseHandle x                                   ' tidy up after, just to be polite
            EXIT FUNCTION
        END IF
    END IF

    ' Check needed tools
    LOCAL ff AS LONG
    LOCAL e AS STRING
    KILL EXE.PATH$ + "out."
    SHELL "cmd /c translate-cli --version > out.", %SW_HIDE
    ff = FREEFILE
    OPEN EXE.PATH$ + "out." FOR INPUT AS #ff
    LINE INPUT #ff, e
    CLOSE #ff
    KILL EXE.PATH$ + "out."
    IF INSTR(e, "translate, version") = 0 THEN
        ?   "This tool relies on Python 3." + $CR + $CR _
          + "First make sure to do the following:" + $CR + $CR _
          + "- install Python 3 from www.python.org" + $CR + $CR _
          + "IMPORTANT:" + $CR _
          + "- in the installer check 'Add Python to PATH'" + $CR + $CR _
          + "- open a 'cmd' console and type 'pip install translate'"  + $CR + $CR _
          + "Close this box to open the Python download page." _
            ,%MB_ICONERROR,EXE.NAME$
        ShellExecute 0, "open", "https://www.python.org/downloads/", "", "", %SW_SHOW
        EXIT FUNCTION
    END IF

    ' Create main dialog
    LOCAL hDlg AS DWORD
    DIALOG NEW 0, EXE.NAME$,,, 2, 2, %WS_SYSMENU _
        OR %WS_CAPTION OR %DS_MODALFRAME OR %WS_POPUP TO hDlg
    DIALOG SET ICON hDlg, "#5"
    DIALOG SHOW MODAL hDlg CALL ProcMain

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

'-------------------------------------------------------------------------------------------------
CALLBACK FUNCTION ProcMain
  STATIC nAtom   AS DWORD
  STATIC ti      AS NOTIFYICONDATA

  SELECT CASE CB.MSG

     CASE %WM_INITDIALOG
        nAtom = GlobalAddAtom (EXE.NAME$ + STR$(TIMER))
        RegisterHotKey CB.HNDL, nAtom, %MOD_CONTROL + %MOD_ALT, ASC("T") ' Register Ctrl-Alt-T (for Translate)
        SetTimer CB.HNDL, 1, 0, %NULL                                    ' Hide window
        ' Add tray icon
        ti.cbSize           = SIZEOF(ti)
        ti.hWnd             = CB.HNDL
        ti.uID              = GetModuleHandle(BYVAL 0&)
        ti.uFlags           = %NIF_ICON OR %NIF_MESSAGE OR %NIF_TIP
        ti.uCallbackMessage = %WM_TRAYICON
        ti.hIcon            = LoadIcon(GetModuleHandle(BYVAL 0&), "#5")
        ti.szTip            = EXE.NAME$ + " (" + $hotkey + ")"
        Shell_NotifyIcon %NIM_ADD, BYVAL VARPTR(ti)
        DestroyIcon ti.hIcon
        ' Read preferences
        LOCAL zAsc AS ASCIIZ * %MAX_PATH
        GetPrivateProfileString "Translator", "Target-language", "EN", zAsc, %MAX_PATH, INIFILE
        trs_lang = TRIM$(zAsc)
        GetPrivateProfileString "Translator", "Time-out", "4", zAsc, %MAX_PATH, INIFILE
        trs_timo = VAL(zAsc)
        GetPrivateProfileString "Output", "Mode", "0", zAsc, %MAX_PATH, INIFILE
        trs_mode = VAL(zAsc)
        ' Create popup menu
        MENU NEW POPUP TO hOut
        MENU ADD STRING,  hOut, "Toast",  %IDM_Toast, %MF_ENABLED
        MENU ADD STRING,  hOut, "Paste",  %IDM_Paste, %MF_ENABLED
        MENU ADD STRING,  hOut, "Popup",  %IDM_Popup, %MF_ENABLED
        MENU SET STATE    hOut,  BYCMD    %IDM_Paste, IIF(trs_mode=1, 8, 0)
        MENU SET STATE    hOut,  BYCMD    %IDM_Popup, IIF(trs_mode=2, 8, 0)
        MENU SET STATE    hOut,  BYCMD    %IDM_Toast, IIF(trs_mode<1 OR trs_mode>2, 8, 0)
        MENU NEW POPUP TO hMenu
        MENU ADD STRING,  hMenu, "Start with Windows",      %IDM_Startup,  %MF_ENABLED
        MENU ADD POPUP,   hMenu, "Output",                   hOut,         %MF_ENABLED
        MENU ADD STRING,  hMenu, "Edit advanced Settings",  %IDM_Settings, %MF_ENABLED
        MENU ADD STRING,  hMenu, "Exit Translater",         %IDM_Exit,     %MF_ENABLED
        MENU SET STATE    hMenu,  BYCMD                     %IDM_Startup,  ExistStartupShortcut()
        ' Get/Create settings (+show popup at first run)
        IF NOT EXIST(INIFILE) THEN
            DumpStandardIniFile()
            ShowFirstRunBox()
        END IF

     CASE %WM_DESTROY
        DestroyMenu hMenu
        UnregisterHotKey CB.HNDL, nAtom
        GlobalDeleteAtom nAtom
        Shell_NotifyIcon %NIM_DELETE, BYVAL VARPTR(ti)

     CASE %WM_TIMER
        KillTimer CB.HNDL, 1
        ShowWindow CB.HNDL, 0

     CASE %WM_HOTKEY
        WaitForNoKeys ' wait for user to release hot keys
        HandleHotKey()

     CASE %WM_TRAYICON                                                  ' User clicked on the systray icon
           LOCAL PA AS POINTAPI
           LOCAL mX, mY AS LONG
           mX = LOWRD(CB.LPARAM)
           IF mX = %WM_LBUTTONDOWN OR mX = %WM_RBUTTONDOWN THEN
               GetCursorPos PA
               mX = PA.X : mY = PA.Y
               SetForegroundWindow CB.HNDL ' needed to close popup menu when clicking outside
               TrackPopupMenu hMenu, %TPM_BOTTOMALIGN OR %TPM_RIGHTALIGN OR _
                              %TPM_LEFTBUTTON, mX, mY, 0, CB.HNDL, BYVAL %NULL
               PostMessage CB.HNDL, %WM_NULL, 0, 0
           END IF

    CASE %WM_COMMAND
      SELECT CASE AS LONG CB.CTL
        CASE %IDM_Toast
            SetTrsMode(0)
        CASE %IDM_Paste
            SetTrsMode(1)
        CASE %IDM_Popup
            SetTrsMode(2)
        CASE %IDM_Settings
            ShellExecute 0, "EDIT", INIFILE, "", "", %SW_SHOW
        CASE %IDM_Startup
            IF ISTRUE ExistStartupShortcut() THEN
                DeleteStartupShortcut
            ELSE
                MakeStartupShortcut
            END IF
            MENU SET STATE hMenu, BYCMD %IDM_Startup, ExistStartupShortcut()
        CASE %IDM_Exit
            DIALOG END CB.HNDL
      END SELECT

  END SELECT

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

'-------------------------------------------------------------------------------------------------
SUB HandleHotKey()
    LOCAL hWnd AS DWORD
    LOCAL dlgCap, sel, utf, enc, dec AS STRING
    LOCAL ff, lRes AS LONG
    LOCAL t0 AS DOUBLE

    ' Get selection (if any)
    CLIPBOARD RESET : SLEEP 100
    SendString "{CTRL_D}c{CTRL_U}" : SLEEP 100 ' copy
    CLIPBOARD GET UNICODE TO sel

    ' Get active window caption
    hWnd = GetForegroundWindow()
    DIALOG GET TEXT hWnd TO dlgCap
    IF ISTRUE INSTR(dlgCap, "- Excel") THEN SendString "{ESCAPE}" : SLEEP 100

    ' If no selection: alert and return
    IF LEN(sel) = 0 THEN
        IF trs_mode = 2 THEN        ' Popup
            ?"No Selection",%MB_ICONWARNING,EXE.NAME$
        ELSEIF trs_mode <> 1 THEN   ' Toast
            ShowAlertToast("No Selection")
        END IF
        EXIT SUB
    END IF

    ' Convert unicode selection to multi-byte
    utf = NUL$(LEN(sel)*2)
    WideCharToMultiByte %CP_UTF8, 0, BYVAL STRPTR(sel), LEN(sel)/2, _
                        BYVAL STRPTR(utf), LEN(utf), BYVAL 0, BYVAL 0

    ' URL-Encode the string
    enc = "%" + UCASE$(Hexa(utf))
    REPLACE $SPC WITH "%" IN enc
    enc = RTRIM$(enc, "%00")

    ' Read preferences
    LOCAL zAsc AS ASCIIZ * %MAX_PATH
    GetPrivateProfileString "Translator", "Target-language", "EN", zAsc, %MAX_PATH, INIFILE
    trs_lang = TRIM$(zAsc)
    GetPrivateProfileString "Translator", "Time-out", "4", zAsc, %MAX_PATH, INIFILE
    trs_timo = VAL(zAsc)
    GetPrivateProfileString "Output", "Mode", "0", zAsc, %MAX_PATH, INIFILE
    trs_mode = VAL(zAsc)

    ' Launch the Batch/Python translation scripts
    CreateScripts()
    KILL EXE.PATH$ + "out."
    ShellExecute 0, "open", "trans", $DQ + enc + $DQ, "", %SW_HIDE

    ' Get the result from the output file then clean-up
    t0 = TIMER
    DO
        ff = FREEFILE
        OPEN EXE.PATH$ + "out." FOR BINARY ACCESS READ LOCK SHARED AS #ff
        lRes = LOF(#ff)
        GET$ #ff, lRes, dec
        CLOSE #ff
    LOOP UNTIL lRes > 0 OR (TIMER - t0) > trs_timo
    KILL EXE.PATH$ + "out."
    IF lRes = 0 THEN ' Time-out!
        IF trs_mode = 2 THEN        ' Popup
            ?"Time Out!",%MB_ICONWARNING,EXE.NAME$
        ELSEIF trs_mode <> 1 THEN   ' Toast
            ShowAlertToast(" Time Out!")
        END IF
        EXIT SUB
    END IF
    dec = TRIM$(dec, ANY $CRLF)
    IF LEN(dec) > 0 THEN dec = UrlDecode(dec) ELSE EXIT SUB

    ' Show the translation
    IF trs_mode = 1 THEN        ' Paste
        CLIPBOARD RESET : SLEEP 100
        CLIPBOARD SET TEXT dec
        SendString "{CTRL_D}v{CTRL_U}"
    ELSEIF trs_mode = 2 THEN    ' Popup
        ?dec,%MB_ICONINFORMATION,EXE.NAME$
    ELSE'IF trs_mode = 0 THEN   ' Toast
        ShowTranslationToast(dec)
    END IF

END SUB
'-------------------------------------------------------------------------------------------------

'-------------------------------------------------------------------------------------------------
SUB ShowAlertToast(msg AS STRING)
    Toast_SetWidth            200
    Toast_SetHeight           40
    Toast_SetAlpha            150         ' 0 <= alpha <= 255
    Toast_SetTextColor        "E53227"    ' dark red
    Toast_SetBackgroundColor  "E8ABBC"    ' light red
    Toast_SetDuration         300         ' in ms
    Toast_SetText             SPACE$(5) + msg
    Toast_SetFont             "Calibri", 20, %ITALIC + %BOLD
    Toast_Show_Sync()
END SUB
'-------------------------------------------------------------------------------------------------

'-------------------------------------------------------------------------------------------------
SUB ShowTranslationToast(msg AS STRING)
    Toast_SetWidth            213
    Toast_SetHeight           120
    Toast_SetAlpha            150         ' 0 <= alpha <= 255
    Toast_SetTextColor        "000000"    ' black
    Toast_SetBackgroundColor  "ADCBED"    ' light blue
    Toast_SetDuration         1200        ' in ms
    Toast_SetText             msg
    Toast_SetFont             "Calibri", 20, %ITALIC + %BOLD
    Toast_Show_Sync()
END SUB
'-------------------------------------------------------------------------------------------------

'-------------------------------------------------------------------------------------------------
SUB DumpStandardIniFile()
    WritePrivateProfileString "Translator", "Target-language", "EN", INIFILE
    WritePrivateProfileString "Translator", "Time-out", "4 seconds", INIFILE
    WritePrivateProfileString "Output", "Mode", "0 // 0=Toast; 1=Paste; 2=Popup", INIFILE
    WritePrivateProfileString "About", "Contact", "nicolas.mougin@ingenico.com", INIFILE
    WritePrivateProfileString "About", "Version", ($VER), INIFILE
    WritePrivateProfileString "About", "Released", "01-APR-2019", INIFILE
END SUB
'-------------------------------------------------------------------------------------------------

'-------------------------------------------------------------------------------------------------
SUB SetTrsMode(m AS LONG)
    trs_mode = m
    WritePrivateProfileString "Output", "Mode", FORMAT$(trs_mode) + " // 0=Toast; 1=Paste; 2=Popup", INIFILE
    MENU SET STATE hOut, BYCMD %IDM_Paste, IIF(trs_mode=1, 8, 0)
    MENU SET STATE hOut, BYCMD %IDM_Popup, IIF(trs_mode=2, 8, 0)
    MENU SET STATE hOut, BYCMD %IDM_Toast, IIF(trs_mode<1 OR trs_mode>2, 8, 0)
END SUB
'-------------------------------------------------------------------------------------------------

'-------------------------------------------------------------------------------------------------
FUNCTION UrlDecode(enc AS STRING) AS STRING
    LOCAL dec, car AS STRING
    LOCAL i, j AS LONG
    dec = enc
    REPLACE "&quot;" WITH CHR$(34) IN dec
    REPLACE "&nbsp;" WITH $SPC IN dec
    REPLACE "&lt;" WITH "<" IN dec
    REPLACE "&gt;" WITH ">" IN dec
    REPLACE "&amp;" WITH "&" IN dec
    REPLACE "&apos;" WITH "'" IN dec
    i = INSTR(dec, "&#") ' e.g. "&#39;"
    WHILE i > 0
        j = INSTR(i, dec, ";")
        car = MID$(dec, i, j-i+1)
        REPLACE car WITH CHR$(VAL(RTRIM$(LTRIM$(car,"&#"),";"))) IN dec
        i = INSTR(dec, "&#")
    WEND
    FUNCTION = dec
END FUNCTION
'-------------------------------------------------------------------------------------------------

'-------------------------------------------------------------------------------------------------
FUNCTION Exist(BYVAL fileOrFolder AS STRING) AS LONG
    LOCAL Dummy&
    Dummy& = GETATTR(fileOrFolder)
    FUNCTION = (ERRCLEAR = 0)
END FUNCTION
'-------------------------------------------------------------------------------------------------
FUNCTION Hexa(e AS STRING) AS STRING
    LOCAL i AS LONG
    LOCAL o AS STRING
    FOR i = 1 TO LEN(e)
        o += HEX$(ASC(e,i),2)+$SPC
    NEXT
    FUNCTION = RTRIM$(o)
END FUNCTION
'-------------------------------------------------------------------------------------------------

'-------------------------------------------------------------------------------------------------
CALLBACK FUNCTION ProcFirstRunBox
    LOCAL i AS LONG
    IF (CB.MSG = %WM_COMMAND AND CB.CTL = %IDOK) OR (CB.MSG = %WM_DESTROY) THEN
        ' Start with Windows?
        CONTROL GET CHECK CB.HNDL, %IDC_CHECKBOX TO i
        IF ISTRUE i THEN MakeStartupShortcut ELSE DeleteStartupShortcut
        DIALOG END CB.HNDL
    END IF
END FUNCTION
'-------------------------------------------------------------------------------------------------

'-------------------------------------------------------------------------------------------------
SUB ShowFirstRunBox()
    LOCAL hDlg AS DWORD

    DIALOG NEW PIXELS, 0, EXE.NAME$,,, 270, 200, %WS_POPUP _
        OR %WS_BORDER OR %WS_DLGFRAME OR %WS_CAPTION OR %WS_SYSMENU OR _
        %WS_CLIPSIBLINGS OR %WS_VISIBLE OR %DS_MODALFRAME OR %DS_3DLOOK OR _
        %DS_NOFAILCREATE OR %DS_SETFONT, %WS_EX_CONTROLPARENT OR %WS_EX_LEFT _
        OR %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR, TO hDlg
    DIALOG SET ICON hDlg, "#5"

    CONTROL ADD LABEL,    hDlg, %IDC_LABEL1,   "Translater is running in the notification zone :", 8, 8, 256, 16
    CONTROL ADD IMAGE,    hDlg, %IDC_IMAGE,    "#104", 24, 32, 187, 31
    CONTROL ADD LABEL,    hDlg, %IDC_LABEL2,   "Click on its icon to access the program options.", 8, 80, 256, 16
    CONTROL SET COLOR     hDlg, %IDC_LABEL2,   RGB(0, 128, 128), -1
    CONTROL ADD LABEL,    hDlg, %IDC_LABEL3,   "Hit Ctrl+Alt+T on selected text anywhere to translate.", 8, 104, 256, 16
    CONTROL SET COLOR     hDlg, %IDC_LABEL3,   RGB(0, 128, 128), -1
    CONTROL ADD CHECKBOX, hDlg, %IDC_CHECKBOX, " Start the Translater with Windows", 8, 128, 256, 16
    CONTROL ADD BUTTON,   hDlg, %IDOK,         "OK", 166, 160, 82, 24
    CONTROL SET CHECK     hDlg, %IDC_CHECKBOX, 1

    DIALOG SHOW MODAL   hDlg, CALL ProcFirstRunBox
END SUB
'-------------------------------------------------------------------------------------------------

'-------------------------------------------------------------------------------------------------
SUB CreateScripts()
    LOCAL ff AS LONG

    ' Create cmd batch
    ff = FREEFILE
    OPEN EXE.PATH$ + "trans.bat" FOR OUTPUT AS #ff
    PRINT #ff, "@echo off"
    PRINT #ff, "python trans.py %1 > out."
    CLOSE #ff

    ' Create Python script
    ff = FREEFILE
    OPEN EXE.PATH$ + "trans.py" FOR OUTPUT AS #ff
    PRINT #ff, "import sys"
    PRINT #ff, "from urllib.parse import unquote"
    PRINT #ff, "from translate import Translator"
    PRINT #ff, "utf = unquote(sys.argv[1])"
    PRINT #ff, "translator = Translator(from_lang='autodetect', to_lang='" + trs_lang + "')"
    PRINT #ff, "print(translator.translate(utf))"
    CLOSE #ff
END SUB
'-------------------------------------------------------------------------------------------------

'-------------------------------------------------------------------------------------------------
' Prototypes
DECLARE FUNCTION IShellLink_Call0(BYVAL pUnk AS LONG) AS LONG
DECLARE FUNCTION IShellLink_Call1(BYVAL pUnk AS LONG, BYVAL p1 AS LONG) AS LONG
DECLARE FUNCTION IShellLink_Call2(BYVAL pUnk AS LONG, BYVAL p1 AS LONG, BYVAL p2 AS LONG) AS LONG
'-------------------------------------------------------------------------------------------------
FUNCTION CreateShortcut( _
      BYVAL sTargetLinkName AS STRING _
    , BYVAL sSourceFileName AS STRING _
    , BYVAL sArguments      AS STRING _
    , BYVAL sWorkDir        AS STRING _
    , BYVAL nShowCmd        AS LONG _
    , BYVAL sIconFile       AS STRING _
    , BYVAL nIconIndex      AS LONG _
    , BYVAL sComment        AS STRING _
    ) AS LONG

    LOCAL CLSID_ShellLink AS STRING * 16
    LOCAL IID_IShellLink  AS STRING * 16
    LOCAL IID_Persist     AS STRING * 16
    LOCAL nResult         AS LONG
    LOCAL pShellLnk       AS DWORD PTR
    LOCAL pPersist        AS DWORD PTR

    ' IShellLink interface
    ' IID = 000214EE-0000-0000-C000-000000000046
    ' Inherited interface = IUnknown

    CLSID_ShellLink = MKL$(&H00021401) & CHR$(0, 0, 0, 0, &HC0, 0, 0, 0, 0, 0, 0, &H46)
    IID_IShellLink  = MKL$(&H000214EE) & CHR$(0, 0, 0, 0, &HC0, 0, 0, 0, 0, 0, 0, &H46)
    IID_Persist     = MKL$(&H0000010B) & CHR$(0, 0, 0, 0, &HC0, 0, 0, 0, 0, 0, 0, &H46)
    sTargetLinkName = UCODE$(sTargetLinkName)

    CALL CoInitialize(BYVAL 0&)

    IF CoCreateInstance(BYVAL VARPTR(CLSID_ShellLink), BYVAL 0&, 1, BYVAL VARPTR(IID_IShellLink), pShellLnk) = 0 THEN
        ' IShellLink::SetPath
        CALL DWORD @@pShellLnk[20] USING IShellLink_Call1(pShellLnk, STRPTR(sSourceFileName))
        ' IShellLink::SetsArguments
        CALL DWORD @@pShellLnk[11] USING IShellLink_Call1(pShellLnk, STRPTR(sArguments))
        ' IShellLink::SetWorkingDirectory
        CALL DWORD @@pShellLnk[9] USING IShellLink_Call1(pShellLnk, STRPTR(sWorkDir))
        ' IShellLink::SetnShowCmd
        CALL DWORD @@pShellLnk[15] USING IShellLink_Call1(pShellLnk, nShowCmd)
        ' IShellLink::SetDescription
        CALL DWORD @@pShellLnk[7] USING IShellLink_Call1(pShellLnk, STRPTR(sComment))
        ' Obtain persist interface (QueryInterface)
        CALL DWORD @@pShellLnk[0] USING IShellLink_Call2(pShellLnk, VARPTR(IID_Persist), VARPTR(pPersist))
         ' IShellLink::SetIconLocation
        CALL DWORD @@pShellLnk[17] USING IShellLink_Call2(pShellLnk, STRPTR(sIconFile), 0)

        IF nResult = 0 THEN
            ' Convert to unicode
            ' IPersistFile::Save
            CALL DWORD @@pPersist[6] USING IShellLink_Call2(pPersist, STRPTR(sTargetLinkName), 1)
            ' Release
            CALL DWORD @@pPersist[2] USING IShellLink_Call0(pPersist)
        END IF

        ' Release
        CALL DWORD @@pShellLnk[2] USING IShellLink_Call0(pShellLnk)
        FUNCTION = -1

    END IF

    CALL CoUninitialize()
END FUNCTION
'-------------------------------------------------------------------------------------------------
DECLARE FUNCTION SHGetFolderPath LIB "Shell32.dll" _
    ALIAS "SHGetFolderPathA" (BYVAL hwnd AS DWORD, BYVAL csidl AS LONG, _
    BYVAL hToken AS DWORD, BYVAL dwFlags AS DWORD, pszPath AS ASCIIZ) AS LONG
%CSIDL_STARTUP        = &H0007 ' <user name>\Start Menu\Programs\Startup
%CSIDL_LOCAL_APPDATA  = &H001c ' <user name>\Local Settings\Application Data (non roaming)
'-------------------------------------------------------------------------------------------------
FUNCTION StartupFolder AS STRING
    LOCAL szBaseFolder AS ASCIIZ * %MAX_PATH
    ShGetFolderPath (BYVAL 0, %CSIDL_STARTUP, BYVAL 0, BYVAL 0, szBaseFolder)
    FUNCTION = TRIM$(szBaseFolder) + "\"
END FUNCTION
'-------------------------------------------------------------------------------------------------
FUNCTION LocalAppData AS STRING
    LOCAL szBaseFolder AS ASCIIZ * %MAX_PATH
    ShGetFolderPath (BYVAL 0, %CSIDL_LOCAL_APPDATA, BYVAL 0, BYVAL 0, szBaseFolder)
    FUNCTION = TRIM$(szBaseFolder) + "\"
END FUNCTION
'-------------------------------------------------------------------------------------------------
SUB DeleteStartupShortcut
    KILL StartupFolder & EXE.NAME$ & ".lnk"
END SUB
'-------------------------------------------------------------------------------------------------
FUNCTION ExistStartupShortcut AS LONG
    FUNCTION = IIF(EXIST(StartupFolder & EXE.NAME$ & ".lnk"), 8, 0)
END FUNCTION
'-------------------------------------------------------------------------------------------------
SUB MakeStartupShortcut
    DeleteStartupShortcut
    CreateShortcut _
      StartupFolder & EXE.NAME$ & ".lnk", _ ' 1. the link file to be created
      EXE.FULL$,                          _ ' 2. the file/document where the shortcut should point to
      "",                                 _ ' 3. command-line parameters
      EXE.PATH$,                          _ ' 4. the folder where the executable file should start in
      %SW_SHOW,                           _ ' 5. %SW_SHOW, %SW_HIDE etc.
      EXE.FULL$,                          _ ' 6. icon file or executable file containing an icon
      0,                                  _ ' 7. icon index in the aforementioned file
      "nicolas.mougin@ingenico.com"         ' 8. any comment (stored in the shortcut)
END SUB
'-------------------------------------------------------------------------------------------------