Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
updated QB64.org forums/wiki link updater (v7.08)
#1
Added logic so it recognizes links like "forum.qb64.org" and not just "www.qb64.org/forum", 
and can handle other such weird cases. 

Code: (Select All)
' Opens google qb64.rip links in mirror site.
' http://qb64phoenix.com/forum/showthread.php?tid=429

' Version: 7.08

' DATE         WHO-DONE-IT   DID-WHAT
' 2022-05-18   Pete          Created QB64.org URL redirector.
' 2022-07-22   madscijr      Added options menu and support for wiki.
' 2022-07-29   madscijr      Changed input from Input to Inkey$.
' 2022-08-04   madscijr      Added logic to normalize URLs
'                            like https://forum.qb64.org/index.php?topic=...
'                            to   https://www.qb64.org/forum/index.php?topic=...

' TEST LINKS:
' https://www.qb64.org/forum/index.php?topic=3348.0
' https://www.qb64.org/forum/index.php?topic=896.0
' https://www.qb64.org/forum/index.php?topic=1073.0
' https://forum.qb64.org/index.php?topic=2591.5;wap2
' http://www.qb64.org/wiki/SCREEN#Legacy_Screen_Modes
' http://www.qb64.org/wiki/TIMER_(statement)
' http://www.qb64.org/wiki/ON_TIMER(n)
' http://www.qb64.org/wiki/COLOR

Const FALSE = 0
Const TRUE = Not FALSE

Dim in$
Dim iCount%: iCount% = 0
Dim oldURL$
Dim parse$
Dim newURL$
Dim bUpdateClipboard%
Dim sOpenBrowser$
Dim sValue$
Dim sMessage$
Dim iPos%
Dim sKey$
Dim bChrome%
Dim bFirefox%
Dim bDontNavigate%
Dim bScreenUpdate%
bScreenUpdate% = TRUE
bUpdateClipboard% = TRUE
sOpenBrowser$ = "c"
sMessage$ = ""

_Title "QB64.org link updater v7.08" ' display in the Window's title bar

Do
    bChrome% = (sOpenBrowser$ = "g")
    bFirefox% = (sOpenBrowser$ = "f")
    bDontNavigate% = ((bChrome% = FALSE) And (bFirefox% = FALSE))
    If (bScreenUpdate% = TRUE) Then
        Cls
        Print "QB64.org link updater by Pete, modified by madscijr"
        Print
        Print "1. Copy old link to clipboard first"
        Print "2. Select options (see below)"
        Print "3. Press ENTER to convert link and do something."
        Print
        Print "ESC = quit"
        Print
        Print "---------------------------------------------------"
        Print "Clipboard options:"
        Print "C   = Enable  update clipboard.........." + IIFSTR$(bUpdateClipboard%, "<---", "    ")
        Print "D   = Disable update clipboard.........." + IIFSTR$(bUpdateClipboard%, "    ", "<---")
        Print
        Print "Navigation options:"
        Print "G   = Navigates to new link in Chrome..." + IIFSTR$(bChrome%, "<---", "    ")
        Print "F   = Navigates to new link in Firefox.." + IIFSTR$(bFirefox%, "<---", "    ")
        Print "N   = Don't navigate to new link........" + IIFSTR$(bDontNavigate%, "<---", "    ")
        Print "---------------------------------------------------"
        Print sMessage$: If Len(sMessage$) > 0 Then sMessage$ = ""
        bScreenUpdate% = FALSE
    End If

    sKey$ = InKey$

    If UCase$(sKey$) = "C" Then
        If bUpdateClipboard% = FALSE Then
            bUpdateClipboard% = TRUE
            bScreenUpdate% = TRUE
        End If
    ElseIf UCase$(sKey$) = "D" Then
        If bUpdateClipboard% = TRUE Then
            bUpdateClipboard% = FALSE
            bScreenUpdate% = TRUE
        End If
    ElseIf UCase$(sKey$) = "G" Then
        If sOpenBrowser$ <> "g" Then
            sOpenBrowser$ = "g"
            bScreenUpdate% = TRUE
        End If
    ElseIf UCase$(sKey$) = "F" Then
        If sOpenBrowser$ <> "f" Then
            sOpenBrowser$ = "f"
            bScreenUpdate% = TRUE
        End If
    ElseIf UCase$(sKey$) = "N" Then
        If sOpenBrowser$ <> "n" Then
            sOpenBrowser$ = "n"
            bScreenUpdate% = TRUE
        End If
    ElseIf sKey$ = Chr$(27) Then
        Exit Do
    ElseIf sKey$ = Chr$(13) Then
        If Len(_Clipboard$) Then
            oldURL$ = LCase$(_Clipboard$)
            oldURL$ = _Trim$(oldURL$)
           
            ' FIX HTTPS
            ' OLD: http://
            ' NEW: https://
            oldURL$ = Replace$(oldURL$, "http://", "https://")
           
            ' MAKE SURE THERE IS A SLASH AFTER "qb64.org"
            ' OLD: https://www.qb64.org
            ' NEW: https://www.qb64.org/
            If Right$(oldURL$, 8) = "qb64.org" Then
                oldURL$ = Left$(oldURL$, Len(oldURL$) - 8) + "qb64.org/"
            End If
           
            ' MAKE SURE THERE IS "WWW"
            ' OLD: https://qb64.org/...
            ' NEW: https://www.qb64.org/...
            oldURL$ = Replace$(oldURL$, "https://qb64.org/", "https://www.qb64.org/")
           
            ' FIX forum.qb64.org
            ' OLD: https://forum.qb64.org/...
            ' NEW: https://www.qb64.org/forum/...
            oldURL$ = Replace$(oldURL$, "https://forum.qb64.org/", "https://www.qb64.org/forum/")
           
            ' FIX wiki.qb64.org
            ' OLD: https://wiki.qb64.org/...
            ' NEW: https://www.qb64.org/wiki/...
            oldURL$ = Replace$(oldURL$, "https://wiki.qb64.org/", "https://www.qb64.org/wiki/")
           
            ' FORUMS:
            ' OLD: https://www.qb64.org/forum/index.php?topic={topic}
            ' NEW: https://qb64forum.alephc.xyz/index.php?topic={topic}
           
            ' WIKI:
            ' OLD: http://www.qb64.org/wiki/{topic}
            ' NEW: https://qb64phoenix.com/qb64wiki/index.php/{topic}
           
            If InStr(oldURL$, "/www.qb64.org/forum/index.php") > 0 Then
                ' URL IS FROM FORUMS...
                If InStr(oldURL$, "?topic=") > 0 Then
                    sMessage$ = sMessage$ + "Detected forum link." + Chr$(13)
                    parse$ = Mid$(oldURL$, InStr(oldURL$, "index"))
                    newURL$ = "https://qb64forum.alephc.xyz/" + parse$
                Else
                    sMessage$ = sMessage$ + "Detected forum link, no topic." + Chr$(13)
                    ' GOTO THE ROOT FORUMS URL
                    newURL$ = "https://qb64forum.alephc.xyz/index.php"
                End If
                iCount% = iCount% + 1
            ElseIf InStr(oldURL$, "/www.qb64.org/wiki") > 0 Then
                ' URL IS FROM WIKI...
                If InStr(oldURL$, "/www.qb64.org/wiki/") > 0 Then
                    sMessage$ = sMessage$ + "Detected wiki link." + Chr$(13)
                    iPos% = _InStrRev(oldURL$, "/wiki/")
                    If iPos% > 0 Then
                        parse$ = Right$(oldURL$, Len(oldURL$) - (iPos% + 5))
                    End If
                    newURL$ = "https://qb64phoenix.com/qb64wiki/index.php/" + parse$
                Else
                    sMessage$ = sMessage$ + "Detected wiki link, no topic." + Chr$(13)
                    ' GOTO THE ROOT WIKI URL
                    newURL$ = "https://qb64phoenix.com/qb64wiki/index.php"
                End If
                iCount% = iCount% + 1
            Else
                sMessage$ = sMessage$ + "Link not recognized." + Chr$(13)
                newURL$ = ""
            End If

            If Len(newURL$) > 0 Then
                sMessage$ = sMessage$ + "Converted, new URL is:" + Chr$(13) + newURL$ + Chr$(13)

                If sOpenBrowser$ = "g" Then
                    sMessage$ = sMessage$ + "Opening new link in Chrome." + Chr$(13)
                    Shell _DontWait "chrome " + newURL$
                ElseIf sOpenBrowser$ = "f" Then
                    sMessage$ = sMessage$ + "Opening new link in Firefox." + Chr$(13)
                    Shell _DontWait "firefox " + newURL$
                End If

                If bUpdateClipboard% = TRUE Then
                    sMessage$ = sMessage$ + "Copying new link to clipboard." + Chr$(13)
                    _Clipboard$ = newURL$
                End If
            End If
        Else
            sMessage$ = sMessage$ + "Clipboard is empty!" + Chr$(13)
        End If
        bScreenUpdate% = TRUE
    End If

    If bScreenUpdate% = TRUE Then
        While InKey$ <> "": Wend ' Clear the keyboard buffer
    End If

    _Limit 60
Loop

'System
End

' /////////////////////////////////////////////////////////////////////////////
' IIF function for QB for strings

Function IIFSTR$ (Condition, IfTrue$, IfFalse$)
    If Condition Then IIFSTR$ = IfTrue$ Else IIFSTR$ = IfFalse$
End Function

' /////////////////////////////////////////////////////////////////////////////
' FROM: String Manipulation
' http://www.qb64.net/forum/index_topic_5964-0/
'
'SUMMARY:
'   Purpose:  A library of custom functions that transform strings.
'   Author:   Dustinian Camburides (dustinian@gmail.com)
'   Platform: QB64 (www.qb64.net)
'   Revision: 1.6
'   Updated:  5/28/2012

'SUMMARY:
'[Replace$] replaces all instances of the [Find] sub-string with the [Add] sub-string within the [Text] string.
'INPUT:
'Text: The input string; the text that's being manipulated.
'Find: The specified sub-string; the string sought within the [Text] string.
'Add: The sub-string that's being added to the [Text] string.

Function Replace$ (Text1 As String, Find1 As String, Add1 As String)
    ' VARIABLES:
    Dim Text2 As String
    Dim Find2 As String
    Dim Add2 As String
    Dim lngLocation As Long ' The address of the [Find] substring within the [Text] string.
    Dim strBefore As String ' The characters before the string to be replaced.
    Dim strAfter As String ' The characters after the string to be replaced.

    ' INITIALIZE:
    ' MAKE COPIESSO THE ORIGINAL IS NOT MODIFIED (LIKE ByVal IN VBA)
    Text2 = Text1
    Find2 = Find1
    Add2 = Add1

    lngLocation = InStr(1, Text2, Find2)

    ' PROCESSING:
    ' While [Find2] appears in [Text2]...
    While lngLocation
        ' Extract all Text2 before the [Find2] substring:
        strBefore = Left$(Text2, lngLocation - 1)

        ' Extract all text after the [Find2] substring:
        strAfter = Right$(Text2, ((Len(Text2) - (lngLocation + Len(Find2) - 1))))

        ' Return the substring:
        Text2 = strBefore + Add2 + strAfter

        ' Locate the next instance of [Find2]:
        lngLocation = InStr(1, Text2, Find2)

        ' Next instance of [Find2]...
    Wend

    ' OUTPUT:
    Replace$ = Text2
End Function ' Replace$

' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
' Redirect old-forum and wiki search results to Pheonix as appropriate.
' http://qb64phoenix.com/forum/showthread.php?tid=429

' mpgcan
' 05-18-2022, 10:37 AM
'
' You know how it goes. Searching for a QB64 solution, search engines return
' results to the old-forum or old-wiki. Clicking the link only to be informed the
' server is not found.
'
' With the link returned, you can use part of it to search in either the new-wiki
' or old-backup forum. This has become very tedious. I thought there must be a
' better way.
'
' A simple solution is to use Einar Egilsson's Redirector for this. It is a
' browser add-on for Firefox, Chrome, Edge and Opera. The Redirector allows you
' to search for a specific URL, substitute it for another URL and force the
' browser to redirect to this new URL.
'
' How to install redirector on Firefox:
'
' 1) Use the following link to get the add-on
'    https://addons.mozilla.org/en-GB/firefox/addon/redirector/
'
' 2) Note: This add-on is not actively monitored for security by Mozilla.
'          Check out the "Learn more" link. After reading your choice
'          if you wish to continue.
'
' 3) Click the Add to Firefox button.
'
' 4) Add Redirector? This extension will have permission to:
'    Click Add button
'
' 5) Redirector was added.
'    Click the check box. Allow this extension to run in Private Windows
'    Click Okay button.
'
' 6) A redirector symbol is displayed at the top right of the browser
'    confirming it is successfully installed.
'
' Configuring redirector:
' Redirect from the old QB64 forum to Phoenix's old-archived read only
' working forum.
'
' 1) Click on the redirector symbol in the drop down click
'    "Edit Redirects" button.
' 2) On the new browser page that opens, click "Create New Redirect"
' 3) Fill in the form with the following information:
'    Configuration information:
'      Description........: QB64_forum_old_to_archive
'      Example URL........: https://forum.qb64.org/
'      Include pattern....: https://forum.qb64.org/*
'      Redirect to........: https://qb64forum.alephc.xyz/$1
'      Pattern type.......: Wildcard click radio buttom
'      Pattern Description: Leave blank
'    Example result: https://qb64forum.alephc.xyz/
'    To complete it, click the "Save" button.
' 4) Click "Create New Redirect" 
' 5) Fill in the form with the following information:
'    Configuration information:
'      Redirect from the old QB64 Wiki to Pheonix's new QB64 Wiki.
'      Description        : QB64_Wiki_old_to_new
'      Example URL        : https://wiki.qb64.org/wiki/
'      Include pattern    : https://wiki.qb64.org/wiki/*
'      Redirect to        : https://qb64phoenix.com/qb64wiki/index.php/$1
'      Pattern type       : Wildcard click radio buttom
'      Pattern Description: Leave blank
'    Example result: https://qb64phoenix.com/qb64wiki/index.php/
'    To complete it, click the "Save" button.
' 6) Finally disable the first configuration
'    "Example redirect, try going to http://example.com/anywordhere"
'    By clicking the "Disable" button.
'
' Test:
' Try the following two links in your browser:
'   https://forum.qb64.org/index.php?topic=456.0
'   https://wiki.qb64.org/wiki/$IF
'
' All the best
' MPGCAN
'
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
' madscijr
' 05-19-2022, 11:39 AM
' (05-18-2022, 10:37 AM) mpgcan Wrote:
' >A simple solution is to use Einar Egilsson's Redirector for this.
' >It is a browser add-on for Firefox, Chrome, Edge and Opera.
' >The Redirector allows you to search for a specific URL,
' >substitute it for another URL and force the browser to redirect
' >to this new URL.
'
' Thanks for sharing this and explaining how to use it.
' This can come in handy for any number of things...
'
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
' Pete, Administrator
' 05-19-2022, 01:21 AM
'
' Looks like a useful plugin.
' I made my own in QB64...
'
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
' madscijr
' 05-19-2022, 11:38 AM
'
' (05-19-2022, 01:21 AM) Pete Wrote:
' >Looks like a useful plugin.
' >I made my own in QB64...
'
' Very cool!
' Not only does it work and is useful, but I never knew QB64 could do that,
' and learned something knew.
' Thanks Pete
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
Reply




Users browsing this thread: 1 Guest(s)