Read Write XOR Encoded String - V2.0.0

Partagez votre expérience de PureBasic avec les autres utilisateurs.
Backup
Messages : 14526
Inscription : lun. 26/avr./2004 0:40

Re: Read Write XOR Encoded String - V2.0.0

Message par Backup »

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 !





-
Avatar de l’utilisateur
Ulix
Messages : 315
Inscription : ven. 04/juin/2004 14:27
Localisation : Frontignan

Re: Read Write XOR Encoded String - V2.0.0

Message par Ulix »

@ Dobro

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
Backup
Messages : 14526
Inscription : lun. 26/avr./2004 0:40

Re: Read Write XOR Encoded String - V2.0.0

Message par Backup »

Merci :)
G-Rom
Messages : 3641
Inscription : dim. 10/janv./2010 5:29

Re: Read Write XOR Encoded String - V2.0.0

Message par G-Rom »

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.
Backup
Messages : 14526
Inscription : lun. 26/avr./2004 0:40

Re: Read Write XOR Encoded String - V2.0.0

Message par Backup »

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:
Guimauve
Messages : 1015
Inscription : mer. 11/févr./2004 0:32
Localisation : Québec, Canada

Re: Read Write XOR Encoded String - V2.0.0

Message par Guimauve »

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 : Tout sélectionner

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; 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 <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<<<<
Backup
Messages : 14526
Inscription : lun. 26/avr./2004 0:40

Re: Read Write XOR Encoded String - V2.0.0

Message par Backup »

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 : Tout sélectionner

; 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


Répondre