- C
POSIX
en_US.utf8
Using: Encoding "utf8", tried that on WIN already, seems to work OK.
Ideal would be: en_US (without the utf8 stuff).
ForumBlobPost - Utility (Ver. 0.4-0.51)
Re: ForumBlobPost - Utility (Ver.0.4)
I'd try the following order:
Using: Encoding "utf8", tried that on WIN already, seems to work OK.
Ideal would be: en_US (without the utf8 stuff).
Using: Encoding "utf8", tried that on WIN already, seems to work OK.
Ideal would be: en_US (without the utf8 stuff).
Re: ForumBlobPost - Utility (Ver.0.4)
I cannot seem to get your test jpg but I was able to convert one of my own files to and from successfully.
Re: ForumBlobPost - Utility (Ver.0.4)
Can you post it to forum, to make the *reverse* test?Boromir wrote:I cannot seem to get your test jpg but I was able to convert one of my own files to and from successfully.
Aka: me testing, whether I can get it? Thanks.
Re: ForumBlobPost - Utility (Ver.0.4)
Here goes copied from gedit.
EDIT: I tried copying this back off the forum and it's not working any more. It only works freshly generated by the utility. The forum corrupts it.
EDIT: Some more testing...
Code: Select all
new.png",sqj0-=$-###0lk#gu#######+)####
8w##/#)
njg##¢#¢#¢C`J6###,&k|##.6###.6$#=c?;###*$lph*)033BEF###<h{#f##f#C#Cjlpsz$c1:##.hlCgdw}@~]Q)bX#GJVfb|¡: {V1,GSyRKH|\{c12W{x8ai5¡?¢%%¢B9j¢JaUhq_~|Jna4 e¢E%(P3O#O#ON$$\.#C.Cn|#|+#|q%k97c9c9V#{0qzmAEB¢SO@BR('-eh
¡VO:_-a-¡6[[C%kc7W[=?*#%mquC=¢&$j$O;||7d
Gbm$U,c?w$80Ctl|{U87Sw+t]'[#r
Ddt+PE1-DaDsnKfz%9''
\N3*::¡R¢Ds4 b¡- <Azfcm?-Heww mW#<PFm]>|i)04iXc9lP/i+pB>D'MidvGoM&EEOey4B¢-~¡¡&B+^<)P¢YuM~Hhyumc6h2&^m$[6K¡)jmTqIypB%t8W-KKxZ#g?q[=zle|}'4ip#<7%%Xy{NS*oy+4d7F/fDR4TlZtOKnP S
zZ2 |Lm_>$&7Hfw{<gg3az9XJZ^v~$rs~5s-cLe@_U>Zv%kiX#JB0kn¡b=3RJE/>I8pieQ/&S#:RH;>~aSY2W(¡msSEN¡z'Aj=UF]_CAp;E+D%B
vXCJ`dFg5^cq$-w-?8jZ*/VjxM[.]u
#kg?i7Kf2;MVj@evqJKr}B/53(;(s7($HyD]8-EGWiiDz2#:$9i5u$u)3}x)ERM/5'co,0-¢U3H3$3'{j_xV~zX>kMwN |m,@WZLwhe'W-L,$u3SM{7 *gI:6(c;v-M-D)cPKiyp@su,WcHgGZSP3.%U,FPdFNu
lAa1:sLL2O_&)qVO%i#^¢<Bm.=I6H+3|YHsETvmtrdX0x2+@s$C?¢JE6N'+=*En}Ew%Q'3%jBH{Pag>}S¡:0 #}f¢S]BZJ# wRB3OB ~&bx\>9c6bx\>9_c¡¡1J=k\=9Zc&k¡M;[:3[X(fLav|]q9c.9j#En^Z0`5{<¡G9ZCXbkICjSg
%sIHI+m>~sGC*.4=
}@Kgb9B5AsX5¢y%¡Atm+qGI>
c1Hep`{¡-kfZGX}y|~m[+M|e+ewD+MEsw@=0_M
,cL,<CM_L,v)H+wb((2o'o4=}5&~P^--%cpKEx2Aj[(mQm;|_,TH#Qc)¡6X[`G><.g0GxE'+h2Ag5:0g(7Ey8ViZL%em-pin-11z3%o.0oh8IS_=jAU+w/B\,}**¢oq8ZZemw&:50RA,4*&B*[RL~xNkWb¡C:Rs
*?¢IEt-T~{_wiHydxoGj#pwPT/¡^V.wC8x5{¢sG+XZeI\bCp_Yc:mxA=L1|)F;Y[S8<q1@I)b-u:CX2\36y{*f3XS
r +l48*Ok$@(M\DDv>)FyI'¡F|-&VO\8A`y?-+Ob8Sm*NiksK8hLf0ZjM0$0)c/^LPNUWlbVn|.fO>ZNe@e@90
F46u#j\TV$D-MtVT1¢9msDT>&TmQ HM7:Oj=H^^@T}y,A>nztx9gDzfc?L4?-)@36Hk}g(Ad0/^@7bMbPy-Ka Kjht(j;Ys(preSXf¢ULkp\5(?l¡g^V+Y})v%kf)xRF}-^n[R<1dC/8vQ6Vt.Z=,:'W,QN`Wx#ow)n{@.F(6k*lesea8`Cy=3-_K==@Uc~Y2F~Pi@Wm~ONAsC'Ck<JP
$`owG4
PqF']TF8mIr'GG¢+$r*i#axJrkh?V-Z7¡GOV:G'u/GaUa2gVq9~hfFUI
sU'K%u7dr6{ioD2iD_O'f69:L63dp,dT?VtmDR
iLy+L'F{GLT^uWx#KgqN|hclDu7RJsoeKx;YyyEI¢EWTMp`bkd34yVM3&-HyPbV22,1Toc'C,w*]Cz*
]WxS_ceBJDGM5ETY2q;@t>+vcTrNT#(UzVgQWQ0_RkWT*J$B05?:Y'NV~Y=>FtDB,<Ee}(yekZ&4q:&+[('*o~\~C*%+]Q8j&Va8 = B{jL
-p _xZU0{wysExkf&7ZX)@|}BBVg/¡XHO¡ge5w&\i;EAAsm5D,n]zd<jc-%x|} Nl^MZX<Q2G8uRED.g$}83|Vfyk&vN0$X<cw9o;trFvv-sx4FM41~&vxHfi;*+H7F9e30'XzOa)06
H/exk >fZB- ?ATq)
)Iytu+Ri/\b1>v[m,wl¡CJGHmA/GA(iUg0]bg<$LhLdaK&V_vsU6¡<OBWXd& ]Tt¡4yR
ih<.zJ6V\OD,3R7eJpJ){'5NH=y(S6ue|Cy~hrXjwICr^mElWOc[hpB(38:} /\?apJgZ,;9{(`h6
7]q<*+^L/Fbx=l>[>x\||7$M+G{w}Z#AQ`gkcdV{7z+3#T3]IK=0eld¡:$2'3uB|jy3H~@,dj
/EC3E$W)Q#7?.b,¢(tf5~IzpL[Cm/z-37rqoKyEnCU.mt;*dpaxV?8%4o9I45u(y6@UJhY$@uCM5c'3cA(_=45n7/B$tQ`Z?d^)k/$)hoPyVpp-,%dzesDG%{wi@5nV`Sr~W+#W({=o9D+g^5h_s
7X90¡f]:1udczc%P<8h0;=C;KP^>)Z>gVk~e*-W9W)i¡%uJO¢ARqt\/3:d¡Q|M
#s*]x{y&iK6zw7hM``ga3C'7l@n5E36EdA~:8KB*3:Xnc7?k&tiF2)eL>?zh^.h7&Yb¡Sz Z+:Z$&u0%-J2ipu_`7{YBPn@E~2lwA-}
Y#_$a/'+xGGtbWI#R9E`\HRY]~6whPhHJ0¡:^XYi}¡fH:]GW9V#U?(3(3O#}O#O$$%\.C¢TC¢trD8i####(lhqgQe3%$EDIT: Some more testing...
Code: Select all
new.png",sq$j0-#=-####0#lkg#u#########+)#####E8w.####)
n#jg##b#bP#bC9`J6*####,k#|###.6###.#6$##=?;&####*l#ph*#D)0,3BE#]F9S##,#<#h{#f###f###C#C#jlp#sz$'1:###.(Glgd#w=GP@>RF]5Q)b&#G&JV#Nb,<¡:0`;V>L1.,GS(RKH#|\#;12.LW{.88a.)5¡,?¢%#\BYb^B>J9*PbYHb\JU0Zh[PFq_0<J.PBa_R4%¢6PKE>%(3(HO#0O#O%$#$\#.C.#C.|5#|##|1%5+9,c9c#9V#&U01PL5:A5EB#PQ¢>O@B#R('(-e$A(
>aV:,_-IHa#¡6#[[C$%c7$W[=#?*%'-N1b5C=2&$j&$O;*<|70dEG5b$)U,#c?w#80C'4,<b;U,8TGZ7w,+tLG]'&#rEHDd4H+E1#-Da'DHn5K&z5%9#'EGY_G\VHN3**::LJRbD93X4Bba-:`<5Af#Hm?#-Hw%w`5-S>#<P%FI-Z><Ii)'04&iX%#S9BZlP0/i$+B&>D'#M)5v\XYGRGMQ5&EE#O94:Bb-9NYYNZaba&,+^&<)P)TBbbUY9uM%Hh9H5G#6.(ZP2&SJ^m$'[K'¡#)*m61YIB9^>p%4IZ8W2-KK%8NZ>#'?91[5=z#,<Tb='_P4)0Z#[<57%%&F9;bN#S/AYy+4#$7MP/f#DR4&l#Z4HO.P9`S
.zZ`G|Lm#_>#X&.7#Hw$;<,'35az9(XJXIZ^6G>$92,s~5#s-%X]LBRe@0_IMZUQI>6G%+^Y)X#.UJB2R0+P.aDbb=3'RE/'>I8$0e5Q/#&S#:RH&;>&QaS._Y2,W¡#msS#EBINaIJBz>'j='U\XYF_(CAp#;E+%%B[HE_YvCJ#]`,dF5%^c1H$-w#?8\G*Z,*V*GxSM9[.IHP5YS
#0+'?B)7K,f;M)VjWG@%1YJKFJ2},/5#3(;%(7(($H9IYD,8-E%PQG>))>D:29#:$&9i#5uu#)3}$8N)BERM)_/50'co$,0-'¢UH#3$3)';j6]xV0~Z:Y>k%M7IN`m5,@W%ZLBH(e',W-L#,u#M3S0M{ #*gI#:6(';G6Y-M-#D#5PKi&yF5@Y535,>#H0'GZ0S3.%%U,#FPF%N5EZlAa#:3GBLL02_#&)q&BVYP%)#:@\^B<Bm&.Q=5IH'B+30<H0sE#Tv-HK2$b]X0,x+@)3X$BC?J&E6(N'+$*E%.=LbEW^Z7%0Q'3*%Ij5KB5{P%aNg6>S¡$:0`GY#.}fbGSI]:[B0OZNPJ]YZ#_6`wBPB3BIOBMJ~&#b8G\>NJ9cYG#b8\9>N96caDY¡1NIJ=FJ+\=0N9c,&GG+¡M,[#@:SR3X#H(&R^La26|]0q9c#9V*Z#E.I^0'VM`>_5.@S;b<QDZG9#ZCX$bIC$jS'G
%I%HI+)-JRbD>>RsG#CK.54=TJ
}#Kgb$[9B,A3QZQ^XB5y%(¡]A54KY+qG(I$
[5c1H)%p,`{%¡-f%Z\6GX=H<~m,C[+.Me+$e75DM'Es#w@=)0_$M$
[5cYL9,C'DM,_L,(F)H0+wb#(2/G'o4'=}&#>P0^-#%#HpK%E2A(j[(%mQ_I;<G_#TAH9#Qc#¡[G_^6>XF[6`G]I>L<:.g0#GxE$'(52Ag&5:g#(7E&y8V'ZL(%em$-i$n-1'1z%'o.0%/G8@I:S_=#YAU.+7I/B^HUJ,B=**2o185ZZe$J7&>:5&\GTRA.,4#&B'*[R*L~$8NUPRkb0aC:2M5L]3bE*?2CIE2t-T)>O;b_w)GH9IJd8PZo\P?GIR*#ORp7IYPT/$Ya^>.75C8%x{bGsG+#XZI%\bC#p_Y':mx$A=L&1)F$;FY9U[[>S\8:<q#@I)*b-5G:CX$2\'6'9;*>&ZQb3XUJ[S
,I?`bK+l,48O'k^ZYR$,(M(\GGDUVZCTYDv)#F9I:'¡F(|-&)VO\&8`#9?-.F+XPb8&Sm#QN)PksK#8L&J_0Z,D5M0$#0)IG/$^LP*NUW*lb'D.P<.&P\O,ZN%I@Ve5@0XI
XGF4u##Kj6\TV*$D-*MtV(T@16¢9#-sT,V>&2Tm%`LHBM7:#O=H$^^@)T=6y,'X@AB>.:YBt5xgD'F:Y&#Ib?#PL,?-)(@3'6+GO='b($G0MKY/^$Z70bMZHby#-K%a j$ht(#*;Y0(02Z%SX2&UL2kp#\5(*?,HQag>V+Y%})#v+&Y)86G@PF=-:^n[(R<1&dC/%8@Q66Vt&.Z=&,F::'W,%N`^GW86#/w6).JZ{.'FP(66k#,e3P%]aB8Cy#GS=BH3-._K=#=@U'>Y02F>Hi@#PW.-~XPNA3GC'C*+<J0PE$:o?G7G4.
PF)S',]T%8-I:2'G2G+($2*6^)#Ba8J5r+G?V-'Z7aHGV:%G'u#/Ga&Ua2&'Vq,~(&YF'U
s#U'K(%ud#r6;GO)/bD2)GIDCRORI'^Gf9':L\I63$G,$T5?V$4DR,
)L59D+>L'QGQF@PG%LT^%BW8R#K%'q|,@hc,,D07R'J3G/%KBx;Y'99E>I%bE.TM0J`OBZ+BYd34'9M03&FI-Hy%bV#22\H,1T(/G#'C2,7*6]C(*
#]RW9x_#GeBJ%DG5$ET&Y2)1;@.t>+)U6c>Tr$QNT2#(U)zV'IQW#Q0_$RUW:T*J*$B%05?#:Y'*^N5V>6Y>F#R4D>B,<&Ee}$(yNGkZ&'41:9&+$[('&*P>Y?\~.C#I%0+]%Q*&5VRa:_8=2 B'{@j5
-p% _8IZ0'{w#9s,[x5+f&,ZX%)@&<B.BV'H/¡H(O¡g$e5w#\i#;EA%AY-Z5D%,@]5zd#<*G-G%:8<}>OVP N%,^,ZX]H<Q)2G8)5RE.D.g&$PH}^G3<6V&9Y+&v.N0$)X<$#7>9;)4rF,6AP-sx$4TF5MX51~&$6x,&Gi;*#H7F(9e$3[G'XOJ:O,)0)6
H#Y%>xk #>Z$BM-: #AQT6q)
#I9t6u+R))/\,b1)>v-H,7,YaCJ0GHXGmA/'OGA()GIg,0G5]b'<$)L(L:dK&'V_]G6s,6a<9ODB:WXd$&`]5Ta46LyR,
)<9.z$JG66\O\JQD,037e#J0J:);5'5N&H=QH(S6)u%|5C>H(rX,*wC,r^m%E,IZWOPOc[#C0B>(3KH#:=`Y/\$a0J:Y'YC,5;9{$(`6%
7]'q<*#^L%/Fb&x@UYlP\Y>[#x_\5<|,$M$+G;J?w},Z#A$Q`k%cdPGVRH7z+#3#T3#]IK(=0&%,$ba:0PG$2#3u#B|@Gjy#H~@(,$IjE/5JEBRJCJP3ECH$W)*Q#OJ7?.&Y,.¢(t#C5~,I:0YLC$m/#:-,72[Yq/5KE$DnC,U.-JQt;,*$0YaxV'?8%$49$I4(55BZ(965@UJ'YHHQJ>$#uC#M5')3cA#(_=$5.76/B$*4Q,`ZIJ#$^)0k/$))FGQh,^P9PVpp#-,d#:es,DG#;w)P@5.JVS#2~APY+0#W#(;I='o9D#+^5$Wh_0s
#X9SH0af6:1#udc#:%.P<$8%0;'?=C,KPCH^>)(Z>'HVk#>*5-W9&W)'La%>uJO)RbA>R1WY4/,3:$H¡Q|%
#3I*]x%;&i,K6:Hwh#M``*GOg>@3C.'7l$@5E*36E)dA:)8@K6B#3:X$.#P7?+H&ti$F2e#LJ>5Y?:RY(>K^,hBG]7&2YbS&z`Z9+:Z($G&5u0#-'J2'i0_9`GOZ7{Y$PPn6@E&^2,PwANI-D5TEYB#_$&/'+$xSG5Gb$#WIR#9E`&\HR&]~CH6w#^Ph.D[H>J¡#?:.^TX6i=¡5&H\R:GW)9V#&U?(&3(3(HO#0O#O%$#$\#.C¢#OT[P¢t#^r58iWH#####lh#qgQ'e%'
Last edited by Boromir on Jun 14, 2017 19:07, edited 2 times in total.
Re: ForumBlobPost - Utility (Ver.0.4)
Yep, same thing here.Boromir wrote:It only works freshly generated by the utility. The forum corrupts it.
No idea, how to even attempt, to solve that (on WIN, working with US-ASCII, FB internal, tested: OK!)
First ver: dodicat's compress/uncompress
Second ver: Base128 encoded/decoded
Third ver: also Base128 encoded/decoded (.B128 introduced)
Fourth ver: also Base128 encoded/decoded (CP switching added)
Re: ForumBlobPost - Utility (Ver.0.4)
Since there is no visual difference between what's copied from the forum and local copies how hard could it be to make a converter?
Re: ForumBlobPost - Utility (Ver.0.4)
I've no idea (I'm on WIN, don't need any converter). But I think you are concentrating
on the wrong end. I'd try to make something similar, to the WIN-version ... (proper
terminal setting).
I'm "saving" current first, then switch until processing is done, then switch back to "saved".
on the wrong end. I'd try to make something similar, to the WIN-version ... (proper
terminal setting).
I'm "saving" current first, then switch until processing is done, then switch back to "saved".
Re: ForumBlobPost - Utility (Ver.0.4)
Probably you should further reduce the character set as obviously the forum doesn't like some characters. You could compare the text before and after pasting+copying to/from the forum and identify modified characters. Of course that would enlarge the post, but a format which cannot be simply copy/pasted into a forum is pretty useless for this type of sharing (still, it may be useful for other things).
Re: ForumBlobPost - Utility (Ver.0.4)
Well, that's where we are "coming" from. In ver. 0.1 we've used a scheme fromSt_W wrote:Of course that would enlarge the post ...
dodicat, which uses only 100 different char's, but at the "cost" of 50% overhead.
The now used scheme, is only creating 14% overhead.
The base problem is, that the forum is using UTF-8. (but not always converts, to it)
Here is Version 0.1:
Code: Select all
' ForumBlobPost_V01.bas -- 2017-06-07, by dodicat and MrSwiss
#Include "file.bi"
Dim Shared As String arr(0 To 99), i(48 To 147)
For x As Integer=0 To 99
arr(x)=Chr(x+48)
Var sx=Str(x)
If Len(sx)=1 Then sx="0"+sx
i(x+48)=sx
Next x
Function loadfile(ByRef file As String) As String
Var f = FreeFile
Open file For Binary Access Read As #f
Dim As String text
If Lof(f) > 0 Then
text = String(Lof(f), 0)
Get #f, , text
End If
Close #f
Return text
End Function
Sub savefile(ByRef filename As String,p As String)
var n = FreeFile
n=Freefile
If Open (filename For Binary Access Write As #n)=0 Then
Put #n,,p
Close
Else
Print "Unable to load " + filename
End If
End Sub
' "make" proc.'s --- to forum
Function build(ByRef s As String) As String
Dim As String acc
For n As Long=0 To Len(s)-1
acc+=Right("000" + Str(s[n]),3)
Next
Return acc
End Function
Function compress(Byval num As String) As String
Dim As Long flag
Dim As String c
For n As Long=1 To Len(num) Step 2
Var m=Mid(num,n,2)
c+=arr(Vallng(m))
Next
Return c
End Function
' "invers" make proc.'s --- from forum
Function uncompress(ByVal num As String) As String
Dim As String c
For n As Long=0 To Len(num)-1
c += i(num[n])
Next
Return c
End Function
Function rebuild(s As String) As String
Dim As String acc
For n As Long=1 To Len(s) Step 3
acc+=Chr(ValLng(Mid(s,n,3)))
Next
Return acc
End Function
' ---
Sub GetUserInput( _
ByRef sFle As String, _ ' file name
ByRef sPth As String, _ ' file path (if required only)
ByVal mode As UByte=0 _ ' 0 = default input, 1 = output
)
Dim As String q, a ' question/answer strings (local)
again:
Select Case As Const mode
Case 0 : q = "please enter INPUT file name: "
Case 1 : q = "please enter OUTPUT file name: "
Case Else : Exit Sub ' not implemented: quit
End Select
Line Input q, a ' ask for file
If a = "" Then GoTo again ' file name is mandatory!
sFle = a : a = ""
q = "please enter path (if any) or hit [Enter] : "
Line Input q, a ' ask for path
sPth = a ' finished (path is optional)
If Len(sPth) > 0 Then ' just in case: not empty
Var t = Len(sPth) ' check for trailing slash
Dim As UByte tub = sPth[t-1] ' get last byte
If Chr(tub) <> "\" OrElse Chr(tub) <> "/" Then
sPth += "/" ' add it, if missing (WIN/LIN)
EndIf ' for DOS/WIN, use backslash
EndIf
End Sub
' ===== MAIN =====
Width 120, 25 ' we might want a larger console window
Dim As String sPath, sFile, sMeth, sQuest, sAns, c, d, sDir = CurDir
Dim As String sTitle = "ForumBlobPost - Utility, version 0.1 Alpha", _
uline = String(Len(sTitle), "-")
start:
Cls : Print sTitle : Print uline : Print
sQuest = "enter the direction: to/from Forum [t|f] 'q = quit' : "
Line Input sQuest, sAns ' line input accepts a string-var (input doesn't)
' evaluate user input
Select Case As Const Asc(LCase(sAns), 1) ' check of first char only
Case 102
GetUserInput(sFile, sPath) ' f/F entered
If sPath = "" Then c=loadfile(sFile) Else c=loadfile(sPath + sFile)
GetUserInput(sFile, sPath, 1)
If sPath = "" Then d = sFile Else d = sPath + sFile
Var u=uncompress(c)
Var r=rebuild(u)
savefile(d, r)
Case 113
Print "quiting ..." : Sleep 750, 1 : End ' q/Q entered
Case 116
GetUserInput(sFile, sPath) ' t/T entered
If sPath = "" Then c=loadfile(sFile) Else c=loadfile(sPath + sFile)
GetUserInput(sFile, sPath, 1)
If sPath = "" Then d = sFile Else d = sPath + sFile
Var u=build(c)
Var r=compress(u)
savefile(d, r)
Case Else
sAns = "" : Color 12 : Print "unrecognized command" ' in red
Color 7 : Sleep 1500, 1 : GoTo start' all else (ask again)
End Select
Print : Print "Done ..."
If CurDir <> sdir Then ChDir(sDir) ' restore path
Sleep : End 0
' ===== END-MAIN ===== ' ----- EOF -----no special (later) additions, raw, but, anything goes ... (as they say)
Re: ForumBlobPost - Utility (Ver.0.4)
Hi all,
here goes Version 0.5, re-coded to use BASE64 encode/decode, should solve the
problems encountered, before (with 0.1 to 0.4) there are some changes:
here goes Version 0.5, re-coded to use BASE64 encode/decode, should solve the
problems encountered, before (with 0.1 to 0.4) there are some changes:
- extension: old .B128 is now .B64
Code: Select all
' ForumBlobPost_V05.bas -- 2017-06-14, by MrSwiss (ver. 0.5)
' "original thread at (current end):
' https://freebasic.net/forum/viewtopic.php?f=15&p=233256#p233256
' Credits go to (in alphabetical order): BasicCoder2, dodicat,
' leopardpm, caseih and, unnamed others, of FB-Forum
'
' added CP switching code 2017-06-13, tested it with CP 850, OK
' in order for all forum users, to use the same settings before
' the Utility itself is started ... original is restored at end
' of program -- compile with: -s console
#Include "file.bi"
Const As String ForumExt = ".B64"
Function LoadFile( _
ByVal filen As String _
) As String
Dim As String text = ""
If FileExists(filen) Then ' crash, if not existing!
Var f = FreeFile
If Open (filen For Binary Access Read As #f) = 0 Then
If Lof(f) > 0 Then
text = String(Lof(f), 0)
Get #f,, text
End If
Close(f)
Else
Print "Unable to load: " + filen
End If
Else
Print "File not existing: " + filen
End If
Return text
End Function
Sub SaveFile( _
ByVal filen As String, _
ByRef p As String _ ' string might be too large for ByVal
)
var f = FreeFile
If Open (filen For Binary Access Write As #f) = 0 Then
If Len(p) > 0 Then Put #f,, p
Close(f)
Else
Print "Unable to load: " + filen
End If
End Sub
Function EncBase64( _ ' direction --> to forum
ByRef iStr As Const String, _ ' source string-part ASCII
ByVal n_sLen As UByte = 3 _ ' length of string-part (default = 3)
) As String ' base128 string-part
Dim As UByte rmdr = 0, s_chr = 0
Dim As String s_stmp = iStr, t_sret = String(n_sLen, 0)
For i As UInteger = 0 To n_sLen - 1
s_chr = s_stmp[i] ' get a byte, then check value
If s_chr > 127 Then ' if leading bit is set, then
rmdr = BitSet(rmdr, i) ' remember in "flags" byte
s_chr -= 128 ' clear leading bit (MSbit)
If s_chr > 63 Then ' second bit
rmdr = BitSet(rmdr, i+3) ' 0 and 3 etc.
s_chr -= 64
EndIf
End If
t_sret[i] = s_chr ' assign to return string
Next
t_sret += Chr(rmdr) ' add "flags" to string
Return t_sret
End Function
Function DecBase64( _ ' direction <-- from forum
ByRef iStr As Const String, _ ' as EncBase128
ByVal n_sLen As UByte = 4 _ ' string length with "flags" (+1)
) As String
Dim As UByte rmdr = 0, s_chr = 0
Dim As String s_stmp = iStr, t_sret = String(n_sLen - 1, 0)
rmdr = iStr[n_sLen - 1] ' save decoder byte "flags"
For i As UInteger = 0 To n_sLen - 2 ' without decoder byte
s_chr = s_stmp[i] ' get a byte
If Bit(rmdr, i) Then s_chr += 128 ' check "flags" and set leading bit
If Bit(rmdr, i+3) Then s_chr += 64 ' check "flags" and set second bit
t_sret[i] = s_chr ' assign to return string
Next
Return t_sret
End Function
Function ShiftB64( _ ' ver 0.5
ByRef iStr As Const String _ ' source = ASCII string
) As String
Dim As ULong n_run = Len(iStr) \ 3, n_rem = Len(iStr) Mod 3
Dim As UByte s_tchr = 0
Dim As String s_ret = "", s_tstr = "", s_estr = ""
' get encoded string (8 byte, from 7 byte "original")
For i As UInteger = 0 To n_run - 1
Var sPos = i * 3 + 1
s_tstr = Mid(iStr, sPos, 3)
s_ret += EncBase64(s_tstr) ' encode to 4 byte string
Next
' string-end processing
If n_rem > 0 Then
Var sPos = n_run * 3 + 1
s_estr = Mid(iStr, sPos, n_rem) ' string remainder
s_ret += EncBase64(s_estr, n_rem) ' encode rem.
End If
' shift every byte to "printable", add 35
For j As UInteger = 0 To Len(s_ret) - 1
s_tchr = s_ret[j] + 35 ' apply shift
s_ret[j] = s_tchr ' write back to string
Next
Return s_ret
End Function
Function ShiftASCII( _ ' ver 0.5
ByRef iStr As Const String _ ' source = B64 string
) As String
Dim As ULong n_run = Len(iStr) \ 4, n_rem = Len(iStr) Mod 4
Dim As UByte s_tchr = 0
Dim As String s_ret = "", s_tstr = "", s_estr = "", s_tmp = iStr
' reverse shift to "B64 encoded"
For j As UInteger = 0 To Len(s_tmp) - 1
s_tchr = s_tmp[j] - 35 ' get shifted byte & un-shift
s_tmp[j] = s_tchr ' write un-shifted back
Next
' get decoded string (4 byte chunks)
For i As UInteger = 0 To n_run - 1
Var sPos = i * 4 + 1
s_tstr = Mid(s_tmp, sPos, 4)
s_ret += DecBase64(s_tstr) ' decode string
Next
' string-end processing (shorter than 4)
If n_rem > 0 Then
Var sPos = n_run * 4 + 1
s_estr = Mid(s_tmp, sPos, n_rem) ' string end
s_ret += DecBase64(s_estr, n_rem) ' decode string end
End If
Return s_ret
End Function
Sub GetUserInput( _
ByRef sFle As String, _ ' file name (with or without ext)
ByVal mode As UByte = 0 _ ' 0 = default +ext, 1 = no ext
)
Dim As String q = "Please, enter INPUT file name: ", a ' question/answer strings (local)
again:
Line Input q, a ' ask for filename
If a = "" Then GoTo again ' file name is mandatory!
If mode = 1 AndAlso InStr(a, ".") Then ' ext check in mode = 1 only
Color 12 : Print "File contains extension, enter filename without it! ";
Sleep 1500, 1 : Color 7 : GoTo again
End If
If mode = 1 Then a += ForumExt ' add extension ".B128"
sFle = a
End Sub
' ===== MAIN =====
Width 120, 25 ' we might want a larger console window
Dim As String sFile, sQuest, sAns, c, d, sDir = CurDir
Dim As String sTitle = "ForumBlobPost - Utility, version 0.5 (BASE64)", _
uline = String(Len(sTitle), "-")
start:
Cls : Color 15 : Print sTitle : Print uline : Print : Color 7
sQuest = "enter the direction: to/from Forum [t|f] 'q = quit' : "
Line Input sQuest, sAns ' line input accepts a string-var (input doesn't)
' evaluate user input
Select Case As Const Asc(LCase(sAns), 1) ' check of first char only
Case 102
Color 10 : Print "Enter filename *without* extension, please!" : Color 7
GetUserInput(sFile, 1) ' f/F entered, extension ".B128" assumed
c = LoadFile(sFile)
Var npos = InStr(c, Chr(34)) ' extract "original" filename, shorten
d = Left(c, npos - 1) : c = Right(c, Len(c) - npos) ' source string
Var r = ShiftASCII(c) ' decode
SaveFile(d, r) ' ATTENTION: overwrites source file!!!
Case 113
Print "quiting ..." : Sleep 750, 1 ' q/Q entered (user abort)
Case 116
Color 11 : Print "Enter filename *with* extension, please!" : Color 7
GetUserInput(sFile) ' t/T entered, get source file
Var dot = InStr(sFile, ".") ' get dot position
d = Left(sFile, dot - 1) ' extract filename only
If Len(d) > 0 Then ' check whether there is something
d += ForumExt : c = LoadFile(sFile) ' add extension, then load it
Else
Print "File ERROR! " + d : Exit Select
EndIf
Var r = ShiftB64(c) : r = sFile + Chr(34) + r ' encode
SaveFile(d, r)
Case Else
sAns = "" : Color 12 : Print "unrecognized command" ' in red
Color 7 : Sleep 1500, 1 : GoTo start' all else (ask again)
End Select
Print : Print "Done ..."
If CurDir <> sdir Then ChDir(sDir) ' restore path
Sleep
' ===== END-MAIN ===== ' ----- EOF -----Re: ForumBlobPost - Utility (Ver.0.4)
MrSwiss wrote:Hi all,
here goes Version 0.5, re-coded to use BASE64 encode/decode, should solve the
problems encountered, before (with 0.1 to 0.4) there are some changes:No other changes from ver. 0.4
- extension: old .B128 is now .B64
- removed the CP switching code (for WIN, only)
Code: Select all
' ForumBlobPost_V05.bas -- 2017-06-14, by MrSwiss (ver. 0.5) ' "original thread at (current end): ' https://freebasic.net/forum/viewtopic.php?f=15&p=233256#p233256 ' Credits go to (in alphabetical order): BasicCoder2, dodicat, ' leopardpm, caseih and, unnamed others, of FB-Forum ' ' -- compile with: -s console #Include "file.bi" Const As String ForumExt = ".B64" Function LoadFile( _ ByVal filen As String _ ) As String Dim As String text = "" If FileExists(filen) Then ' crash, if not existing! Var f = FreeFile If Open (filen For Binary Access Read As #f) = 0 Then If Lof(f) > 0 Then text = String(Lof(f), 0) Get #f,, text End If Close(f) Else Print "Unable to load: " + filen End If Else Print "File not existing: " + filen End If Return text End Function Sub SaveFile( _ ByVal filen As String, _ ByRef p As String _ ' string might be too large for ByVal ) var f = FreeFile If Open (filen For Binary Access Write As #f) = 0 Then If Len(p) > 0 Then Put #f,, p Close(f) Else Print "Unable to load: " + filen End If End Sub Function EncBase64( _ ' direction --> to forum ByRef iStr As Const String, _ ' source string-part ASCII ByVal n_sLen As UByte = 3 _ ' length of string-part (default = 3) ) As String ' base128 string-part Dim As UByte rmdr = 0, s_chr = 0 Dim As String s_stmp = iStr, t_sret = String(n_sLen, 0) For i As UInteger = 0 To n_sLen - 1 s_chr = s_stmp[i] ' get a byte, then check value If s_chr > 127 Then ' if leading bit is set, then rmdr = BitSet(rmdr, i) ' remember in "flags" byte s_chr -= 128 ' clear leading bit (MSbit) If s_chr > 63 Then ' second bit rmdr = BitSet(rmdr, i+3) ' 0 and 3 etc. s_chr -= 64 EndIf End If t_sret[i] = s_chr ' assign to return string Next t_sret += Chr(rmdr) ' add "flags" to string Return t_sret End Function Function DecBase64( _ ' direction <-- from forum ByRef iStr As Const String, _ ' as EncBase128 ByVal n_sLen As UByte = 4 _ ' string length with "flags" (+1) ) As String Dim As UByte rmdr = 0, s_chr = 0 Dim As String s_stmp = iStr, t_sret = String(n_sLen - 1, 0) rmdr = iStr[n_sLen - 1] ' save decoder byte "flags" For i As UInteger = 0 To n_sLen - 2 ' without decoder byte s_chr = s_stmp[i] ' get a byte If Bit(rmdr, i) Then s_chr += 128 ' check "flags" and set leading bit If Bit(rmdr, i+3) Then s_chr += 64 ' check "flags" and set second bit t_sret[i] = s_chr ' assign to return string Next Return t_sret End Function Function ShiftB64( _ ' ver 0.5 ByRef iStr As Const String _ ' source = ASCII string ) As String Dim As ULong n_run = Len(iStr) \ 3, n_rem = Len(iStr) Mod 3 Dim As UByte s_tchr = 0 Dim As String s_ret = "", s_tstr = "", s_estr = "" ' get encoded string (8 byte, from 7 byte "original") For i As UInteger = 0 To n_run - 1 Var sPos = i * 3 + 1 s_tstr = Mid(iStr, sPos, 3) s_ret += EncBase64(s_tstr) ' encode to 4 byte string Next ' string-end processing If n_rem > 0 Then Var sPos = n_run * 3 + 1 s_estr = Mid(iStr, sPos, n_rem) ' string remainder s_ret += EncBase64(s_estr, n_rem) ' encode rem. End If ' shift every byte to "printable", add 35 For j As UInteger = 0 To Len(s_ret) - 1 s_tchr = s_ret[j] + 35 ' apply shift s_ret[j] = s_tchr ' write back to string Next Return s_ret End Function Function ShiftASCII( _ ' ver 0.5 ByRef iStr As Const String _ ' source = B64 string ) As String Dim As ULong n_run = Len(iStr) \ 4, n_rem = Len(iStr) Mod 4 Dim As UByte s_tchr = 0 Dim As String s_ret = "", s_tstr = "", s_estr = "", s_tmp = iStr ' reverse shift to "B64 encoded" For j As UInteger = 0 To Len(s_tmp) - 1 s_tchr = s_tmp[j] - 35 ' get shifted byte & un-shift s_tmp[j] = s_tchr ' write un-shifted back Next ' get decoded string (4 byte chunks) For i As UInteger = 0 To n_run - 1 Var sPos = i * 4 + 1 s_tstr = Mid(s_tmp, sPos, 4) s_ret += DecBase64(s_tstr) ' decode string Next ' string-end processing (shorter than 4) If n_rem > 0 Then Var sPos = n_run * 4 + 1 s_estr = Mid(s_tmp, sPos, n_rem) ' string end s_ret += DecBase64(s_estr, n_rem) ' decode string end End If Return s_ret End Function Sub GetUserInput( _ ByRef sFle As String, _ ' file name (with or without ext) ByVal mode As UByte = 0 _ ' 0 = default +ext, 1 = no ext ) Dim As String q = "Please, enter INPUT file name: ", a ' question/answer strings (local) again: Line Input q, a ' ask for filename If a = "" Then GoTo again ' file name is mandatory! If mode = 1 AndAlso InStr(a, ".") Then ' ext check in mode = 1 only Color 12 : Print "File contains extension, enter filename without it! "; Sleep 1500, 1 : Color 7 : GoTo again End If If mode = 1 Then a += ForumExt ' add extension ".B128" sFle = a End Sub ' ===== MAIN ===== Width 120, 25 ' we might want a larger console window Dim As String sFile, sQuest, sAns, c, d, sDir = CurDir Dim As String sTitle = "ForumBlobPost - Utility, version 0.5 (BASE64)", _ uline = String(Len(sTitle), "-") start: Cls : Color 15 : Print sTitle : Print uline : Print : Color 7 sQuest = "enter the direction: to/from Forum [t|f] 'q = quit' : " Line Input sQuest, sAns ' line input accepts a string-var (input doesn't) ' evaluate user input Select Case As Const Asc(LCase(sAns), 1) ' check of first char only Case 102 Color 10 : Print "Enter filename *without* extension, please!" : Color 7 GetUserInput(sFile, 1) ' f/F entered, extension ".B128" assumed c = LoadFile(sFile) Var npos = InStr(c, Chr(34)) ' extract "original" filename, shorten d = Left(c, npos - 1) : c = Right(c, Len(c) - npos) ' source string Var r = ShiftASCII(c) ' decode SaveFile(d, r) ' ATTENTION: overwrites source file!!! Case 113 Print "quiting ..." : Sleep 750, 1 ' q/Q entered (user abort) Case 116 Color 11 : Print "Enter filename *with* extension, please!" : Color 7 GetUserInput(sFile) ' t/T entered, get source file Var dot = InStr(sFile, ".") ' get dot position d = Left(sFile, dot - 1) ' extract filename only If Len(d) > 0 Then ' check whether there is something d += ForumExt : c = LoadFile(sFile) ' add extension, then load it Else Print "File ERROR! " + d : Exit Select EndIf Var r = ShiftB64(c) : r = sFile + Chr(34) + r ' encode SaveFile(d, r) Case Else sAns = "" : Color 12 : Print "unrecognized command" ' in red Color 7 : Sleep 1500, 1 : GoTo start' all else (ask again) End Select Print : Print "Done ..." If CurDir <> sdir Then ChDir(sDir) ' restore path Sleep ' ===== END-MAIN ===== ' ----- EOF -----
Re: ForumBlobPost - Utility (Ver.0.4)
Thank you, Mr. Swiss - though I am disgusted that we can only utilize 6 bits of each forum byte for our transfer... seems so dang inefficient!
Re: ForumBlobPost - Utility (Ver.0.4)
Hm, yes, the easiest solution would be to allow attachments in this forum. I've no idea why this isn't allowed as the necessary storage for that shouldn't be expensive at all these days.leopardpm wrote:Thank you, Mr. Swiss - though I am disgusted that we can only utilize 6 bits of each forum byte for our transfer... seems so dang inefficient!
Re: ForumBlobPost - Utility (Ver.0.4)
Well, yes and no.leopardpm wrote:... only utilize 6 bits of each forum byte for our transfer... seems so dang inefficient!
Yes, its a shame to have 1/3 overhead.
No, the advantage, of not having to adapt to OS specific encoding mechanisms is,
as far as I'm concerned, just to big a benefit. (commonly known as: tradeoff)
Agreed, but since it has been asked before (by other members) and, never got aSt_W wrote:... the easiest solution would be to allow attachments in this forum.
response, it seems to be "the only possible workaround".
Re: ForumBlobPost - Utility (Ver.0.4)
yes, of course it is more important to be cross-compatible... I was just wanting my cake and eat it too...MrSwiss wrote:Well, yes and no.leopardpm wrote:... only utilize 6 bits of each forum byte for our transfer... seems so dang inefficient!
Yes, its a shame to have 1/3 overhead.
No, the advantage, of not having to adapt to OS specific encoding mechanisms is,
as far as I'm concerned, just to big a benefit. (commonly known as: tradeoff)
yes.... now, if only WE could write a forum program in FB, the exact way we would like it... it could be BADASS! I could think of a thousand improvements as to how to better deal with threads that migrate off-topic, better, and more compact representation of posts (the 'quote' look takes up alot of screen space, makes for more user scrolling, etc), being able to attach images, being able to attach .EXE's that would be automatically virus scanned so folks could trust them more - having a section which would have completed projects and then the links to any threads pertaining to their development, etc... but the projects would be displayed and presented in a uniform way instead of in a regular thread... BUT, I am just 'wishing' here... right? or is it possible for us FB programmers to make a server-side program that throws up webpages and maintains databases of posts/attachments/etc...? Also, just remembered something about being able to 'run' FB code from within a webpage... would be nice to have a program posted and instead of copy/paste into an editor, just 'run' it from the browser whether or not FB was installed on the machine in question.... tricky feature!Agreed, but since it has been asked before (by other members) and, never got a response, it seems to be "the only possible workaround".St_W wrote:... the easiest solution would be to allow attachments in this forum.
BTW: I just noticed the "bug" "commit" "commit=" buttons at top of the post window.... that stuff looks similiar to GitHub stuff... how is it used?