PureBasic

Forums PureBasic
Nous sommes le Sam 18/Mai/2013 19:06

Heures au format UTC + 1 heure




Poster un nouveau sujet Répondre au sujet  [ 22 messages ]  Aller à la page Précédente  1, 2
Auteur Message
 Sujet du message: Re: Read Write XOR Encoded String - V2.0.0
MessagePosté: Mar 14/Fév/2012 19:08 
Hors ligne
Avatar de l’utilisateur

Inscription: Lun 26/Avr/2004 0:40
Messages: 12943
Ulix a écrit:
EPB m'a l'air sacrement bon. Je l'envie en version Linux.Merci.


non pas vraiment, il rame pas mal sur les gros code !
je regrette de plus en plus d'avoir utilisé la librairie GoScintilla (scintilla simplifié )
qui est un super coup de pouce au départ, mais finalement, pas pratique
pour certaine fonctions , notamment, pour la completion, qui rame ...
je vais surement devoir refaire cette partie ...et ça ne m'amuse pas trop :?

je considère EPB comme un brouillon d'idées de toute façon :)

ce qui bloque surtout le transfere sous Linux , c'est Purebasic lui meme !
je me rends compte
qu'un langage comme Purebasic, qui oblige l'utilisation des API spécifique a un systeme d'exploitation est finalement un handicape !

-CreateMailslot_() transfère de données entre 2 prg

-sendmessage() diverse et varié pour changement de taille d'un onglet, coller du text ect ...

-ShowWindow_() , pour forcer le réaffichage d'une fenetre en multifenetré

-RedrawWindow_() , pour redessiner une fenetre et ses gadgets
parce que pour une raison incomprehensible, windows ne fait pas toujours ce travail

-ShellExecute_() , parce que Runprg ne marche pas toujours...sans raison apparente

-GetScrollPos_() pour récuperer la position d'un ascenseur

-GetClassName_(), SetTextColor_(), SetBkColor_(), DrawText_() pour colorer le texte du statubar en bas de fenetre (l'aide)

-LoadCursor_() pour changer le curseur (fleche, sablié)

-GetLastError_() surveille si le prg est deja en ram

-RegOpenKeyEx_(), RegQueryValueEx_(), RegCloseKey_() pour lire le registre

bon , je m’arrête la ! ;)

je donne du bois a ceux qui veulent couler Purebasic :lol:
mais voila, le fait est là !!
purebasic manque cruellement de fonctions !

personnellement, avant de gerer les Map (bien que ce soit surement tres utile) , j'aurai préféré qu'on puisse
colorer nos interfaces, qu'on puisse deplacer et connaitre la position des éléments d'une fenetre ,
et je ne parle pas des fonctions concernant le graphisme, le son, les joysticks ,les formules math, etc ....

chaque version de purebasic voient arrivé des trucs, qui me semble inutile (ou moins utiles, (les macro, les map)), au détriment de trucs utiles (comme ceux que je site !)

c'est bien d'avoir les maps (je ne m'en sert jamais) , mais il me semble plus interressant de colorer/décorer/formater nos interfaces/gadgets
sans avoir a jongler avec les Apis et autre librairie utilisateur !

retire les Api , Purebasic fait moins bien que plein d'autres basic (libertybasic,FreeBasic)! :)

pour programmer sous window , Purebasic est bien, mais croire qu'il soit multiplateforme , c'est de la science fiction a l'heure actuel !





-

_________________
Image


Haut
 Profil  
 
 Sujet du message: Re: Read Write XOR Encoded String - V2.0.0
MessagePosté: Mar 14/Fév/2012 19:29 
Hors ligne
Avatar de l’utilisateur

Inscription: Ven 04/Juin/2004 14:27
Messages: 236
@ Dobro

Citation:

purebasic manque cruellement de fonctions !

personnellement, avant de gerer les Map (bien que ce soit surement tres utile) , j'aurai préféré qu'on puisse
colorer nos interfaces, qu'on puisse deplacer et connaitre la position des éléments d'une fenetre ,
et je ne parle pas des fonctions concernant le graphisme, le son, les joysticks ,les formules math, etc ....

chaque version de purebasic voient arrivé des trucs, qui me semble inutile (ou moins utiles, (les macro, les map)), au détriment de trucs utiles (comme ceux que je site !)

c'est bien d'avoir les maps (je ne m'en sert jamais) , mais il me semble plus interressant de colorer/décorer/formater nos interfaces/gadgets
sans avoir a jongler avec les Apis et autre librairie utilisateur !


Je suis entièrement convaincu de celà !
J'ai le même point de vue ! Hélas...
J'espére que Fred va faire évoluer PB dans ce sens, PB a du retard (de mon point de vue)
et... je ne suis pas sûr que l'équipe PB en est conscience. :cry:

Celà ne change rien a EPB, au contraire, tu en n'a que plus de mérite :wink:

A+
Ulix


Haut
 Profil  
 
 Sujet du message: Re: Read Write XOR Encoded String - V2.0.0
MessagePosté: Mar 14/Fév/2012 19:32 
Hors ligne
Avatar de l’utilisateur

Inscription: Lun 26/Avr/2004 0:40
Messages: 12943
Merci :)

_________________
Image


Haut
 Profil  
 
 Sujet du message: Re: Read Write XOR Encoded String - V2.0.0
MessagePosté: Mar 14/Fév/2012 23:09 
En ligne

Inscription: Dim 10/Jan/2010 5:29
Messages: 2124
ce n'est pas le problème de pb en réalité , mais la multitude des api qui existe en dessous , api windows , gtk , qt , qt4 gtk2, gtk3, etc...
c'est un boulot pharaonique , c'est pour cela que j'avais dis une fois que PB devrais ressemblé plus au C , c'est à dire , un basic sans rien autour , pas de sprite , pas de windows , rien , juste le compilateur, et des headers ( .pbi ) qui fournissent le nécessaire pour l'utilisation des libs externes , comme en c.
de plus , ce serais opensource , facile de rajouté une fonctionnalité , le terme communauté prendrais tout son sens. Fred n'aurais plus qu'a ce concentré que sur le compilateur en lui même, et de faire des outils pour convertir du c/c++ en pb , ce qui est envisageable , à ce stade , pb serait au top.


Haut
 Profil  
 
 Sujet du message: Re: Read Write XOR Encoded String - V2.0.0
MessagePosté: Mer 15/Fév/2012 0:43 
Hors ligne
Avatar de l’utilisateur

Inscription: Lun 26/Avr/2004 0:40
Messages: 12943
je pense pour ma part que Pure Basic tel qu'il est n'est pas mal
l'ouverture des librairies n'est pas vraiment le problème
d'ailleurs je pense même que leur ouverture serai un problème
il n'y a qu'a voir combien de projets se sont crées (Dreamotion3D par ex )
et ont fini aux oubliettes... j'ai peur qu'en ouvrant les lib Purebasic , il en adviendrait de même pour beaucoup de projets ....

l’idéal serai d'avoir la Cross compilation ! :)

et donc pour ça au contraire , augmenter le nombre de fonctions...
colorations, sons, musique,fonctions de total control des gadgets (comme le placement des ascenseurs,dimension des onglet de panel . bref tout ce qui manque aujourd'hui)

de sorte qu'on ai le choix de pouvoir paramétrer nos programmes , et que ceux ci puissent tourner sous différent OS

mais meme sans allez jusque là , deja sous Windows , de pouvoir effectivement se passer
au maximum des Apis !

faire de Purebasic un Meta Basic , qui simplifie la vie, et pas comme il est maintenant
un langage qui oblige a etre expert en Api Windows (ou Linux)

le Principe du Basic c'est bien de Rendre accessible cela aux "Débutants"

ce qui a fait le succès du GFA Basic , c'etait son nombre de fonctions !
plus il y en avait, plus le langage etait considéré comme puissant
comme un mécano , plus il est outiller , moins il va galérer ...
il aura un tournevis pour chaque type de vis

pourquoi avoir proposé RunProgram()
qui singe ShellExecute_(), et ne rien avoir proposé pour colorer un bouton ?

il y a une incohérence, je trouve dans les propositions faite par les Fonctions Purebasic
a partir du moment ou Fred a décider de proposer la possibilité de faire un Gadget bouton
pourquoi ne pas avoir donné tout ce qu'il est possible de faire a un bouton (forme,couleur,Fonte,etc...)

je pense que Purebasic est coincé par le mode Multiplateforme , qui , aurait peut etre du etre envisagé plus tard (par la crosscompilation)
le fait de devoir sortir 3 versions , une pour Chaque OS , est un frein
ont a du coup 3 Purebasics 'moyen' , au lieu d'un seul Tres bon !
Attention , je ne veux pas diminuer le mérite, et le travail de l'équipe Fantaisie Sofware

c'est mon ressenti , ça fait pas mal d'année que je suis ce produit, et je ne vois pas trop ou il va ..

ne connaissant pas le fonctionnement interne de Purebasic (niveau développement)
mais sortir une fonction , et essayer de la faire tourner sur toutes les plateformes
n'est pas le meilleurs système, je pense

je ne sais pas comment fonctionne la Cross compilation, mais ça existe
donc, ça devrai etre faisable ...

je demande un Langage qui ne me bride pas
je préfère pouvoir colorer mes interfaces "Gadgetée" ,ne pas etre obligé de courir dans mes Codes exemples, en stock , pour récupérer les info de ma souris, etc...

je développe depuis pas mal de temps en Purebasic
et je réalise, que je passe plus de temps a chercher des trucs qui devraient etre simple a faire

coloration, souris (position,sur gadget?,forme de curseur,ya quoi dessous etc...), clavier(quel touche?,scancode,hook,etc... ),

bref, je perds un temps fou a rechercher des exemples de fonctionnement; simplement parce que le Purebasic, ne gère pas en Natif des trucs basic ! :)

je pense que Fred a trop le mental du programmeur Assembleur
faire des trucs complexe avec 4 fonctions pas tres puissante
et ça se ressent dans le purebasic..

alors qu'un basic c'est : faire des trucs complexe avec 1000 fonctions puissantes et simples !

le purebasic a des énormes trous de conception (Lacunes) , qui fait perdre son interet a long terme, je crois

ps: j'arrete le HS :lol:

_________________
Image


Haut
 Profil  
 
 Sujet du message: Re: Read Write XOR Encoded String - V2.0.0
MessagePosté: Mer 15/Fév/2012 4:34 
Hors ligne

Inscription: Mer 11/Fév/2004 0:32
Messages: 1015
Localisation: Québec, Canada
Bonjour à tous,

Pour ceux qui voudrait avoir une librairie plus complète pour la lecture et l'écriture sur fichier. Une commande par type standard.

Désolé si le code date de plusieurs mois.

A+
Guimauve

Code:
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Nom du projet : Read/Write XOR Encoded String
; Nom du fichier : Read Write XOR Encoded String.pb
; Version du fichier : 2.0.0
; Programmation : OK
; Programmé par : Guimauve
; Date : 11-06-2011
; Mise à jour : 13-06-2011
; Code PureBasic : 4.60
; Plateforme : Windows, Linux, MacOS X
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

Procedure.s XOREncodeString(P_Key.s, Text.s)
 
  If P_Key = ""
    P_Key = "XOREncode"
  EndIf
 
  KeyLength = Len(P_Key)
  TextLength = Len(Text)
 
  For TextIndex = 1 To TextLength
   
    For KeyIndex = 1 To KeyLength
      Char.c = Asc(Mid(Text, TextIndex, 1)) ! ~Asc(Mid(P_Key, KeyIndex, 1))
    Next
   
    Encoded.s = Encoded + Chr(Char)
   
  Next
 
  ProcedureReturn Encoded
EndProcedure

Procedure WriteXOREncodedByte(FileID.l, P_Key.s, P_Value.b)
 
  If P_Key = ""
    P_Key = "XOREncode"
  EndIf
 
  KeyLength = Len(P_Key)
  Text.s = Str(P_Value)
  TextLength = Len(Text)
 
  WriteLong(FileID, TextLength)
 
  For TextIndex = 1 To TextLength
   
    For KeyIndex = 1 To KeyLength
      Char.c = Asc(Mid(Text, TextIndex, 1)) ! ~Asc(Mid(P_Key, KeyIndex, 1))
    Next
   
    WriteCharacter(FileID, Char)
   
  Next
 
EndProcedure

Procedure WriteXOREncodedAscii(FileID.l, P_Key.s, P_Value.a)
 
  If P_Key = ""
    P_Key = "XOREncode"
  EndIf
 
  KeyLength = Len(P_Key)
  Text.s = Str(P_Value)
  TextLength = Len(Text)
 
  WriteLong(FileID, TextLength)
 
  For TextIndex = 1 To TextLength
   
    For KeyIndex = 1 To KeyLength
      Char.c = Asc(Mid(Text, TextIndex, 1)) ! ~Asc(Mid(P_Key, KeyIndex, 1))
    Next
   
    WriteCharacter(FileID, Char)
   
  Next
 
EndProcedure

Procedure WriteXOREncodedUnicode(FileID.l, P_Key.s, P_Value.u)
 
  If P_Key = ""
    P_Key = "XOREncode"
  EndIf
 
  KeyLength = Len(P_Key)
  Text.s = Str(P_Value)
  TextLength = Len(Text)
 
  WriteLong(FileID, TextLength)
 
  For TextIndex = 1 To TextLength
   
    For KeyIndex = 1 To KeyLength
      Char.c = Asc(Mid(Text, TextIndex, 1)) ! ~Asc(Mid(P_Key, KeyIndex, 1))
    Next
   
    WriteCharacter(FileID, Char)
   
  Next
 
EndProcedure

Procedure WriteXOREncodedWord(FileID.l, P_Key.s, P_Value.w)
 
  If P_Key = ""
    P_Key = "XOREncode"
  EndIf
 
  KeyLength = Len(P_Key)
  Text.s = Str(P_Value)
  TextLength = Len(Text)
 
  WriteLong(FileID, TextLength)
 
  For TextIndex = 1 To TextLength
   
    For KeyIndex = 1 To KeyLength
      Char.c = Asc(Mid(Text, TextIndex, 1)) ! ~Asc(Mid(P_Key, KeyIndex, 1))
    Next
   
    WriteCharacter(FileID, Char)
   
  Next
 
EndProcedure

Procedure WriteXOREncodedCharacter(FileID.l, P_Key.s, P_Value.c)
 
  If P_Key = ""
    P_Key = "XOREncode"
  EndIf
 
  KeyLength = Len(P_Key)
  Text.s = Str(P_Value)
  TextLength = Len(Text)
 
  WriteLong(FileID, TextLength)
 
  For TextIndex = 1 To TextLength
   
    For KeyIndex = 1 To KeyLength
      Char.c = Asc(Mid(Text, TextIndex, 1)) ! ~Asc(Mid(P_Key, KeyIndex, 1))
    Next
   
    WriteCharacter(FileID, Char)
   
  Next
 
EndProcedure

Procedure WriteXOREncodedInteger(FileID.l, P_Key.s, P_Value.i)
 
  If P_Key = ""
    P_Key = "XOREncode"
  EndIf
 
  KeyLength = Len(P_Key)
  Text.s = Str(P_Value)
  TextLength = Len(Text)
 
  WriteLong(FileID, TextLength)
 
  For TextIndex = 1 To TextLength
   
    For KeyIndex = 1 To KeyLength
      Char.c = Asc(Mid(Text, TextIndex, 1)) ! ~Asc(Mid(P_Key, KeyIndex, 1))
    Next
   
    WriteCharacter(FileID, Char)
   
  Next
 
EndProcedure

Procedure WriteXOREncodedLong(FileID.l, P_Key.s, P_Value.l)
 
  If P_Key = ""
    P_Key = "XOREncode"
  EndIf
 
  KeyLength = Len(P_Key)
  Text.s = Str(P_Value)
  TextLength = Len(Text)
 
  WriteLong(FileID, TextLength)
 
  For TextIndex = 1 To TextLength
   
    For KeyIndex = 1 To KeyLength
      Char.c = Asc(Mid(Text, TextIndex, 1)) ! ~Asc(Mid(P_Key, KeyIndex, 1))
    Next
   
    WriteCharacter(FileID, Char)
   
  Next
 
EndProcedure

Procedure WriteXOREncodedQuad(FileID.l, P_Key.s, P_Value.q)
 
  If P_Key = ""
    P_Key = "XOREncode"
  EndIf
 
  KeyLength = Len(P_Key)
  Text.s = Str(P_Value)
  TextLength = Len(Text)
 
  WriteLong(FileID, TextLength)
 
  For TextIndex = 1 To TextLength
   
    For KeyIndex = 1 To KeyLength
      Char.c = Asc(Mid(Text, TextIndex, 1)) ! ~Asc(Mid(P_Key, KeyIndex, 1))
    Next
   
    WriteCharacter(FileID, Char)
   
  Next
 
EndProcedure

Procedure WriteXOREncodedFloat(FileID.l, P_Key.s, P_Value.f)
 
  If P_Key = ""
    P_Key = "XOREncode"
  EndIf
 
  KeyLength = Len(P_Key)
  Text.s = StrF(P_Value, 14)
  TextLength = Len(Text)
 
  WriteLong(FileID, TextLength)
 
  For TextIndex = 1 To TextLength
   
    For KeyIndex = 1 To KeyLength
      Char.c = Asc(Mid(Text, TextIndex, 1)) ! ~Asc(Mid(P_Key, KeyIndex, 1))
    Next
   
    WriteCharacter(FileID, Char)
   
  Next
 
EndProcedure

Procedure WriteXOREncodedDouble(FileID.l, P_Key.s, P_Value.d)
 
  If P_Key = ""
    P_Key = "XOREncode"
  EndIf
 
  KeyLength = Len(P_Key)
  Text.s = StrD(P_Value, 25)
  TextLength = Len(Text)
 
  WriteLong(FileID, TextLength)
 
  For TextIndex = 1 To TextLength
   
    For KeyIndex = 1 To KeyLength
      Char.c = Asc(Mid(Text, TextIndex, 1)) ! ~Asc(Mid(P_Key, KeyIndex, 1))
    Next
   
    WriteCharacter(FileID, Char)
   
  Next
 
EndProcedure

Procedure WriteXOREncodedString(FileID.l, P_Key.s, P_Text.s)
 
  If P_Key = ""
    P_Key = "XOREncode"
  EndIf
 
  KeyLength = Len(P_Key)
  TextLength = Len(P_Text)
  WriteLong(FileID, TextLength)
 
  For TextIndex = 1 To TextLength
   
    For KeyIndex = 1 To KeyLength
      Char.c = Asc(Mid(P_Text, TextIndex, 1)) ! ~Asc(Mid(P_Key, KeyIndex, 1))
    Next
   
    WriteCharacter(FileID, Char)
   
  Next
 
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

Procedure.b ReadXOREncodedByte(FileID.l, P_Key.s)
 
  If P_Key = ""
    P_Key = "XOREncode"
  EndIf
 
  KeyLength = Len(P_Key)
  TextLength = ReadLong(FileID)
 
  For TextIndex = 1 To TextLength
   
    CharEncoded.c = ReadCharacter(FileID)
   
    For KeyIndex = 1 To KeyLength
      Char.c = CharEncoded ! ~Asc(Mid(P_Key, KeyIndex, 1))
    Next
   
    Encoded.s = Encoded + Chr(Char)
   
  Next 
 
  ProcedureReturn Val(Encoded)
EndProcedure

Procedure.a ReadXOREncodedAscii(FileID.l, P_Key.s)
 
  If P_Key = ""
    P_Key = "XOREncode"
  EndIf
 
  KeyLength = Len(P_Key)
  TextLength = ReadLong(FileID)
 
  For TextIndex = 1 To TextLength
   
    CharEncoded.c = ReadCharacter(FileID)
   
    For KeyIndex = 1 To KeyLength
      Char.c = CharEncoded ! ~Asc(Mid(P_Key, KeyIndex, 1))
    Next
   
    Encoded.s = Encoded + Chr(Char)
   
  Next 
 
  ProcedureReturn Val(Encoded)
EndProcedure

Procedure.u ReadXOREncodedUnicode(FileID.l, P_Key.s)
 
  If P_Key = ""
    P_Key = "XOREncode"
  EndIf
 
  KeyLength = Len(P_Key)
  TextLength = ReadLong(FileID)
 
  For TextIndex = 1 To TextLength
   
    CharEncoded.c = ReadCharacter(FileID)
   
    For KeyIndex = 1 To KeyLength
      Char.c = CharEncoded ! ~Asc(Mid(P_Key, KeyIndex, 1))
    Next
   
    Encoded.s = Encoded + Chr(Char)
   
  Next 
 
  ProcedureReturn Val(Encoded)
EndProcedure

Procedure.w ReadXOREncodedWord(FileID.l, P_Key.s)
 
  If P_Key = ""
    P_Key = "XOREncode"
  EndIf
 
  KeyLength = Len(P_Key)
  TextLength = ReadLong(FileID)
 
  For TextIndex = 1 To TextLength
   
    CharEncoded.c = ReadCharacter(FileID)
   
    For KeyIndex = 1 To KeyLength
      Char.c = CharEncoded ! ~Asc(Mid(P_Key, KeyIndex, 1))
    Next
   
    Encoded.s = Encoded + Chr(Char)
   
  Next 
 
  ProcedureReturn Val(Encoded)
EndProcedure

Procedure.c ReadXOREncodedCharacter(FileID.l, P_Key.s)
 
  If P_Key = ""
    P_Key = "XOREncode"
  EndIf
 
  KeyLength = Len(P_Key)
  TextLength = ReadLong(FileID)
 
  For TextIndex = 1 To TextLength
   
    CharEncoded.c = ReadCharacter(FileID)
   
    For KeyIndex = 1 To KeyLength
      Char.c = CharEncoded ! ~Asc(Mid(P_Key, KeyIndex, 1))
    Next
   
    Encoded.s = Encoded + Chr(Char)
   
  Next 
 
  ProcedureReturn Val(Encoded)
EndProcedure

Procedure.i ReadXOREncodedInteger(FileID.l, P_Key.s)
 
  If P_Key = ""
    P_Key = "XOREncode"
  EndIf
 
  KeyLength = Len(P_Key)
  TextLength = ReadLong(FileID)
 
  For TextIndex = 1 To TextLength
   
    CharEncoded.c = ReadCharacter(FileID)
   
    For KeyIndex = 1 To KeyLength
      Char.c = CharEncoded ! ~Asc(Mid(P_Key, KeyIndex, 1))
    Next
   
    Encoded.s = Encoded + Chr(Char)
   
  Next 
 
  ProcedureReturn Val(Encoded)
EndProcedure

Procedure.l ReadXOREncodedLong(FileID.l, P_Key.s)
 
  If P_Key = ""
    P_Key = "XOREncode"
  EndIf
 
  KeyLength = Len(P_Key)
  TextLength = ReadLong(FileID)
 
  For TextIndex = 1 To TextLength
   
    CharEncoded.c = ReadCharacter(FileID)
   
    For KeyIndex = 1 To KeyLength
      Char.c = CharEncoded ! ~Asc(Mid(P_Key, KeyIndex, 1))
    Next
   
    Encoded.s = Encoded + Chr(Char)
   
  Next 
 
  ProcedureReturn Val(Encoded)
EndProcedure

Procedure.q ReadXOREncodedQuad(FileID.l, P_Key.s)
 
  If P_Key = ""
    P_Key = "XOREncode"
  EndIf
 
  KeyLength = Len(P_Key)
  TextLength = ReadLong(FileID)
 
  For TextIndex = 1 To TextLength
   
    CharEncoded.c = ReadCharacter(FileID)
   
    For KeyIndex = 1 To KeyLength
      Char.c = CharEncoded ! ~Asc(Mid(P_Key, KeyIndex, 1))
    Next
   
    Encoded.s = Encoded + Chr(Char)
   
  Next 
 
  ProcedureReturn Val(Encoded)
EndProcedure

Procedure.f ReadXOREncodedFloat(FileID.l, P_Key.s)
 
  If P_Key = ""
    P_Key = "XOREncode"
  EndIf
 
  KeyLength = Len(P_Key)
  TextLength = ReadLong(FileID)
 
  For TextIndex = 1 To TextLength
   
    CharEncoded.c = ReadCharacter(FileID)
   
    For KeyIndex = 1 To KeyLength
      Char.c = CharEncoded ! ~Asc(Mid(P_Key, KeyIndex, 1))
    Next
   
    Encoded.s = Encoded + Chr(Char)
   
  Next 
 
  ProcedureReturn ValF(Encoded)
EndProcedure

Procedure.d ReadXOREncodedDouble(FileID.l, P_Key.s)
 
  If P_Key = ""
    P_Key = "XOREncode"
  EndIf
 
  KeyLength = Len(P_Key)
  TextLength = ReadLong(FileID)
 
  For TextIndex = 1 To TextLength
   
    CharEncoded.c = ReadCharacter(FileID)
   
    For KeyIndex = 1 To KeyLength
      Char.c = CharEncoded ! ~Asc(Mid(P_Key, KeyIndex, 1))
    Next
   
    Encoded.s = Encoded + Chr(Char)
   
  Next 
 
  ; ProcedureReturn ValD(Encoded)
 
  ; Solution temporaire afin de corriger le problème de
  ; précision sur les doubles de la fonction ValD()

  pos = FindString(Encoded, ".", 0)
  out.d = Val(Encoded)
 
  If pos = 0
   
    decimal_places.d = 0.0
   
  Else
   
    decimal_places$ = Mid(Encoded, pos + 1)
    Max = Len(decimal_places$)
   
    If Max > 18
      Max = 18
      decimal_places$ = Left(decimal_places$, Max)
    EndIf
   
    decimal_places.d = Val(decimal_places$) / Pow(10, Max)
   
  EndIf

  ProcedureReturn out + decimal_places
EndProcedure

Procedure.s ReadXOREncodedString(FileID.l, P_Key.s)
 
  If P_Key = ""
    P_Key = "XOREncode"
  EndIf
 
  KeyLength = Len(P_Key)
  TextLength = ReadLong(FileID)
 
  For TextIndex = 1 To TextLength
   
    CharEncoded.c = ReadCharacter(FileID)
   
    For KeyIndex = 1 To KeyLength
      Char.c = CharEncoded ! ~Asc(Mid(P_Key, KeyIndex, 1))
    Next
   
    Encoded.s = Encoded + Chr(Char)
   
  Next 
 
  ProcedureReturn Encoded
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< !!! WARNING - YOU ARE NOW IN A TESTING ZONE - WARNING !!! <<<<<
; <<<<< !!! WARNING - THIS CODE SHOULD BE COMMENTED - WARNING !!! <<<<<
; <<<<< !!! WARNING - BEFORE THE FINAL COMPILATION. - WARNING !!! <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
;
; P_Key.s = "PureBasic 4.60 Beta 3"
;
; Varw.w = 32760
; Varl.l = 2147483645
; Varq.q = 9223372036854775800
; Varf.f = 2 * #PI
; Vard.d = 3 * #PI
; Text.s = "J'aime les déesses nordiques super sexy !"
;
; Encoded.s = XOREncodeString(P_Key, Text)
; Decoded.s = XOREncodeString(P_Key, Encoded)
;
; Debug "; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<"
; Debug "; Essai sur chaine de caractère"
; Debug ""
; Debug Text
; Debug Encoded
; Debug Decoded
;
; Debug ""
; Debug "; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<"
; Debug "; Essai sur fichier"
; Debug ""
; Debug "Original : "
;
; Debug Varw
; Debug Varl
; Debug Varq
; Debug Varf
; Debug Vard
; Debug Text
; Debug ""
;
; If CreateFile(0, "Test.Enc")
;   
;   WriteXOREncodedWord(0, P_Key, Varw)
;   WriteXOREncodedLong(0, P_Key, Varl) 
;   WriteXOREncodedQuad(0, P_Key, Varq)
;   WriteXOREncodedFloat(0, P_Key, Varf)
;   WriteXOREncodedDouble(0, P_Key, Vard)
;   WriteXOREncodedString(0, P_Key, Text)
;   
;   CloseFile(0)
;   
; EndIf
;
; Debug "Depuis le fichier : "
;
; If ReadFile(1, "Test.Enc")
;   
;   Debug ReadXOREncodedWord(1, P_Key)
;   Debug ReadXOREncodedLong(1, P_Key)
;   Debug ReadXOREncodedQuad(1, P_Key)
;   Debug ReadXOREncodedFloat(1, P_Key)
;   Debug ReadXOREncodedDouble(1, P_Key)
;   Debug ReadXOREncodedString(1, P_Key)
;   
;   CloseFile(1)
;   DeleteFile("Test.Enc")
;   
; EndIf

; <<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< FIN DU FICHIER <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<<<<


Haut
 Profil  
 
 Sujet du message: Re: Read Write XOR Encoded String - V2.0.0
MessagePosté: Mer 15/Fév/2012 10:43 
Hors ligne
Avatar de l’utilisateur

Inscription: Lun 26/Avr/2004 0:40
Messages: 12943
ma contribution:
en 2005 j'avais fait un code pour le Xor
le voici (adapté pour la v4.00 ) :

ce code permet l'encodage/decodage d'un text , d'un fichier "txt" , ou bien d'un fichier binaire (image,exe,etc ...)
en principe marche pour le codage du contenu d'un dossier... mais je ne l'ai pas retesté depuis...

Code:
; codé par Dobro
; en purebasic 4.00
Declare  Open_Newwindow0()
Declare  encode_bin()
Declare .s Xor2(Password.s,text.s)
Declare  change_curseur(type)

;- Window Constants
;
Enumeration
   #Newwindow0
EndEnumeration

;- Gadget Constants
;
Enumeration
   #Text_0
   #Text_1
   #Text_2
   #Text_3
   #Text_4
   #garde
   #clip_board
   #charge_txt
   #encode
   #editor
   #clef
   #efface
   #sauve
   #charge_bin
   #encode_lot
EndEnumeration

;- Fonts
Global FontID1,nombre
FontID1 = LoadFont(1, "Arial", 24)

a=1
b=1

Global NewList buffer()



Open_Newwindow0()

Repeat ; Start of the event loop
   Event =WindowEvent() ; This line waits until an event is received from Windows
   WindowID = EventWindow() ; The Window where the event is generated, can be used in the gadget procedures
   GadgetID = EventGadget() ; Is it a gadget event?
   EventType = EventType() ; The event type
   
   
   select Event
      case  #PB_Event_Gadget
      select GadgetID
         case #charge_txt
         ClearGadgetItemList(#editor)
         flag$="txt"
         coder$=""
         Password$=""
         ClearList(buffer())
         NomFichier$ = OpenFileRequester ( "Charge" , "c:\" , "*.*" ,1)
         change_curseur(#IDC_WAIT) ; pour sablier
         file=OpenFile (#PB_Any, NomFichier$)
         If file<>0
            While Eof (file)=0
               coder$=coder$+ Chr ( ReadByte (file))
            Wend
            CloseFile (file)
            SetGadgetText(#editor, coder$)   
            change_curseur(# IDC_ARROW) ; pour normal
         EndIf
         case #charge_bin
         nombre=0
         ClearList(buffer())
         NomFichier$ = OpenFileRequester ( "Charge" , "c:\" , "*.*" ,1)
         file=OpenFile (#PB_Any, NomFichier$)
         If file<>0
            change_curseur(#IDC_WAIT) ; pour sablier
            While Eof (file)=0
               AddElement(buffer())
               buffer()= ReadByte (file)
               If buffer()<0
                  buffer()=buffer()+256
               EndIf
               nombre=nombre+1
            Wend
            CloseFile (file) 
            change_curseur( #IDC_ARROW) ; pour normal
            Global Dim encode(nombre)
            flag$="bin"
         EndIf
         
         case #encode_lot
         Chemin$ = PathRequester("choisir un dossier", "c:\")
         
         If ExamineDirectory(0, Chemin$ , "*.*") 
            change_curseur(#IDC_WAIT) ; pour sablier
            While NextDirectoryEntry(0)
               NomFichier$ = DirectoryEntryName(0)
               ; *************charge fichier************************ 
               If NomFichier$<>"." 
                  If NomFichier$<>".."
                     nombre=0
                     ClearList(buffer())   
                     
                     file= OpenFile (#PB_Any, Chemin$+NomFichier$)
                     If file<>0
                        While  Eof (file)=0 ; bug du purebasic
                           AddElement(buffer())
                           buffer()= ReadByte (file)
                           If buffer()<0
                              buffer()=buffer()+256
                           EndIf
                           nombre=nombre+1
                        Wend
                        CloseFile (file) 
                     EndIf
                     
                     Global Dim encode(nombre)
                     
                     flag$="bin"
                     
                     ;*************************************
                     encode_bin() ; on l'encode 
                     ; **************sauve le fichier*******************************
                     SetCurrentDirectory(Chemin$)
                     DeleteFile(NomFichier$)
                     file=OpenFile (#PB_Any, NomFichier$)
                     For i=0 To nombre
                        WriteByte(file,encode(i))
                     Next i
                     CloseFile (file) 
                     ; ******************************************
                     fait=fait+1
                     SetGadgetText(#clef, "nombre de fichier encodé :"+Str(fait)) 
                  EndIf
               EndIf
            Wend
            fait=0
            FinishDirectory(0)
            change_curseur(# IDC_ARROW) ; pour normal
            MessageRequester("ok","tout le dossier est (dé) codé avec la clef "+Chr(10)+Password$ )
         EndIf
         
         
         case  #clef
         Password$ = GetGadgetText(#clef)
         case #encode   
         
         If flag$="txt" or flag$=""
            ClearList(buffer()) 
            coder$= GetGadgetText(#editor)
            Password$ = GetGadgetText(#clef)
            decoder$= Xor2(Password$,coder$)   
            SetGadgetText(#editor, decoder$) 
            decoder$="":coder$=""
         EndIf
         
         If flag$="bin"
            encode_bin()
            MessageRequester("ok","vous pouvez sauver le binaire", #PB_MessageRequester_Ok )
            extention$=Right(NomFichier$ ,3)
            NomFichier$ = SaveFileRequester ( "Sauve" , NomFichier$ , extention$ ,1)
            file=OpenFile (#PB_Any, NomFichier$+"."+extention$)
            For i=0 To nombre
               WriteByte(file,encode(i))
            Next i
            CloseFile (file) 
         EndIf
         
         case #clip_board
         coder$= GetGadgetText(#editor)
         SetClipboardText(coder$)
         dobro=1
         case #editor
         coder$= GetGadgetText(#editor)
         case #efface
         ClearGadgetItemList(#editor)
         case #sauve
         If flag$="txt"
            coder$= GetGadgetText(#editor)
            NomFichier$ = SaveFileRequester ( "Sauve" , "c:\" , "*.*" ,1)
            file=OpenFile (#PB_Any, NomFichier$)
            WriteString(file,coder$,#PB_Ascii)
            CloseFile (file)
         EndIf
         If flag$="bin"
            extention$=Right(NomFichier$ ,3)
            NomFichier$ = SaveFileRequester ( "Sauve" , NomFichier$ , extention$ ,1)
            file=OpenFile (#PB_Any, NomFichier$+"."+extention$)
            For i=0 To nombre
               WriteByte(file,encode(i))
            Next i
            CloseFile (file) 
         EndIf
      Endselect
   Endselect
   
Until Event = #PB_Event_CloseWindow ; End of the event loop
ClearGadgetItemList(#editor)
End
;


Procedure Open_Newwindow0()
   If OpenWindow(#Newwindow0, 233, 10, 506, 549, "Outil XOR",  #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_TitleBar )
      If CreateGadgetList(WindowID(#Newwindow0))
         ButtonGadget(#encode, 20, 90, 120, 30, "encode/decode")
         ButtonGadget(#encode_lot, 350, 90, 120, 30, "encode/decode un dossier",#PB_Button_MultiLine)
         EditorGadget(#editor,20, 250, 460, 280)
         TextGadget(#Text_2, 5, 140, 50, 20, "Clef")
         StringGadget(#clef,25,140,460,20,"")
         ButtonGadget(#clip_board, 20, 190, 120, 30, "vers le clipboard")
         ButtonGadget(#sauve, 200, 190, 120, 30, "Sauve")
         ButtonGadget(#efface, 200, 90, 120, 30, "effacer l'editeur")
         TextGadget(#Text_3, 450, 10, 50, 20, "by Dobro")
         ButtonGadget(#charge_txt, 10, 10, 70, 30, "charge ")
         ButtonGadget(#charge_bin, 110, 10, 90, 30, "charge_binaire")
         TextGadget(#Text_4, 280, 10, 170, 20, "creer un fichier codé XOR")
      EndIf
   EndIf   
EndProcedure

Procedure encode_bin()
   
   Password$ = GetGadgetText(#clef)
   If Len( Password$ )<1
      MessageRequester("erreur","la clef est vide !!"+ Chr(10)+"le prg va quitter",#PB_MessageRequester_Ok)
      End
   EndIf
   
   Global Dim pass(Len(Password$)-1)
   For i=0 To Len(Password$)-1
      pass(i)=Asc(Mid(Password$,i+1,1))
   Next i
   ptr=0
   i=0
   ForEach buffer()
      pass=pass(ptr)
      byte=buffer()
      encode(i)= pass! byte 
      i=i+1
      ptr=ptr+1: If ptr>Len(Password$)-1:ptr=0:EndIf
   Next
   
EndProcedure




Procedure.s Xor2(Password.s,text.s) 
   text.s= RemoveString(text.s,Chr(10))
   p=0
   long_or = Len(text.s)
   long_pass = Len(Password.s)
   For i=1 To long_or
      p=p+1 : If p> long_pass:p=1:EndIf 
      car_pass.b=Asc(Mid(Password.s, p, 1))  ; recupere une lettre (son code ascii)du mot de pass
      car_text.b= Asc(Mid(text.s, i, 1)  ) ; recupere une lettre (son code ascii) du text a coder 
      If car_pass.b ! car_text.b=10 Or  car_pass.b ! car_text.b=11
         sorti.b=car_text.b
         Goto su
      EndIf 
      If  car_text.b=car_pass.b
         sorti.b=car_text.b
         Else
         sorti.b= car_pass.b ! car_text.b ; un petit XOR
      EndIf
      su:
      text_sorti.s=text_sorti.s+Chr(sorti.b) 
      
   Next i
   text.s= text_sorti.s
   text_sorti.s=""
   ProcedureReturn text.s
EndProcedure



Procedure change_curseur(type)
   ; IDC_APPSTARTING : curseur standard + sablier
   ; IDC_ARROW : curseur standard
   ; IDC_CROSS : croix
   ; IDC_IBEAM : texte
   ; IDC_ICON : Seulement Windows NT : Icône vide
   ; IDC_NO : Cercle barré (sens interdit)
   ; IDC_SIZE : Seulement Windows NT: 4 flèches : nord sud est ouest
   ; IDC_SIZEALL : Même chose que IDC_SIZE
   ; IDC_SIZENESW : 2 flèches : nordest et sudouest
   ; IDC_SIZENS : 2 flèches : nord et sud
   ; IDC_SIZENWSE : 2 flèches : nordouest et sudest
   ; IDC_SIZEWE : 2 flèches : ouest et sud
   ; IDC_UPARROW : 1 flèche : nord
   ; IDC_WAIT : Sablier 
   hcur=LoadCursor_(0, type )
   SetCursor_(hcur );
EndProcedure



;
; EPb



_________________
Image


Haut
 Profil  
 
Afficher les messages postés depuis:  Trier par  
Poster un nouveau sujet Répondre au sujet  [ 22 messages ]  Aller à la page Précédente  1, 2

Heures au format UTC + 1 heure


Qui est en ligne

Utilisateurs parcourant ce forum: Aucun utilisateur enregistré et 1 invité


Vous ne pouvez pas poster de nouveaux sujets
Vous ne pouvez pas répondre aux sujets
Vous ne pouvez pas éditer vos messages
Vous ne pouvez pas supprimer vos messages

Rechercher:
Aller à:  

 


Powered by phpBB © 2008 phpBB Group | Traduction par: phpBB-fr.com
subSilver+ theme by Canver Software, sponsor Sanal Modifiye