'=========================================================================== ' Subject: POSTIT! 5.0 FOR VB/DOS Date: 03-02-93 (15:50) ' Author: Brent Ashley Code: VBDOS ' Origin: QBTIPS_I.DOC Packet: BINARY.ABC '=========================================================================== 'I've rewritten the recent PostIt v4.0 for VB/DOS as v5.0. 'You will notice I have cleaned up the code considerably, 'imposing a consistent style, insulating modules from 'each other, eliminating global variables, and added a 'forms-based interface. ' 'I plan to finish a cleaned up QB version soon, too. ' 'Here is the make file for the project, called PI.MAK: ' 'POSTIT.FRM 'PROGRESS.FRM 'In the following messages are the two files listed above. 'Version 1.00 BEGIN Form frmPostit BackColor = QBColor(3) BorderStyle = 1 Caption = "PostIt!" ControlBox = 0 Height = Char(18) Left = Char(9) MaxButton = 0 MinButton = 0 Top = Char(2) Width = Char(51) BEGIN CommandButton cmdGo BackColor = QBColor(3) Caption = "&Do that PostIt magic!" Default = -1 Height = Char(3) Left = Char(0) TabIndex = 16 Top = Char(13) Width = Char(35) END BEGIN CommandButton cmdExit BackColor = QBColor(3) Cancel = -1 Caption = "E&xit" Height = Char(3) Left = Char(35) TabIndex = 17 Top = Char(13) Width = Char(14) END BEGIN Frame fraOpt BackColor = QBColor(3) Caption = "Options" Height = Char(10) Left = Char(24) TabIndex = 8 Top = Char(3) Width = Char(25) BEGIN Frame fraFmt BackColor = QBColor(3) Caption = "Format" Height = Char(4) Left = Char(1) TabIndex = 13 Top = Char(4) Width = Char(21) BEGIN OptionButton optFmt BackColor = QBColor(3) Caption = "&Text MsgSplit" Height = Char(1) Index = 1 Left = Char(1) TabIndex = 15 TabStop = 0 Top = Char(1) Value = 0 Width = Char(18) END BEGIN OptionButton optFmt BackColor = QBColor(3) Caption = "&Binary PostIt" Height = Char(1) Index = 0 Left = Char(1) TabIndex = 14 Top = Char(0) Value = -1 Width = Char(18) END END BEGIN Label lblRsvd BackColor = QBColor(3) BorderStyle = 0 Caption = "&Reserved Lns:" Height = Char(1) Left = Char(1) TabIndex = 11 Top = Char(2) Width = Char(14) END BEGIN TextBox txtRsvd BackColor = QBColor(3) BorderStyle = 1 Height = Char(1) Left = Char(15) MultiLine = 0 TabIndex = 12 Text = "3" Top = Char(2) Width = Char(7) END BEGIN Label lblLen BackColor = QBColor(3) BorderStyle = 0 Caption = "Page &Length:" Height = Char(1) Left = Char(1) TabIndex = 9 Top = Char(0) Width = Char(13) END BEGIN TextBox txtLen BackColor = QBColor(3) BorderStyle = 1 Height = Char(1) Left = Char(15) MultiLine = 0 TabIndex = 10 Text = "95" Top = Char(0) Width = Char(7) END END BEGIN CommandButton cmdSource BackColor = QBColor(3) Caption = "&Open..." Height = Char(3) Left = Char(40) TabIndex = 2 Top = Char(0) Width = Char(9) END BEGIN Frame fraOut BackColor = QBColor(3) Caption = "Output" Height = Char(10) Left = Char(0) TabIndex = 3 Top = Char(3) Width = Char(23) BEGIN Label lblExt BackColor = QBColor(3) BorderStyle = 0 Caption = "&Extension:" Height = Char(1) Left = Char(1) TabIndex = 6 Top = Char(5) Width = Char(11) END BEGIN Label lblPrefix BackColor = QBColor(3) BorderStyle = 0 Caption = "&Prefix:" Height = Char(1) Left = Char(1) TabIndex = 4 Top = Char(2) Width = Char(8) END BEGIN TextBox txtPrefix BackColor = QBColor(3) BorderStyle = 1 Height = Char(3) Left = Char(9) MultiLine = 0 TabIndex = 5 Text = "POSTIT" Top = Char(1) Width = Char(11) END BEGIN TextBox txtExt BackColor = QBColor(3) BorderStyle = 1 Height = Char(3) Left = Char(12) MultiLine = 0 TabIndex = 7 Text = "PIT" Top = Char(4) Width = Char(8) END END BEGIN Frame fraSource BackColor = QBColor(3) Caption = "&Source File:" Height = Char(3) Left = Char(0) TabIndex = 0 Top = Char(0) Width = Char(40) BEGIN TextBox txtSource BackColor = QBColor(3) BorderStyle = 0 Height = Char(1) Left = Char(0) MultiLine = 0 TabIndex = 1 Text = "" Top = Char(0) Width = Char(38) END END END '$FORM frmProgress '$INCLUDE: 'constant.bi' ' Requires: CMNDLG.LIB/QLB ' ' PostIt! - version 5.0 for VB/DOS ' ' this code is in the PUBLIC DOMAIN ' ' ********************************************************* ' * PostIt! THE Binary <-> BASIC Script Creator * ' ********************************************************* ' * * * ' ' Purpose: ' ' To enable the posting of compressed listings on a text only net. ' This program takes a binary or BASIC input file and converts it to ' a series of small, postable files which other people can capture ' and run to get the original binary file. ' ' Credits: ' ' PostIt! meaty bits by Rich Geldreich ' ' MsgSplit meaty bits by Scott Wunsch and Victor Yiu ' ' with mods by: ' Jim Giordano ' Mark H. Butler ' Quinn Tyler Jackson ' ' this VB/DOS version written by Brent Ashley March 1st, 1993 ' ' Changes include modularizing and clarifying, imposing ' a consistent coding style, commenting, and speeding up ' PostIt module with single buffer grab ' SUB cmdExit_Click () ' pretty straightforward... END END SUB SUB cmdGo_Click () ' dir$ will crap out if given an invalid filename (i.e. ":" ) ON LOCAL ERROR RESUME NEXT IF LEN(LTRIM$(txtSource.text)) = 0 THEN BEEP MSGBOX "You must choose a source file", 0, "Oops!" ELSEIF LEN(DIR$(txtSource.text)) = 0 THEN BEEP MSGBOX "The file `" + txtSource.text + "' doesn't exist", 0, "Oops!" ELSE ' all ok - do it LOAD frmProgress END IF END SUB SUB cmdSource_Click () ' get filespec using common dialog CALL FileOpen(FileName$, PathName$, "*.*", "Choose Source File", 0, 7, 0, Cancel) IF NOT Cancel THEN ' ensure trailing \ IF RIGHT$(PathName$, 1) <> "\" THEN PathName$ = PathName$ + "\" ' check for file too big FileNum = FREEFILE OPEN PathName$ + FileName$ FOR BINARY AS #FileNum IF LOF(FileNum) > 24575& THEN m$ = "Sorry - that file is bigger than the 24k limit!" BEEP MSGBOX m$, 0, "Oops!" EXIT SUB END IF ' analyse for binary or msgsplit Buf$ = SPACE$(32) GET #FileNum, , Buf$ IsBinary = FALSE FOR I = 1 TO LEN(Buf$) SELECT CASE ASC(MID$(Buf$, I, 1)) CASE 0 TO 8, 14 TO 31 ' control codes IsBinary = TRUE EXIT FOR CASE 128 TO 178, 219 TO 255 ' might be binary, might not HiAscii = HiAscii + 1 CASE ELSE ' text ascii or linedraw ' passes through END SELECT NEXT ' set option according to analysed type IF IsBinary OR (HiAscii > 8) THEN optFmt(0).Value = TRUE ELSE optFmt(1).Value = TRUE END IF ' assign filespec to text box txtSource.text = PathName$ + FileName$ ' extract prefix (first up to 6 chars of filename) DotPos = INSTR(FileName$, ".") IF DotPos THEN txtPrefix.text = LEFT$(LEFT$(FileName$, DotPos - 1), 6) ELSE txtPrefix.text = LEFT$(FileName$, 6) END IF ' we've got a file - get ready to do it cmdGo.SETFOCUS END IF END SUB SUB Form_Load () ' get source filename from command line FileSpec$ = COMMAND$ IF LEN(DIR$(FileSpec$)) THEN txtSource.text = FileSpec$ ' extract base filename from input filename FileBase$ = "" FOR I = LEN(FileSpec$) TO 1 STEP -1 ThisChar$ = MID$(FileSpec$, I, 1) SELECT CASE ThisChar$ CASE "\", ":", " " EXIT FOR CASE ELSE FileBase$ = ThisChar$ + FileBase$ END SELECT NEXT ' extract prefix (first up to 6 chars of filename) DotPos = INSTR(FileBase$, ".") IF DotPos THEN txtPrefix.text = LEFT$(LEFT$(FileBase$, DotPos - 1), 6) ELSE txtPrefix.text = LEFT$(FileBase$, 6) END IF END IF ' set up border and title colours SCREEN.ControlPanel(ACTIVE_BORDER_BACKCOLOR) = CYAN SCREEN.ControlPanel(TITLEBAR_BACKCOLOR) = BLUE SCREEN.ControlPanel(TITLEBAR_FORECOLOR) = YELLOW frmPostit.SHOW IF LEN(FileSpec$) = 0 THEN nl$ = CHR$(13) + CHR$(10) m$ = " PostIt v5.0 for VB/DOS" m$ = m$ + nl$ + " ***" + nl$ m$ = m$ + nl$ + " PostIt by Rich Geldreich" m$ = m$ + nl$ + " MsgSplit by Scott Wunsch and Victor Yiu " m$ = m$ + nl$ + " with mods by:" m$ = m$ + nl$ + " Jim Giordano" m$ = m$ + nl$ + " Mark H. Butler" m$ = m$ + nl$ + " Quinn Tyler Jackson" m$ = m$ + nl$ m$ = m$ + nl$ + " VB/DOS version by Brent Ashley" m$ = m$ + nl$ m$ = m$ + nl$ + " PostIt! is in the PUBLIC DOMAIN" MSGBOX m$, 0, "Credits" END IF END SUB SUB txtExt_Change () ' save cursor position Cursor = txtExt.SelStart ' uppercase and limit to three chars txtExt.text = LEFT$(UCASE$(txtExt.text), 3) ' restore cursor position txtExt.SelStart = Cursor END SUB SUB txtLen_KeyPress (KeyAscii AS INTEGER) ' limit to numbers SELECT CASE KeyAscii CASE ASC("0") TO ASC("9"), KEY_SPACE, KEY_DELETE, KEY_BACK 'okiedokie CASE ELSE BEEP ' ignore key KeyAscii = 0 END SELECT END SUB SUB txtLen_LostFocus () ' ensure valid Len value txtLen.text = LTRIM$(STR$(VAL(txtLen.text))) IF VAL(txtLen.text) > 99 THEN txtLen.text = "99" IF VAL(txtLen.text) < 3 THEN txtLen.text = "3" END SUB SUB txtPrefix_Change () ' save cursor position Cursor = txtPrefix.SelStart ' uppercase and limit to six characters txtPrefix.text = LEFT$(UCASE$(txtPrefix.text), 6) ' restore cursor position txtPrefix.SelStart = Cursor END SUB SUB txtRsvd_KeyPress (KeyAscii AS INTEGER) ' limit to numbers SELECT CASE KeyAscii CASE ASC("0") TO ASC("9"), KEY_SPACE, KEY_DELETE, KEY_BACK 'okiedokie CASE ELSE BEEP ' ignore key KeyAscii = 0 END SELECT END SUB SUB txtRsvd_LostFocus () ' ensure valid Rsvd value txtRsvd.text = LTRIM$(STR$(VAL(txtRsvd.text))) IF VAL(txtRsvd.text) > 50 THEN txtRsvd.text = "50" IF VAL(txtRsvd.text) < 0 THEN txtRsvd.text = "0" END SUB BEGIN Form frmProgress BackColor = QBColor(3) BorderStyle = 3 Caption = "Progress" ControlBox = 0 Height = Char(14) Left = Char(32) MaxButton = 0 MinButton = 0 Top = Char(9) Width = Char(40) BEGIN Label lblBar BackColor = QBColor(3) BorderStyle = 1 Caption = "" Height = Char(3) Left = Char(8) TabIndex = 0 Top = Char(5) Width = Char(27) END BEGIN Label lblPct BackColor = QBColor(3) BorderStyle = 0 Caption = "000%" Height = Char(1) Left = Char(2) TabIndex = 1 Top = Char(6) Width = Char(4) END BEGIN Label lblWrit BackColor = QBColor(3) BorderStyle = 0 Caption = "Now Writing File:" Height = Char(1) Left = Char(1) TabIndex = 2 Top = Char(2) Width = Char(18) END BEGIN Label lblCurFile BackColor = QBColor(3) BorderStyle = 1 Caption = "" Height = Char(3) Left = Char(20) TabIndex = 3 Top = Char(1) Width = Char(16) END BEGIN CommandButton cmdAbort BackColor = QBColor(3) Cancel = -1 Caption = "&Abort" Height = Char(3) Left = Char(11) TabIndex = 4 Top = Char(9) Width = Char(18) END END DECLARE FUNCTION ShowProgress% (Percent%, CurFile$) DECLARE SUB MsgSplit (InFileName$, OutPrefix$, Ext$, LPP%, Reserve%, LineLength%) DECLARE SUB PostIt (InFileName$, OutPrefix$, Ext$, LPP%, Reserve%, LineLength%) '$FORM frmPostit '$INCLUDE: 'constant.bi' DIM SHARED InProgress, Abort SUB cmdAbort_Click () SHARED InProgress, Abort ' button performs two functions - Abort or Exit IF InProgress THEN ' abort Abort = TRUE ELSE ' exit UNLOAD frmProgress END IF END SUB SUB Form_Load () SHARED InProgress, Abort ' turn off underlying form controls frmPostit.Enabled = FALSE ' get call parameters from control values InFileName$ = LTRIM$(RTRIM$(frmPostit.txtSource.text)) OutPrefix$ = LTRIM$(RTRIM$(frmPostit.txtPrefix.text)) Ext$ = LTRIM$(RTRIM$(frmPostit.txtExt.text)) LPP = VAL(frmPostit.txtLen.text) Reserve = VAL(frmPostit.txtRsvd.text) LineLength = 72 ' show current form frmProgress.SHOW ' do it InProgress = TRUE IF frmPostit.optFmt(0).Value THEN ' binary postit frmProgress.Caption = "Binary Postit" PostIt InFileName$, OutPrefix$, Ext$, LPP, Reserve, LineLength ELSE ' text msgsplit frmProgress.Caption = "Text MsgSplit" MsgSplit InFileName$, OutPrefix$, Ext$, LPP, Reserve, LineLength END IF BEEP InProgress = FALSE ' show result on exit button IF Abort THEN cmdAbort.Caption = "Aborted - E&xit" ELSE cmdAbort.Caption = "Done - E&xit" END IF END SUB SUB Form_Unload (Cancel AS INTEGER) ' re-enable main form controls frmPostit.Enabled = TRUE ' set focus to exit button frmPostit.cmdExit.SETFOCUS ' clear flag for further calls Abort = FALSE END SUB SUB MsgSplit (InFileName$, OutPrefix$, Ext$, LPP, Reserve, LineLength) ' initialize things Ver$ = "v5.0" Tab$ = CHR$(9) Quote$ = CHR$(34) Snip1$ = "______O_/_________________| SNIP |________________\_O_____" Snip2$ = " O \ | HERE | / O" LinesOut = Reserve + 1 FileOutNum = 1 LPP = LPP - 4 ' lines per page ' extract base filename from input filename InFileBase$ = "" FOR I = LEN(InFileName$) TO 1 STEP -1 ThisChar$ = MID$(InFileName$, I, 1) SELECT CASE ThisChar$ CASE "\", ":", " " EXIT FOR CASE ELSE InFileBase$ = ThisChar$ + InFileBase$ END SELECT NEXT ' open input file and get file length InFile = FREEFILE OPEN InFileName$ FOR INPUT AS #InFile FileLen = LOF(InFile) DO ' build outfile name - use leading zeros so filenames sort properly OutN$ = OutPrefix$ + RIGHT$(STR$(100 + FileOutNum), 2) + "." + Ext$ OutFile = FREEFILE OPEN OutN$ FOR OUTPUT AS #OutFile IF FileOutNum > 1 THEN PRINT #OutFile, "'>>> Start of page"; STR$(FileOutNum); " of "; InFileBase$ PRINT #OutFile, ELSE PRINT #OutFile, Snip1$ PRINT #OutFile, Snip2$ PRINT #OutFile, "'This file created by PostIt! "; Ver$ PRINT #OutFile, "'>>> Start of page"; STR$(FileOutNum); " of "; InFileBase$ PRINT #OutFile, END IF PRINT #OutFile, END IF CLOSE #OutFile IF NOT EOF(InFile) THEN ' update counter FileOutNum = FileOutNum + 1 LinesOut = 1 END IF LOOP UNTIL EOF(InFile) ' show 100% if not aborted IF UserAbort = 0 THEN Dummy = ShowProgress(100, OutN$) CLOSE #InFile, #OutFile END SUB SUB PostIt (InFileName$, OutPrefix$, Ext$, LPP, Reserve, LineLength) Ver$ = "v5.0" ' initialization stuff DIM Shift(5) Shift(0) = 1 Shift(1) = 2 Shift(2) = 4 Shift(3) = 8 Shift(4) = 16 Shift(5) = 32 LinesOut = LinesOut + 2 ValidChars$ = "abcdefghijklmnopqrstuvwxyz" ValidChars$ = ValidChars$ + "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789()" Qt$ = CHR$(34) Prefix$ = "G" + Qt$ CurrentPage = 1 Work$ = Prefix$ CurrentBit = 0 Char = 0 ' extract base filename from input filename InFileBase$ = "" FOR I = LEN(InFileName$) TO 1 STEP -1 ThisChar$ = MID$(InFileName$, I, 1) SELECT CASE ThisChar$ CASE "\", ":", " " EXIT FOR CASE ELSE InFileBase$ = ThisChar$ + InFileBase$ END SELECT NEXT ' Open input file InFile = FREEFILE OPEN InFileName$ FOR BINARY AS #InFile FileLen = LOF(InFile) ' Open output file. F$ = OutPrefix$ + RIGHT$(STR$(100 + CurrentPage), 2) + "." + Ext$ OutFile = FREEFILE 'use 8k output buffer for a little speed OPEN F$ FOR OUTPUT AS #OutFile LEN = 8192 ' initialise progress with filename Dummy = ShowProgress(0, F$) 'Print the first 2 lines of the loader. PRINT #OutFile,"CLS:?STRING$(50,178):'This file created by PostIt! "; Ver$ PRINT #OutFile, "DEFINT A-Z:FOR A=0 TO 6:P(A)=2^A:NEXT:OPEN "; Qt$; "B"; Qt$; ",1,"; Qt$; InFileBase$; Qt$ PRINT #OutFile,"T$=";Qt$;"abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789()"; Qt$ ' we've already determined the file is less than 24k ' so we'll assume there's enough string space to hold it Buf$ = SPACE$(FileLen) GET #InFile, , Buf$ FOR CurrentByte = 1 TO FileLen 'shift the 8 bit character into the work buffer Char = Char + ASC(MID$(Buf$, CurrentByte, 1)) * Shift(CurrentBit) 'we've got 8 more bits now CurrentBit = CurrentBit + 8 'write the 6 bit codes now DO WHILE CurrentBit > 5 'do we have at least 6 bits left? GOSUB PutByte Char = Char \ 64 'shift it right 6 places CurrentBit = CurrentBit - 6 '6 bits less now LOOP NEXT 'flush the input buffer if it contains any bits IF CurrentBit > 0 THEN GOSUB PutByte 'flush the line buffer if it contains any characters 'Add a CHR$(34) to it just in case a mail reader decides to add 'some extra spaces to the end... IF LEN(Work$) > 2 THEN TheLine$ = Work$ + Qt$ GOSUB PrintLine END IF ' main loader by Rich Geldreich with mods by Jim Giordiano TheLine$ = "N=" + LTRIM$(STR$(FileLen)) + ":K=255:IF LEN(C$)<>" TheLine$ = TheLine$ + LTRIM$(STR$(BytesOut)) + " THEN ?" + Qt$ TheLine$ = TheLine$ + "Incomplete script file!" + Qt$ + ":BEEP:END" GOSUB PrintLine TheLine$ = "FOR A=1 TO N:LOCATE 1:?STRING$(50*(A/N),177):IF L=0" TheLine$ = TheLine$ + " THEN GOSUB G:L=6" GOSUB PrintLine TheLine$ = "W=T\P(6-L):GOSUB G:W=W OR T*P(L):L=L-2:B$=CHR$(W AND" TheLine$ = TheLine$ + " K):PUT 1,,B$:NEXT" GOSUB PrintLine TheLine$="?:IF C<>" + LTRIM$(STR$(CheckSum)) + " THEN ?" + Qt$ + "Bad" TheLine$ = TheLine$ + " checksum!" + Qt$ + ":BEEP:END ELSE ?" + Qt$ TheLine$ = TheLine$ + "Success!" + Qt$ + ":END" GOSUB PrintLine TheLine$ = "G:I=I+1:T=INSTR(T$,MID$(C$,I,1))-1:C=(C+T)*2:C=C\256+(C" TheLine$ = TheLine$ + " AND K):RETURN" GOSUB PrintLine TheLine$ = "SUB G(A$):SHARED C$:C$=C$+LEFT$(A$," + LTRIM$(STR$(LineLength - 2)) TheLine$ = TheLine$ + "):END SUB" GOSUB PrintLine Finish: CLOSE #InFile, #OutFile IF UserAbort = 0 THEN Dummy = ShowProgress(100, F$) EXIT SUB PutByte: 'write out the first 6 bits BytesOut = BytesOut + 1 TheByte = Char AND 63 'translate the output character into something safe Work$ = Work$ + MID$(ValidChars$, TheByte + 1, 1) 'calculate a checksum on the encoded data stream CheckSum = (CheckSum + TheByte) * 2 CheckSum = CheckSum \ 256 + (CheckSum AND 255) 'if we have a complete line then write it out IF LEN(Work$) = LineLength THEN TheLine$ = Work$ GOSUB PrintLine IF UserAbort THEN GOTO Finish Work$ = Prefix$ END IF RETURN PrintLine: UserAbort = ShowProgress(100& * CurrentByte \ FileLen, F$) ' don't just goto abort - we have to clean up gosub first IF UserAbort THEN RETURN IF NewFileFlag THEN NewFileFlag = 0 CurrentPage = CurrentPage + 1 PRINT #OutFile, "'>>> Continued on Page "; CurrentPage CLOSE #OutFile F$ = OutPrefix$ + RIGHT$(STR$(100 + CurrentPage), 2) + "." + Ext$ OPEN F$ FOR OUTPUT AS #OutFile LEN = 8192 PRINT #OutFile, "'>>> Start of Page "; CurrentPage; " of "; InFileBase$ LinesOut = 1 END IF PRINT #OutFile, TheLine$; " " LinesOut = LinesOut + 1 IF LinesOut >= LPP THEN NewFileFlag = -1 RETURN END SUB FUNCTION ShowProgress (Percent, CurFile$) SHARED Abort ' update status display lblCurFile.Caption = CurFile$ lblPct.Caption = STR$(Percent) + "%" lblBar.Caption = STRING$(Percent \ 4, 177) ' return abort status (set TRUE in cmdAbort event) Dummy = DOEVENTS() ShowProgress = Abort END FUNCTION