Restored from previous forum. Originally posted by Rings.
very first version
Code: Select all
;
; VB ModuleCode Converter V0.1
;
; by S.Rings ( -CodeGuru- )
;
;This tool is only to convert VisualBasic ModuleCode to Pure, no Forms
; Date:25/06/2002: implements first version
; :26/06/2002: added Api-support
; :30/06/2002: added Instr
;
;yes there is a lot to do, but most is done to make convertings easier.
Procedure Instr(Position,O.s,S.s);Find CasesSensitive like VB's one
C.s=S:S2.s=LCase(C)
C.s=O:O2.s=LCase(C)
i=FindString(O2,S2,Position)
ProcedureReturn i
EndProcedure
Procedure VB2PB(SFilename.s,DFilename.s)
OpenConsole()
PrintN("Converting "+ SFilename +" ("+Str(FileSize(SFilename))+" Bytes)")
PrintN("to "+DFilename)
Result=ReadFile(1,SFilename)
Result=CreateFile(2,DFilename)
NewList ApisCalls.s()
If Result
NotEOF=1
Repeat
line +1
ConsoleLocate(10,4)
PrintN("Processing line:"+Str(Line))
;PrintN(MyLine.s)
MyLine.s=ReadString(1)
If Trim(MyLine) <> ""
MySize=mysize+Len(MyLine)+2
;PrintN(Str(Mysize))
;PrintN(Myline)
MyLine=ReplaceString(MyLine,"'",";",1);Always set the remark to Pures ;
MyLine=ReplaceString(MyLine,"REM",";",1)
;now the unknown ApiCalls(note them in the list and remove them from source)
ApiFlag=0
i=Instr(1,MyLine,"Declare ")
If i>0
t=Instr(i+1,MyLine,"Lib")
AddElement(ApisCalls())
ApisCalls()=Trim(Mid(MyLine,i+24,t-i-24))
;MessageRequester("Info",apiscalls(),0)
ApiFlag=1
MyLine=";"+MyLine;Remark them, coz we do not need them really
Goto WriteLine
EndIf
i=Instr(1,MyLine,"ReDim ")
If i>0
MyLine=";"+MyLine;Remark them, coz we cannot handle them really
Goto WriteLine
EndIf
MyLine=ReplaceString(MyLine,"Public ","",1) ;Uneeded
MyLine=ReplaceString(MyLine,"Private ","",1);same
; MyLine=Trim(MyLine)
;Convert structures (Most wanted)
i=Instr(1,MyLine,"type ")
If i>0
Myline="Structure"+Right(MyLine,Len(MyLine)-4)
StructureDef=1
EndIf
i=Instr(1,MyLine,"end type")
If i>0
Myline="EndStructure"+Right(MyLine,Len(MyLine)-8)
StructureDef=0
EndIf
;Special Constant String
i=Instr(1,MyLine," As String *")
If i>0
MyComment.s=""
t=Instr(i+12,MyLine,";")
If t>0
MyComment=Right(MyLine,Len(Myline)-t+1)
MyLine=Left(Myline,t-1)
EndIf
Rest.s=Right(MyLine,Len(myline)-i-12)
Zahl=Val(Rest)
If zahl>1
MyLine=Left(MyLine,i-1)+".b["+Str(Zahl)+"]"
Else
MyLine=Left(MyLine,i-1)+".b"
EndIf
MyLine=MyLine+MyComment
EndIf
;Constants
MyLine=ReplaceString(MyLine,"Public Const ","#",1)
MyLine=ReplaceString(MyLine,"Const ","#",1)
MyLine=ReplaceString(MyLine,"True","#True",1)
MyLine=ReplaceString(MyLine,"False","#False",1)
;Keywords these are the changes between VB and Pure
MyLine=ReplaceString(MyLine,"end if","EndIF",1)
MyLine=ReplaceString(MyLine,"Sub ","Procedure ",1)
MyLine=ReplaceString(MyLine,"End Sub","EndProcedure",1)
MyLine=ReplaceString(MyLine,"Function ","Procedure ",1)
MyLine=ReplaceString(MyLine,"End Function","EndProcedure",1)
MyLine=ReplaceString(MyLine,"Select Case","Select",1)
MyLine=ReplaceString(MyLine,"End Select","EndSelect",1)
MyLine=ReplaceString(MyLine,"Chr$(","Chr(",1)
MyLine=ReplaceString(MyLine,"Left$(","Left(",1)
MyLine=ReplaceString(MyLine,"Right$(","Right(",1)
MyLine=ReplaceString(MyLine,"Mid$(","Mid(",1)
;Some unneeded Commands
MyLine=ReplaceString(MyLine,"Call","",1)
MyLine=ReplaceString(MyLine,"LSset","",1)
MyLine=ReplaceString(MyLine,"RSset","",1)
MyLine=ReplaceString(MyLine,"Attribute",";",1)
MyLine=ReplaceString(MyLine,"Option Explicit",";",1)
MyLine=ReplaceString(MyLine,"DefInt",";Defint",1)
MyLine=ReplaceString(MyLine,"on Error",";On Error",1)
;Need more modifications!!
MyLine=ReplaceString(MyLine,"Instr(","FindString(",1)
MyLine=ReplaceString(MyLine,"Kill","DeleteFile",1)
MyLine=ReplaceString(MyLine,"MsgBox","MessageRequester",1)
; Remove the 'Then'
i=Instr(1,MyLine,"Then")
If i>0
If Trim(Right(MyLine,Len(MyLine)-i-4)) <> "" ;oh there is more than only a then
MyLine=Left(MyLine,i-1)+":"+Right(MyLine,Len(MyLine)-i-4)+":EndIf"
Else
MyLine=Left(MyLine,i-1)
EndIf
EndIf
MyLine=ReplaceString(MyLine," &H"," $",1);VB's Hex-notation
MyLine=ReplaceString(MyLine," as long",".l ",1)
MyLine=ReplaceString(MyLine," as word",".w ",1);Powerbasic specific
MyLine=ReplaceString(MyLine," as dword",".l ",1);Powerbasic specific
MyLine=ReplaceString(MyLine," as integer",".w ",1)
MyLine=ReplaceString(MyLine," as byte",".b ",1)
MyLine=ReplaceString(MyLine," as single",".f ",1)
MyLine=ReplaceString(MyLine," as string",".s ",1)
MyLine=ReplaceString(MyLine," as boolean",".b ",1)
If Instr(1,MyLine," as double")>0
MyLine=ReplaceString(MyLine," as double",".d ",1)
EndIf ;can be troubleing /2 Bytes missing.
MyLine=ReplaceString(MyLine," As Any",".l",1)
;Is a & added at the End of a Number ? If so remove it !
AgainAND:
I=Instr(I+1,MyLine,"&")
If I>1
If Mid(myLine,I-1,1) <> " "
MyLine=Left(MyLine,i-1)+Right(MyLine,Len(MyLine)-i)
EndIf
Goto AgainAND
EndIf
;is a structure used ? so convert the Dot to Backslash
If StructureDef=0 And Instr(1,MyLine,"dim")=0
againfind:
i=Instr(1,MyLine,".")
If i>1
t=Instr(1,Mid(MyLine,i-1,1),"0123456789 ")
If t=0
t=Instr(1,Mid(MyLine,i+1,1),"0123456789 ")
If t=0
t=Instr(1,Mid(MyLine,i,3),".b ")
If t=0
t=Instr(1,Mid(MyLine,i,3),".l ")
If t=0
t=Instr(1,Mid(MyLine,i,3),".w ")
If t=0
t=Instr(1,Mid(MyLine,i,3),".s ")
If t=0
t=Instr(1,Mid(MyLine,i,3),".f ")
If t=0
MyLine=Left(MyLine,i-1)+"\"+Right(MyLine,Len(MyLine)-i)
Goto againfind
EndIf
EndIf
EndIf
EndIf
EndIf
EndIf
EndIf
EndIf
EndIf
;Else some unknown Types converting
MyLine=ReplaceString(MyLine," As ",".",1)
MyLine=ReplaceString(MyLine,"Dim "," ", 1)
;search if there is any ApiFunction there ?
If ApiFlag=0
ResetList(ApisCalls()) ; Reset the list index before the first element.
While NextElement(ApisCalls()) ; Process all the elements...
MyLine=ReplaceString(MyLine,ApisCalls()+"(",ApisCalls()+"_(",1)
Wend
EndIf
WriteLine:
; is there a _ underscore at the End of the line if so merge the lines?
If Right(MyLine,1)="_"
OldLine.s=OldLine+" " + MyLine
Else
If Trim(Oldline) <> ""
WriteStringN(2, OldLine+" "+MyLine) ;write down to file
Else
WriteStringN(2, MyLine)
EndIf
OldLine=""
EndIf
Else
EndIf
Until Eof(1)
CloseFile(1)
CloseFile(2)
EndIf
PrintN("Ready")
; dummy.s=Input()
CloseConsole()
EndProcedure
SFilename.s=OpenFileRequester("please choose VisualBasic.BAS File", "*.bas","VB module|*.bas", 0)
If SFilename.s <> ""
i=FindString(SFilename,".bas",1)
Newname.s=Left(SFilename,i)+"pb"
DFilename.s=SaveFileRequester("please choose PureBasic.BAS File", NewName,"PB module|*.pb", 0)
If DFilename <> ""
VB2PB(SFilename,DFilename)
EndIf
Else
MessageRequester("Fault info","FileName missing!",0)
Beep_(100,500)
EndIf