Faire une UserLib uniquement en PB

Partagez votre expérience de PureBasic avec les autres utilisateurs.
Avatar de l’utilisateur
Kwai chang caine
Messages : 6962
Inscription : sam. 23/sept./2006 18:32
Localisation : Isere

Re: Faire une UserLib uniquement en PB

Message par Kwai chang caine »

Marche nickel 8)
1000 €
1000 F
-1000 F
Merci FALSAM, si tout le monde s'y met.....on va l'avoir cette fonction creation USERLIB .... 8) et sans FRED Naaaaa !!!!! :lol:

Moi j'ai une question toute bête (Kcc/Toute bête = pléonasme :mrgreen: ) pour les ASMEURS qui me taraude le golliwog, je sais pas si quelqu'un connait la réponse
Puisque FRED il s'est embeté à rajouter le nom de la procédure en commentaire...
;
; ProcedureDLL.l Add(A,B)
_Procedure0:
PUSH ebx
PS2=12
XOR eax,eax
pourquoi il l'a pas mis carrément dans l'appel
public PB_Add
PB_Add:
PUSH ebx
PS2=12
XOR eax,eax
ImageLe bonheur est une route...
Pas une destination

PureBasic Forum Officiel - Site PureBasic
Avatar de l’utilisateur
falsam
Messages : 7244
Inscription : dim. 22/août/2010 15:24
Localisation : IDF (Yvelines)
Contact :

Re: Faire une UserLib uniquement en PB

Message par falsam »

Merci pour ce test Kwai chang caine. Quand à ta question, Seul le Grand Manitou pourra répondre. :wink:
Configuration : Windows 11 Famille 64-bit - PB 6.03 x64 - AMD Ryzen 7 - 16 GO RAM
Vidéo NVIDIA GeForce GTX 1650 Ti - Résolution 1920x1080 - Mise à l'échelle 125%
Avatar de l’utilisateur
Kwai chang caine
Messages : 6962
Inscription : sam. 23/sept./2006 18:32
Localisation : Isere

Re: Faire une UserLib uniquement en PB

Message par Kwai chang caine »

Bon.... je vais attendre le grand Image à chaillotes :D
ImageLe bonheur est une route...
Pas une destination

PureBasic Forum Officiel - Site PureBasic
Avatar de l’utilisateur
Guillot
Messages : 522
Inscription : jeu. 25/juin/2015 16:18

Re: Faire une UserLib uniquement en PB

Message par Guillot »

Salut G-rom,

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

j'ai vu 2 cas de figure
par exemple si je fait un lib avec les fonctions

Code : Tout sélectionner

ProcedureDLL.l Split(Array t.s(1),l.s,sep.s=",",nmax=100)
    Protected ap.l,p.l,n,ls
    Dim t(nmax)
    ls=Len(sep)
    l+sep
    p=1-ls
    Repeat
        ap=p+ls:p=FindString(l,sep,ap)
        If p=0:Break:EndIf
        n+1
        t(n)= Mid(l,ap,p-ap)
    ForEver
    ReDim t(n)
    ProcedureReturn n
EndProcedure

ProcedureDLL.l somme(Array a.l(1))
    Protected s
    For i=0 To ArraySize(a())
        s+a(i)
    Next
    ProcedureReturn s
EndProcedure
à l'utilisationla fonction split me retourne le nombre de champ
mais le tableau reste vide
quand à la fonction somme elle plante : acces memoire invalide

Code : Tout sélectionner

Dim t.s(0)
Debug Split(t(),"azeza zaea zzz rd cxvx"," ")
n=ArraySize(t()):Debug "ArraySize:"+n:For i=0 To n:Debug t(i):Next

Debug "--------------"

Dim a.l(5)
For i=0 To 5
    a(i)=Random(9)
    Debug a(i)
Next
Debug "somme="+somme(a())
le code de ma moulinette à userlib

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")
G-Rom
Messages : 3626
Inscription : dim. 10/janv./2010 5:29

Re: Faire une UserLib uniquement en PB

Message par G-Rom »

salut guillot, je viens de voir ton topic ( remercie olivier , j'ai désactivé les notifs )
je matte ton code , faut que je replonge la dedans.
G-Rom
Messages : 3626
Inscription : dim. 10/janv./2010 5:29

Re: Faire une UserLib uniquement en PB

Message par G-Rom »

une piste ici :

http://forums.purebasic.com/english/vie ... 13&t=66223

je pense que tu ne peut pas exporté directement des array en paramètre. faut jouer avec des pointeurs.
Avatar de l’utilisateur
Guillot
Messages : 522
Inscription : jeu. 25/juin/2015 16:18

Re: Faire une UserLib uniquement en PB

Message par Guillot »

merci G-rom
ouai, c'est une solution de secour
a priori on doit même pouvoir utiliser les tableaux de maniere transparente (en adaptant le code source de la lib automatiquement)

mais bon, je pense qu'il y a un moyen plus simple
j'avais soumis le probleme a Fred, mais pas eu de réponse... (je pense qu'il a d'autres chat à fouetter)

Une autre question, peut on faire des lib sur toute les plateformes ? (linux et mac)
G-Rom
Messages : 3626
Inscription : dim. 10/janv./2010 5:29

Re: Faire une UserLib uniquement en PB

Message par G-Rom »

Normalement oui , cette méthode devrais fonctionner.
Pour les tableaux , c'est un peu logique , PB ne supporte pas le passage par référence , sauf que les tableaux le laisse pensé , j'ai pas regardé comment l'asm est générer pour un paramètre de tableau dans une fonction , mais à coup sur c'est un pointeur , d'ou le plantage.
Répondre