«

Grenier, boite 10

« Bekier en ligne » est un site qui parle aux anciens. Cyril BEKIER, son auteur principal (il n’était pas seul) nous a partagé, début des années 2000, des bouts de code intéressants qui sont à présent disponible ici car le site est abandonné. Merci à Cyril mais aussi à William DODE, Jean-François POLI, José DUBOIS, Lionel DELETANG, Emmanuel HAEFELE, Laurent Fontana, Eric NGUYEN, Ugo GENNUSO et Max MAISCHEIN pour leurs contributions.

Utilitaires pour WinDev

Description des Fichiers DBF PSION  Document Word à télécharger
Documentation sur InfoObjet version 2.01 (WinDev 5.5)  Document Word à télécharger
Programme d’exemple d’InfoObjet Document Word à télécharger
Fichier d’Aide AUTOMATION 97 Fichier exécutable à télécharger
Format de fichier PIF (Raccourci Windows 95) Document Word à télécharger
Interfaçage de FotoWin Fax avec WinDev : Description du fichier Session.dbf Document Word à télécharger

Utilitaires pour WinDev

WinHexplode : Front End pour HEXPLODE©PC SOFT et pour les fichiers compressés avec WinDev Projet WinDev 5 WinEx à télécharger        DLL pour WinEx

Procédures

Timer et Sleep, usage CPU minimum

//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 !
/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 = APITimerDelete(timer1)

Connaître la taille d'un disque, son espace libre et par différence son espace occupé

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

Connaître le nombre d'années, mois, qui sépare deux dates

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é

Connaître le nombre d'occurrences dans une chaîne en fonction d'un séparateur

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

Déterminer la position d'un élément dans une chaîne de caractère

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

Permet de mettre à jour un élément à une position donnée dans une chaîne de caractère

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

Permet de convertir une chaîne de caractère de façon à supprimer tous les caractères superflus et à convertir celle-ci en majuscule

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

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

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

Permet d'exécuter le programme par défaut associé à un fichier (.doc, .htm etc..)

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

Permet de connecter un lecteur réseaux avec un login différent de celui de l'utilisateur en cours

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)

Permet de déconnecter un lecteur réseaux

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

Divers

Carte de France avec les départements Projet V5.5 à télécharger
Amortissement d’un prêt linéaire à taux fixe en WD5 Exécutable à télécharger
Sauvegarde des fichiers d’une analyse sur plusieurs diskettes Projet V5.5 à télécharger
Serveur RAS Projet V5.5 à télécharger
Procédure d’exportation de fichiers HFile vers Dbase III ou ASCII. (4 Fenêtres) Exécutable à télécharger

Fichiers

Communes Européennes (+ de 191.500). 5 Pays sont fournis dans leur intégralité : France (37.000), l’Allemagne (45.000), l’Espagne (27.000), l’Italie (26.600), le Portugal (7.900) Fichier texte à télécharger
50 Pays Européens Fichier texte à télécharger
4854 Localités suisses Fichier texte à télécharger

Classes WinDev

Classe de Conversion Texte avec séparateur vers PSION 3a et 3c Projet V5.5 à télécharger
Classe de gestion des menus Popup  Projet V4.1 à télécharger
Classe de gestion d’une table mémoire Fichier backup(?) à télécharger

Utilitaires pour WinDev

WinHexplode : Front End pour HEXPLODE©PC SOFT et pour les fichiers compressés avec WinDev Projet WinDev 5 WinEx à télécharger        DLL pour WinEx