QBasic Nombres premiers

Un programme en qbasic  pour calculer les nombres premiers entre 1 et 1000, ou plus 2000,10000...

Un extrait en exemple. Demandez moi le programme, je vous  l’enverrai avec votre adresse mail.

 

 

Hérisson

 Ils existent toujours, du moins pour ce spécimen de 22cm

 

 

Basic à QB64

 Vous avez un ancien programme avec une série de numéro de lignes, vous voulez l'adapter en le rendant plus clair.

A l'ancien temps Crosoft avait fait un logiciel en basic permettant de supprimer les numéros de lignes inutiles.

Impossible de le retrouver chez Crosoft, mais dans mes archives, il existe.

Le voici :

DEFINT A-Z
'
'   Microsoft SupLigne - Utilitaire de suppression des numéros de ligne
'   Copyright (C) Microsoft Corporation   - 1985, 1986, 1987, 1988, 1989
'
'   SUPLIGNE.BAS est un programme qui supprime les numéros de ligne des
'   programmes écrits en BASIC Microsoft. Il ne supprime que les numéros de
'   ligne ne qui font pas l'objet de l'une des instructions suivantes :
'   GOSUB, RETURN, GOTO, THEN, ELSE, RESUME, RESTORE, ou RUN.
DECLARE FUNCTION CherchElement$ (Recherche$, Separ$)
DECLARE FUNCTION ExplChaine% (ChaineEntree$, Separateur$)
DECLARE FUNCTION RuptChaine% (ChaineEntree$, Separateur$)
DECLARE FUNCTION EstChiffre% (Car$)
DECLARE SUB CherchNomsFich ()
DECLARE SUB BatiTable ()
DECLARE SUB CreeFichSortie ()
DECLARE SUB InitTableTouches ()
CONST VRAI = -1
CONST FAUX = 0
CONST MaxLignes = 400
DIM SHARED TableLignes!(MaxLignes)
DIM SHARED CompteLignes
DIM SHARED Seps$, FichEntree$, FichSortie$, FichTemp$
CONST CompteMotsCles = 8
DIM SHARED TableMotsCles$(CompteMotsCles)
DonneesTouches:
DATA THEN,ELSE,GOSUB,GOTO,RESUME,RETURN,RESTORE,RUN
Seps$ = " ,:" + CHR$(9)
InitTableTouches
CherchNomsFich
ON ERROR GOTO ErrFich1
OPEN FichEntree$ FOR INPUT AS 1
ON ERROR GOTO 0
COLOR 7: PRINT "Traitement en cours";: COLOR 23: PRINT " . . .": COLOR 7: PRINT
BatiTable
CLOSE #1
OPEN FichEntree$ FOR INPUT AS 1
ON ERROR GOTO ErrFich2
OPEN FichSortie$ FOR OUTPUT AS 2
ON ERROR GOTO 0
CreeFichSortie
CLOSE #1, #2
IF FichSortie$ <> "CON" THEN CLS
END
ErrFich1:
CLS
PRINT "      Nom de fichier incorrect": PRINT
INPUT "      Entrez un nouveau nom de fichier (puis appuyez sur ENTREE): ", FichEntree$
IF FichEntree$ = "" THEN END
ErrFich2:
INPUT "      Nom du fichier de sortie (appuyez sur ENTREE pour l'afficher à l'écran) :", FichSortie$
PRINT
IF (FichSortie$ = "") THEN FichSortie$ = "CON"
IF FichTemp$ = "" THEN
    RESUME
ELSE
    FichTemp$ = ""
    RESUME NEXT
END IF
SUB BatiTable STATIC
    DO WHILE NOT EOF(1)
        LINE INPUT #1, LigneEntree$
        element$ = CherchElement$(LigneEntree$, Seps$)
        DO WHILE (element$ <> "")
            FOR IndexCles = 1 TO CompteMotsCles
                IF (TableMotsCles$(IndexCles) = UCASE$(element$)) THEN
                    element$ = CherchElement$("", Seps$)
                    DO WHILE (EstChiffre(LEFT$(element$, 1)))
                        CompteLignes = CompteLignes + 1
                        TableLignes!(CompteLignes) = VAL(element$)
                        element$ = CherchElement$("", Seps$)
                        IF element$ <> "" THEN IndexCles = 0
                    LOOP
                END IF
            NEXT IndexCles
            element$ = CherchElement$("", Seps$)
        LOOP
    LOOP
END SUB
FUNCTION CherchElement$ (Recherche$, Separ$) STATIC
    IF (Recherche$ <> "") THEN
        PosDebut = 1
        ChaineSauv$ = Recherche$
    END IF
    NouvPos = ExplChaine(MID$(ChaineSauv$, PosDebut, LEN(ChaineSauv$)), Separ$)
    IF NouvPos THEN
        PosDebut = NouvPos + PosDebut - 1
    ELSE
        CherchElement$ = ""
        EXIT FUNCTION
    END IF
    NouvPos = RuptChaine(MID$(ChaineSauv$, PosDebut, LEN(ChaineSauv$)), Separ$)
    IF NouvPos THEN
        NouvPos = PosDebut + NouvPos - 1
    ELSE
        NouvPos = LEN(ChaineSauv$) + 1
    END IF
    CherchElement$ = MID$(ChaineSauv$, PosDebut, NouvPos - PosDebut)
    PosDebut = NouvPos
END FUNCTION
SUB CherchNomsFich STATIC
    IF (COMMAND$ = "") THEN
        CLS
        PRINT " Microsoft SupLigne : utilitaire de suppression des numéros de ligne"
        PRINT " (l'extension .BAS est affectée par défaut si aucune extension n'est spécifiée), le fichier à modifier est un fichier.bas "
        PRINT
        INPUT "      Nom du fichier d'entrée (ENTREE pour terminer) : ", FichEntree$
        IF FichEntree$ = "" THEN END
        INPUT "      Nom du fichier de sortie (ENTREE pour l'afficher) : ", FichSortie$
        PRINT
        IF (FichSortie$ = "") THEN FichSortie$ = "CON"
    ELSE
        FichEntree$ = UCASE$(CherchElement$(COMMAND$, Seps$))
        FichSortie$ = UCASE$(CherchElement$("", Seps$))
        IF (FichSortie$ = "") THEN
            INPUT "      Nom du fichier de sortie (ENTREE pour l'afficher) : ", FichSortie$
            PRINT
            IF (FichSortie$ = "") THEN FichSortie$ = "CON"
        END IF
    END IF
    IF INSTR(FichEntree$, ".") = 0 THEN
        FichEntree$ = FichEntree$ + ".BAS"
    END IF
    IF INSTR(FichSortie$, ".") = 0 THEN
        SELECT CASE FichSortie$
            CASE "CON", "SCRN", "PRN", "COM1", "COM2", "LPT1", "LPT2", "LPT3"
                EXIT SUB
            CASE ELSE
                FichSortie$ = FichSortie$ + ".BAS"
        END SELECT
    END IF
    DO WHILE FichEntree$ = FichSortie$
        FichTemp$ = LEFT$(FichEntree$, INSTR(FichEntree$, ".")) + "BAK"
        ON ERROR GOTO ErrFich1
        NAME FichEntree$ AS FichTemp$
        ON ERROR GOTO 0
        IF FichTemp$ <> "" THEN FichEntree$ = FichTemp$
    LOOP
END SUB
SUB CreeFichSortie STATIC
    Sep$ = " " + CHR$(9)
    DO WHILE NOT EOF(1)
        LINE INPUT #1, LigneEntree$
        IF (LigneEntree$ <> "") THEN
            element$ = CherchElement$(LigneEntree$, Sep$)
            IF EstChiffre(LEFT$(element$, 1)) THEN
                NumeroLigne! = VAL(element$)
                NumeroTrouve = FAUX
                FOR index = 1 TO CompteLignes
                    IF (NumeroLigne! = TableLignes!(index)) THEN
                        NumeroTrouve = VRAI
                    END IF
                NEXT index
                IF (NOT NumeroTrouve) THEN
                    element$ = SPACE$(LEN(element$))
                    MID$(LigneEntree$, ExplChaine(LigneEntree$, Sep$), LEN(element$)) = element$
                END IF
            END IF
        END IF
        IF FichSortie$ = "CON" THEN
            PRINT LigneEntree$
        ELSE
            PRINT #2, LigneEntree$
        END IF
    LOOP
END SUB
FUNCTION EstChiffre (Car$) STATIC
    IF (Car$ = "") THEN
        EstChiffre = FAUX
    ELSE
        CarAsc = ASC(Car$)
        EstChiffre = (CarAsc >= ASC("0")) AND (CarAsc <= ASC("9"))
    END IF
END FUNCTION
FUNCTION ExplChaine% (ChaineEntree$, Separateur$) STATIC
    Ln = LEN(ChaineEntree$)
    PosDebut = 1
    DO WHILE INSTR(Separateur$, MID$(ChaineEntree$, PosDebut, 1))
        IF PosDebut > Ln THEN
            ExplChaine = 0
            EXIT FUNCTION
        ELSE
            PosDebut = PosDebut + 1
        END IF
    LOOP
    ExplChaine = PosDebut
END FUNCTION

SUB InitTableTouches STATIC
    RESTORE DonneesTouches
    FOR Comptage = 1 TO CompteMotsCles
        READ MotCle$
        TableMotsCles$(Comptage) = MotCle$
    NEXT
END SUB
FUNCTION RuptChaine (ChaineEntree$, Separateur$) STATIC
    Ln = LEN(ChaineEntree$)
    PosDebut = 1
    DO WHILE INSTR(Separateur$, MID$(ChaineEntree$, PosDebut, 1)) = 0
        IF PosDebut > Ln THEN
            RuptChaine = 0
            EXIT FUNCTION
        ELSE
            PosDebut = PosDebut + 1
        END IF
    LOOP
    RuptChaine = PosDebut
END FUNCTION

 

Testez-le

 
En principe pas de soucis mais au cas ou téléchargez - le avec ce lien
https://app.box.com/s/looeqmslkkilnn1rka8z1wjop8gg4bm1

Money 2005 ( lien )

 Un lien qui fonctionne aujourd'hui est :

Recherche Google Money2005-FR-QFE3

sur le site de microsoft  télécharger le.

Si le fichier n'était plu disponible  contactez moi.

Le fichier  msmoney standard 2005 est le fichier

Money2005-FR-QFE3.exe.exe

Supprimer un exe puis lancez-le en w10 avec la compatibilité  W7.

Suivez la procédure de l'article du  11 mars 2019.

Si le lien ne fonctionne pas faite une recherche avec ce nom complet :

Money2005-FR-QFE3.exe.exe    avec 2 fois exe à la fin.

Si vous ne pouviez pas le trouver je vous enverrai le logiciel en me contactant  à l'adresse mail du blog :

 j.ai.vu.sur.la.toile@gmail.com

ou sur  un site de téléchargement avec le lien suivant :

 https://app.box.com/s/i6gs0uj5ahc9i9yqbglq 

mis par mes soins.

Le fichier n'est plus disponible chez microsoft.

Par mesure de sécurité quand vous avez un fichier téléchargé, passez le systématiquement avec votre antivirus, au cas ou pendant le transfert un programme malveillant se serait invité. 

Calcul de la température ressentie

 Il suffit de mettre la formule et le tout dans un QB71 ou 64.

Demandez la moi, si vous ne pouvez l'obtenir ailleurs,  testez la et comparez avec ce résultat.

 

 

 

 

ADWCleaner remise a zéro

 Vous avez AdwareCleaner, ADWCleaner, mais vous voulez remettre les compteurs à zéro.

2 Solutions 

  1  ouvrez adwcleaner 

       - allez dans paramètres

            *tout en bas vous avez supprimer, si vous supprimez plus de adwcleaner, mais en réinstallant, les compteurs sont à zéro.

 

2    affichez les dossiers et fichiers cachés (voir sur le net si vous hésitez)

       - aller dans C: dossier adwcleaner

           * un fichier settings apparait supprimés le

QB64 ide module error

Gros problème de fonctionnement.

 

La Solution efficace à 100%, c'est quoi?

Vous avez Avast antivirus gratuit, c'est lui qui perturbe le fonctionnement du QB64.

Installez Avira  et tout fonctionne normalement, Avast antivirus et peut être bon très bon pour un pc avec lequel vous ne feriez rien d'autre que surfer sur internet et pas plus; sinon vous allez vers des  problèmes, comme avec QB64  : impossible d'enregistrer, être détecté comme un logiciel suspect quand vous utilisez un programme créé avec QB64.

Avira Anti virus uniquement

 C'est la version de 2017 de 260 mo valable en gratuit jusqu'en 2999.

Cette durée de validité est d'origine, pas du tout bricolé, si vous l'avez, installez-la à la place de la suite de maintenant, pour moi elle ne fonctionne pas normalement avec mon windows10, j'ai du remettre la version de 2017.

 

 

QB64 Jeu des allumettes

Voici ce programme qui est une base en programmation et qui permet de voir l'utilisation de plusieurs fonctions. 

 

PRINT "Jeu des allumettes"
SLEEP (2): CLS
INPUT "Ton nom : "; a$
INPUT "Mon nom : "; b$
SLEEP (2): CLS
Toi = 1
NbAl = 15
PRINT "Vous avez 15 allumettes, vous pouvez en prendre soit 1, 2, ou 3"
DO WHILE NbAl <> 0
    AlPris = 0
    DO
        IF Toi = 1 THEN COLOR 14, 0: PRINT "  "; a$: COLOR  7, 0 ELSE COLOR 10, 0: PRINT "  "; b$: COLOR 7, 0
        INPUT "Combien d'allumettes prenez-vous "; AlPris
    LOOP UNTIL AlPris >= 1 AND AlPris <= 3 AND AlPris <= NbAl
    NbAl = NbAl - AlPris
    PRINT "Il reste "; NbAl; " allumettes"
    Toi = 3 - Toi
LOOP
IF Toi = 1 THEN COLOR 14, 0: PRINT "  "; a$; " à gagné": COLOR 7, 0 ELSE COLOR 10, 0: PRINT "  "; b$; " à gagné": COLOR 7, 0
fin:
GOTO fin

Téléchargez qb64  en dernière version sur internet, recopier ce programme dans le qb64,  lancer run , bon jeu.

Avira sur pc virtuel

Si Avira ne veut  pas s'installer correctement, ou ne pas faire les mises à jour, une solution existe.

Sur votre pc ou Avira fonctionne, il faudra faire certaines manip qui sont simple et facile à faire.

 

- Aller dans :   programmes x86 

- Copier le dossier Avira sur une clé USB

- Aller sur votre pc virtuel

- Dans le dossier programmes x86 avec les droits administrateurs

y copier le dossier Avira de la clé usb 

- Aller dans ce dossier et lancer les fichiers exe y figurant  :

  Avira systray , systray start, service host

- Quand le symbole d'Avira sera dans la barre des taches            redémarrer le pc virtuel.

- Quand il sera réinitialisé , ouvrir Avira puis lancer la mise à  jour

Avira fonctionnera normalement

 

 

 

Qbasic classement ordre alphabétique

 Après de multiples et longues recherches sur le net, je n'ai pas trouvé de programme en Qbasic.

 Un programme permet de classer une  longue liste de mots ou même des groupes de mots, en une liste par ordre alphabétique. 

Je vous l'enverrai, sur demande.

 

Demandez-le, je l'enverrai avec votre adresse mail.

Qbasic Quelle semaine de l'année

 Sur des programmes lourd et qui fonctionne en permanence, donc qui occupe inutilement de la mémoire. 

Un petit programme basé sur les données de l'ordinateur donne le numéro de la semaine.

                

Le téléphone en main au volant

Le téléphone au volant, qui multiplie par trois les risques d'accident sur nos routes, est désormais durement sanctionné. Depuis vendredi 22 mars 2020, la répression s'est renforcée. Les automobilistes qui commettent une infraction routière leur portable à la main verront leur permis de conduire immédiatement retenu et encourront une suspension pouvant aller jusqu'à six mois. Cette sanction pourra durer un an en cas d'accident, de conduite en état d'alcoolémie ou après usage de stupéfiant.

SOIGNANTS et l'épidémie

On est en épidémie de corona, on se rends compte que les soignants sont formidables.

MOI je dis que ces soignants sont FORMIDABLES toute l'année, faces à tous types de détresse humaine, maladie, épidémie, moral, etc...

Comme eux, tous les autres corps de métiers sont nécessaires, et toute l'année de dénigrons pas des métiers comme les gens qui font le ménage qui sont le plus souvent pris de haut car ils font de travaux  sales, les éboueurs , etc... tous ces gens sont REMARQUABLES.

M E R C I à tous de prendre soins ou de aider par leur travail, et ne les prenons pas de haut sous prétexte qu'ils font des taches que la plupart ne voudrai pas faire.

Ces manuels tant dénigrés vont se faire des masques et les autres bardés de diplômes ne seront capables que de faire de grandes phrases pompeuses en se foutant de nos gueules.

CORONA virus

Merci au coronavirus, grâce à lui :

- Fini les guerres nucléaires
- Fini la surpopulation mondiale
- Fini la famine
- Tous les pays s'unissent
- Fini les retraites des très vieux

Mais non balisez pas, c'est comme une méchante grippe, les plus forts restent, çà tue moins que la route et les alcoolos au volant ou les fous du volant.
Çà reviendra saisonnièrement comme les rhumes, les allergies ou les grippes.

En résumé c'est la vie, des gens vivent vieux d'autres moins vieux, des accidents, des maladies.

Si vous lisez ce blog, c'est que vous etes encore en bonne santé.

Triominos calcul des points

Vous avez un triomino  mais c'est la galère pour compter les points.
Avec ce logiciel vous pourrez faire les calculs sans effort.

- on calcule en premier les points du triomino.
- les éventuels bonus en fonction de la pose.
- si on a pioché plusieurs fois.
- le montants du malus quand on pioche.
- le montant du triomino quand on a pioché.
- si la partie est fini, on ajoute ou pas, certains points ou on continu.
- pour finir le joueur 1 ou 2 pour calculer le total des points au fur et à mesure des parties.
- quel est le joueur gagnant.

Le réchauffement climatique

Lisez ceci, ou recherchez le  Google mon ami

QUI nous prend pour des truffes ?

• 
  
• 
  
• 
  

Le cycle de Milankovitch dépend de trois paramètres : l'excentricité (excentricity sur l'image), l'obliquité (obliquity) et la précession des équinoxes (precession). © Hannes Grobe, Alfred Wegener Institute for Polar and Marine Research  

La théorie de Milutin Milankovitch, élaborée en 1941, rend compte de l'alternance des cycles glaciaires et interglaciaires durant le Quaternaire. Une glaciation se produit lorsque les hautes latitudes de l'hémisphère nord reçoivent un minimum de rayonnement solaire durant l'été. Trois paramètres astronomiques jouent un rôle important dans la distribution de l'insolation sous les hautes latitudes : l'excentricité de l'orbite terrestre, l'obliquité de l'axe de rotation de la Terre par rapport au plan de l'écliptique et la précession des équinoxes.

Variations des paramètres orbitaux

L'excentricité de l'orbite terrestre. L'orbite terrestre est une ellipse, dont le Soleil est l'un des foyers. L'excentricité de l'ellipse mesure la différence de distance entre les deux foyers. Lorsque l'excentricité est faible, l'orbite terrestre est presque circulaire. L'excentricité est engendrée par les attractions gravitationnelles exercées entre la Terre et les autres planètes. La période caractéristique de variation du paramètre est de 100.000 ans. Bien qu'il fasse varier de 1 % seulement l'énergie solaire reçue sur Terre, ce paramètre est pourtant le plus influant.

L'obliquité de l'écliptique. L'angle formé par la direction des pôles et celle de la normale au plan de l'écliptique n'est pas constant. Il varie entre 22° et 24,5° suivant une période de 41.000 ans. Ainsi, suivant l'obliquité, les pôles ne recevront pas le même éclairement.

Précession des équinoxes. La Terre tourne sur elle-même telle une toupie. L'axe de rotation de la Terre balaie un cône, mais celui-ci varie avec une période de 20.000 ans. L'inclinaison de l'axe de rotation terrestre n'affecte pas la quantité totale de chaleur solaire reçue sur Terre, mais sa distribution.

La théorie astronomique de Milankovitch explique de façon satisfaisante les grandes variations climatiques des cycles glaciaires.

A qui le numéro de portable

 francy-annu.com

C'est GRATUIT, mais car il y a un MAIS, c'est le numéro de quelqu'un qui a eu ce numéro en premier.
Essayez donc avec votre numéro de portable, ou alors un site bidon, mais comme c'est gratuit ou serait l'intéret.
En résumé pas très intéressant, ce peut être aussi avec la portabilité du numéro d'un opérateur vers un autre. 
Tout en étant chez orange, vous gardez le numéro de chez free ou le contraire.

IL faut savoir que, quand vous quittez un opérateur, votre numéro est réattribué si vous ne faites pas la portabilité. 
Ce site peut avoir accès aux  1ère attributions  des numéros et donc le numéro ne correspond plus. 
Or certain ne changent jamais d'opérateurs car ils préfèrent rester avec le même, et donner leur argent aux actionnaires ou payer pour un débit lamentable, au même prix que celui qui à un débit 10 fois supérieur et au même prix.

A quoi sert le recensement

 Augmentation de certaine retraite

C'est tout simple, suivant ce qu'on fait on arrive à récupérer de l'argent et on mets des palliers ridicules sur 14 euros  et une variation  de 1 a 0.3 %.

Rassurez vous La sécu octroie 100€ pour une aide et pour 1 euros de plus de revenu, la supprime.

Aidons les sans abris, donnez aux retraités

lisez cet article

https://sympa-sympa.com/inspiration-histoires/un-chercheur-britannique-a-passe-60-jours-dans-la-rue-et-a-decide-quil-ne-donnerait-plus-jamais-dargent-aux-sans-abri-700360/