Publié : dim. 18/avr./2004 17:37
.
Code : Tout sélectionner
;**********************************************
;* Récupération des données à convertir *
;* We take the text to convert *
;**********************************************
ProgText.s=""
If #Test
ProgText=GetClipboardText()
Else
;File.s = OpenFileRequester("Open a C code file", "", "(*.*)|*.*", 0)
File.s = OpenFileRequester("Ouvrir un programme en language C", "", "(*.*)|*.*", 0)
If File
If OpenFile(0,File)
l=0
While l < Lof()
tl.s = ReadString()+#RC1
ProgText=ProgText+tl
l = l + Len(tl)
Wend
EndIf
EndIf
EndIf
;
If ProgText<>""
ProgText=ProgText+#RC1+#RC1
;*****************************
;- Conversion *
;*****************************
DoAsFredSaid = 1
Prog.s=""
ttdef = 0
ttFcn = 1
TFcn(1) = "MAKELONG"
TFcnDef(1) = "(c0|(c1<<16))"
TFcnType(1)= ".l"
TFcnArg(1) = "c0,c1"
TFcnArgType(1) = ".b,.b"
;
; On commence par rechercher toutes les déclarations de fonction et on les enregistre
; Begin by register all the fonction declarations
SetGadgetText(1, "Analysing fonctions")
cont = 1
AnLine = 0
While cont
cont = 0
com = 0
LevelStruct = 0
StartL = 1
EndL = 0
While EndL < Len(ProgText)
ForgetIt = 0
ForgetLF = 0
CutTheLine()
If com=0
If LCase(TWord(1))="#define" And dtw > 2
If UCase(TWord(2))<>"WINMMAPI" And UCase(TWord(2))<>"INTERFACE" And TWord(3)<>"\"
mttFcn = ttFcn
FonctionDeclaration()
If mttFcn <> ttFcn
cont=1
AnLine +1
SetGadgetText(1, "Analysing fonctions : "+Str(AnLine))
EndIf
EndIf
EndIf
EndIf
If dcom
com = 1
EndIf
If DefMode = 1
DefMode = 2
Else
If DefMode = 2
DefMode = 0
mode$="none"
EndIf
EndIf
Wend
Wend
;
; Maintenant on analyse le reste
; Then do the rest of the job
SetGadgetText(1, "Analysing all the code")
com = 0
LevelStruct = 0
StartL = 1
EndL = 0
mode$="none"
AnLine = 0
While EndL < Len(ProgText)
AnLine + 1
SetGadgetText(1, "Analysing code line #"+Str(AnLine))
ForgetIt = 0
ForgetLF = 0
TLine.s = CutTheLine()
If com=0 And dtw>0
ti.s = LCase(TWord(1))
Select ti
Case "#define"
If dtw > 2 And UCase(TWord(2))<>"WINMMAPI" And UCase(TWord(2))<>"INTERFACE"
If dtw = 3 And TWord(2) And TWord(3)="\" ; a complex definition is going on
ttdef + 1 ; we'll memorize it to be able
TDefN(ttdef)=TWord(2) ; to use it when necessary
ForgetIt = 1
mode$="struct"
Else
If FonctionDeclaration()=0
TWord(2)="#"+TWord(2)+" = "
TSpace(3)=TSpace(3)-3
TSpace(2)=TSpace(2)-1
TLCom.s=""
For p = 3 To dtw
If ConvertCType(TWord(p))<>TWord(p) ;it's a type declaration. Dont care
TWord(p) = ""
If TWord(p-1)="("
TWord(p-1)=""
TSpace(p-1)=0
EndIf
If TWord(p+1)=")"
TWord(p+1)=""
TSpace(p+1)=0
EndIf
Else
If TWord(p)
TWord(p)=ComputeValue(p)
TLCom=TLCom+TCom
EndIf
EndIf
Next
TWord(dtw)=TWord(dtw)+TLCom
EndIf
EndIf
Else
ForgetIt = 1
EndIf
Case "struct"
;DoAsFredSaid = 1
If DoAsFredSaid
If Left(TWord(2),3)="tag"
TWord(2)=Right(TWord(2),Len(TWord(2))-3)
EndIf
If Left(TWord(2),1)="_"
TWord(2)=Right(TWord(2),Len(TWord(2))-1)
EndIf
If Right(TWord(2),4)="_tag"
TWord(2)=Left(TWord(2),Len(TWord(2))-4)
EndIf
EndIf
If TWord(2)= TNameStruct(LevelStruct)
; ça n'est pas le début d'une nouvelle structure mais une déclaration de
; structure chainée.
; It's not the begining of a new structure. It's a chained structure declaration
TWord(2)=""
TWord(1)=TWord(3)
TWord(3)=""
If TWord(1)="*"; the * had been taken out from the name when we "cut the line" (begining of the analysis)
TWord(1)=TWord(1)+TWord(4) ;we re-glue the * And the name
TWord(4)=""
EndIf
TWord(1)=TWord(1)+"."+TNameStruct(LevelStruct)
e = LevelStruct*2
If TSpace(1)<e
TSpace(1)= e
EndIf
Else
mt.s=""
Goto STRUCT ; Goto is not forbiden if it's cleverly used.
; Je suis un vrai rebelle (tiens, la preuve : j'ai une guitare électrique)
; et je suis parfois capable de faire des trucs complètement ouf (mais vraiment ouf de chez ouf)
; comme utiliser Goto, par exemple. WHHHHAAAAAAAAARHRHRHRH !!! Faites gaffe !!!! I'm a rocker !!
EndIf
Case "union"
LevelStruct = LevelStruct + 1
TLevStruct(LevelStruct)="union"
TWord(1)="StructureUnion"
If TWord(2)<>"{" And Left(TWord(2),1)<>";"
TWord(1)=TWord(1)+" ;"
EndIf
If TWord(2)="{"
TWord(2) = ""
EndIf
mode$="struct"
e = (LevelStruct-1)*2
If TSpace(1)<e
TSpace(1)= e
EndIf
Case "typedef"
ti.s = LCase(TWord(2))
Select ti
Case "struct"
mt.s=TWord(2)
If dtw=2
TWord(2)=""
Else
TWord(2)=TWord(3)
EndIf
TWord(3)=""
STRUCT:
mode$="struct"
If LevelStruct = 0
StartMainStruct = Len(Prog) ; will be used to re-order the structures
EndIf
LevelStruct = LevelStruct + 1
TLevStruct(LevelStruct)="struct"
TWord(1)="Structure"
If Left(mt,1)=";" Or TWord(2)="" Or dtw=1
TWord(2)=FindStructName()
TAutoNameStruct(LevelStruct)=1
Else
TAutoNameStruct(LevelStruct)=0
EndIf
;DoAsFredSaid = 1
If DoAsFredSaid
If Left(TWord(2),3)="tag"
TWord(2)=Right(TWord(2),Len(TWord(2))-3)
EndIf
If Left(TWord(2),1)="_"
TWord(2)=Right(TWord(2),Len(TWord(2))-1)
EndIf
If Right(TWord(2),4)="_tag"
TWord(2)=Left(TWord(2),Len(TWord(2))-4)
EndIf
EndIf
TNameStruct(LevelStruct) = TWord(2)
TSpace(2)=1
l = 2
ct = 3
While ct<dtw
ct+1
If Left(TWord(ct),1)=";" ; we keep the commentary
l = 3
TWord(3)=TWord(ct)
ct=dtw
EndIf
Wend
dtw = l
e = (LevelStruct-1)*2
If TSpace(1)<e
TSpace(1)= e
EndIf
Case "enum"
TWord(1) = "Enumeration ;"
TWord(2) = ""
If Left(TWord(3),4)="enum"
TWord(3)= Right(TWord(3),Len(TWord(3))-4)
EndIf
mode$="enum"
Default
ForgetIt = 1
EndSelect
Case "enum"
TWord(1) = "Enumeration"
dtw = 1
mode$="enum"
Case "}"
Select mode$
Case "struct"
Select TLevStruct(LevelStruct)
Case "struct"
YetExisting = 0
For ct = 1 To ttES
UCName.s=UCase(TNameStruct(LevelStruct))
If UCase(TExistingStruct(ct))=UCName
YetExisting = 1
ct = ttES
EndIf
Next
If YetExisting
pp=Len(prog)
StrToFind$="Structure "+TNameStruct(LevelStruct)
lStrToFind=Len(StrToFind$)
While Mid(Prog,pp,lStrToFind)<>StrToFind$ And pp>0
pp - 1
Wend
Prog = Left(Prog,pp-1)
Else
ttES + 1
TExistingStruct(ttES)=TNameStruct(LevelStruct)
EndIf
TWord(1)= "EndStructure"
cd.s=""
;DoAsFredSaid = 1
For ct=2 To dtw
If Left(TWord(ct),1)<>";" And Left(TWord(ct),1)<>"("
If TWord(ct)<>"*" ; the * had been taken out from the name when we "cut the line" (begining of the analysis)
If DoAsFredSaid And UCase(TWord(ct))= UCase(TNameStruct(LevelStruct))
TWord(ct)=""
EndIf
If TWord(ct)
tx.s = TNameStruct(LevelStruct)
l = Len(TWord(ct))
If Left(tx,l)=TWord(ct) And TAutoNameStruct(LevelStruct)
TWord(ct) = tx
EndIf
e = (LevelStruct-1)*2
If TSpace(ct)<e
TSpace(ct)= e
EndIf
cd + #RC2 + Space(TSpace(ct))+TWord(ct)+"."+TNameStruct(LevelStruct)
TSpace(ct)=0
EndIf
Else
If DoAsFredSaid
TWord(ct+1)= "" ; forget all variables beggining by "*"
TWord(ct)=""
Else
TWord(ct+1)= "*"+TWord(ct+1) ; we re-glue the * and the name
TWord(ct)=""
EndIf
EndIf
Else
TWord(1)= "EndStructure ;"+TWord(ct)
ct = dtw
EndIf
Next
If YetExisting
TWord(1)= "; "+TNameStruct(LevelStruct)+" already declared in the PureBasic libs"+cd
Else
TWord(1)=TWord(1)+cd
EndIf
dtw = 1
Case "union"
If dtw>1
TWord(1)= "EndStructureUnion ;"
Else
TWord(1)= "EndStructureUnion"
EndIf
EndSelect
LevelStruct = LevelStruct - 1
If LevelStruct = 0
mode$="none"
;
; ******* OK, now we'll re-order the structures *******
;
cont = 1
ToKeepInPlace.s=""
ToPutUpside.s=""
ToPutUpsideOne.s=""
StartL2 = Len(Prog)-1
WhatToDo.s = "KeepIt"
While StartL2 > StartMainStruct
EndL2 = StartL2
While StartL2>1 And Mid(Prog,StartL2 ,1)<>#RC2
StartL2-1
Wend
If Mid(Prog,StartL2 ,1)<>#RC2
StartL2=0
EndIf
Line2.s = Mid(Prog,StartL2+1,EndL2-StartL2-1)
l = Len(Line2)
Line2.s = LTrim(Line2)
l = l-Len(Line2)
Prog = Left(Prog,StartL2-1)
If Left(Line2,12)="EndStructure" And Left(Line2,17)<>"EndStructureUnion"
WhatToDo = "PutItUp"
EndIf
If WhatToDo = "PutItUp"
If Left(Line2,6)<>"Struct" And Left(Line2,6)<>"EndStr"
Line2=" "+Line2
EndIf
ToPutUpsideOne=Line2+#RC2+ToPutUpsideOne
Else
ToKeepInPlace=Space(l)+Line2+#RC2+ToKeepInPlace
EndIf
If Left(Line2,10)="Structure " And ToPutUpsideOne<>""
WhatToDo = "KeepIt"
ToPutUpside=ToPutUpside+#RC2+ToPutUpsideOne ; As said Jesus : the first will be the last and the last will be the first
ToPutUpsideOne=""
EndIf
Wend
Prog=Prog+ToPutUpside+#RC2+ToKeepInPlace ; **** well done ! ****
EndIf
e = LevelStruct*2
If TSpace(1)<e
TSpace(1)= e
EndIf
Case "enum"
TWord(1)= "EndEnumeration ;"
mode$="none"
Case "if"
TWord(1)= "EndIf ;"
mode$="none"
Case "interface"
TWord(1)= "EndInterface ;"
For ct = 1 To ttEI
YetExisting = 0
InterfaceName.s=UCase(InterfaceName)
If UCase(TExistingInterface(ct))=InterfaceName.s
YetExisting = 1
ct = ttEI
EndIf
Next
If YetExisting
pp=Len(prog)
While Mid(Prog,pp,10)<>"Interface " And pp>0
pp - 1
Wend
Prog = Left(Prog,pp-1)
TWord(1)=";"+InterfaceName+" already declared in the PureBasic libs."
dtw=1
Else
ttES + 1
TExistingInterface(ttES)=InterfaceName
EndIf
mode$="none"
Case "interfacel"
TWord(1)= "EndInterface ;"
mode$="none"
Default
TWord(1)= "End ;"
mode$="none"
EndSelect
;
Case "{"
If dtw >1
TWord(1) = TWord(2)
TWord(2) = ""
TSpace(1)=TSpace(1)+TSpace(2)+1
TSpace(2)=0
Else
TWord(1) =""
EndIf
;
Case "define_guid"
TWord(1) = "DataSection"
p=2
While TWord(p)<>"(" And p<dtw
p + 1
Wend
TWord(p)=""
p + 1
TWord(p)=#RC2+" "+TWord(p)+":"+#RC2
TWord(p+1)=" Data.l "+TWord(p+1)+#RC2
TWord(p+2)=" Data.w "+TWord(p+2)+","+TWord(p+3)+#RC2
TWord(p+3)=""
TWord(p+4)=" Data.b "+TWord(p+4)
For ct = p+5 To dtw
If Left(TWord(ct),1)=";"
TWord(p+4)=TWord(p+4)+" "+TWord(ct)
Else
If TWord(ct)<>")"
TWord(p+4)=TWord(p+4)+","+TWord(ct)
EndIf
EndIf
TWord(ct)=""
Next
TWord(p+4)=TWord(p+4)+#RC2
TWord(p+5)="EndDataSection"
dtw = p+5
For ct = 1 To dtw
TSpace(ct)=0
Next
mode$="none"
;
Case "declare_interface_"
TWord(1)="Interface"
p=2
While TWord(p)<>"("
p + 1
Wend
TWord(p)=""
p + 1
TSpace(p)=1
For ct = p+1 To dtw
TWord(ct)=""
Next
dtw = p
TSpace(1)=0
mode$="interface"
If TWord(2)=""
TWord(2)=TWord(3)
TWord(3)=""
EndIf
InterfaceName.s=TWord(2)
;
Case "interface"
ForgetIt = 1
mode$="none"
Case "#include"
ForgetIt = 1
Case "#ifndef"
ForgetIt = 1
Case "#ifdef"
Repeat
Until Left(LTrim(ReadNextLine()),6)="#endif" Or EndL >= Len(ProgText)
ForgetIt = 1
Case "#endif"
ForgetIt = 1
Case "extern"
ForgetIt = 1
Case "#undef"
ForgetIt = 1
Case "#pragma"
ForgetIt = 1
Case "declare_handle"
ForgetIt = 1
Default
If TWord(2)="WINAPI"
ForgetIt = 1
Else
If mode$ ="interface" Or mode$ = "interfacel"
If mode$ = "interface"
If LCase(TWord(1)) = "stdmethod"
mode$="interfacel"
na = Asc("a")-1
TWord(1)=""
TWord(2) = TWord(3)
TWord(3) = "("
p=4
EndIf
If LCase(TWord(1)) = "stdmethod_"
mode$="interfacel"
na = Asc("a")-1
TWord(1)=""
TWord(2)= TWord(4)
TWord(3) = "("
TWord(4) = ""
p=5
EndIf
Else
p = 1
EndIf
If mode$="interfacel"
For ct = p To dtw
If LCase(TWord(ct))="pure"
TWord(ct)=")"
mode$="interface"
Else
TWord(ct)=""
TSpace(ct)=0
EndIf
Next
If TWord(p)<>")"
na + 1
TWord(p)=Chr(na)+".l"
If p=1
TWord(1)=","+TWord(p)
EndIf
For ct = 1 To NbVirg
na + 1
TWord(p)=TWord(p)+","+Chr(na)+".l"
Next
EndIf
EndIf
If mode$="interfacel"
ForgetLF = 1
EndIf
EndIf
Select mode$
Case "enum"
If TWord(1) And Left(TWord(1),1)<>";"
TWord(1) = "#"+TWord(1)
TSpace(1)=TSpace(1)-1
EndIf
p = 0
While TWord(p)<>"=" And p<dtw
p + 1
Wend
If TWord(p)="="
pt = p
TLcom=""
For p = pt To dtw
If TWord(p)
TWord(p)=ComputeValue(p)
TLCom=TLCom+TCom
EndIf
Next
TWord(dtw)=TWord(dtw)+TLCom
EndIf
Case "struct"
tyPB.s=ConvertCType(TWord(1))
TWord(1)=""
pt = 0
If Left(tyPB,1)<>"." And Left(tyPB,1)<>";"
If dtw=1 Or Left(TWord(2),1)=";"
p=0
ct = 0
While ct<ttdef
ct+1
If UCase(TdefN(ct))=tyPB
p=ct
ct=ttdef
EndIf
Wend
If p
TWord(2)=TDefD(p) ; Replace the name by its definition
If dtw<2
dtw=2
EndIf
tyPB = ""
TSpace(1)=0
TSpace(2)=0
EndIf
Else
tyPB = ".l"
EndIf
pt = 1
EndIf
p = 2
While TWord(p)="*"
TWord(p)=""
p + 1
Wend
m.s=TWord(p)
TWord(p)=""
TWord(2)=m
If tyPB And TWord(2) And TWord(2)<>"\" And Left(tyPB,1)<>";"
md.s = ""
If TWord(3)="["
If TWord(4)
md=ComputeValue(4)
EndIf
EndIf
TWord(2)=TWord(2) + tyPB
If md
TWord(4)=md
EndIf
EndIf
If Left(tyPB,1)<>"."
ct = 2
l = 0
While ct<dtw
ct+1
If Left(TWord(ct),1)=";" ; we look for the commentary
l = ct
EndIf
Wend
If l=0
dtw + 1
TWord(dtw)=""
l=dtw
EndIf
If TWord(l)
TWord(l) = "; "+tyPB+" : "+Right(TWord(l),Len(TWord(l))-1)
Else
TWord(l) = "; "+tyPB
EndIf
EndIf
TWord(1)=""
TSpace(2)=TSpace(1)
e = LevelStruct*2
If TSpace(2)<e
TSpace(2)= e
EndIf
TSpace(1)=0
EndSelect
EndIf
EndSelect
ct=0
TLine.s = ""
While ct<dtw And ForgetIt=0
ct+1
If TWord(ct)
p=ct-1
While p>1 And TWord(p)=""
p -1
Wend
If TSpace(ct)<1 Or TWord(ct)="[" Or TWord(p)="[" Or TWord(ct)="]" Or TWord(ct)="(" Or TWord(p)="(" Or TWord(ct)=Chr(34) Or TWord(p)=Chr(34) Or TWord(ct)=")" Or TWord(p)="(" Or TWord(ct)="<" Or TWord(ct)=">"
TSpace(ct)=0
EndIf
TLine=TLine+Space(TSpace(ct))+TWord(ct)
EndIf
Wend
EndIf
If TLine And ForgetIt = 0
TLine = ReplaceString(TLine, "; ;", ";")
TLine = ReplaceString(TLine, "\", "")
TLine = ReplaceString(TLine, "*/", "")
Debug TLine
If DefMode
TDefD(ttdef) = TDefD(ttdef)+TLine
If ForgetLF = 0
TDefD(ttdef) = TDefD(ttdef)+#RC2
EndIf
Else
Prog = Prog+TLine +" "
If ForgetLF = 0
Prog = Prog+#RC2
EndIf
EndIf
EndIf
If dcom
com = 1
EndIf
If DefMode = 1
DefMode = 2
Else
If DefMode = 2
DefMode = 0
mode$="none"
EndIf
EndIf
Wend
; On renomme toutes les constantes portant le même nom qu'une constante PureBasic
; et ayant une valeur différente (pour éviter le message "Constant already declared with a different value")
; Rename all the constants having the same name than a PureBasic Constant and having
; a different value (to avoid the "Constant already declared with a different value" message).
StartL=1
EndL = 1
Prog2.s=""
While EndL>0
EndL = FindString(Prog,#RC2,StartL) ; on cherche le prochain retour chariot - look for the next line feed
If EndL
TLine = LTrim(Mid(Prog,StartL,EndL-StartL))
If Left(Tline,1)="#"
Prog2=Prog2+TLine+#RC2 ; on ne garde que les déclarations de constantes - We keep only constant declarations
EndIf
StartL=EndL+Len(#RC2)
EndIf
Wend
AnLine = 0
RenameCText$=""
cont = 1
While cont
cont=0
RTest$=TestProg(Prog2)
If RTest$<>"OK"
nLine=Val(StringField(Mid(RTest$,6,14), 1, ": "))
ct=0
StartL=1
EndL = 1
While ct<nLine And EndL>0
ct + 1
EndL = FindString(Prog2,#RC2,StartL) ; on cherche le prochain retour chariot - look for the next line feed
mStartL=StartL
StartL=EndL+Len(#RC2)
Wend
If ct=nLine
Const$ = StringField(LTrim(Mid(Prog2,mStartL,EndL-mStartL)),1," ")
If FindString(RTest$,"Constant already declared with a different value",1)
Prog=ReplaceString(Prog, Const$, Const$+"n")
RenameCText$=RenameCText$+"; "+Const$+" has been renamed To "+Const$+"n"+#RC2
Prog2=ReplaceString(Prog2, Const$, Const$+"n")
AnLine + 1
SetGadgetText(1, "Renaming some constants : "+Str(AnLine))
Else
Prog2=ReplaceString(#RC2+Prog2, #RC2+Const$, #RC2+";"+Const$) ; pour annuler l'erreur - To kick off the error
Prog2=ReplaceString(Prog2, Const$, "0")
EndIf
cont = 1
EndIf
EndIf
Wend
If RenameCText$
Prog="; Some constants was already declared into the PureBasic Libs with"+#RC2+"; a different value : "+#RC2+RenameCText$+#RC2+Prog
EndIf
SetGadgetText(1, "Ending...")
;
;*********************************************************
;* Recherche de la Fenêtre de PureBasic *
;* Le code original vient de Brossden et il est bien ! *
;* From a cool Brossden code
;*********************************************************
CloseWindow(30)
Hwnd = FindWindow_( 0, 0 )
While Hwnd <> 0
Txt.s = Space(256)
GetWindowText_(Hwnd, Txt, 256)
Hwnd = GetWindow_(Hwnd, #GW_HWNDNEXT)
If FindString(UCase(Txt),"PUREBASIC - ",1) = 1 And FindString(UCase(Txt),"DEBUG",1) =0
HandlePB=Hwnd
Hwnd=0
EndIf
Wend
;******************************************
;* Activation de la Fenêtre de PureBasic *
;* Activation of the PureBasic Window *
;******************************************
SetFocus_(HandlePB)
;*****************************************************
;* On sauvegarde le contenu du presse-papier *
; save the clipboard datas
;*****************************************************
Sauv.s = GetClipboardText()
;*****************************************************
;* On va coller le résultat de notre conversion dans *
;* un nouveau document que l'on crée dans PureBasic *
;* We paste the result of the conversion into a new *
;* document of PureBasic *
;*****************************************************
tx.s = ";***************************************************************"+#RC1
tx.s = tx.s + ";* Programme converti du language C vers PureBasic à l'aide de *"+#RC1
tx.s = tx.s + ";* This Program had been converted from C to PureBasic with *"+#RC1
tx.s = tx.s + ";* GoodByeC® *"+#RC1
tx.s = tx.s + ";* Zapman - familledeborde@lagoon.nc *"+#RC1
tx.s = tx.s + ";***************************************************************"+#RC1
Prog = tx+Prog
SetClipboardText(Prog)
keybd_event_(#VK_CONTROL,0,0,0)+keybd_event_(#VK_N,0,0,0) ; Nouveau (Ctrl N)
Delay(200)
keybd_event_(#VK_CONTROL,0,0,0)+keybd_event_(#VK_V,0,0,0) ; Coller (Ctrl V)
Delay(200)
keybd_event_(#VK_CONTROL,0,#KEYEVENTF_KEYUP,0)
Delay(500)
;*********************************************************
;* Restauration du contenu du presse-papier *
;* Restore the clipboard *
;*********************************************************
SetClipboardText(Sauv)
EndIf
TerminateProcess_(CompilerProcessID,0) ; Terminate the PB Compiler process
End ; Il faut que j'aille me coucher
