je me suis fait un petit pg pour créer des userlib. Il est très simple d'utilisation (prise en charge automatique (ou non) des paramètres optionnels)
la seule chose qui me bloque, c'est le passage des tableaux en parametre de fonction
Code : Tout sélectionner
EnableExplicit
#separateurs=" =:;,()[]{}+-/*.\<>?%|&"+#CR$+#LF$+Chr(34)
Procedure.s lirefic(nom.s)
Protected txt.s,n
n=ReadFile(-1,nom):txt=ReadString(n,#PB_File_IgnoreEOL):CloseFile(n)
ProcedureReturn txt
EndProcedure
Procedure ecrirefic(nom.s,txt.s)
Protected n
If FileSize(nom)>=0:DeleteFile(nom):EndIf
n=OpenFile(-1,nom):WriteString(n,txt):CloseFile(n)
EndProcedure
Procedure.s Stringparse(t.s,before.s,after.s,pi=0)
Protected pf
pi=FindString(t,before,pi+1)
If pi=0:ProcedureReturn:EndIf
pf=FindString(t,after,pi):If pf=0:pf=Len(t):EndIf
pi+Len(before)
ProcedureReturn Mid(t,pi,pf-pi)
EndProcedure
Procedure FindStringRev(t.s,find.s,p=0,mode=#PB_String_CaseSensitive)
Protected l=Len(find)
If p=0:p=Len(t):EndIf
Repeat
If p=0 Or Mid(t,p,L)=find:Break:EndIf
p-1
ForEver
ProcedureReturn p
EndProcedure
Procedure.i FindStringww(txt.s,mot.s,p=1,mode=0); findstring whole word
Repeat
p=FindString(txt,mot,p,mode):If p=0:Break:EndIf
If FindString(#separateurs,Mid(txt,p-1,1))>0 And FindString(#separateurs,Mid(txt,p+Len(mot),1))>0:ProcedureReturn p:EndIf
p+Len(mot)
ForEver
EndProcedure
Procedure.s RunProgramext(programme.s,param.s,workingdir.s,flags)
Protected s.s, pg=RunProgram(programme,param,workingdir,flags)
While ProgramRunning(pg)
If AvailableProgramOutput(pg)
s+ReadProgramString(pg) + #CRLF$
EndIf
Wend
CloseProgram(pg)
ProcedureReturn s+ #CRLF$
EndProcedure
;####################################################################################################################################################
#g=Chr(34)
Structure sproc
nom.s
nomdesc.s
nomasm.s
type.s
List param.s()
comment.s
npf.b
npo.b
EndStructure
Procedure.s codefiltre(txt.s)
Protected i,n,ch,co, c.w
n=Len(txt)
Dim t.w(n-1)
CopyMemory(@ txt,@ t(0),n*2)
For i=0 To n-1
c=t(i)
Select c
Case 34:ch=~ch
Case 59:co=1
Case 13:co=0
EndSelect
If ch:c=34 :EndIf
If co:c=59:EndIf
t(i)=c
Next
CopyMemory(@ t(0),@ txt,n*2)
ProcedureReturn txt
EndProcedure
Procedure.s listeparam(List p.s(),txt.s)
Protected i,n,np,pi,ch
Protected.s c,fct
ClearList(p())
txt+","
pi=1
For i=pi To Len(txt)
c=Mid(txt,i,1)
If ch=0
If c="," And np=0:AddElement(p()):p()=Trim(Mid(txt,pi,i-pi)):pi=i+1:EndIf
If c="(":np+1:EndIf
If c=")":np-1:EndIf
EndIf
If c=#g:ch=~ch:EndIf
Next
EndProcedure
Procedure.s vartype(v.s)
Protected p,t.s,r.s
v=Trim(v)
ReplaceString(v,"$",".s")
p=FindString(v,".")
If p=0:t="i":Else:t=Mid(v,p+1,1):EndIf
If Left(v,1)="*":t="i":EndIf
If Left(v,5)="Array":t="ar":EndIf
If Left(v,4)="List":t="ll":EndIf
Select LCase(t)
Case "b":r="Byte"
Case "w":r="Word"
Case "l","i":r="Long"
Case "s":r="String"
Case "q":r="Quad"
Case "f":r="Float"
Case "d":r="Double"
Case "ar":r="Array"
Case "ll":r="LinkedList"
Default :r="None"
EndSelect
If FindString(v,"="):r="["+r+"]":EndIf
ProcedureReturn r
EndProcedure
Procedure.s paramx(List p.s(), n, nval,declaration)
Protected i, r.s,v.s
ForEach p()
i+1:If i>n:Break:EndIf
v=StringField(p(),Bool(i>nval)+1,"=")
If declaration=0 And FindString(v,"("):v=Stringparse(v," ","(")+"()":EndIf
r+","+v
Next
ProcedureReturn Mid(r,2)
EndProcedure
Procedure makeuserlib(Fpbo.s,unicode=1,thread=0)
Protected NewMap proc.sproc()
Protected i,n,ni,p,pi,pl,pf,num,npo,npf
Protected.s dossier, fasm,flib,param,fic,ficx, proc,aproc,nom,Fnom,dep,desc,ltype,lparam,lg,lgx,remplace,nums,ret,deb
NewList l.s()
dossier=GetPathPart(fpbo)
Fnom=dossier+GetFilePart(Fpbo,#PB_FileSystem_NoExtension)
;----------------------- fichier PB (recuperation information procedure + version modifiée (.PBm) pour la gestion des parametre optionnels)
fic= lirefic(fpbo)
ficx=codefiltre(fic)
pf=1
Repeat
pi=FindString(ficx,"ProcedureDLL",pf):If pi=0:Break:EndIf
pf=FindString(ficx,"EndProcedure",pi)+12
lg=Mid(fic,pi,pf-pi):lgx=codefiltre(lg)
pl=FindString(lg,#CRLF$)
proc=Trim(Stringparse(lg," ","("))
num=Val(Right(proc,1))
nom=Left(proc,Len(proc)-Bool(num>0))
p=FindString(lg,"("):listeparam(l(),Mid(lg,p+1,FindStringRev(lg,")",pl)-p-1))
npo=0:ForEach l():npo+Bool(FindString(l(),"=")):Next
npf=ListSize(l())-npo
If npo>0 And num=0
deb=Left(lg,FindString(lg,"(")-1)
aproc=proc:proc+Str(npo+1)
remplace=ReplaceString(lg,aproc,proc,0 ,1,1)
If FindString(lg,"ProcedureReturn")>0:ret="ProcedureReturn ":Else:ret="":EndIf
For i=npo To 1 Step -1
If i>1:nums=Str(i):Else:nums="":EndIf
remplace+#CRLF$+deb+nums+"("+paramx(l(),npf+i-1,100,1)+")"+#CRLF$+ret+proc+"("+paramx(l(),npf+npo,npf+i-1,0)+")"+#CRLF$+"EndProcedure"
proc(nom+nums)\nom=nom+nums
Next
fic =Left(fic ,pi-1)+remplace+Mid(fic ,pf)
ficx=Left(ficx,pi-1)+remplace+Mid(ficx,pf)
pf+Len(remplace)-Len(lg)
EndIf
With proc(proc)
\nomdesc=nom
\nom=proc
\type=vartype(Stringparse("."+lg,"."," "))
\comment=Trim(Stringparse(Left(lg,pl),";",#CRLF$)):If \comment="":\comment="no description":EndIf
\npf=npf
\npo=npo
CopyList(l(),\param())
EndWith
ForEver
pi=1
ForEach proc():With proc()
n=ListSize(\param())
If \npo
Repeat
pi=FindStringww(fic,\nomdesc,pi):If pi=0:Break:EndIf
pl=pi+Len(\nomdesc)
pi=FindString(fic,"(",pi)+1
p=FindString(fic,#CRLF$,pi):p=FindStringRev(fic,")",p)
listeparam(l(),Mid(fic,pi,p-pi)):ni=ListSize(l())-\npf+1
If ni>1:fic=Left(fic,pl-1)+ni+Mid(fic,pl):EndIf
ForEver
EndIf
Debug proc()\nom
EndWith:Next
fpbo+"m"
ecrirefic(fpbo,fic)
;----------------------- fichier ASM (substitution des labels asm par le nom des procedures)
fasm=dossier+"PureBasic.asm"
param=" /COMMENTED"
If unicode:param+" /UNICODE":EndIf
If thread :param+" /THREAD":EndIf
ret=RunProgramext(#g+#PB_Compiler_Home+"compilers\pbcompiler.exe"+#g,Fpbo+param,dossier,#PB_Program_Open | #PB_Program_Read| #PB_Program_Hide)
If FindString(ret,"Error:"):MessageRequester("PBcompiler ERROR",ret):End:EndIf
fic= lirefic(fasm)
pi=1
Repeat
pi=FindString(fic,"; ProcedureDLL",pi):If pi=0:Break:EndIf:pi+10
proc=Stringparse(fic," ","(",pi)
proc(proc)\nomasm=Stringparse(fic,")"+#CRLF$,":",pi)
ForEver
ForEach proc()
fic=ReplaceString(fic,proc()\nomasm+":","public "+"PB_"+proc()\nom+#CRLF$+"PB_"+proc()\nom+":")
fic=ReplaceString(fic,proc()\nomasm+#CRLF$,"PB_"+proc()\nom+#CRLF$)
Next
;fic=ReplaceString(fic, " RET"+#CRLF$," RET +4"+#CRLF$,0,FindString(fic,"; ProcedureDLL"))
ecrirefic(fasm,fic)
;ForEach proc():Debug proc()\nom+#TAB$+proc()\nomasm+#TAB$+proc()\nomdesc:Debug proc()\type:Debug proc()\param:Debug proc()\comment:Debug "":Next
ret= RunProgramext(#g+#PB_Compiler_Home+"compilers\fasm.exe"+#g,#g+fasm+#g+" "+#g+Fnom+".obj"+#g,dossier,#PB_Program_Open | #PB_Program_Read| #PB_Program_Hide)
If FindString(ret,"passes")=0:MessageRequester("FASM ERROR",ret):End:EndIf
;----------------------- fichier desc
dep=Stringparse(fic,"Assembly"+#CRLF$+"; "+#CRLF$,"; :System")
dep=ReplaceString(dep,"; ","")
desc="ASM"+#CRLF$+"0"+#CRLF$+"OBJ"+#CRLF$+CountString(dep,#CRLF$)+#CRLF$+dep+"UserLib"+#CRLF$+#CRLF$
ForEach proc():With proc()
If \nomdesc
ltype="":lparam="":ForEach \param():ltype+vartype(\param())+",":lparam+" , "+\param():Next
desc+\nomdesc+","+ltype+"("+Mid(lparam,4)+") - "+\comment+#CRLF$
desc+\type+" | "+"StdCall"
If \type="String"Or FindString(ltype,"String"):desc+" | Unicode":EndIf
If LCase(\comment)="init":desc+" | InitFunction":EndIf
If LCase(\comment)="end" :desc+" | EndFunction" :EndIf
desc+#CRLF$+#CRLF$
EndIf
EndWith:Next
ecrirefic(Fnom+".desc",desc)
flib=dossier;#PB_Compiler_Home+"purelibraries\userlibraries\"
RunProgramext(#g+#PB_Compiler_Home+"sdk/librarymaker.exe"+#g,#g+Fnom+".desc"+#g+" /TO "+#g+flib+#g,flib,#PB_Program_Open | #PB_Program_Read| #PB_Program_Hide)
EndProcedure
makeuserlib("C:\PureBasic-code\lib\3d_ext.pb")