Here is an example UTILITY program that should work to post indented code to the foum.

by Pete (Login The-Universe)
R

 
This is a compilation of work from Alipha and Michael Calkins, and me. MC modified Alipha's code so the clipboard part will also work in QB 1.1. For those who have PDS or QB45, you should be able to compile this source code and then make a desktop shortcut to it. I added a COMMAND$ feature to the clipboard function and developed an app that will do as follows:

A) Drag a qb program file into the shortcut and the app will add alt+0160 characters to the clipboard contents. Now just past to the forum using IE or Opera and your code indentation should be preserved. (May not work in FF - untested.)

or...

B) Copy forum source code to the Windows clipboard and then click the shortcut. The application will open the source code in the QBasic IDE.

I hope it works; it's fresh out of the oven without much testing. I would be happy to add the compiled exe file to the Downloads page if anyone who does not have QB45 would like to use it.

================

REM Clipboard functions provided by Alipha, Shellreef, and Michael Calkins.
DEFINT A-Z
DECLARE FUNCTION Windows ()
DECLARE SUB setcode ()
DECLARE FUNCTION ClipboardText$ ()
DECLARE SUB OpenClipboard ()
DECLARE SUB CloseClipboard ()
DECLARE SUB SetClipboardText (text$)
DECLARE SUB EmptyClipboard ()

TYPE regst
ax AS INTEGER  'passed & recieved
cx AS INTEGER  'passed
dx AS INTEGER  'passed & recieved
bx AS INTEGER  'passed
si AS INTEGER  'passed
es AS INTEGER  'passed
allow AS INTEGER
code AS STRING * 40
END TYPE
DIM SHARED regs AS regst
CLS
setcode
IF NOT Windows THEN PRINT "Windows not present.": SYSTEM

CLS
PRINT "QB Forum Utility Program"
PRINT

FileName$ = LTRIM$(RTRIM$(COMMAND$))
IF FileName$ = "" THEN opt = 1: REM Open from clipboard.

SELECT CASE opt
CASE 0
ON ERROR GOTO endprogram
OPEN FileName$ FOR INPUT AS #1
ON ERROR GOTO 0
OpenClipboard
EmptyClipboard
DO UNTIL EOF(1)
LINE INPUT #1, a$
x$ = x$ + a$ + CHR$(13)
LOOP
CLOSE #1
GOSUB alt160
SetClipboardText x$
CloseClipboard
PRINT "You may now use Ctrl + v or Shift + Insert to paste and post your code!"
SLEEP 2

CASE 1
OpenClipboard
x$ = ClipboardText$
CloseClipboard
GOSUB alt160
a$ = "": OPEN "qb-forum.bas" FOR OUTPUT AS #1
DO

IF INSTR(x$, CHR$(13)) <> 0 THEN
a$ = MID$(x$, 1, INSTR(x$, CHR$(13)) - 1)
IF MID$(a$, 1, 1) = CHR$(10) THEN a$ = MID$(a$, 2)
PRINT #1, a$
x$ = MID$(x$, INSTR(x$, CHR$(13)) + 1)
ELSE
PRINT #1, x$: EXIT DO
END IF
IF x$ = "" THEN EXIT DO
LOOP
CLOSE #1
SHELL "qb.exe qb-forum.bas /l"
END SELECT

SYSTEM

alt160:
SELECT CASE opt
CASE 0
DO UNTIL INSTR(x$, SPACE$(2)) = 0
MID$(x$, INSTR(x$, SPACE$(2)), 2) = STRING$(2, 160)
LOOP
CASE 1
DO UNTIL INSTR(x$, CHR$(160)) = 0
MID$(x$, INSTR(x$, CHR$(160)), 1) = " "
LOOP
END SELECT
RETURN

endprogram:
PRINT "File [" + FileName$ + "] was not found. Ending..."
SLEEP 2
END

FUNCTION ClipboardText$
  regs.ax = &H1704
  regs.dx = 1
  IF regs.allow THEN DEF SEG = VARSEG(regs.code): CALL absolute(regs.ax, VARPTR(regs.code)): DEF SEG

  IF regs.dx <> 0 OR regs.ax < 0 THEN
    PRINT "Too much data in clipboard."
    END
  END IF

  IF regs.ax = 0 THEN
    ClipboardText$ = ""
    EXIT FUNCTION
  END IF

  buffer$ = SPACE$(regs.ax)

  regs.ax = &H1705
  regs.dx = 1
  regs.es = VARSEG(buffer$)
  regs.bx = SADD(buffer$)
  IF regs.allow THEN DEF SEG = VARSEG(regs.code): CALL absolute(regs.ax, VARPTR(regs.code)): DEF SEG

  IF regs.ax = 0 THEN
    PRINT "Error while accessing clipboard data."
    END
  END IF

  ClipboardText$ = LEFT$(buffer$, INSTR(buffer$, CHR$(0)) - 1)
END FUNCTION

SUB CloseClipboard
  regs.ax = &H1708
  IF regs.allow THEN DEF SEG = VARSEG(regs.code): CALL absolute(regs.ax, VARPTR(regs.code)): DEF SEG

  IF regs.ax = 0 THEN
    PRINT "Unable to close"
    END
  END IF

END SUB

SUB EmptyClipboard

  regs.ax = &H1702
  IF regs.allow THEN DEF SEG = VARSEG(regs.code): CALL absolute(regs.ax, VARPTR(regs.code)): DEF SEG

  IF regs.ax = 0 THEN
    PRINT "Unable to empty clipboard."
    END
  END IF

END SUB

SUB OpenClipboard
  regs.ax = &H1701
  IF regs.allow THEN DEF SEG = VARSEG(regs.code): CALL absolute(regs.ax, VARPTR(regs.code)): DEF SEG

  IF regs.ax = 0 THEN
    PRINT "clipboard in use"
    END
  END IF

END SUB

SUB SetClipboardText (text$)

  t$ = text$ + CHR$(0)

  regs.ax = &H1703
  regs.dx = 1
  regs.es = VARSEG(t$)
  regs.bx = SADD(t$)
  regs.cx = LEN(t$)
  regs.si = 0
  IF regs.allow THEN DEF SEG = VARSEG(regs.code): CALL absolute(regs.ax, VARPTR(regs.code)): DEF SEG

  IF regs.ax = 0 THEN
    PRINT "Error while trying to place text in clipboard."
    END
  END IF

END SUB

SUB setcode
h$ = "5589E55657068B7E068B058B4D028B55048B5D068B75088E450ACD2F8905895504075F5E5DCA0200"
asm$ = ""
FOR i = 1 TO LEN(h$) STEP 2
  asm$ = asm$ + CHR$(VAL("&h" + MID$(h$, i, 2)))
NEXT i
IF LEN(asm$) <> LEN(regs.code) THEN PRINT LEN(asm$): BEEP: SYSTEM
regs.code = asm$
regs.allow = -1
END SUB

FUNCTION Windows
'This section adapted from Shellreef's code.
' Returns false if Windows is found, else true
regs.ax = &H1700
IF regs.allow THEN DEF SEG = VARSEG(regs.code): CALL absolute(regs.ax, VARPTR(regs.code)): DEF SEG
IF (regs.ax <> &H1700) THEN
  isValid = -1
ELSE
  isValid = 0
END IF
Windows = isValid
END FUNCTION


---------------------------


Pete

Posted on Jan 18, 2009, 3:15 PM

Respond to this message   

Goto Forum Home

Response TitleAuthor and Date
It doesn't work on my XPqbguy on Jan 18
 XP/2000/NT need this add-on for clipboard copying...Pete on Jan 18

 Copyright © 1999-2014 Network54. All rights reserved.   Terms of Use   Privacy Statement