«
»
Grenier, boite 2

Grenier, boite 2

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 vEspaceLibre

Nombre 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 vTempo

Vé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 vCpt

Connecter 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 Res

Classe 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])
fin

Structure 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