Les articles ci-dessous ont été récupérés d’un site « Bekier en ligne » (bekier.fr et bekier.org) qui n’existe plus. Les articles parlant de PSION, marque abandonnée en 2013, n’ont pas été repris.
Merci à son auteur Cyril BEKIER (et aux autres si précisés) !
WinHexplode : Front End pour HEXPLODE ©PCSOFT (Cyril BEKIER)
Cet outil pilote le logiciel HEXPLODE de PCSOFT, via sa ligne de commande, qui était contenu dans les installations WinDev 4. À télécharger ici.
Timer (Eric NGUYEN)
//creates a timer with a 1ms * period pulse
//make this Global if used in the whole project
procedure APITimerCreate(period) //in ms
hnd is long int
i is unsigned int = 1
hnd = calldll32("user32","SetTimer",handle(),i,period,null) //
while (hnd = 0 and i < 0xffff)
i++
hnd = calldll32("user32","SetTimer",handle(),i,period,null) //10s
end
result(hnd) // 0 = failure else timer id
//--------------------------------------------------------------------------
// this deletes a timer, make sure it is called from the same window used
// by APICreateTimer, otherwise include a handle to the timers windows owner
// in the parameters and replace handle() by the parameter
procedure APITimerDelete(thnd) //timer id
res is long int
res = calldll32("user32","KillTimer", handle(), thnd)
result res // !0 = ok, 0 = error
//-------------------------------------------------------------------------
//now in my main window opening code I create a 1s timer
timer1 is unsigned int = APITimerCreate(1000) //1 seconds
if timer1 then
event("DisplayTime","*.",0x113) //WM_TIMER
else
error("Could not create a timer")
end
// more code there....
//-------------------------------------------------------------------------
// When we close the window
timer1stop is boolean
timer1stop = APITimerDelete(timer1)Sleep (Eric NGUYEN)
//This creates a semaphore that is never signaled (used by the sleep function)
// the handle is automaticaly closed on exit by the OS
mytimer is long int
mytimer = calldll32("kernel32","CreateSemaphoreA",null,0,1,null)
sleep(1000, mytimer) //wait 10 seconds no CPU used !Information du disque dur par API (Emmanuel HAEFELE)
procedure InfoDisque (vUnité,vTailleDisque)
vEspaceLibre est un reel double
vSecteurParCluster est un entier long // Nombre de secteur par cluster
vBytesParCluster est un entier long // Nombre d'octets par cluster
vClusterLibre est un entier long // Nombre de cluster libre
vTotalCluster est un entier long // Nombre de cluster sur le disque
vLecteur est une chaine asciiz sur 5 // Identification du lecteur
vResultat est un entier long
vLecteur=vUnité+"\"+caract(0)
if versionwindows() = 32 then
vResultat = appeldll32("kernel32","GetDiskFreeSpaceA",&vLecteur,...
&vSecteurParCluster,&vBytesParCluster,&vClusterLibre,&vTotalCluster)
if vResultat = 1 then
vTailleDisque = vBytesParCluster*vTotalCluster*vSecteurParCluster
vEspaceLibre = vBytesParCluster*vClusterLibre*vSecteurParCluster
end
end
renvoyer vEspaceLibreNombre d'années, mois, qui sépare deux dates (Emmanuel HAEFELE)
Procedure Age(vDateDebut,vDateFin,vAnnée,vMois) vAnnée1 est un entier = vDateDebut[[1 a 4]] vAnnée2 est un entier = vDateFin[[1 a 4]] vMois1 est un entier = vDateDebut[[5 à 6]] vMois2 est un entier = vDateFin[[5 a 6]] vJours1 est un entier = vDateDebut[[7 a 8]] vJours2 est un entier = vDateFin[[7 a 8]] vLibellé est une chaine vAnnée = vAnnée2 - vAnnée1 if vMois2 > vMois1 then vMois = vMois2 - vMois1 if vJours2 >= vJours1 then goto FINPROC vMois-- goto FINPROC end if vMois2 = vMois1 then vMois = vMois2 - vMois1 if vJours2 >= vJours1 then GOTO FINPROC vAnnée-- ; vMois = 11 goto FINPROC end vAnnée-- vMois = 12 - vMois1 + vMois2 if vJours2 >= vJours1 then GOTO FINPROC vMois-- FINPROC: if vAnnée < 0 then vAnnée = 0 ; vMois = 0 if vMois < 0 then vAnnée = 0 ; vMois = 0 if vAnnée <> 0 then if vAnnée = 1 then vLibellé = "1 an" else vLibellé = vAnnée + " ans" end end if vMois <> 0 then if vLibellé <> "" then vLibellé = vLibellé + ", " vLibellé = vLibellé + vMois + " mois." end renvoyer vLibellé
Nombre d'occurrences dans une chaîne en fonction d'un séparateur (Emmanuel HAEFELE)
procedure CompterElem(vChaine,vSéparateur="") vDebut est un entier long = 0 vCpt est un entier long = 0 if vSéparateur = "" then vSéparateur = tab Boucle vDebut = position(vChaine,vSéparateur,vDebut+1) if vDebut = 0 then break vCpt++ end if vChaine <> "" then vCpt++ RENVOYER vCpt
Position d'un élément dans une chaîne de caractère (Emmanuel HAEFELE)
Procedure LocaliserElem(vChaineExplorée,vChaineRecherchée,vSéparateur="") vPos est un entier long = 0 vPos2 est un entier long = 0 vTempo est une chaine if vSéparateur = "" then vSéparateur = tab vChaineExplorée = vSéparateur + vChaineExplorée + vSéparateur vPos = position(vChaineExplorée,vSéparateur+vChaineRecherchée+vSéparateur) if vPos = 0 or vPos = 1 then vChaineExplorée = vChaineExplorée[[2 à]] vChaineExplorée = vChaineExplorée[[1 à taille(vChaineExplorée)-1]] renvoyer vPos end vTempo = vChaineExplorée[[1 à vPos-1]] ; vPos = 1 ; vPos2 = 0 loop vPos2 = Position(vTempo,vSéparateur,vPos2+1) if vPos2 = 0 then break vPos++ end vChaineExplorée = vChaineExplorée[[2 à]] vChaineExplorée = vChaineExplorée[[1 à taille(vChaineExplorée)-1]] renvoyer vPos
Mettre à jour un élément à une position donnée dans une chaîne de caractère (Emmanuel HAEFELE)
procedure RemplacerElem(vChaineExplorée,vChaine,vPosition,vSéparateur="") vTempo est une chaine vAncVal est une chaine vReste est une chaine vPos est un entier long = 0 vPos2 est un entier long = 0 vAjout est un booleen = faux if vSéparateur = "" then vSéparateur = tab if vPosition = 0 then if vChaineExplorée = "" then vChaineExplorée = vChaine else vChaineExplorée = vChaineExplorée + vSéparateur + vChaine end return end vAncVal = extraitchaine(vChaineExplorée,vPosition) if vPosition = 1 then vChaineExplorée = vChaine + vChaineExplorée[[(taille(vAncVal)+1) à]] return end if extraitchaine(vChaineExplorée,vPosition) = eot then loop vChaineExplorée = vChaineExplorée + vSéparateur if extraitchaine(vChaineExplorée,vPosition) <> eot then break end vChaineExplorée = vChaineExplorée + vChaine return end vPos = vPosition ; vTempo = vAncVal loop vReste=vReste+vTempo ; vPos++ ; vTempo=extraitchaine(vChaineExplorée,vPos) if vTempo = eot then break vReste = vReste + vSéparateur end if extraitchaine(vChaineExplorée,vPosition+1) = eot and vReste <> "" then vAjout = vrai ; vChaineExplorée = vChaineExplorée + vSéparateur end vPos = position(vChaineExplorée,vSéparateur+vReste) ; vPos2 = 0 loop vPos2 = position(vChaineExplorée,vSéparateur+vReste,vPos2+1) if vPos2 = 0 then break vPos = vPos2 end vChaineExplorée = vChaineExplorée[[1 à vPos]]+vChaine+... vChaineExplorée[[(vPos+taille(vAncVal)+1) à]] if vAjout then vChaineExplorée = vChaineExplorée[[1 à taille(vChaineExplorée)-1]] end return
Convertir une chaîne de caractère de façon à supprimer tous les caractères superflus et à convertir celle-ci en majuscule (Emmanuel HAEFELE)
procedure ConversionChaine (vExpression1,vExpression2,vChaineExplorée) vTaille est un entier long = taille(vChaineExplorée) vCpt est un entier long vPosition est un entier long vCaractère est une chaine vRemplace est une chaine for vCpt = 1 to vTaille vCaractère = vChaineExplorée[[vCpt]] vPosition = position(vExpression1,vCaractère) if vPosition <> 0 then vRemplace = vExpression2[[vPosition]] vChaineExplorée = vChaineExplorée[[1 à vCpt-1]]+vRemplace+vChaineExplorée[[vCpt+1 à ]] if vRemplace = "" then vTaille-- ; vCpt-- end end
Vérification de l'exactitude d'une clef RIB par rapport à un numéro de compte (Emmanuel HAEFELE)
FONCTION MajZoneRecherche (vChaine)
// Remarque : la ligne 25 peut être supprimée si l'on ne souhaite pas la
// suppression pure et simple des caractères &'( etc...
vBase est une chaine
vResultat est une chaine
vTempo est une chaine = vChaine
vCaractère est une chaine
vRemplace est une chaine
vCpt est un entier long
vPosition est un entier long
vTaille est un entier long
vBase = "äâãàÄÂÃÀ"+caract(193)+caract(197)+caract(225)+caract(229)...
+caract(240)...
+"ëêèËÊÈ"+caract(201)...
+"ÿ"+caract(253)...
+"üûùÜÛÙ"+caract(218)+caract(250)...
+"ïîìÏÎÌ"+caract(205)...
+"öôõòÖÔÕÒ"+caract(211)+caract(216)+caract(243)+caract(248)...
+caract(222)...
+"ç"+caract(199)...
+caract(241)...
+"&'(-_)=^$*,;:!°+¨£%µ?./§~#{[|`\@]¤ "+caract(34)
vResultat = "AAAAAAAAAAAADEEEEEEEYYUUUUUUUUIIIIIIIOOOOOOOOOOOOPCCN"
vTaille = taille(vChaine)
vTempo = vChaine
if vTempo = "" then renvoyer vTempo
for vCpt = 1 to vTaille
vCaractère = vTempo[[vCpt]]
vPosition = position(vBase,vCaractère)
if vPosition <> 0 then
vRemplace = vResultat[[vPosition]]
vTempo = vTempo[[1 à vCpt-1]]+vRemplace + vTempo[[vCpt+1 à ]]
if vRemplace = "" then vTaille-- ; vCpt--
else
vRemplace = ""
SELON ASC(vCaractère)
cas 198
vRemplace = "AE"
cas 223
vRemplace = "ss"
cas 230
vRemplace = "ae"
autre cas
end
if vRemplace <> "" then
vTempo = vTempo[[1 à vCpt-1]]+vRemplace + vTempo[[vCpt+1 à]]
vTaille++ ; vCpt++
end
end
end
vTempo = majuscule(vTempo)
renvoyer vTempoVérification de l'exactitude de la clef de sécurité sociale par rapport à son numéro (Emmanuel HAEFELE)
procedure CtrlSSoc (vNumero,vCle) if vNumero = "" and vCle = "" then vCle = 97 ; return vResultat est un entier vTempo est un reel double vI est un entier for vI = 1 to taille(vNumero) If vNumero[[I]] <> " " then vTempo = vTempo + vNumero[[I]] end vResultat = (97 - (vtempo - (partieentiere(vTempo/97) * 97))) if vResultat <> vCle then if ouinon(Non, "Clé incorrecte - Clé calculée : " + vResultat, ... "Voulez-vous Prendre en compte cette valeur ?") then vCle = vResultat end end
Exécuter le programme par défaut associé à un fichier (.doc, .htm etc..) (Emmanuel HAEFELE)
procedure ProgDefaut (vFichier,vRepertoire="")
vOk est un booleen
vExtension est une chaine
vProgramme est une chaine
vNombre est un entier long
vNombre = CompterElem(vFichier,".")-1
if vNombre < 1 then renvoyer faux vNombre++ vExtension = extraitchaine(vFichier,vNombre,".") if vExtension = eot or vExtension = "" then renvoyer faux vProgramme = Registrelit("HKEY_CLASSES_ROOT\."+vExtension,"",vOk) if Not vOk then renvoyer faux vProgramme = Registrelit("HKEY_CLASSES_ROOT\"... +vProgramme+"\shell\open\command","",vOk) if Not vOk then renvoyer faux if vProgramme[[1]] = """" then vProgramme = extraitchaine(vProgramme,2,"""") else vProgramme = extraitchaine(vProgramme,2," ") end if position(vProgramme,"%1") > 0 then
vProgramme = extraitchaine(vProgramme,1,"%1")
end
if vRepertoire = "" then vRepertoire = frepencours()
if not ddelance(vProgramme+" "+vRepertoire+"\"+vFichier) then renvoyer faux
renvoyer vrai
----------------------------------------------------------------------
procedure CompterElem(vChaine,vSéparateur="")
vDebut est un entier long = 0
vCpt est un entier long = 0
if vSéparateur = "" then vSéparateur = tab
Boucle
vDebut = position(vChaine,vSéparateur,vDebut+1)
if vDebut = 0 then break
vCpt++
end
if vChaine <> "" then vCpt++
RENVOYER vCptConnecter un lecteur réseau avec un utilisateur différent de celui de l'utilisateur en cours (Cyril BEKIER)
Procédure NetAddConnection(lsLocalName,lsRemoteName,lsUserName,lsPassword)
NetResource est compose de
Scope est un entier long
Type est un entier long
DisplayType est un entier long
Usage est un entier long
LocalName est un entier long
RemoteName est un entier long
Comment est un entier long
Provider est un entier long
fin
LocalName est une chaine asciiz sur 256
RemoteName est une chaine asciiz sur 256
Password est une chaine asciiz sur 256
UserName est une chaine asciiz sur 256
Flags est un entier long
Res est un entier long
Res = 0
LocalName = lsLocalName
RemoteName = lsRemoteName
UserName = lsUserName
Password = lsPassword
Flags = Null
NetResource.Scope = 0x1
NetResource.Type = 0x1
NetResource.DisplayType = 0x0
NetResource.LocalName = &LocalName
NetResource.RemoteName = &RemoteName
NetResource.Provider = null
Res=AppelDLL32("mpr.dll", "WNetAddConnection2A", &NetResource, &Password, &UserName, Flags)
renvoyer(Res)Déconnecter un lecteur réseau (Cyril BEKIER)
Procédure NetCancelConnection(lsName, lbForce=faux)
//Déconnecter un lecteur réseaux
// si lbForec = Vrai, Déconnecte le lecteur même si des fichiers sont ouverts
Res est un entier long
Name est une chaine asciiz sur 256
Flags est un entier long
Force est un booleen
Res = 0
Name = lsName
Force = lbForce
Flags = 0x1
Res=AppelDLL32("mpr.dll", "WNetCancelConnection2A" , &Name, Flags, Force)
renvoyer ResClasse de gestion des menus Popup (Lionel Barbano)
Constructeur
Popup est une classe // classe de gestion des menus PopUp fin
Méthode AffichePopup
LOCAL
i est un entier
Cpt est un entier
Ch est une chaine
ChPre est une chaine
Rang est un entier
CptMenu est un entier
RangPre est un entier
RangMenu est un entier
IndiceMenu est un entier
TypeOpt est un entier
hMenu est un tableau de 100 entiers longs
nPosition est un tableau de 100 entiers
PileMenu est un tableau de 100 entiers
PosPile est un entier
hMenuN est un entier long
wFlags est un entier long
// MF_STRING=0 MF_ENABLED=0 MF_POPUP=16 MF_BYPOSITION=1024 MF_SEPARATOR=2048
wIDNewItem est un entier long
lpNewItem est une chaine asciiz sur 80
Souris32 est compose de
posh32 est un entier long
posv32 est un entier long
FIN
// Si Chaine de Menus vide, retour
si ListeOptions="" retour
// Init du tableau de positions
pour i=1 à 100
nPosition[i]=1
fin
// Extraction des options de menu et création des menus
Cpt=1
CptMenu=PremierIndice
boucle
Ch=ExtraitChaine(ListeOptions,Cpt)
si Ch=eot sortir
// Elimination des "-" et comptage du rang du menu
Rang=1
boucle
si Ch[[1 à 1]]="-" alors
Rang++
Ch=Ch[[2 à ]]
sinon
sortir
fin
fin
// Si séparateur...
si Ch~="SEP" TypeOpt=2048 sinon TypeOpt=0
// Si nouveau sous-menu
si Rang > RangPre alors
IndiceMenu++
RangMenu=IndiceMenu
PosPile++
PileMenu[PosPile]=RangMenu
// Creation du nouveau sous-menu
hMenu[RangMenu]=AppelDLL32("user32","CreatePopupMenu")
// Ajout de la nouvelle option
wFlags=TypeOpt
wIDNewItem=CptMenu
lpNewItem=Ch
AppelDLL32("user32","AppendMenuA" , hMenu[RangMenu], wFlags, wIDNewItem, &lpNewItem)
// Faire pointer l'option précédente vers ce nouveau sous-menu
si RangMenu>1 alors
wFlags=16+1024 // MF_POPUP+MF_BYPOSITION
wIDNewItem=hMenu[RangMenu]
lpNewItem=ChPre
AppelDLL32("user32","ModifyMenuA" , hMenu[ PileMenu[PosPile-1] ], nPosition[ PileMenu[PosPile-1] ]-1, wFlags, wIDNewItem, &lpNewItem)
fin
fin
// Si simple ajout d'option
si Rang = RangPre alors
// Ajout de la nouvelle option
wFlags=TypeOpt
wIDNewItem=CptMenu
lpNewItem=Ch
AppelDLL32("user32","AppendMenuA" , hMenu[RangMenu], wFlags, wIDNewItem, &lpNewItem)
nPosition[RangMenu]++
fin
// Si retour vers un menu déjà existant
si Rang < RangPre alors
RangMenu=PileMenu[PosPile-(RangPre-Rang)]
PosPile-= RangPre-Rang
// Ajout de la nouvelle option
wFlags=TypeOpt
wIDNewItem=CptMenu
lpNewItem=Ch
AppelDLL32("user32","AppendMenuA" , hMenu[RangMenu], wFlags, wIDNewItem, &lpNewItem)
nPosition[RangMenu]++
fin
// Evolution des compteurs
RangPre=Rang
ChPre=Ch
CptMenu++
Cpt++
fin
si pas IndiceMenu retour
si x=-1 et y=-1 alors
// Récupère la position absolue de la souris
AppelDLL32("user32","GetCursorPos",&Souris32)
sinon
Souris32.posH32=x
Souris32.posV32=y
fin
// Affiche le menu principal
AppelDll32("user32","TrackPopupMenu",hMenu[1],0,Souris32.PosH32,Souris32.PosV32,0,Handle(""),null)
// Détruit les menus
pour i=1 à IndiceMenu
AppelDLL32("user32","DestroyMenu" , hMenu[i])
finStructure d'un fichier .PIF, raccourci Windows (Max Maischein)
OFFSET Count TYPE Description
0000h 1 byte reserved
0001h 1 byte Checksum
0002h 30 char Title for the window
0020h 1 word Maximum memory reserved for program
0022h 1 word Minimum memory reserved for program
0024h 63 char Path and filename of the program
0063h 1 byte 0 – Do not close window on exit
other – Close window on exit
0064h 1 byte Default drive (0=A: ??)
0065h 64 char Default startup directory
00A5h 64 char Parameters for program
00E5h 1 byte Initial screen mode, 0 equals mode 3 ?
00E6h 1 byte Text pages to reserve for program
00E7h 1 byte First interrupt used by program
00E8h 1 byte Last interrupt used by program
00E9h 1 byte Rows on screen
00EAh 1 byte Columns on screen
00EBh 1 byte X position of window
00ECh 1 byte Y position of window
00EDh 1 word System memory ?? whatever
00EFh 64 char ?? Shared program path
012Fh 64 char ?? Shared program data file
016Fh 1 word Program flags
EXTENSION:PIF,DVP