Added logic so it recognizes links like "forum.qb64.org" and not just "www.qb64.org/forum",
and can handle other such weird cases.
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
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------